Gehe zu deutscher Webseite

ViaThinkSoft CodeLib

This article is in:
CodeLibProgramming aidsDelphi

uses
  ShellAPI;

procedure PerformSoftwareUpdate;
var
  sl: TStringList;
const
  DOWNLOAD_ZIP = 'software_update.zip';
  VBS_SCRIPTNAME = 'software_update.vbs';
begin
  CopyFile('d:\test\TEST - Kopie.zip', PChar(IncludeTrailingPathDelimiter((ExtractFilePath(ParamStr(0))))+DOWNLOAD_ZIP), false); // TODO: Perform actual download of your file e.g. from a web server

  OwnParameters := '';
  for i := 1 to ParamCount do
  begin
    OwnParameters := OwnParameters + ParamStr(i) + ' ';
  end;
  OwnParameters := Trim(OwnParameters);

  sl := TStringList.Create;
  sl.Add('');
  sl.Add(''' Automatic program update');
  sl.Add(''' (C) 2022 Daniel Marschall, ViaThinkSoft');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Consts (will be set by the executing program)');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('ZipFile="'+IncludeTrailingPathDelimiter((ExtractFilePath(ParamStr(0))))+DOWNLOAD_ZIP+'"');
  sl.Add('ExtractTo="'+IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+'"');
  sl.Add('StartApp="'+ExtractFileName(ParamStr(0))+'"');
  sl.Add('Params="'+OwnParameters+'"');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Wait (be sure that the executing program is terminated)');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('WScript.Sleep 1000');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Now unpack the program files and overwrite if they already exist);
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('Set fso = CreateObject("Scripting.FileSystemObject")');
  sl.Add('''If the extraction location does not exist create it.');
  sl.Add('If NOT fso.FolderExists(ExtractTo) Then');
  sl.Add(' fso.CreateFolder(ExtractTo)');
  sl.Add('End If');
  sl.Add('''Extract the contants of the zip file.');
  sl.Add('set objShell = CreateObject("Shell.Application")');
  sl.Add('set FilesInZip=objShell.NameSpace(ZipFile).items');
  sl.Add('objShell.NameSpace(ExtractTo).CopyHere FilesInZip, 16 ''16=NoOverwriteConfirmation');
  sl.Add('Set fso = Nothing');
  sl.Add('Set objShell = Nothing');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Start our program again');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('Set objShell = CreateObject("Shell.Application")');
  sl.Add('objShell.ShellExecute ExtractTo+StartApp, Params, ExtractTo, "open", 1 ''1=normal');
  sl.Add('Set objShell = Nothing');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Delete this script and the update ZIP');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('Set fso = CreateObject("Scripting.FileSystemObject")');
  sl.Add('fso.DeleteFile(ZipFile)');
  sl.Add('fso.DeleteFile(WScript.ScriptFullName)');
  sl.Add('Set fso = Nothing');
  sl.Add('');
  sl.SaveToFile(VBS_SCRIPTNAME);
  FreeAndNil(sl);
  ShellExecute(handle, 'open', VBS_SCRIPTNAME, '', PChar(ExtractFilePath(ParamStr(0))), SW_NORMAL);
  Application.Terminate; // Important! We must not take longer than 1 second to exit!
end;
Daniel Marschall
ViaThinkSoft Co-Founder

Feedback? Problems? Please drop us a message!

Your name (optional):

E-mail address (optional):

Message: