home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d2456 / TCSCOMP.ZIP / TCSComp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-03-24  |  2.9 KB  |  92 lines
  1. unit TCSComp;
  2. {This is freeware Delphi component which allow to check program exe file for
  3.  changes and if any, use Windows installer service to reinstall program.
  4.  Copyright (c) 2002 Ainars Skangals
  5.  Version 1.0
  6.  This component is provided "as is" without warranty of any kind,
  7.  either expressed or implied.}
  8. interface
  9.  
  10. uses
  11.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  12.  
  13. type
  14.   TReinstallEvent = procedure(Sender: TObject; var Reinstall: Boolean) of object;
  15.  
  16.   TFileCheckSumComp = class(TComponent)
  17.   private
  18.     { Private declarations }
  19.     FGUID:String;
  20.     FCheckOnStart:Boolean;
  21.     FOnReinstall:TReinstallEvent;
  22.   protected
  23.     { Protected declarations }
  24.     Procedure Loaded; override;
  25.   public
  26.     { Public declarations }
  27.     Procedure CheckFile;
  28.   published
  29.     { Published declarations }
  30.     // This is the Windows installer package GUID. If you use Installshield Express,
  31.     // you can find it in General information - Product code.
  32.     // Also you can export UID file with AInstaller - you will find product code in GENERAL section.
  33.     Property GUID:String read FGUID write FGUID;
  34.     // set to true to automatically check on program start
  35.     Property CheckOnStart:boolean read FCheckOnStart write FCheckOnStart;
  36.     // Event to intercept reinstallation.
  37.     Property OnReinstall:TReinstallEvent read FOnReinstall write FOnReinstall;
  38.   end;
  39.  
  40. procedure Register;
  41.  
  42. {$R TCSComp.res}
  43.  
  44. implementation
  45.  
  46. function MapFileAndCheckSum(Filename: PChar; // File to get checksum
  47.   var HeaderSum,  // Checksum read from PE file header. For Delphi compiled programs it is always 0
  48.   CheckSum: DWORD // Calculated checksum
  49.   ): DWORD;       // 0 if success
  50.   stdcall; external 'Imagehlp.dll' name 'MapFileAndCheckSumA';
  51.  
  52. Procedure TFileCheckSumComp.Loaded;
  53. begin
  54. Inherited;
  55. if FCheckOnStart then CheckFile;
  56. end;
  57.  
  58. Procedure TFileCheckSumComp.CheckFile;
  59. var HCS,FCS:DWord;
  60.     Reinst:Boolean;
  61.     StartupInfo: TStartupInfo;
  62.     ProcessInfo: TProcessInformation;
  63.     s:string;
  64. begin
  65.  if MapFileAndCheckSum(PChar(Application.ExeName),HCS,FCS)=0 then
  66.  if (HCS>0)and(HCS<>FCS) then begin
  67.   Reinst:=true;
  68.   if assigned(FOnReinstall) then FOnReinstall(Self,Reinst);
  69.   if (FGUID<>'') and Reinst then
  70.   FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  71.   with StartupInfo do begin
  72.       cb := SizeOf(TStartupInfo);
  73.       dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
  74.       wShowWindow := SW_SHOW;
  75.       end;
  76.   s:='msiexec /fa '+FGUID; // Run msiexec with option to reinstall all files
  77.   // can be replaced with
  78.   // s:='msiexec /fc '+FGUID';
  79.   // if installer correctly sets msidbFileAttributesChecksum attribute in msi package Files table
  80.   if CreateProcess(nil,PChar(s),nil, nil, False,
  81.       NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
  82.       Application.Terminate;
  83.   end;
  84. end;
  85.  
  86. procedure Register;
  87. begin
  88.   RegisterComponents('Install', [TFileCheckSumComp]);
  89. end;
  90.  
  91. end.
  92.