autoupdate.pas

autoupdate 1.02 source code

   FileOp.wFunc := FO_COPY;
   FileOp.pFrom := FromFile;
   FileOp.pTo := ToFile;
   FileOp.fFlags := FOF_NOCONFIRMATION or FOF_SIMPLEPROGRESS;
   FileOp.lpszProgressTitle := 'Copying file.  Please wait...';

   SHFileOperation(FileOp);

   if FileOp.fAnyOperationsAborted then
   begin
      if not CopyFile(PChar(Source), PChar(Dest), False) then
      begin
         ShowMessage('Fallback copy failed with error=' + IntTOStr(GetLastError) + ' ' + SysErrorMessage(GetLastError));
      end;
   end;

   StrDispose(FromFile);
   StrDispose(ToFile);
end;

procedure TAutoUpdate.PerformUpgrade;
var
   Progress : TItigProgressKnown;
   StartupInf : STARTUPINFO;
   ProcessInf : PROCESS_INFORMATION;
   OldFileName : String;
   i : Integer;
begin
   CreateInfo;

   // we do this twice to make sure that the ssl options are set correctly?
   //CheckServerVersion;
   CheckServerVersion;
   if Info.Option.ServerVersion >= AUTOUPDATE_VERSION then
   try
      // check server for new version
      Progress := TItigProgressKnown.Create(self);
      try
         Progress.AutoClose := True;
         Progress.Execute(wtDownload, Info);
         if Info.GetResult = irOK then
         begin
            // copy the file...
            OldFileName := DestinationFile + '.old';
            if FileExists(OldFileName) then
            begin
               i := 1;
               while True do
               begin
                  OldFileName := DestinationFile + '.old.' + IntToStr(i);
                  if not FileExists(OldFileName) then
                  begin
                     break;
                  end;
                  Inc(i);
               end;
            end;
            ShellCopyFile(0, DestinationFile, OldFileName);
            ShellCopyFile(0, Info.Option.DownloadedFile, DestinationFile);

            // start the new application
            FillMemory(@StartupInf, sizeof(STARTUPINFO), 0);
            FillMemory(@ProcessInf, sizeof(PROCESS_INFORMATION), 0);

            StartupInf.cb := Sizeof(StartupInf);
            if CreateProcess( nil,
                           PChar(DestinationFile),
                           nil,
                           nil,
                           False,
                           0,
                           nil,
                           nil,
                           StartupInf,
                           ProcessInf)
               then
            begin
               CloseHandle(ProcessInf.hProcess);
               CloseHandle(ProcessInf.hThread);
               Application.Terminate;
            end
            else
            begin
               MessageDlg('Error restarting upgraded application', mtError, [mbOK], 0);
            end;
         end
         else
         begin
            MessageDlg('The AutoUpdate procedure failed.', mtError, [mbOK], 0);
         end;
      finally
         Info.ClearResult;
         Progress.Free;
      end;
   finally
   end
   else
   begin
      MessageDlg('AutoUpdate Server Version does not match.  Please try manual upgrade', mtInformation, [mbOK], 0);
   end;
end;

function TAutoUpdate.DownloadHelper(Helper : String) : Boolean;
var
   Progress : TItigProgressKnown;
   F : TBinaryFile;
begin
   Result := false;
   CreateInfo;
   Info.Option.DownloadedFile := Helper;
   try
      // check server for new version
      Progress := TItigProgressKnown.Create(self);
      try
         Progress.AutoClose := True;
         Progress.Execute(wtGetHelper, Info);
         if Info.GetResult = irOK then
         begin
            //MessageDlg('Success', mtInformation, [mbOK], 0);
            // check the file size...
            f := TBinaryFile.Create;
            try
               f.Assign(Helper);
               if f.FileSize > 0 then
               begin
                  Result := True;
               end
               else
               begin
                  f.Delete;
               end;
            finally
               f.Free;
            end;
         end
         else
         begin
            MessageDlg('The AutoUpdate procedure failed.', mtError, [mbOK], 0);
            try
               DeleteFile(Helper);
            except
            end;
         end;
      finally
         Info.ClearResult;
         Progress.Free;
      end;
   finally
   end;
end;

procedure TAutoUpdate.StartUpgrade;
var
   Helper : String;
   Command : String;
   StartupInf : STARTUPINFO;
   ProcessInf : PROCESS_INFORMATION;
   Error : DWORD;
