修改资源的例子

以前的代码：
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.