首页  编辑  

修改资源的例子

Tags: /超级猛料/Resource.资源和使用/   Date Created:
以前的代码:
program BinaryReplace;
uses
 Forms,
 BinRep1 in 'BinRep1.pas' {BinaryEdit};
{$R *.RES}
begin
 Application.Initialize;
 Application.CreateForm(TBinaryEdit, BinaryEdit);
 Application.Run;
end.
unit BinRep1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls, ComCtrls, Buttons, ShellAPI;
CONST
 Max_Buffer = 4096;
type
 Buffer_Type = ARRAY [1..Max_Buffer] OF BYTE;
 TBinaryEdit = class(TForm)
   EXE_Name: TEdit;
   OpenDialog1: TOpenDialog;
   Label1: TLabel;
   Label4: TLabel;
   GroupBox1: TGroupBox;
   Label5: TLabel;
   orig_ico: TEdit;
   new_ico: TEdit;
   Label6: TLabel;
   GroupBox2: TGroupBox;
   Label2: TLabel;
   Find_Str: TEdit;
   Label3: TLabel;
   Replace_Str: TEdit;
   Zero_Breaks: TCheckBox;
   Progress: TProgressBar;
   Bevel1: TBevel;
   Browse2: TBitBtn;
   Browse3: TBitBtn;
   Browse: TBitBtn;
   Modify_Icon: TBitBtn;
   Modify_String: TBitBtn;
   First_Only: TCheckBox;
   Image1: TImage;
   Image2: TImage;
   Bevel2: TBevel;
   Bevel3: TBevel;
   Prev_Icon: TSpeedButton;
   Next_Icon: TSpeedButton;
   procedure Modify_StringClick(Sender: TObject);
   procedure BrowseClick(Sender: TObject);
   procedure Modify_IconClick(Sender: TObject);
   procedure Browse2Click(Sender: TObject);
   procedure Browse3Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Extract_IconClick(Sender: TObject);
   procedure Next_IconClick(Sender: TObject);
   procedure Prev_IconClick(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   PROCEDURE Modify_File;
 end;
var
 BinaryEdit: TBinaryEdit;
 Data_In  : FILE OF BYTE;
 Data_Out : FILE OF BYTE;
 Find_Buffer : Buffer_Type;
 Rep_Buffer  : Buffer_Type;
 Find_Size   : INTEGER;
 Rep_Size    : INTEGER;
 Icon_Index  : INTEGER;
 Run_Path    : STRING;
implementation
{$R *.DFM}
procedure TBinaryEdit.Modify_StringClick(Sender: TObject);
VAR
 n : INTEGER;
BEGIN
 IF Zero_Breaks.Checked
 THEN
 BEGIN
   IF ((Length(Find_Str.Text) * 2 - 1) > Max_Buffer) OR ((Length(Replace_Str.Text) * 2 - 1) > Max_Buffer)
   THEN
   BEGIN
     MessageDlg('The text data is too large. Only data up to ' + IntToStr(Max_Buffer) + ' bytes can be replaced in a single modifcation',
                mtWarning, [mbOk], 0);
     Exit;
   END;
 END
 ELSE
 BEGIN
   IF (Length(Find_Str.Text) > Max_Buffer) OR (Length(Replace_Str.Text) > Max_Buffer)
   THEN
   BEGIN
     MessageDlg('The text data is too large. Only data up to ' + IntToStr(Max_Buffer) + ' bytes can be replaced in a single modifcation',
                mtWarning, [mbOk], 0);
     Exit;
   END;
 END;
 FOR n := 1 TO Length(Find_Str.Text)
 DO
   IF Zero_Breaks.Checked
   THEN
   BEGIN
     Find_Buffer[n * 2 - 1] := ORD(Find_Str.Text[n]);
     Find_Buffer[n * 2] := 0;
   END
   ELSE
     Find_Buffer[n] := ORD(Find_Str.Text[n]);
 IF Zero_Breaks.Checked
 THEN
   Find_Size := Length(Find_Str.Text) * 2 - 1
 ELSE
   Find_Size := Length(Find_Str.Text);
 IF Length(Replace_Str.Text) >= Length(Find_Str.Text)
 THEN
   Replace_Str.Text := Copy(Replace_Str.Text, 1, Length(Find_Str.Text));
 FOR n := 1 TO Length(Replace_Str.Text)
 DO
   IF Zero_Breaks.Checked
   THEN
   BEGIN
     Rep_Buffer[n * 2 - 1] := ORD(Replace_Str.Text[n]);
     Rep_Buffer[n * 2] := 0;
   END
   ELSE
     Rep_Buffer[n] := ORD(Replace_Str.Text[n]);
 IF Zero_Breaks.Checked
 THEN
   Rep_Size := Length(Replace_Str.Text) * 2 - 1
 ELSE
   Rep_Size := Length(Replace_Str.Text);
 IF Rep_Size < Find_Size
 THEN
   REPEAT
     Rep_Size := Rep_Size + 1;
     Rep_Buffer[Rep_Size] := 0;
   UNTIL Rep_Size = Find_Size;
 Modify_File;
END;
PROCEDURE TBinaryEdit.Modify_File;
VAR
 temp_byte     : BYTE;
 n             : INTEGER;
 Buffer        : Buffer_Type;
 Count         : INTEGER;
 Replaced      : INTEGER;
 Read_Count    : LONGINT;
 New_Ext       : STRING;
 Search_Active : BOOLEAN;
 Replace_First : BOOLEAN;
begin
{MessageDlg('Find Buffer: ' + IntToStr(Find_Size) + ' Rep Buffer: ' + IntToStr(Rep_Size), mtInformation, [mbOk], 0);}
 IF NOT(FileExists(EXE_Name.text))
 THEN
 BEGIN
   MessageDlg('Source file "' + orig_ico.text + '" not found', mtWarning, [mbOk], 0);
   Exit;
 END;
 New_Ext := ExtractFileExt(EXE_Name.Text); {Get old ext}
 IF New_Ext[1] = '.'                       {Strip off leading '.' (if there is one)}
 THEN
   New_Ext := Copy(New_Ext, 2, Length(New_Ext) - 1);
 New_Ext := '.~' + Copy(New_Ext, 1, Length(New_Ext) - 1); {Add the leading '~'}
 IF FileExists(ChangeFileExt(EXE_Name.Text, New_Ext)) {Do we have an existing backup?}
 THEN
   DeleteFile(ChangeFileExt(EXE_Name.Text, New_Ext)); {Delete it}
 RenameFile(EXE_Name.Text, ChangeFileExt(EXE_Name.Text, New_Ext)); {Create a new backup}
 AssignFile(data_in, ChangeFileExt(EXE_Name.Text, New_Ext));
 Reset(data_in);
 AssignFile(data_out, EXE_Name.Text);
 ReWrite(data_out);
 Screen.Cursor := crHourglass;
 Replaced := 0;
 Read_Count := 0;
 Progress.Max := FileSize(data_in) DIV 1024;
 Progress.Position := 0;
 Progress.Visible := TRUE;
 Search_Active := TRUE;
 Replace_First := First_Only.Checked;
 WHILE NOT(EOF(data_in))
 DO
 BEGIN
   READ(data_in, temp_byte);
   Read_Count := Read_Count + 1;
   IF (temp_byte = Find_Buffer[1]) AND Search_Active
   THEN                          {Does the read byte match the first byte in the buffer?}
   BEGIN                         {Yes. Check to see if the following bytes also match the buffer}
     Count := 1;
     Buffer[1] := Find_Buffer[1];
     WHILE NOT(EOF(data_in)) AND (count < Find_Size) AND (Buffer[count] = Find_Buffer[count])
     DO
     BEGIN
       count := count + 1;
       READ(data_in, Buffer[count]);
       Read_Count := Read_Count + 1;
     END;
     IF count = Find_Size        {Did what we read, match what we were looking for?}
     THEN
     BEGIN
       FOR n := 1 TO Count       {Yes. Output the replacement data}
       DO
         WRITE(data_out, Rep_Buffer[n]);
       Replaced := Replaced + 1;
       Search_Active := NOT(Replace_First);
     END
     ELSE
       FOR n := 1 TO Count       {No. Output wthe original data}
       DO
         WRITE(data_out, Buffer[n]);
   END
   ELSE
     WRITE(data_out, temp_byte);
   IF (Read_Count MOD 1024) = 0 {Have we read a K?}
   THEN
   BEGIN                        {Update the progress indicators}
     Label1.Caption := 'Read: ' + IntToStr(Read_Count DIV 1024) + ' KBytes';
     Progress.Position := Progress.Position + 1;
     Application.ProcessMessages;
   END;
 END;
 CloseFile(data_in);
 CloseFile(data_out);
 Progress.Position := Progress.Max;
 Application.ProcessMessages;
 Progress.Visible := FALSE;
 Label1.Caption := '';
 Screen.Cursor := crDefault;
 CASE Replaced OF
   0 : MessageDlg('Data could not be located. No changes have been made', mtWarning, [mbOk], 0);
   1 : MessageDlg('Replaced ' + IntToStr(Replaced) + ' instance of the data', mtInformation, [mbOk], 0);
 ELSE
   MessageDlg('Replaced ' + IntToStr(Replaced) + ' instances of the data', mtInformation, [mbOk], 0);
 END;
end;
procedure TBinaryEdit.BrowseClick(Sender: TObject);
begin
 OpenDialog1.Filter := 'Executable Files (*.exe)|*.exe|All Files (*.*)|*.*';
 OpenDialog1.Filename := EXE_Name.Text;
 OpenDialog1.FilterIndex := 0;
 IF OpenDialog1.Execute
 THEN
 BEGIN
   EXE_Name.Text := OpenDialog1.Filename;
   Icon_Index := 0;
   Orig_Ico.Text := '';
   Extract_IconClick(Self);
 END;
end;
procedure TBinaryEdit.Modify_IconClick(Sender: TObject);
VAR
 Temp_Byte : BYTE;
 n         : INTEGER;
begin
{We can treat an icon replace exactly the same as a text replace. Both are simply}
{streams of bytes, but in the case of icons, the bytes come in from a file rather}
{than have the user type in several hundred values. This routine merely rips the }
{data from the two icon files (original file (what to look for) and the new file }
{(what to replace it with)), sets up the two buffers, and gets the search process}
{kicked off}
 IF NOT(FileExists(orig_ico.text))
 THEN
 BEGIN
   MessageDlg('Icon file "' + orig_ico.text + '" not found', mtWarning, [mbOk], 0);
   Exit;
 END;
 IF NOT(FileExists(new_ico.text))
 THEN
 BEGIN
   MessageDlg('Icon file "' + new_ico.text + '" not found', mtWarning, [mbOk], 0);
   Exit;
 END;
 AssignFile(data_in, orig_ico.text);
 Reset(data_in);
 Find_Size := 0;
 FOR n := 1 TO 43
 DO
   READ(data_in, temp_byte); {Skip first 43 bytes (Header?)}
 WHILE NOT(EOF(data_in))
 DO
 BEGIN
   READ(data_in, temp_byte);
   Find_Size := Find_Size + 1;
   IF Find_Size <= Max_Buffer
   THEN
     Find_Buffer[Find_Size] := Temp_Byte;
 END;
 CloseFile(data_in);
 AssignFile(data_in, new_ico.text);
 Reset(data_in);
 Rep_Size := 0;
 FOR n := 1 TO 43
 DO
   READ(data_in, temp_byte); {Skip first 43 bytes (Header?)}
 WHILE NOT(EOF(data_in))
 DO
 BEGIN
   READ(data_in, temp_byte);
   Rep_Size := Rep_Size + 1;
   IF Rep_Size <= Max_Buffer
   THEN
     Rep_Buffer[Rep_Size] := Temp_Byte;
 END;
 CloseFile(data_in);
 IF Rep_Size <> Find_Size
 THEN
 BEGIN
   MessageDlg('The two icons are not the same size (' + IntToStr(Find_Size) + ' & ' + IntToStr(Rep_Size) + '). Unable to modify',
              mtWarning, [mbOk], 0);
   Exit;
 END;
 IF (Rep_Size > Max_Buffer) OR (Find_Size > Max_Buffer)
 THEN
   MessageDlg('The icon data is too large. Only data up to ' + IntToStr(Max_Buffer) + ' bytes can be replaced in a single modifcation',
              mtWarning, [mbOk], 0)
 ELSE
   Modify_File;
end;
procedure TBinaryEdit.Browse2Click(Sender: TObject);
begin
 OpenDialog1.Filter := 'Icon Files (*.ico)|*.ico|All Files (*.*)|*.*';
 OpenDialog1.Filename := Orig_Ico.Text;
 OpenDialog1.FilterIndex := 0;
 IF OpenDialog1.Execute
 THEN
 BEGIN
   Orig_Ico.Text := OpenDialog1.Filename;
   Image1.Picture.LoadFromFile(Orig_Ico.Text);
 END;
end;
procedure TBinaryEdit.Browse3Click(Sender: TObject);
begin
 OpenDialog1.Filter := 'Icon Files (*.ico)|*.ico|All Files (*.*)|*.*';
 OpenDialog1.Filename := New_Ico.Text;
 OpenDialog1.FilterIndex := 0;
 IF OpenDialog1.Execute
 THEN
 BEGIN
   New_Ico.Text := OpenDialog1.Filename;
   Image2.Picture.LoadFromFile(New_Ico.Text);
 END;
end;
procedure TBinaryEdit.FormCreate(Sender: TObject);
begin
 Run_Path := ExtractFilePath(ParamStr(0));
 IF Run_Path[Length(Run_Path)] <> '\'
 THEN
   Run_Path := Run_Path + '\';
 ClientWidth := Bevel1.Width;
 ClientHeight := Bevel1.Top + Bevel1.Height;
 Label1.Caption := '';
 Progress.Visible := FALSE;
 Application.Title := Caption;
end;
procedure TBinaryEdit.Extract_IconClick(Sender: TObject);
VAR
 icon_handle : LONGINT;
 buffer      : ARRAY [0..1024] OF CHAR;
begin
 IF NOT(FileExists(EXE_Name.Text))
 THEN
   Exit;
 StrPCopy(Buffer, EXE_Name.Text);
 icon_handle := ExtractIcon(BinaryEdit.Handle, buffer, icon_index);
 IF Icon_Handle = 0  {Did we get a valid handle back?}
 THEN
 BEGIN               {No}
   IF Icon_Index = 0 {Is this the first icon in the file?}
   THEN              {Yes. There can't be any icons in this file}
   BEGIN
     MessageDlg('No icons found in source file', mtWarning, [mbOk], 0);
     Image1.Visible := FALSE;
   END
   ELSE              {No. We must have gone beyond the limit. Step back}
     Icon_Index := Icon_Index - 1;
   Exit;
 END;
{We now have our extracted icon. Save it to a temp file in readiness for the modifocation}
 Image1.Picture.Icon.Handle := icon_handle;
 Image1.Picture.Icon.SaveToFile(Run_Path + 'orig.ico');
 orig_ico.Text := LowerCase(Run_Path + 'orig.ico');
 Image1.Visible := TRUE;
end;
procedure TBinaryEdit.Next_IconClick(Sender: TObject);
begin
 IF NOT(FileExists(EXE_Name.Text))
 THEN
   Exit;
 Icon_Index := Icon_Index + 1;
 Extract_IconClick(Self);
end;
procedure TBinaryEdit.Prev_IconClick(Sender: TObject);
begin
 IF NOT(FileExists(EXE_Name.Text)) OR (Icon_Index <= 0)
 THEN
   Exit;
 Icon_Index := Icon_Index - 1;
 Extract_IconClick(Self);
end;
end.