From cc51baeebc8b69d9b1c4ce5a8e8f39ca8f8b2908 Mon Sep 17 00:00:00 2001 From: gbamber Date: Fri, 13 Jan 2017 18:56:56 +0000 Subject: [PATCH] To V0.2.0.0: Work-in-progress. Main functions working OK git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5638 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../lazautoupdate/latest_stable/lazupdate.lpk | 15 +- .../lazautoupdate/latest_stable/lazupdate.pas | 3 +- .../latest_stable/ulazautoupdate.pas | 506 ++++++------------ .../latest_stable/updatehmsource/updatehm.lpi | 94 ++-- .../latest_stable/updatehmsource/updatehm.lpr | 8 +- .../latest_stable/updatehmsource/updatehm.lps | 23 +- .../latest_stable/updatehmsource/updatehm.res | Bin 988 -> 984 bytes 7 files changed, 223 insertions(+), 426 deletions(-) diff --git a/components/lazautoupdate/latest_stable/lazupdate.lpk b/components/lazautoupdate/latest_stable/lazupdate.lpk index 6f2270c63..2c45146fb 100644 --- a/components/lazautoupdate/latest_stable/lazupdate.lpk +++ b/components/lazautoupdate/latest_stable/lazupdate.lpk @@ -52,8 +52,8 @@ A component for SourceForge Project Developers and end-users to update their app along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. "/> - - + + @@ -72,19 +72,20 @@ A component for SourceForge Project Developers and end-users to update their app + + + + - + - - - - + diff --git a/components/lazautoupdate/latest_stable/lazupdate.pas b/components/lazautoupdate/latest_stable/lazupdate.pas index d62c4cbd8..5c88de6b7 100644 --- a/components/lazautoupdate/latest_stable/lazupdate.pas +++ b/components/lazautoupdate/latest_stable/lazupdate.pas @@ -4,11 +4,12 @@ unit lazupdate; +{$warn 5023 off : no warning about unused units} interface uses ulazautoupdate, aboutlazautoupdateunit, VersionSupport, uappisrunning, - LazarusPackageIntf; + lazautoupdate_httpclient, LazarusPackageIntf; implementation diff --git a/components/lazautoupdate/latest_stable/ulazautoupdate.pas b/components/lazautoupdate/latest_stable/ulazautoupdate.pas index f2c238c24..8a9d42b04 100644 --- a/components/lazautoupdate/latest_stable/ulazautoupdate.pas +++ b/components/lazautoupdate/latest_stable/ulazautoupdate.pas @@ -1,8 +1,6 @@ unit ulazautoupdate; { - Original DownloadHTTP code: wiki.freepascal.org - Thread source: http://freepascalanswers.wordpress.com/2012/06/15/synapas-http-thread/ VersionSupport: Mike Thompson - mike.cornflake@gmail.com Added to and modified by minesadorada@charcodelvalle.com @@ -37,21 +35,18 @@ interface uses - Forms, Classes, SysUtils, strutils, LazUTF8,FileUtil,LazFileUtils, Dialogs, StdCtrls, - Buttons, httpsend, DateUtils, asyncprocess, zipper, LResources, + Forms, Classes, SysUtils, lazautoupdate_httpclient, strutils, + LazUTF8, FileUtil, LazFileUtils, Dialogs, StdCtrls, + Buttons, DateUtils, asyncprocess, zipper, LResources, VersionSupport, inifiles, aboutlazautoupdateunit, uappisrunning, LCLProc, - fileinfo , winpeimagereader {need this for reading exe info} + fileinfo, winpeimagereader {need this for reading exe info} , elfreader {needed for reading ELF executables} , machoreader {needed for reading MACH-O executables} - ; + {$IFDEF WINDOWS},Windows,ShellAPI{$ENDIF}; // Thanks to Windows 10 and 704 error const -// C_OnlineAppPath = -//'https://sourceforge.net/project/%s/files/%s/%s/download'; -// https://sourceforge.net/projects/lazautoupdate/files/updates/updatepackwin32.zip/download -// https://heanet.dl.sourceforge.net/project/lazautoupdate/updates/dboxmonitorwin64.zip C_OnlineAppPath = - 'http://sourceforge.net/projects/%s/files/%s/%s/download'; + 'https://sourceforge.net/projects/%s/files/%s/%s/download'; // [updatepath,projectname,filename] C_TLazAutoUpdateComponentVersion = '0.2.0'; C_LAUTRayINI = 'lauimport.ini'; @@ -104,13 +99,13 @@ const More checks on PrettyName V0.1.25:Changed default: CopyTree = TRUE V0.1.26:Updated uses clause for FileUtils. - V0.2.0: ?? + V0.2.0: Rewritten for 2017 } - C_TThreadedDownloadComponentVersion = '0.0.2'; + C_TThreadedDownloadComponentVersion = '0.0.3'; { V0.0.1: Initial alpha V0.0.2: Added fDebugmode to all classes and functions - V0.0.3: ?? + V0.0.3: Changed to http_client } C_OnlineVersionsININame = 'versions.ini'; // User can change C_UpdatesFolder = 'updates'; // User can change @@ -119,10 +114,13 @@ const C_GUIEntry = 'GUI'; C_ModuleEntry = 'Module'; {$IFDEF WINDOWS} - C_Updater = 'updatehm.exe'; + {$IFDEF CPU32}C_Updater = 'updatehmwin32.exe';{$ENDIF} + {$IFDEF CPU64}C_Updater = 'updatehmwin64.exe';{$ENDIF} C_LOCALUPDATER = 'lauupdate.exe'; - {$ELSE} - C_Updater = 'updatehm'; + {$ENDIF} + {$IFDEF LINUX} + {$IFDEF CPU32}C_Updater = 'updatehmlinux32';{$ENDIF} + {$IFDEF CPU64}C_Updater = 'updatehmlinux64';{$ENDIF} C_LOCALUPDATER = 'lauupdate'; {$ENDIF} @@ -188,14 +186,15 @@ type OnlineVersion: string) of object; TOnDownloaded = procedure(Sender: TObject; ResultCode, BytesDownloaded: integer) of object; - TOnDebugEvent = procedure(Sender: TObject; lauMethodName, lauMessage: string) of object; + TOnDebugEvent = procedure(Sender: TObject; lauMethodName, lauMessage: string) of + object; TLazAutoUpdate = class(TAboutLazAutoUpdate) private fSourceForgeProjectName: string; fApplicationVersionString: string; fApplicationVersionQuad: TVersionQuad; - fGuiQuad:TVersionQuad; + fGuiQuad: TVersionQuad; fProjectType: TProjectType; fThreadDownload: TThreadedDownload; fAppFileName: string; @@ -228,7 +227,7 @@ type fSilentMode: boolean; fLCLVersion, fWidgetSet, fFPCVersion, fLastCompiled, fTargetOS: string; fQuad: TVersionQuad; - fProgVersion:TProgramVersion; + fProgVersion: TProgramVersion; objFileVerInfo: TFileVersionInfo; procedure SetProjectType(AValue: TProjectType); // projectype=auOther property Sets @@ -248,7 +247,8 @@ type public constructor Create(AOwner: TComponent); override; - Procedure DebugTest; + destructor Destroy; override; + procedure DebugTest; {Main functions} // If NewVersionAvailable then DownloadNewVersion then UpdateToNewVersion // Returns TRUE if GUIVersion > AppVersion @@ -301,7 +301,7 @@ type property LastError: string read fLastError; // Debugging use only property DebugMode: boolean read fDebugMode write SetDebugMode; -// property AppVersionNumber: integer read fApplicationVersionQuad; + // property AppVersionNumber: integer read fApplicationVersionQuad; // Info useful for About dialogs property LCLVersion: string read fLCLVersion; @@ -317,7 +317,8 @@ type property OnDebugEvent: TOnDebugEvent read fOnDebugEvent write fOnDebugEvent; // Embedded class - property ThreadDownload: TThreadedDownload read fThreadDownload write fThreadDownload; + property ThreadDownload: TThreadedDownload + read fThreadDownload write fThreadDownload; // Set this property before using methods property SFProjectName: string read fSourceForgeProjectName write SetSourceForgeProjectName; @@ -334,7 +335,7 @@ type // Version of this component property AutoUpdateVersion: string read fComponentVersion; // Zipfile contains a whole directory tree (relative to App Directory) - property CopyTree: boolean read fCopyTree write fCopyTree default TRUE; + property CopyTree: boolean read fCopyTree write fCopyTree default True; // Default is 'updates' *must be the same in SourceForge file section* property UpdatesFolder: string read fUpdatesFolder write fUpdatesFolder; // Default=versions.ini File in SourceForge /updates folder @@ -345,7 +346,8 @@ type // Set to FALSE if you want to handle them in form code property ShowDialogs: boolean read fShowDialogs write SetShowDialogs default False; // How many counts to wait until 'Too long' meesage quits out - property VersionCountLimit: cardinal read fVersionCountLimit write fVersionCountLimit; + property VersionCountLimit: cardinal read fVersionCountLimit + write fVersionCountLimit; // How many counts to wait until 'Too long' meesage quits out property DownloadCountLimit: cardinal read fDownloadCountLimit write fDownloadCountLimit; @@ -416,8 +418,9 @@ type // Non-threaded version (redundant v0.0.1) -function DownloadHTTP(URL, TargetFile: string; - var ReturnCode, DownloadSize: integer; bIsSourceForge, fDebugMode: boolean): boolean; + +function DownloadHTTP(URL, TargetFile: string; var ReturnCode, DownloadSize: integer; + bIsSourceForge, fDebugMode: boolean): boolean; procedure Register; @@ -443,9 +446,9 @@ begin while MilliSecondOfTheDay(Now) < (ThisSecond + MillisecondDelay) do ; end; -Procedure TLazAutoUpdate.DebugTest; +procedure TLazAutoUpdate.DebugTest; begin - ShowMessage(fApplicationVersionString); + ShowMessage(fApplicationVersionString); end; constructor TLazAutoUpdate.Create(AOwner: TComponent); @@ -470,29 +473,30 @@ begin // Grab the application and form objects from the application fParentApplication := Tapplication(AOwner.Owner); fParentForm := TForm(AOwner); - fApplicationVersionString:='No build information available'; - objFileVerInfo:=TFileVersionInfo.Create(fParentApplication); - TRY - Try - objFileVerInfo.Filename:=ParamStrUTF8(0); - objFileVerInfo.ReadFileInfo; - fApplicationVersionString:=objFileVerInfo.VersionStrings.Values['FileVersion']; - fileinfo.GetProgramVersion(fApplicationVersionQuad); - fileinfo.GetProgramVersion(fProgVersion); - Except - // Eat other Exceptions? - On E:EResNotFound do - ShowMessage('There is no version information in your project!'); - On E:Exception do Application.Terminate; - end; + fApplicationVersionString := 'No build information available'; + objFileVerInfo := TFileVersionInfo.Create(fParentApplication); + try + try + objFileVerInfo.Filename := ParamStrUTF8(0); + objFileVerInfo.ReadFileInfo; + fApplicationVersionString := objFileVerInfo.VersionStrings.Values['FileVersion']; + fileinfo.GetProgramVersion(fApplicationVersionQuad); + fileinfo.GetProgramVersion(fProgVersion); + except + // Eat other Exceptions? + On E: EResNotFound do + ShowMessage('There is no version information in your project!'); + On E: Exception do + Application.Terminate; + end; finally - objFileVerInfo.Free; + objFileVerInfo.Free; end; // fApplicationVersionString := GetFileVersion; if (fApplicationVersionString = 'No build information available') then fApplicationVersionString := '0.0.0.0'; - fCopyTree := TRUE; // User can change + fCopyTree := True; // User can change // UpdateList: Redundant? AddToUpdateList('', LazUTF8.ParamStrUTF8(0), GetFileVersion, 0); @@ -553,10 +557,14 @@ begin AboutBoxVersion := C_TLazAutoUpdateComponentVersion; AboutBoxAuthorname := 'Gordon Bamber'; //AboutBoxOrganisation (string) - AboutBoxAuthorEmail := 'minesadorada@gmail.com'; + AboutBoxAuthorEmail := 'minesadorada@charcodelvalle.com'; AboutBoxLicenseType := 'MODIFIEDGPL'; end; - +destructor TLazAutoUpdate.Destroy; +begin + FreeAndNil(fThreadDownload); + inherited destroy; +end; function TLazAutoUpdate.AppIsActive(const ExeName: string): boolean; begin Result := AppIsRunning(ExeName); @@ -820,7 +828,8 @@ begin VersionINI := TIniFile.Create(sznewINIPath); try fGUIOnlineVersion := VersionINI.ReadString(C_INISection, C_GUIEntry, '0.0.0.0'); - if NOT TryStrToVersionQuad(fGUIOnlineVersion,fGuiQuad) then fGUIQuad:=StrToVersionQuad('0.0.0.0'); + if not TryStrToVersionQuad(fGUIOnlineVersion, fGuiQuad) then + fGUIQuad := StrToVersionQuad('0.0.0.0'); finally VersionINI.Free; end; @@ -840,9 +849,10 @@ begin [iGUIVersion, fApplicationVersionQuad])); } // Test: Is the online version newer? - if NewerVersion(fGUIQuad,fApplicationVersionQuad) then Result:=TRUE; -// if (iGUIVersion > fApplicationVersionQuad) then -// Result := True; + if NewerVersion(fGUIQuad, fApplicationVersionQuad) then + Result := True; + // if (iGUIVersion > fApplicationVersionQuad) then + // Result := True; end; @@ -991,8 +1001,8 @@ begin end else if fFireDebugEvent then - fOndebugEvent(Self, 'NewVersionAvailable', - Format('DownloadSize was %d', [fDownloadSize])); + fOndebugEvent(Self, 'NewVersionAvailable', + Format('DownloadSize was %d', [fDownloadSize])); end; end; @@ -1213,7 +1223,7 @@ function TLazAutoUpdate.CreateLocalLauImportFile: boolean; var LAUTRayINI: TIniFile; szSection: string; - szSuffix:String; + szSuffix: string; begin // read the VMT once if Assigned(fOndebugEvent) then @@ -1227,14 +1237,14 @@ begin end; // Make up OS-Bitness suffix {$IFDEF WINDOWS} - szSuffix:='win'; + szSuffix := 'win'; {$ELSE} - szSuffix:='linux'; + szSuffix := 'linux'; {$ENDIF} {$IFDEF CPU64} - szSuffix+='64'; + szSuffix += '64'; {$ELSE} - szSuffix+='32'; + szSuffix += '32'; {$ENDIF} Result := False; LAUTRayINI := TIniFile.Create(ProgramDirectory + C_LAUTRayINI); @@ -1248,9 +1258,10 @@ begin szSection := fParentForm.Caption else szSection := 'My Application'; - If ((AnsiContainsText(szSection,{$I %FPCTARGETOS%}) = FALSE) - AND (AnsiContainsText(szSection,szSuffix) = FALSE)) then - szSection += szSuffix; + if ((AnsiContainsText(szSection, +{$I %FPCTARGETOS%} + ) = False) and (AnsiContainsText(szSection, szSuffix) = False)) then + szSection += szSuffix; WriteString(szSection, 'AppPrettyName', szSection); WriteString(szSection, 'AppPath', ExtractFilename(fAppFilename)); WriteString(szSection, 'INIPath', fVersionsININame); @@ -1334,14 +1345,14 @@ begin if not FileExistsUTF8(szDestLAUTrayPath + C_LAUTRayINI) then begin // Move C_LAUTRayINI from app folder to local folder - if CopyFile(szSourceLAUTrayPath, szDestLAUTrayPath + C_LAUTRayINI, + if FileUtil.CopyFile(szSourceLAUTrayPath, szDestLAUTrayPath + C_LAUTRayINI, [cffOverwriteFile]) then begin if fFireDebugEvent then fOndebugEvent(Self, 'RelocateLauImportFile', - Format('Relocated %s from %s to %s', [C_LAUTRayINI, - szSourceLAUTrayPath, szDestLAUTrayPath])); - DeleteFile(szSourceLAUTrayPath); + Format('Relocated %s from %s to %s', + [C_LAUTRayINI, szSourceLAUTrayPath, szDestLAUTrayPath])); + SysUtils.DeleteFile(szSourceLAUTrayPath); end else if fFireDebugEvent then @@ -1609,7 +1620,8 @@ begin // remotely shut down the app? if fSilentMode then begin - If AppIsRunning(ExtractFileName(fAppFilename)) then KillApp(ExtractFileName(fAppFilename)); + if AppIsRunning(ExtractFileName(fAppFilename)) then + KillApp(ExtractFileName(fAppFilename)); if fFireDebugEvent then fOndebugEvent(Self, 'RemoteUpdateToNewVersion', Format('Killing %s ready for update', [fAppFilename])); @@ -1628,9 +1640,28 @@ begin end; function TLazAutoUpdate.UpdateToNewVersion: boolean; + +{$IFDEF WINDOWS} +// function RunAsAdmin(const Handle: Hwnd; const Path, Params: string): Boolean; +function RunAsAdmin(const Handle: THandle; const Path, Params: string): Boolean; +var + sei: TShellExecuteInfoA; +begin + FillChar(sei, SizeOf(sei), 0); + sei.cbSize := SizeOf(sei); + sei.Wnd := Handle; + sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; + sei.lpVerb := 'runas'; + sei.lpFile := PAnsiChar(Path); + sei.lpParameters := PAnsiChar(Params); + sei.nShow := SW_SHOWNORMAL; + Result := ShellExecuteExA(@sei); +end; +{$ENDIF} var cCount: cardinal; szAppDir: string; + szParams:String; begin Result := False; szAppDir := AppendPathDelim(ExtractFilePath(fAppFilename)); @@ -1642,7 +1673,6 @@ begin fOndebugEvent(Self, 'UpdateToNewVersion', 'Entering UpdateToNewVersion'); - // Running update using updatehm? if not AppIsRunning(ExtractFileName(fAppFilename)) then Result := DoSilentUpdate @@ -1658,6 +1688,7 @@ begin Format(C_UpdaterMissing, [szAppDir + C_Updater])); Exit; end; + if not DirectoryExistsUTF8(szAppDir + fUpdatesFolder) then begin if fShowDialogs then @@ -1672,16 +1703,42 @@ begin // remotely shut down the app? if fSilentMode then begin - If AppIsRunning(ExtractFileName(fAppFilename)) then KillApp(ExtractFileName(fAppFilename)); + if AppIsRunning(ExtractFileName(fAppFilename)) then + KillApp(ExtractFileName(fAppFilename)); if fFireDebugEvent then fOndebugEvent(Self, 'UpdateToNewVersion', Format('Killing %s ready for update', [fAppFilename])); end; +{$IFDEF WINDOWS} + szParams:=ExtractFileName(fAppFilename); + szParams:=szParams + ' ' + fUpdatesFolder; + szParams:=szParams + ' ' + C_WhatsNewFilename; + szParams:=szParams + ' ' + fParentApplication.Title; + if (fCopyTree = True) then + szParams:=szParams + ' copytree'; + if fFireDebugEvent then + fOndebugEvent(Self, 'UpdateToNewVersion', + Format('Executing %s', [szAppDir + C_UPDATER])); + RunAsAdmin(fParentForm.Handle,szAppDir + C_UPDATER, szParams); + // Check for C_WhatsNewFilename in the app directory in a LOOP + if fFireDebugEvent then + fOndebugEvent(Self, 'UpdateToNewVersion', + Format('Waiting for %s', [szAppDir + C_WhatsNewFilename])); + while not FileExistsUTF8(szAppDir + C_WhatsNewFilename) do + begin + fParentApplication.ProcessMessages; + Inc(CCount); + if cCount > 10000000 then + Break; // Get out of jail in case updatehm.exe fails to copy file + end; +{$ELSE} // Update and re-start the app FUpdateHMProcess := TAsyncProcess.Create(nil); try +// FUpdateHMProcess.Executable := AppendPathDelim(GetAppConfigDir(false)) + C_Updater; FUpdateHMProcess.Executable := szAppDir + C_UPDATER; +// FUpdateHMProcess.CurrentDirectory := AppendPathDelim(GetAppConfigDir(false)); FUpdateHMProcess.CurrentDirectory := szAppDir; if not fSilentMode then FUpdateHMProcess.ConsoleTitle := @@ -1697,7 +1754,11 @@ begin if fFireDebugEvent then fOndebugEvent(Self, 'UpdateToNewVersion', Format('Executing %s', [szAppDir + C_UPDATER])); - FUpdateHMProcess.Execute; +TRY + FUpdateHMProcess.Execute; +EXCEPT + raise Exception.CreateFmt('Error %d: Run this application in Administrator mode or turn off UAC',[GetLastOSError]); +END; // Check for C_WhatsNewFilename in the app directory in a LOOP if fFireDebugEvent then @@ -1710,15 +1771,15 @@ begin if cCount > 10000000 then Break; // Get out of jail in case updatehm.exe fails to copy file end; - - finally - FUpdateHMProcess.Free; - if not fSilentMode then - fParentForm.Close; - end; +finally + FUpdateHMProcess.Free; +end; +{$ENDIF} if fFireDebugEvent then fOndebugEvent(Self, 'UpdateToNewVersion', 'Success'); + if not fSilentMode then + fParentForm.Close; Result := True; end; end; @@ -1914,298 +1975,39 @@ begin end; { End of class members} - -function DownloadHTTPStream(URL: string; Buffer: TStream; fDebugMode: boolean): boolean; - // Download file; retry if necessary. -const - MaxRetries = 3; -var - RetryAttempt: integer; - HTTPGetResult: boolean; -begin - Result := False; - RetryAttempt := 1; - HTTPGetResult := False; - while ((HTTPGetResult = False) and (RetryAttempt < MaxRetries)) do - begin - HTTPGetResult := HttpGetBinary(URL, Buffer); - //Application.ProcessMessages; - WaitFor(100 * RetryAttempt); - // Sleep(100 * RetryAttempt); - RetryAttempt := RetryAttempt + 1; - end; - if HTTPGetResult = False then - if fDebugmode then - raise Exception.Create(C_CannotLoadFromRemote); - Buffer.Position := 0; - if Buffer.Size = 0 then - if fDebugmode then - raise Exception.Create(C_DownloadIsEmpty) - else - Result := True; -end; - -function SFDirectLinkURL(URL: string; Document: TMemoryStream): string; -{ -Transform this part of the body: - -into a valid URL: -http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&ts=1329648745&use_mirror=kent -} -const - Refresh = ' 0 then - begin - URLStart := AnsiPos(URLMarker, HTMLBody[Counter]) + Length(URLMarker); - if URLStart > RefreshStart then - begin - // Look for closing " - URL := Copy(HTMLBody[Counter], URLStart, - PosEx('"', HTMLBody[Counter], URLStart + 1) - URLStart); - //infoln('debug: new url after sf noscript:'); - //infoln(URL); - break; - end; - end; - end; - finally - HTMLBody.Free; - end; - Result := URL; -end; - -function SourceForgeURL(URL: string; fDebugmode: boolean; - var AReturnCode: integer): string; - // Detects sourceforge download and tries to deal with - // redirection, and extracting direct download link. - // Thanks to - // Ocye: http://lazarus.freepascal.org/index.php/topic,13425.msg70575.html#msg70575 -// http://downloads.sourceforge.net/project/lazautoupdate/updates/updatepackwin32.ini?r=&ts=1481210267&use_mirror=heanet -const - SFProjectPart = '//sourceforge.net/projects/'; - SFFilesPart = '/files/'; - SFDownloadPart ='/download'; -var - HTTPSender: THTTPSend; - i, j: integer; - FoundCorrectURL: boolean; - SFDirectory: string; //Sourceforge directory - SFDirectoryBegin: integer; - SFFileBegin: integer; - SFFilename: string; //Sourceforge name of file - SFProject: string; - SFProjectBegin: integer; -begin - // Detect SourceForge download; e.g. from URL - // 1 2 3 4 5 6 7 8 9 - // 1234557890123456789012345578901234567890123455789012345678901234557890123456789012345578901234567890 - // http://sourceforge.net/projects/base64decoder/files/base64decoder/version%202.0/b64util.zip/download - // ^^^project^^^ ^^^directory............^^^ ^^^file^^^ - FoundCorrectURL := True; //Assume not a SF download - i := Pos(SFProjectPart, URL); - if i > 0 then - begin - // Possibly found project; now extract project, directory and filename parts. - SFProjectBegin := i + Length(SFProjectPart); - j := PosEx(SFFilesPart, URL, SFProjectBegin); - if (j > 0) then - begin - SFProject := Copy(URL, SFProjectBegin, j - SFProjectBegin); - SFDirectoryBegin := PosEx(SFFilesPart, URL, SFProjectBegin) + Length(SFFilesPart); - if SFDirectoryBegin > 0 then - begin - // Find file - // URL might have trailing arguments... so: search for first - // /download coming up from the right, but it should be after - // /files/ - i := RPos(SFDownloadPart, URL); - // Now look for previous / so we can make out the file - // This might perhaps be the trailing / in /files/ - SFFileBegin := RPosEx('/', URL, i - 1) + 1; - - if SFFileBegin > 0 then - begin - SFFilename := Copy(URL, SFFileBegin, i - SFFileBegin); - //Include trailing / - SFDirectory := Copy(URL, SFDirectoryBegin, SFFileBegin - SFDirectoryBegin); - // if fdebugmode then SHowMessage('SFFilename=' + SFFilename); - // if fdebugmode then SHowMessage('SFDirectory=' + SFDirectory); - FoundCorrectURL := False; - end; - end; - end; - end; - - if not FoundCorrectURL then - begin - try - // Rewrite URL if needed for Sourceforge download redirection - // Detect direct link in HTML body and get URL from that - HTTPSender := THTTPSend.Create; - //Who knows, this might help: - HTTPSender.UserAgent := - 'curl/7.21.0 (i686-pc-linux-gnu) libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18'; - while not FoundCorrectURL do - begin - HTTPSender.HTTPMethod('GET', URL); - // if fdebugmode then showmessagefmt('Return code is %d',[HTTPSender.Resultcode]); - // SEE: http_ReturnCodes.txt - case HTTPSender.Resultcode of - 301, 302, 307: - begin - for i := 0 to HTTPSender.Headers.Count - 1 do - Begin - // if fdebugmode then SHowMessage('Header string=' + HTTPSender.Headers.Strings[i]); - if (Pos('Location: ', HTTPSender.Headers.Strings[i]) > 0) or - (Pos('location: ', HTTPSender.Headers.Strings[i]) > 0) then - begin - // if fdebugmode then SHowMessage('Header string=' + LeftStr(HTTPSender.Headers.Strings[i],Length( HTTPSender.Headers.Strings[i]) div 2)); - //if fdebugmode then SHowMessage('Header string=' + RightStr(HTTPSender.Headers.Strings[i],Length( HTTPSender.Headers.Strings[i]) div 2)); - j := Pos('use_mirror=', HTTPSender.Headers.Strings[i]); - if j > 0 then - URL := - 'http://' + RightStr(HTTPSender.Headers.Strings[i], - length(HTTPSender.Headers.Strings[i]) - j - 10) + - 'downloads.sourceforge.net/project/' + SFProject + - '/' + SFDirectory + SFFilename - else - URL := StringReplace(HTTPSender.Headers.Strings[i], - 'Location: ', '', []); - HTTPSender.Clear;//httpsend - FoundCorrectURL := True; - AReturnCode := HTTPSender.Resultcode; - break; //out of rewriting loop - end; - end; - end; - 100..200: - begin - //Could be a sourceforge timer/direct link page, but... - if AnsiPos('Content-Type: text/html', HTTPSender.Headers.Text) > 0 then - begin - // find out... it's at least not a binary - URL := SFDirectLinkURL(URL, HTTPSender.Document); - end; - FoundCorrectURL := True; //We're done by now - AReturnCode := HTTPSender.Resultcode; - end; - 500: - begin - // if fDebugMode then ShowMessageFmt(C_Error500, [HTTPSender.ResultCode]); - AReturnCode := HTTPSender.Resultcode; - Break; - end; - //Raise Exception.Create('No internet connection available'); - //Internal Server Error ('+aURL+')'); - 404: - begin - // if fDebugMode then ShowMessageFmt(C_Error404, [HTTPSender.ResultCode]); - AReturnCode := HTTPSender.Resultcode; - Break; - end; - else - raise Exception.Create(C_DownloadFailedErrorCode + - IntToStr(HTTPSender.ResultCode) + ' (' + HTTPSender.ResultString + ')'); - end;//case - end;//while - finally - AReturnCode := HTTPSender.Resultcode; - HTTPSender.Free; - end; - end; - Result := URL; -end; - -function DownloadHTTP(URL, TargetFile: string; var ReturnCode, DownloadSize: integer; -bIsSourceForge, fDebugmode: boolean): boolean; +function DownloadHTTP(URL, TargetFile: string; + var ReturnCode, DownloadSize: integer; bIsSourceForge, fDebugmode: boolean): boolean; // Download file; retry if necessary. // Deals with SourceForge download links - // Could use Synapse HttpGetBinary, but that doesn't deal - // with result codes (i.e. it happily downloads a 404 error document) const MaxRetries = 3; var - HTTPGetResult : boolean; - HTTPSender : THTTPSend; - RetryAttempt,i : integer; + HTTPClient: TFPHTTPClient; + HTTPGetResult: boolean; + RetryAttempt, i: integer; begin Result := False; RetryAttempt := 1; - //Optional: mangling of Sourceforge file download URLs; see below. + HTTPClient := TFPHTTPClient.Create(nil); if bIsSourceForge then begin - URL := SourceForgeURL(URL, fDebugMode, ReturnCode); //Deal with sourceforge URLs - // if fDebugMode then ShowMessage(LeftStr(URL,Length(URL) div 2)); - // if fDebugMode then ShowMessage(RightStr(URL,Length(URL) div 2)); + HTTPClient.AllowRedirect:=True; end; // ReturnCode may not be useful, but it's provided here - HTTPSender := THTTPSend.Create; - try - try + try + try // Try to get the file - HTTPGetResult := HTTPSender.HTTPMethod('GET', URL); - - while (HTTPGetResult = False) and (RetryAttempt < MaxRetries) do - begin - WaitFor(500 * RetryAttempt); - // sleep(500 * RetryAttempt); - HTTPGetResult := HTTPSender.HTTPMethod('GET', URL); - RetryAttempt := RetryAttempt + 1; - end; - // If we have an answer from the server, check if the file - // was sent to us - ReturnCode := HTTPSender.Resultcode; - DownloadSize := HTTPSender.DownloadSize; - ShowMessageFmt('DownloadHTTP Return code=%d',[HTTPSender.Resultcode]); - ShowMessageFmt('DownloadHTTP Download Size=%d',[HTTPSender.DownloadSize]); - case HTTPSender.Resultcode of - 100..299: - begin - with TFileStream.Create(TargetFile, fmCreate or fmOpenWrite) do - try - Seek(0, soFromBeginning); - CopyFrom(HTTPSender.Document, 0); - finally - Free; - end; - Result := True; - end; //informational, success - 301: // moved permanently - begin - URL:=SourceForgeURL(URL,TRUE,ReturnCode); - ShowMessage(URL); - end; - 302..399: - Result := False; //redirection. Not implemented, but could be. - 400..499: Result := False; //client error; 404 not found etc - 500..599: Result := False; //internal server error - else - Result := False; //unknown code - end; - except + HTTPClient.Get(URL, TargetFile); + ReturnCode := HTTPClient.ResponseStatusCode; + DownloadSize := Filesize(TargetFile); + except // We don't care for the reason for this error; the download failed. Result := False; - end; - finally - HTTPSender.Free; - end; + end; + finally + HTTPClient.Free; + end; end; diff --git a/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lpi b/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lpi index 54118db8d..d9274c65d 100644 --- a/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lpi +++ b/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lpi @@ -1,7 +1,7 @@ - + @@ -13,8 +13,11 @@ - + + + + @@ -22,50 +25,17 @@ - + - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + @@ -87,13 +57,13 @@ - - + + - + @@ -115,13 +85,13 @@ - - + + - + @@ -146,13 +116,13 @@ - - + + - + @@ -174,8 +144,11 @@ + + + - + @@ -205,15 +178,32 @@ - + + + + + + + + + + + + + + + + - + + + diff --git a/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lpr b/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lpr index 741fd3769..5cd7026c9 100644 --- a/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lpr +++ b/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lpr @@ -67,7 +67,7 @@ uses const C_AppPrettyName = 'Lazarus Auto-Updater'; C_WhatsNewFileName = 'whatsnew.txt'; - C_Version = '0.0.14'; + C_Version = '0.0.15'; C_UpdatesDirectory = 'updates'; C_LogFileName = 'updatehmlog.txt'; C_LAUTRayINI = 'lauimport.ini'; @@ -120,9 +120,13 @@ var begin if ParamCount = 0 then begin + WriteLn('=========================================================='); Writeln(LineEnding + '==== updatehm v' + C_Version + ' - an lazautoupdate application ===='); Writeln('Usage: updatehm exename.exe [updatesfoldername] [whatnewfilename] [exePrettyName] [copytree]'); + WriteLn('=========================================================='); + WriteLn('Press any key to continue'); + ReadLn; Halt; end; @@ -135,6 +139,8 @@ begin WriteLn('optional parameters are'); WriteLn('-h or /h - this screen'); WriteLn('=========================================================='); + WriteLn('Press any key to continue'); + ReadLn; Halt; end; diff --git a/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lps b/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lps index 8422091d3..a672b489e 100644 --- a/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lps +++ b/components/lazautoupdate/latest_stable/updatehmsource/updatehm.lps @@ -2,15 +2,15 @@ - - + + - - + + @@ -134,26 +134,23 @@ - + - + - - + - + - - - + + - diff --git a/components/lazautoupdate/latest_stable/updatehmsource/updatehm.res b/components/lazautoupdate/latest_stable/updatehmsource/updatehm.res index 47798e1dcef377ed2bc44a56d9d3bbfe25ff4179..31b7b7796b8a1c3cea6b161a4a3ab5a1c5cea5c6 100644 GIT binary patch delta 68 zcmcb^euI620^^K{it<3hQJk# R=rI_8@MJ?~{mCyel5dQ!G delta 71 zcmcb?eusU60^^*Cit<3hQJRv8Ow1+>oRh7Y6?qL9^cV~o WOn{^T1H