autoupdate.pas

autoupdate 1.02 source code

unit AutoUpdate;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ItigProgressKnown, itignet, itigoptions, WinBinFile;

const wtCheckServer = 'CHECK_SERVER';
const wtCheckVersion = 'CHECK_VERSION';
const wtDownload = 'DOWNLOAD_APP';
const wtReportBug = 'REPORT_BUG';
const wtGetHelper = 'DOWNLOAD_HELPER';
const wtGetFile = 'DOWNLOAD_FILE';
const AUTOUPDATE_VERSION = 103;

type
  TAutoUpdate = class(TComponent)
  private
    { Private declarations }
    fApplicationName : String;
    fURL : String;
    fVersion : String;
    fVersionNo : Integer;
    fResourceName : String;

    fDebugMethod : TDebugMethod;
    fGetProxyMethod : TGetProxyFunction;

    Info : TItigNet;

    procedure CreateInfo;
    procedure StartUpgrade;
    function DownloadHelper(Helper : String) : Boolean;
    procedure CheckServerVersion;
  protected
    { Protected declarations }
  public
    DestinationFile : String;
    ResourceImage : String;
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure CheckForUpgrade(Verbose : Boolean);
    procedure PerformUpgrade;
    procedure SetVersion(NewVersion : String);
    procedure Debug(S : String);
    procedure GetFile(FileName : String);

    // ITIGNet RPC Calls
    procedure ActionCheckServerVersionRPC(Context : TRPCContext);
    procedure ActionCheckVersionRPC(Context : TRPCContext);
    procedure ActionDownloadRPC(Context : TRPCContext);
    procedure ActionDownloadHelperRPC(Context : TRPCContext);
    procedure ActionDownloadFileRPC(Context : TRPCContext);
  published
    { Published declarations }
    property ApplicationName : String read FApplicationName write FApplicationName;
    property URL : String read FURL write FURL;
    property DebugMethod : TDebugMethod read fDebugMethod write fDebugMethod;
    property Version : String read fVersion write SetVersion;
    property VersionNumber : Integer read fVersionNo write fVersionNo;
    property ResourceName : String read fResourceName write fResourceName;
    property OnGetProxy : TGetProxyFunction read fGetProxyMethod write fGetProxyMethod;
  end;

procedure Register;


implementation

uses ShellAPI, WinIOCTL;

type TIsDebuggerPresent = function : BOOL; stdcall;

function IsDebuggerPresent : BOOL;
var
   hModule : hInst;
//   Error : DWORD;
   JIsDebuggerPresent : TIsDebuggerPresent;
   P : Pointer;
begin
   Result := False;

   // see if we can get IsDebuggerPresent from kernel32.dll

   hModule := GetModuleHandle('kernel32.dll');
   if hModule = 0 then
   begin
      // wininet is not yet loaded...
      hModule := LoadLibrary('kernel32.dll');
      {if hModule = 0 then
      begin
         Error := GetLastError;
         //raise Exception.Create('Error loading Windows Internet Library.  ' + SysErrorMessage(Error));
      end;}
   end;

   if hModule <> 0 then
   begin
      P := GetProcAddress(hModule, 'IsDebuggerPresent');
      if P = nil then
      begin
         //raise Exception.Create('Could not find procedure ' + ProcName);
      end
      else
      begin
         JIsDebuggerPresent := p;
         Result := JIsDebuggerPresent;
      end;
   end;

end;

procedure Register;
begin
  RegisterComponents('Samples', [TAutoUpdate]);
end;

constructor TAutoUpdate.Create(AOwner: TComponent);
begin
   inherited;

   Info := nil;
end;

procedure TAutoUpdate.CreateInfo;
begin
   if not Assigned(Info) then
   begin
      Info := TItigNet.Create(0{Handle}, fDebugMethod, fGetProxyMethod);
      Info.RegisterRPC(wtCheckServer, ActionCheckServerVersionRPC);
      Info.RegisterRPC(wtCheckVersion, ActionCheckVersionRPC);
      Info.RegisterRPC(wtDownload, ActionDownloadRPC);
//      Info.RegisterRPC(wtReportBug, ActionReportBugRPC);
      Info.RegisterRPC(wtGetHelper, ActionDownloadHelperRPC);
      Info.RegisterRPC(wtGetFile, ActionDownloadFileRPC);
   end;
   Info.Option.SetURL(fURL);
   Info.Option.ApplicationName := fApplicationName;
   Info.Option.VersionNumber := fVersionNo;
   Info.Option.CurrentVersion := fVersion;
