home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d2456 / TCSCOMP.ZIP / Unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2002-04-01  |  5.4 KB  |  169 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Buttons, StdCtrls, TCSComp;
  8.  
  9. type
  10.   PIMAGE_DOS_HEADER = ^IMAGE_DOS_HEADER;
  11.   IMAGE_DOS_HEADER = packed record      { DOS .EXE header }
  12.     e_magic         : WORD;             { Magic number }
  13.     e_cblp          : WORD;             { Bytes on last page of file }
  14.     e_cp            : WORD;             { Pages in file }
  15.     e_crlc          : WORD;             { Relocations }
  16.     e_cparhdr       : WORD;             { Size of header in paragraphs }
  17.     e_minalloc      : WORD;             { Minimum extra paragraphs needed }
  18.     e_maxalloc      : WORD;             { Maximum extra paragraphs needed }
  19.     e_ss            : WORD;             { Initial (relative) SS value }
  20.     e_sp            : WORD;             { Initial SP value }
  21.     e_csum          : WORD;             { Checksum }
  22.     e_ip            : WORD;             { Initial IP value }
  23.     e_cs            : WORD;             { Initial (relative) CS value }
  24.     e_lfarlc        : WORD;             { File address of relocation table }
  25.     e_ovno          : WORD;             { Overlay number }
  26.     e_res           : packed array [0..3] of WORD; { Reserved words }
  27.     e_oemid         : WORD;             { OEM identifier (for e_oeminfo) }
  28.     e_oeminfo       : WORD;             { OEM information; e_oemid specific }
  29.     e_res2          : packed array [0..9] of WORD; { Reserved words }
  30.     e_lfanew        : Longint;          { File address of new exe header }
  31.   end;
  32.  
  33.   PIMAGE_OPTIONAL_HEADER = ^IMAGE_OPTIONAL_HEADER;
  34.   IMAGE_OPTIONAL_HEADER = packed record
  35.    { Standard fields. }
  36.     Magic           : WORD;
  37.     MajorLinkerVersion : Byte;
  38.     MinorLinkerVersion : Byte;
  39.     SizeOfCode      : DWORD;
  40.     SizeOfInitializedData : DWORD;
  41.     SizeOfUninitializedData : DWORD;
  42.     AddressOfEntryPoint : DWORD;
  43.     BaseOfCode      : DWORD;
  44.     BaseOfData      : DWORD;
  45.    { NT additional fields. }
  46.     ImageBase       : DWORD;
  47.     SectionAlignment : DWORD;
  48.     FileAlignment   : DWORD;
  49.     MajorOperatingSystemVersion : WORD;
  50.     MinorOperatingSystemVersion : WORD;
  51.     MajorImageVersion : WORD;
  52.     MinorImageVersion : WORD;
  53.     MajorSubsystemVersion : WORD;
  54.     MinorSubsystemVersion : WORD;
  55.     Reserved1       : DWORD;
  56.     SizeOfImage     : DWORD;
  57.     SizeOfHeaders   : DWORD;
  58.     CheckSum        : DWORD; // File checksum tested with MapFileAndCheckSum
  59.     Subsystem       : WORD;
  60.     DllCharacteristics : WORD;
  61.     SizeOfStackReserve : DWORD;
  62.     SizeOfStackCommit : DWORD;
  63.     SizeOfHeapReserve : DWORD;
  64.     SizeOfHeapCommit : DWORD;
  65.     LoaderFlags     : DWORD;
  66.     NumberOfRvaAndSizes : DWORD;
  67. //    DataDirectory   : packed array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of IMAGE_DATA_DIRECTORY;
  68.   end;
  69.  
  70.   TForm1 = class(TForm)
  71.     Label1: TLabel;
  72.     Label2: TLabel;
  73.     Button1: TButton;
  74.     Edit1: TEdit;
  75.     SpeedButton1: TSpeedButton;
  76.     OpenDialog1: TOpenDialog;
  77.     Button2: TButton;
  78.     FileCheckSumComp1: TFileCheckSumComp;
  79.     Edit2: TEdit;
  80.     procedure SpeedButton1Click(Sender: TObject);
  81.     procedure Button1Click(Sender: TObject);
  82.     procedure Button2Click(Sender: TObject);
  83.   private
  84.     { Private declarations }
  85.   public
  86.     { Public declarations }
  87.   end;
  88.  
  89. var
  90.   Form1: TForm1;
  91.  
  92. implementation
  93.  
  94. {$R *.DFM}
  95. // Key function of the program
  96. function MapFileAndCheckSum(Filename: PChar; // File to get checksum
  97.   var HeaderSum,  // Checksum read from PE file header. For Delphi compiled programs it is always 0
  98.   CheckSum: DWORD // Calculated checksum
  99.   ): DWORD;       // 0 if success
  100.   stdcall; external 'Imagehlp.dll' name 'MapFileAndCheckSumA';
  101.  
  102. procedure TForm1.SpeedButton1Click(Sender: TObject);
  103. begin
  104.  if OpenDialog1.Execute then
  105.  Edit1.text:=Opendialog1.FileName;
  106. end;
  107.  
  108. procedure TForm1.Button1Click(Sender: TObject);
  109. var a,b:DWord;
  110. begin
  111.  if MapFileAndCheckSum(PChar(Edit1.Text),a,b)=0 then begin
  112.  Label1.Caption:='Found: '+Inttohex(a,8);
  113.  Edit2.Text:=Inttohex(b,8);
  114.  end
  115. end;
  116.  
  117. procedure TForm1.Button2Click(Sender: TObject);
  118. var f:file;
  119.     Dos:Image_Dos_Header;
  120.     NT:Image_Optional_Header;
  121.     c:char;
  122.     a,b:DWord;
  123. begin
  124. if MessageDlg('Do you have file backup copy?'+#13+#10+ 'This operation can destroy original file!',
  125.     mtWarning, [mbNo, mbYes], 0) = mrNo then Exit;
  126. try
  127. assignfile(f,Edit1.text);
  128. Reset(f,1);
  129. BlockRead(f,Dos,sizeof(Dos));
  130. if Dos.e_lfanew<sizeof(dos) then exit;
  131. Seek(f,Dos.e_lfanew); // Go to the Win32 program header
  132. // Check the signature
  133. Blockread(f,c,1);
  134. if c<>'P' then begin
  135.    Showmessage('Not a program file!');
  136.    exit;
  137.    end;
  138. Blockread(f,c,1);
  139. if c<>'E' then begin
  140.    Showmessage('Not a program file!');
  141.    exit;
  142.    end;
  143. Blockread(f,c,1);
  144. if c<>#0 then begin
  145.    Showmessage('Not a program file!');
  146.    exit;
  147.    end;
  148. Blockread(f,c,1);
  149. if c<>#0 then begin
  150.    Showmessage('Not a program file!');
  151.    exit;
  152.    end;
  153. Seek(f,Dos.e_lfanew+24); // Go to the optional header
  154. BlockRead(f,NT,sizeof(NT));
  155. if NT.CheckSum>0 then // Do not change if file has checksum
  156.  Showmessage('Already has checksum '+inttohex(NT.CheckSum,8)) // Display it
  157.  else
  158.  if MapFileAndCheckSum(PChar(Edit1.Text),a,b)=0 then begin
  159.   NT.CheckSum:=b; // Set the checksum to the calculated one
  160.   Seek(f,Dos.e_lfanew+24);
  161.   BlockWrite(f,NT,sizeof(NT)); // Save changed header
  162.   end;
  163. finally
  164.  Closefile(f);
  165.  end;
  166. end;
  167.  
  168. end.
  169.