{ This file is part of the Simba Project Copyright (c) 2009 by Raymond van Venetiƫ and Merlijn Wajer Simba is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Simba is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with MML. If not, see . See the file COPYING, included in this distribution, for details about the copyright. Script Manager for the Simba project. } { Raymond`, 11-9-2010 20:26:27: ScriptManager/General/Settings.xml (Lijst van alle geinstaleerde scripts) ScriptManager/General//Info.xml (Informatie over het script) ScriptManager// (Alle files die het script nodig heeft) } unit scriptmanager; {$mode objfpc}{$H+} interface uses {$IFDEF UNIX}cthreads,cmem,{$ENDIF} Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ActnList, Menus, settings, updater,strutils, MufasaTypes, dom, mmisc, Simbasettings, SimbaUnit; type { TSimbaScript } TSimbaScript = class(TObject) private function IsInstalled: boolean; procedure LoadFromNode( Script : TDOMNode); public Name, Version, Author, Description, URL: String; Tags, Files: TStringList; LocalScript : TSimbaScript; // property Installed : boolean read IsInstalled; Installed : boolean; procedure Dbg; constructor Create; destructor Destroy; override; end; { TLSimbaScript } TLSimbaScript = class(TSimbaScript) //Installed Script (Local Simba Script) public AutoCheckUpdates : boolean; OnlineScript : TSimbaScript; procedure LoadFromFile(const filename : string); function LoadFromName(const ScriptName,maindir : string) : boolean; //Maindir = maindir of ScriptManager procedure SaveToFile(const FileName : string); procedure Save(const MainDir : string); //MainDir = maindir of ScriptManager constructor create; end; { TScriptManager } TScriptManager = class (TObject) private FMaindir: string; FRScripts : TList; //Array of the online scripts FLScripts : TList; //Array of the local scripts FRVersion : String; FUpdating : boolean; function GetLScriptCount: integer; function GetMainDir: string; function GetScript(index : integer): TSimbaScript; function GetRScriptCount: integer; function GetLScriptByName(name: string): TLSimbaScript; function isNewerVersion(ver1, ver2: string): boolean; procedure AppendRemoteDB(url: string); public function FindRScriptByName(name : string) : Integer; function FindLScriptByName(name : string) : Integer; property MainDir : string read GetMainDir write FMaindir; property SimbaScript[index : integer] : TSimbaScript read GetScript; procedure RUpdate; //Gets the online scripts procedure LUpdate; //Loads the local scripts, uses MainDir function NewVersion(Script : integer) : boolean; //Checks for updates for Script procedure InstallNewRScript(Script : integer); //Installs Script (Online -> Local) function UpdateLScript(Script : integer; ignoreupdating : boolean = false) : boolean; //Updates all the info/files of local script procedure LSave; //Saves the local scripts, uses MainDir property LScriptCount : integer read GetLScriptCount; //LScript = Local Script = Installed Script property RScriptCount : integer read GetRScriptCount; //Online script property Version : string read FRVersion; constructor Create; destructor Destroy; override; end; { TForm1 } TForm1 = class(TForm) Button1: TButton; Button2: TButton; GroupBox1: TGroupBox; ListView1: TListView; Memo1: TMemo; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure ClickItem(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange); private Mng : TScriptManager; public { public declarations } end; var Form1: TForm1; implementation uses XMLRead,XMLWrite; {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin Mng := TScriptManager.Create; ListView1.Columns.Add.Width:= ClientWidth; end; procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange); var Script : TSimbaScript; begin if Item.Data <> nil then begin Memo1.Clear; Script := TSimbaScript(Item.data); Memo1.Lines.add('Name: ' + Script.Name); Memo1.lines.add('Author: ' + Script.Author); Memo1.Lines.add('Version: ' + Script.Version); Memo1.Lines.add('Installed: '+ BoolToStr(Script.IsInstalled, true)); Memo1.Lines.add('Description: ' + Script.Description); end; end; procedure TForm1.ClickItem(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var item: TListItem; begin item := Form1.ListView1.GetItemAt(x, y); if item = nil then exit; if item.data = nil then exit; { Any selection causes the description to change } { form1.Memo1.Lines.Clear(); form1.Memo1.Lines.Append(TSimbaScript(item.data).Description); if Button = mbLeft then begin end else if Button = mbRight then begin { Popup Actions } Form1.ScriptPopup.Items[0].Caption:= 'Install ' + TSimbaScript(item.data).Name; Form1.ScriptPopup.PopUp(); end; //form1.Memo1.Text := TSimbaScript(item.data).Description; } end; procedure TForm1.Button1Click(Sender: TObject); var i, l: integer; Item : TListItem; begin Mng.LUpdate; Mng.RUpdate; ListView1.Items.Clear; for i := 0 to Mng.RScriptCount - 1 do begin Item := ListView1.Items.Add; Item.Data := Mng.SimbaScript[i]; Item.Caption := Mng.SimbaScript[i].Name; Item.SubItems.Add(Mng.SimbaScript[i].Author); end; end; procedure TForm1.Button2Click(Sender: TObject); var Script : TSimbaScript; begin if (ListView1.Selected <> nil) and (ListView1.Selected.Data <> nil) then begin Script := TSimbaScript(ListView1.Selected.Data); if Script.IsInstalled then begin ShowMessage('Updating Script "' + Script.Name + '"'); Mng.UpdateLScript(mng.FindRScriptByName(Script.Name)); ShowMessage('Finished Updating Script "' + Script.Name + '"'); end else begin ShowMessage('Installing Script "' + Script.Name + '"'); Mng.InstallNewRScript(mng.FindRScriptByName(Script.Name)); ShowMessage('Finished Installing Script "' + Script.Name + '"'); end; end; end; { TSimbaScript } function TSimbaScript.IsInstalled: boolean; begin Result := Self.Installed; end; procedure TSimbaScript.LoadFromNode(Script: TDOMNode); function NodeContents(ItemStr : string; node : TDOMNode) : string; var tmpNode : TDOMNode; begin result := ''; if node = nil then exit; tmpNode := node.FindNode(itemstr); if tmpNode <> nil then result := Trim(tmpNode.TextContent); end; function NodeSubContents(ItemStr : string; node : TDOMNode) : TStringList; var tmpNode : TDOMNode; begin Result := TStringList.Create; if node = nil then begin Result.Free; exit; end; tmpNode := node.FindNode(itemstr); if tmpNode <> nil then begin tmpNode := tmpNode.FirstChild; while tmpNode <> nil do begin Result.add(trim(tmpNode.TextContent)); tmpNode := tmpNode.NextSibling; end; end; end; begin Author:= NodeContents('Author',script); Name := NodeContents('Name',script); Version := NodeContents('Version',script); Description:= NodeContents('Description',script); Tags := NodeSubContents('Tags',script); Files := NodeSubContents('Files',script); URL := 'http://old.villavu.com/sm/scripts/'+Name+'.tar.bz2'; end; procedure TSimbaScript.Dbg; var i : integer; begin Writeln(Name); Writeln(' Author: ' + Author); Writeln(' Version: ' + Version); Writeln(' Description: ' + Description); Writeln(' Installed: '+ BoolToStr(Installed,true)); { Writeln(' Tags:'); for i := 0 to Tags.Count - 1 do Writeln(' ' + Tags[i]); Writeln(' Files:'); for i := 0 to Files.Count - 1 do Writeln(' ' + Files[i]); }end; constructor TSimbaScript.Create; begin inherited; Installed := False; {stuff here} end; destructor TSimbaScript.Destroy; begin if Files <> nil then FreeAndNil(Files); if Tags <> nil then FreeAndNil(Tags); {stuff here} inherited; end; { TScriptManager } function TScriptManager.GetLScriptByName(name: string): TLSimbaScript; var I : integer; Scr : TLSimbaScript; begin result := nil; for i := FLScripts.Count - 1 downto 0 do scr := TLSimbaScript(FLScripts[i]); if scr.Name = Name then result := scr; exit(); end; function TScriptManager.FindRScriptByName(name: string): Integer; var I : integer; begin for i := FRScripts.Count - 1 downto 0 do if TSimbaScript(FRScripts[i]).Name = Name then exit(i); result := -1; end; function TScriptManager.FindLScriptByName(name: string): Integer; var I : integer; begin for i := FLScripts.Count - 1 downto 0 do if TLSimbaScript(FLScripts[i]).Name = Name then exit(i); result := -1; end; function TScriptManager.GetLScriptCount: integer; begin result := FLScripts.Count; end; function TScriptManager.GetMainDir: string; begin result := IncludeTrailingPathDelimiter(FMainDir); end; function TScriptManager.GetScript(index : integer): TSimbaScript; begin result := TSimbaScript(FRScripts[index]); end; function TScriptManager.GetRScriptCount: integer; begin result := FRScripts.Count; end; procedure TScriptManager.RUpdate; var Databs : TStringList; X : integer; begin Databs := TStringList.Create; Databs.Add('http://tootoot222.hopto.org:8080/~mcteo/scriptman/scripts.xml'); // ShowMessage(SettingsForm.Settings.GetKeyValueDefLoad('Settings/SourceEditor/DefScriptPath', ,SimbaSettingsFile)); ShowMessage(SimbaSettingsFile); // ShowMessage(LoadSettingDef('Settings/SourceEditor/DefScriptPath', ExpandFileName(MainDir+DS+'default.simba'))); FRScripts.Clear(); for X := 0 to Databs.Count-1 do begin AppendRemoteDB(Databs[X]); end; Databs.Free; end; { Downloads online scripts.xml and parses it, populating FRScripts } procedure TScriptManager.AppendRemoteDB(url: string); var XMLFile : string; Stream : TStringStream; XMLDoc : TXMLDocument; Node,Script : TDOMNode; Subs : TStringList; Down : TDownloadThread; SScript : TSimbaScript; LScr : TLSimbaScript; I : integer; begin if FUpdating then exit; FUpdating := True; // Down := TDownloadThread.Create('http://old.villavu.com/sm',@XMLFile); Down := TDownloadThread.Create(url, @XMLFile); // Down := TDownloadThread.Create('http://tootoot222.hopto.org:8080/~mcteo/scriptman/scripts.xml',@XMLFile); down.Execute; while down.Done = false do begin Application.ProcessMessages; Sleep(25); end; Stream := TStringStream.Create(XMLFile); ReadXMLFile(XMLDoc,Stream); Stream.Free; Node := XMLDoc.FirstChild.FindNode('Version'); if node <> nil then FRVersion:= Node.TextContent; Node := XMLDoc.FirstChild.FindNode('ScriptList'); if node <> nil then begin script := Node.FirstChild; WriteLn('loading remote script from online db'); while Script <> nil do begin SScript := TSimbaScript.Create; SScript.LoadFromNode(Script); i := FindRScriptByName(SScript.Name); if (i = -1) then // if no remote scripts with same name begin i := FindLScriptByName(SScript.Name); if (i = -1) then // if no local scripts with same name begin FRScripts.Add(SScript); end else // there is a local script with same name begin LScr := GetLScriptByName(SScript.Name); if (LScr <> nil) then begin if isNewerVersion(SScript.Version, LScr.Version) then // if local script is older begin SScript.Installed := True; FRScripts.Add(SScript); // add newer version of script end; end; end; end else begin SScript.free; // TSimbaScript(FScripts[i]).LoadFromNode(Script); end; Script := Script.NextSibling; end; WriteLn('finished loading remote script from online db'); end; XMLDoc.Free; FUpdating := false; // MatchLocalOnline; end; { Opens local scripts.xml and parses it, populating FLScripts } procedure TScriptManager.LUpdate; var XMLDoc : TXMLDocument; Node,Script,tmpNode : TDOMNode; Subs : TStringList; Down : TDownloadThread; SScript : TLSimbaScript; I : integer; begin if DirectoryExists(MainDir) = false then exit; WriteLn('Reading XML Config file from "' + maindir + 'General' + DirectorySeparator+ 'scripts.xml"'); if FileExists(maindir + 'General' + DirectorySeparator+ 'scripts.xml') then begin ReadXMLFile(XMLDoc,maindir + 'General' + DirectorySeparator+ 'scripts.xml'); // Node := XMLDoc.FirstChild.FindNode('ScriptList'); Node := XMLDoc.FindNode('ScriptList'); if node <> nil then begin FLScripts.Clear(); script := Node.FirstChild; WriteLn('loading local script from local db'); while script <> nil do begin SScript := TLSimbaScript.Create; tmpNode := script.FindNode('Name'); if tmpNode <> nil then begin SScript.LoadFromName(Trim(tmpNode.TextContent), maindir); i := FindLScriptByName(SScript.Name); if (i = -1) then begin FLScripts.Add(SScript); end else begin SScript.free; TLSimbaScript(FLScripts[i]).LoadFromName(Node.TextContent,maindir); end; end; script := script.NextSibling; end; WriteLn('finished loading local scripts from local db'); end; XMLDoc.Free; end; end; { Compares versions and returns true if ver1 > ver2 } function TScriptManager.isNewerVersion(ver1, ver2: string): boolean; var v1, v2: Extended; begin v1 := StrToFloat(ver1); v2 := StrToFloat(ver2); result := (v1 > v2); end; function TScriptManager.NewVersion(Script: integer): boolean; begin // MatchLocalOnline; with TLSimbaScript(FLScripts[Script]) do result := OnlineScript.Version <> Version; end; { Sets up some vars/dirs and hands installation to update script func } procedure TScriptManager.InstallNewRScript(Script: integer); var Scrpt : TSimbaScript; LScrpt: TLSimbaScript; Dir : string; begin if FUpdating then exit; FUpdating := true; Scrpt := TSimbaScript(FRScripts[Script]); LScrpt := TLSimbaScript.create; LScrpt.Name:= Scrpt.Name; LScrpt.OnlineScript := Scrpt; Dir := MainDir + LScrpt.Name + DirectorySeparator; if DirectoryExists(dir) then Writeln('Directory already exists, yet continue?'); if not CreateDir(Dir) then Writeln('Failed to create dir..'); FLScripts.Add(LScrpt); UpdateLScript(FLScripts.Count - 1, true); end; { Downloads script files and puts them in their own directory, then triggers updating of local scripts.xml to match FLScripts } function TScriptManager.UpdateLScript(Script: integer; ignoreupdating : boolean = false) : boolean; var LScrpt : TLSimbaScript; Scrpt : TSimbaScript; DownloadThread : TDownloadDecompressThread; begin Result := true; if not NewVersion(Script) then Exit; if FUpdating and not ignoreupdating then exit; FUpdating := true; LScrpt := TLSimbaScript(FLScripts[Script]); Scrpt := LScrpt.OnlineScript; with LScrpt do begin Version:= Scrpt.Version; Name:= Scrpt.Name; Author := Scrpt.Author; Description:= Scrpt.Description; Tags.Assign(Scrpt.Tags); Files.Assign(Scrpt.Files); // URL := 'http://old.villavu.com/sm/scripts/'+name+ '.tar.bz2'; URL := 'http://tootoot222.hopto.org:8080/~mcteo/scriptman/'+name+'.tar.bz2'; end; LScrpt.Save(MainDir); //Saves the setting file, now we only need to update the files DownloadThread := TDownloadDecompressThread.Create(LScrpt.URL,MainDir + LScrpt.Name + DS,true); DownloadThread.execute; while DownloadThread.Done = false do begin Application.ProcessMessages; Sleep(25); end; Result := DownloadThread.Succeeded; DownloadThread.Free; LSave; //Update the scripts XML file FUPdating := false; end; { Updates local scripts.xml to match FLScripts } procedure TScriptManager.LSave; var XMLDoc : TXMLDocument; procedure AddTextElement(root : TDOMNode; Element : string; Text : string); var node : TDOMNode; begin Node := XMLDoc.createElement(Element); root.AppendChild(node); node.TextContent:= Text; end; var Node, ChildNode : TDOMNode; i : integer; begin if DirectoryExists(MainDir) = false then exit; XMLDoc := TXMLDocument.Create; Node := XMLDoc.CreateElement('ScriptList'); XMLDoc.AppendChild(node); for i := 0 to FLScripts.Count - 1 do begin TLSimbaScript(FLScripts[i]).Dbg; ChildNode := XMLDoc.CreateElement('Script'); AddTextElement(childnode,'Name', TLSimbaScript(FLScripts[i]).Name); Node.AppendChild(ChildNode); end; WriteXMLFile(XMLDoc,maindir + 'General' + DirectorySeparator+ 'scripts.xml'); XMLDoc.Free; end; constructor TScriptManager.Create; begin inherited; FLScripts := TList.Create; FRScripts := TList.Create; FRVersion := ''; FUpdating:= False; FMainDir:= ExtractFileDir(Application.ExeName); CreateDir(MainDir + 'General'); end; destructor TScriptManager.Destroy; begin while FRScripts.Count > 0 do begin TSimbaScript(FRScripts[0]).Free; FRScripts.Delete(0); end; while FLScripts.Count > 0 do begin TLSimbaScript(FLScripts[0]).Free; FLScripts.Delete(0); end; inherited Destroy; end; { TLSimbaScript } procedure TLSimbaScript.LoadFromFile(const filename: string); var XMLDoc : TXMLDocument; begin ReadXMLFile(XMLDoc,filename); Self.LoadFromNode(XMLDoc.FirstChild); XMLDoc.Free; end; function TLSimbaScript.LoadFromName(const ScriptName, MainDir : string) : boolean; begin Result := false; if FileExists(MainDir + 'General' + DirectorySeparator + ScriptName + DirectorySeparator + 'info.xml') then begin Result := true; LoadFromFile(MainDir + 'General' + DirectorySeparator + ScriptName + DirectorySeparator + 'info.xml'); end; end; procedure TLSimbaScript.SaveToFile(const FileName: string); var XMLDoc : TXMLDocument; procedure AddTextElement(root : TDOMNode; Element : string; Text : string); var node : TDOMNode; begin Node := XMLDoc.createElement(Element); root.AppendChild(node); node.TextContent:= Text; end; var Node,SubNode : TDOMNode; i : integer; begin XMLDoc := TXMLDocument.Create; Node := XMLDoc.CreateElement('Script'); XMLDoc.AppendChild(Node); AddTextElement(node,'Name',Name); AddTextElement(node,'Author',Author); AddTextElement(node,'Version',Version); AddTextElement(node,'Description',Description); AddTextElement(node,'AutoCheckUpdates', BoolToStr(AutoCheckUpdates,true)); SubNode := XMLDoc.CreateElement('Tags'); Node.AppendChild(SubNode); for i := 0 to Tags.Count - 1 do AddTextElement(SubNode,'Tag',Tags[i]); SubNode := XMLDoc.CreateElement('Files'); Node.AppendChild(SubNode); for i := 0 to Files.Count - 1 do AddTextElement(SubNode,'File',Files[i]); WriteXMLFile(XMLDoc,FileName); XMLDoc.Free; end; procedure TLSimbaScript.Save(const MainDir: string); begin if not DirectoryExists(MainDir + 'General' + DirectorySeparator + Name) then CreateDir(MainDir + 'General' + DirectorySeparator + Name); SaveToFile(MainDir + 'General' + DirectorySeparator + Name + DirectorySeparator + 'info.xml'); end; constructor TLSimbaScript.create; begin inherited; Tags := TStringList.Create; //Might leak, but careface Files := TStringList.create; //Same ^ AutoCheckUpdates:= true; end; end.