From 9c21ec3ae9c3b66028aacd9c82351874d1e8f0fa Mon Sep 17 00:00:00 2001 From: Raymond Date: Fri, 16 Apr 2010 16:03:26 +0200 Subject: [PATCH] Added SRL-update extension. Made a decompress/untar thread, so that this is no long thread-blocking :). --- Projects/SAMufasaGUI/psextension.pas | 1 + Projects/SAMufasaGUI/testunit.pas | 45 ++++++++----- Units/MMLAddon/PSInc/Wrappers/extensions.inc | 25 +++++-- Units/MMLAddon/mmisc.pas | 68 ++++++++++++++++++++ 4 files changed, 120 insertions(+), 19 deletions(-) diff --git a/Projects/SAMufasaGUI/psextension.pas b/Projects/SAMufasaGUI/psextension.pas index 0691aac..f1d84fa 100644 --- a/Projects/SAMufasaGUI/psextension.pas +++ b/Projects/SAMufasaGUI/psextension.pas @@ -135,6 +135,7 @@ begin Sender.AddFunction(@ext_UnTarEx,'function UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean;'); Sender.AddFunction(@DirectoryExists,'Function DirectoryExists (Const Directory : String) : Boolean;'); Sender.AddFunction(@FileExists,'Function FileExists (Const FileName : String) : Boolean;'); + Sender.AddFunction(@ForceDirectories,'function ForceDirectories(Const Dir: string): Boolean;'); Sender.AddFunction(@GetFiles, 'function GetFiles(Path, Ext: string): TStringArray;'); Sender.AddFunction(@GetDirectories,'function GetDirectories(Path: string): TstringArray;'); Sender.AddFunction(@ext_MessageDlg,'function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;'); diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 6a546e1..6f1aade 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -1098,7 +1098,6 @@ end; procedure TForm1.CreateDefaultEnvironment; var PluginsPath,extensionsPath : string; - FontUpdater : TProcThread; begin CreateSetting('Settings/Updater/CheckForUpdates','True'); CreateSetting('Settings/Updater/CheckEveryXMinutes','30'); @@ -2606,12 +2605,19 @@ begin end; procedure TForm1.FontUpdate; + procedure Idler; + begin + Application.ProcessMessages; + Sleep(25); + end; + var CurrVersion : integer; LatestVersion : integer; FontDownload : TDownloadThread; Stream : TStringStream; - Decompressed : TMemoryStream; + UnTarrer : TUntarThread; + Decompress : TDecompressThread; begin if UpdatingFonts then exit; @@ -2625,23 +2631,32 @@ begin FontDownload.InputURL:= LoadSettingDef('Settings/Fonts/UpdateLink',FontURL + 'Fonts.tar.bz2'); FontDownload.resume; while FontDownload.Done = false do - begin - Application.ProcessMessages; - Sleep(25); - end; + Idler; Stream := TStringStream.Create(FontDownload.ResultStr); try - Decompressed := DecompressBZip2(stream); - if UnTar(decompressed, FontPath,true) then + Decompress := TDecompressThread.Create(Stream); + Decompress.Resume; + while Decompress.Finished = false do + Idler; + if Decompress.Result <> nil then begin; - FormWriteln('Succesfully installed the new fonts!'); - SetSetting('Settings/Fonts/Version',IntToStr(LatestVersion),true); - if Assigned(self.OCR_Fonts) then - self.OCR_Fonts.Free; - Self.OCR_Fonts := TMOCR.Create(nil); - OCR_Fonts.InitTOCR(fontPath); + UnTarrer := TUntarThread.Create(Decompress.Result,FontPath,True); + UnTarrer.Resume; + while UnTarrer.Finished = false do + Idler; + if UnTarrer.Result then + begin; + FormWriteln('Succesfully installed the new fonts!'); + SetSetting('Settings/Fonts/Version',IntToStr(LatestVersion),true); + if Assigned(self.OCR_Fonts) then + self.OCR_Fonts.Free; + Self.OCR_Fonts := TMOCR.Create(nil); + OCR_Fonts.InitTOCR(fontPath); + end; + UnTarrer.Free; + Decompress.Result.Free; end; - Decompressed.free; + Decompress.free; finally Stream.Free; FontDownload.Free; diff --git a/Units/MMLAddon/PSInc/Wrappers/extensions.inc b/Units/MMLAddon/PSInc/Wrappers/extensions.inc index 4d608b3..14ae558 100644 --- a/Units/MMLAddon/PSInc/Wrappers/extensions.inc +++ b/Units/MMLAddon/PSInc/Wrappers/extensions.inc @@ -40,35 +40,52 @@ end; function ext_UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean; var Stream : TStringStream; - MS : TMemoryStream; + Untarrer : TUntarThread; begin result := false; try Stream := TStringStream.Create(Input); - result := UnTar(stream,outputdir,overwrite); + Untarrer := TUntarThread.Create(stream,outputdir,overwrite); + Untarrer.Resume; + while Untarrer.Finished = false do + begin + Application.ProcessMessages; + sleep(25); + end; + result := Untarrer.Result; finally + Untarrer.Free; stream.free; end; end; function ext_DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean; var Stream : TStringStream; + Decompress : TDecompressThread; MS : TMemoryStream; begin result := false; try Stream := TStringStream.Create(Input); - ms := DecompressBZip2(Stream,blocksize); + Decompress := TDecompressThread.Create(Stream); + Decompress.Resume; + while Decompress.Finished = false do + begin + Application.ProcessMessages; + sleep(25); + end; + ms := Decompress.Result; if ms.size > 0 then begin ms.Position:= 0; SetLength(output,ms.Size); MS.Read(output[1],MS.size); - ms.free; result := true; end; + ms.free; finally stream.free; + Decompress.Free; end; end; diff --git a/Units/MMLAddon/mmisc.pas b/Units/MMLAddon/mmisc.pas index 45f3e4d..122049c 100644 --- a/Units/MMLAddon/mmisc.pas +++ b/Units/MMLAddon/mmisc.pas @@ -21,6 +21,35 @@ type procedure Execute; override; end; + { TDecompressThread } + + TDecompressThread = class(TThread) + private + FFinished : boolean; + Finput : TStream; + FBlockSize : Cardinal; + public + Result : TMemoryStream; + constructor Create(const input : TStream; const BlockSize : Cardinal = 4096); + procedure Execute; override; + property Finished : boolean read FFinished; + end; + + { TUntarThread } + + TUntarThread = class(TThread) + private + FFinished : boolean; + Finput : TStream; + FOverWrite : boolean; + FOutputDir : string; + public + Result : boolean; + constructor Create(const Input : TStream;const outputdir : string; overwrite : boolean); + procedure Execute; override; + property Finished : boolean read FFinished; + end; + implementation function DecompressBZip2(const input: TStream; const BlockSize: Cardinal): TMemoryStream; @@ -116,5 +145,44 @@ begin ClassProc; end; +constructor TDecompressThread.Create(const input: TStream; + const BlockSize: Cardinal); +begin + inherited Create(True); + FFinished:= False; + FBlockSize:= BlockSize; + FInput := Input; + Result := nil; +end; + +{ TDecompressThread } + +procedure TDecompressThread.Execute; +begin + if Finput <> nil then + result := DecompressBZip2(Finput,FBlocksize); + Ffinished := True; +end; + +{ TUntarThread } + +constructor TUntarThread.Create(const Input: TStream; const outputdir: string; + overwrite: boolean); +begin + inherited Create(true); + FFinished:= false; + FInput := Input; + FOutputDir:= OutputDir; + FOverWrite:= overwrite; + Result:= False; +end; + +procedure TUntarThread.Execute; +begin + if (Finput <> nil) and (FOutputDir <> '') then + result := UnTar(FInput,Foutputdir,FOverWrite); + FFinished:= True; +end; + end.