home *** CD-ROM | disk | FTP | other *** search
- unit TCSComp;
- {This is freeware Delphi component which allow to check program exe file for
- changes and if any, use Windows installer service to reinstall program.
- Copyright (c) 2002 Ainars Skangals
- Version 1.0
- This component is provided "as is" without warranty of any kind,
- either expressed or implied.}
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
-
- type
- TReinstallEvent = procedure(Sender: TObject; var Reinstall: Boolean) of object;
-
- TFileCheckSumComp = class(TComponent)
- private
- { Private declarations }
- FGUID:String;
- FCheckOnStart:Boolean;
- FOnReinstall:TReinstallEvent;
- protected
- { Protected declarations }
- Procedure Loaded; override;
- public
- { Public declarations }
- Procedure CheckFile;
- published
- { Published declarations }
- // This is the Windows installer package GUID. If you use Installshield Express,
- // you can find it in General information - Product code.
- // Also you can export UID file with AInstaller - you will find product code in GENERAL section.
- Property GUID:String read FGUID write FGUID;
- // set to true to automatically check on program start
- Property CheckOnStart:boolean read FCheckOnStart write FCheckOnStart;
- // Event to intercept reinstallation.
- Property OnReinstall:TReinstallEvent read FOnReinstall write FOnReinstall;
- end;
-
- procedure Register;
-
- {$R TCSComp.res}
-
- implementation
-
- function MapFileAndCheckSum(Filename: PChar; // File to get checksum
- var HeaderSum, // Checksum read from PE file header. For Delphi compiled programs it is always 0
- CheckSum: DWORD // Calculated checksum
- ): DWORD; // 0 if success
- stdcall; external 'Imagehlp.dll' name 'MapFileAndCheckSumA';
-
- Procedure TFileCheckSumComp.Loaded;
- begin
- Inherited;
- if FCheckOnStart then CheckFile;
- end;
-
- Procedure TFileCheckSumComp.CheckFile;
- var HCS,FCS:DWord;
- Reinst:Boolean;
- StartupInfo: TStartupInfo;
- ProcessInfo: TProcessInformation;
- s:string;
- begin
- if MapFileAndCheckSum(PChar(Application.ExeName),HCS,FCS)=0 then
- if (HCS>0)and(HCS<>FCS) then begin
- Reinst:=true;
- if assigned(FOnReinstall) then FOnReinstall(Self,Reinst);
- if (FGUID<>'') and Reinst then
- FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
- with StartupInfo do begin
- cb := SizeOf(TStartupInfo);
- dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
- wShowWindow := SW_SHOW;
- end;
- s:='msiexec /fa '+FGUID; // Run msiexec with option to reinstall all files
- // can be replaced with
- // s:='msiexec /fc '+FGUID';
- // if installer correctly sets msidbFileAttributesChecksum attribute in msi package Files table
- if CreateProcess(nil,PChar(s),nil, nil, False,
- NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
- Application.Terminate;
- end;
- end;
-
- procedure Register;
- begin
- RegisterComponents('Install', [TFileCheckSumComp]);
- end;
-
- end.
-