end;

procedure TAutoUpdate.Debug(S : String);
begin
   if Assigned(fDebugMethod) then
   begin
      fDebugMethod(s);
   end
end;

procedure TAutoUpdate.SetVersion(NewVersion : String);
begin
   fVersion := NewVersion;
   Inc(fVersionNo);
end;

procedure TAutoUpdate.CheckForUpgrade(Verbose : Boolean);
var
   Progress : TItigProgressKnown;
begin
   CreateInfo;

//   CheckServerVersion;
   CheckServerVersion;

   if Info.Option.ServerVersion >= AUTOUPDATE_VERSION then
   try
      // check server for new version
      Progress := TItigProgressKnown.Create(self);
      try
         Progress.AutoClose := True;
Debug('TAutoUpdate.CheckForUpgrade');
         Progress.Execute(wtCheckVersion, Info);
         if Info.GetResult = irOK then
         begin
            //MessageDlg('Success', mtInformation, [mbOK], 0);
            // check available version...
            if Info.Option.Available then
            begin
               // we should make a pretty form for this...
               if Length(Info.Option.Readme) > 0 then
               begin
                  MessageDlg(Info.Option.Readme, mtInformation, [mbOK], 0);
               end;
               if MessageDlg('A new version is available.  Do you want to upgrade now?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
               begin
                  // we need to save the proxy settings to the registry so that the helper can use them
                  Info.Option.SaveInternet;

                  StartUpgrade;
               end;
            end
            else
            begin
               if Verbose then
               begin
                  MessageDlg('There are no software updates available for this product at this time.', mtInformation, [mbOK], 0);
               end;
            end;
         end
         else
         begin
            //MessageDlg('The AutoUpdate procedure failed.', mtError, [mbOK], 0);
         end;
      finally
         Info.ClearResult;
         Progress.Free;
      end;
   finally
   end
   else
   begin
      if Verbose then
      begin
         MessageDlg('AutoUpdate Server Version does not match.  Please try manual upgrade', mtInformation, [mbOK], 0);
      end;
   end;
end;

procedure TAutoUpdate.CheckServerVersion;
var
   Progress : TItigProgressKnown;
begin
   CreateInfo;
   try
      // check server for new version
      Progress := TItigProgressKnown.Create(self);
      try
         Progress.AutoClose := True;
         Progress.Execute(wtCheckServer, Info);
         if Info.GetResult = irOK then
         begin
            // The number will be checked later
         end
         else
         begin
            //MessageDlg('The AutoUpdate procedure failed.', mtError, [mbOK], 0);
         end;
      finally
         Info.ClearResult;
         Progress.Free;
      end;
   finally
   end;
end;

procedure TAutoUpdate.GetFile(FileName : String);
var
   Progress : TItigProgressKnown;
begin
   CreateInfo;
   try
      // check server for new version
      Progress := TItigProgressKnown.Create(self);
      try
         Progress.AutoClose := True;
         Debug('TAutoUpdate.GetFile');
         Info.Option.DownloadedFile := FileName;
         Progress.Execute(wtGetFile, Info);
         if Info.GetResult = irOK then
         begin
            MessageDlg('The file was successfuly download.', mtInformation, [mbOK], 0);
            // downloaded...
         end
         else
         begin
//            MessageDlg('The file is not available for download.', mtInformation, [mbOK], 0);
         end;
      finally
         Info.ClearResult;
         Progress.Free;
      end;
   finally
   end;
end;

procedure ShellCopyFile(ParentWnd : HWND; Source : String; Dest : String);
var
   FileOp      : TSHFILEOPSTRUCT;
   FromFile    : PChar;
   ToFile      : PChar;
begin
   if FileExists(Dest) then
   begin
      DeleteFile(Dest);
   end;

   FromFile := StrAlloc(Length(Source) + 2);
   ZeroMemory(FromFile, Length(Source) + 2);
   Move(PChar(Source)^, FromFile^, Length(Source));

   ToFile := StrAlloc(Length(Dest) + 2);
   ZeroMemory(ToFile, Length(Dest) + 2);
   Move(PChar(Dest)^, ToFile^, Length(Dest));

   ZeroMemory(@FileOp, SizeOf(FileOp));
   FileOp.Wnd := ParentWnd;