begin
   // Always Download a new helper app
   Helper := ExtractFilePath(Application.ExeName) + 'autohelp.exe';

   if FileExists(Helper) then
   begin
      DeleteFile(Helper);
   end;


   if DownloadHelper(Helper) then
   begin

      FillMemory(@StartupInf, sizeof(STARTUPINFO), 0);
      FillMemory(@ProcessInf, sizeof(PROCESS_INFORMATION), 0);

      StartupInf.cb := Sizeof(StartupInf);
      // Start the helper and then kill ourself...
      // do we need to check security....?
      Command := Helper + ' ' + fURL + ' ' + fApplicationName + ' upgrade "' + Application.ExeName + '" ' + ResourceName;
      if IsDebuggerPresent then
      begin
         if MessageDlg('This process is currently being debugged.  Do you wish to create the child process?', mtError, [mbYes, mbNo], 0) = mrNo then
         begin
            exit;
         end;
      end;

      if CreateProcess( nil,
                     PChar(Command),
                     nil,
                     nil,
                     False,
                     0,
                     nil,
                     nil,
                     StartupInf,
                     ProcessInf)
         then
      begin
         CloseHandle(ProcessInf.hProcess);
         CloseHandle(ProcessInf.hThread);
         Application.Terminate;
      end
      else
      begin
         Error := GetLastError;
         MessageDlg('Error ' + IntToStr(Error) + ' starting upgrade procedure. ' + SysErrorMessage(Error), mtError, [mbOK], 0);
      end;
   end
   else
   begin
      // we could not download the helper so we can't upgrade
   end;
end;

procedure TAutoUpdate.ActionCheckServerVersionRPC(Context : TRPCContext);
var
   i : Integer;
begin
   Context.AddKeyValue('action', 'server_check');

   Context.Post.ScriptName := Context.Network.Option.GetScriptName;
   Context.Execute('');
   Debug(Context.Results.Text);

   Context.Network.Option.ServerVersion := 0;
   for i := 0 to Context.Keys.Count - 1 do
   begin
      if Context.Keys[i] = 'version' then
      begin
         Context.Network.Option.ServerVersion := StrToIntDef(Context.Values[i], 0);
      end;
   end;
end;

procedure TAutoUpdate.ActionCheckVersionRPC(Context : TRPCContext);
var
   i : Integer;
   Readme : String;
begin
   Context.AddKeyValue('action', 'check');
   Context.AddKeyValue('application', Context.Network.Option.ApplicationName);
   Context.AddKeyValue('version', Context.Network.Option.CurrentVersion);
   Context.AddKeyValue('versionno', IntToStr(Context.Network.Option.VersionNumber));

   Context.Post.ScriptName := Context.Network.Option.GetScriptName;
   Context.Execute('');
   Debug(Context.Results.Text);

   Context.Network.Option.Available := False;
   for i := 0 to Context.Keys.Count - 1 do
   begin
      if Context.Keys[i] = 'available' then
      begin
         if Context.Values[i] = 'true' then
         begin
            Context.Network.Option.Available := True;
         end;
      end;
      if Context.Keys[i] = 'readme' then
      begin
         if Length(Readme) > 0 then
         begin
            Readme := Readme + #10;
         end;
         Readme := Readme + Context.Values[i];
      end;
   end;

   Context.Network.Option.Readme := Readme;
end;

procedure TAutoUpdate.ActionDownloadRPC(Context : TRPCContext);
begin
   Context.AddKeyValue('action', 'download');
   Context.AddKeyValue('application', Context.Network.Option.ApplicationName);

   Context.Network.Option.DownloadedFile := Context.Network.Option.GetTempPath + Context.Network.Option.ApplicationName + '.autoupgrade';
   Context.ReceiveFile('', Context.Network.Option.DownloadedFile);
end;

procedure TAutoUpdate.ActionDownloadHelperRPC(Context : TRPCContext);
begin
   Context.AddKeyValue('action', 'gethelper');
   Context.AddKeyValue('application', Context.Network.Option.ApplicationName);

   Context.ReceiveFile('', Context.Network.Option.DownloadedFile);
end;

procedure TAutoUpdate.ActionDownloadFileRPC(Context : TRPCContext);
begin
   Context.AddKeyValue('action', 'getfile');
   Context.AddKeyValue('application', Context.Network.Option.ApplicationName);
   Context.AddKeyValue('filename', Context.Network.Option.DownloadedFile);
   Context.ReceiveFile('', Context.Network.Option.DownloadedFile);
end;

end.