home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / delphi / SAVESCRN / DOFIX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-04  |  2.8 KB  |  114 lines
  1. unit Dofix;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, FileCtrl;
  8.  
  9. type
  10.   TfrmFix = class(TForm)
  11.     Label1: TLabel;
  12.     GroupBox1: TGroupBox;
  13.     FileListBox1: TFileListBox;
  14.     DirectoryListBox1: TDirectoryListBox;
  15.     DriveComboBox1: TDriveComboBox;
  16.     FilterComboBox1: TFilterComboBox;
  17.     cmdFIX: TBitBtn;
  18.     cmdExit: TBitBtn;
  19.     Label2: TLabel;
  20.     cedTitle: TEdit;
  21.     Label3: TLabel;
  22.     procedure cmdFIXClick(Sender: TObject);
  23.   private
  24.     { Private declarations }
  25.     procedure PutTitleInFile(FileName, Title: string);
  26.   public
  27.     { Public declarations }
  28.   end;
  29.  
  30. var
  31.   frmFix: TfrmFix;
  32.  
  33. implementation
  34.  
  35. {$R *.DFM}
  36.  
  37. procedure TfrmFix.PutTitleInFile(FileName, Title: string);
  38. var
  39.   fh, i, Pos, Len, Read, j: Integer;
  40.   ShortName, tmp: string;
  41.   Buffer: array [1..4096] of Byte;
  42. begin
  43.   ShortName := UpperCase(ExtractFileName(FileName));
  44.   Len := Length(ShortName);
  45.  
  46.   fh := FileOpen(FileName, fmOpenReadWrite);
  47.   { It should be here at the start of the file }
  48.   Read := FileRead(fh, Buffer, sizeof(Buffer));
  49.  
  50.   { Do a simple search for the length of the
  51.     file name, first }
  52.   i:=1;
  53.   Pos := 0;
  54.   while (Pos=0) and (i < (sizeof(Buffer)-Len)) do
  55.   begin
  56.     if Buffer[i] = Len then
  57.     begin
  58.       for j:=0 to Len do tmp[j] := Char(Buffer[i+j]);
  59.       if tmp=ShortName then Pos := i-1;
  60.     end;
  61.     i := i+1;
  62.   end;
  63.   if Pos=0 then
  64.     MessageDlg('Could not find stamp in EXE file!', mtError,[mbOk], 0)
  65.   else
  66.   begin
  67.     { Add some extra info Windows wants }
  68.     Title := 'SCRNSAVE: ' + Title;
  69.     { From beginnig of file }
  70.     FileSeek(fh, Pos, 0);
  71.     FileWrite(fh, Title, Length(Title)+1);
  72.   end;
  73.   FileClose(fh);
  74. end;
  75.  
  76. procedure TfrmFix.cmdFIXClick(Sender: TObject);
  77. var
  78.   FileName, NewName: string;
  79. begin
  80.   { Filename with path }
  81.   FileName := FileListBox1.FileName;
  82.  
  83.   if FileName='' then
  84.   begin
  85.     MessageDlg('Please choose an EXE file to fix', mtError,[mbOk], 0);
  86.     exit;
  87.   end;
  88.  
  89.   if cedTitle.Text='' then
  90.   begin
  91.     MessageDlg('Please give the screen saver a name', mtError,[mbOk], 0);
  92.     exit;
  93.   end;
  94.  
  95.   PutTitleInFile(FileName, cedTitle.Text);
  96.  
  97.   NewName := Copy(FileName,1,Length(FileName)-4) + '.scr';
  98.   if not RenameFile(FileName, NewName) then
  99.     MessageDlg('Could not rename the file ' + UpperCase(FileName) +
  100.                ' to ' + UpperCase(NewName) +
  101.                Chr(10) +
  102.                'Rename the file and place it in the windows directory.',
  103.                mtInformation,[mbOk], 0)
  104.   else
  105.     MessageDlg('The file ' + ExtractFileName(FileName) +
  106.                ' has been fixed and has the extension ''.scr''.' +
  107.                Chr(10) +
  108.                'Place it in the windows directory.',
  109.                mtInformation,[mbOk], 0);
  110.   FileListBox1.Update;
  111. end;
  112.  
  113. end.
  114.