500个大元,如何修改别的EXE的图标,我要代码,收到给分。(0分)

  • 主题发起人 主题发起人 jingtao
  • 开始时间 开始时间
J

jingtao

Unregistered / Unconfirmed
GUEST, unregistred user!
我曾经有一个代码,但只能修改某些符合大小的图标有的话发到
lovejingtao@21cn.com
谢谢。
 
把你的代码先贴出来共享 :-)
没准有人能改进
 
二进制修改
 
wjiachun>但代码在一个硬盘里面而那个盘又坏了。。。。
面条》具体地说。。。。
 
已经发了,结帐吧!
谁还想要发个email给我,我的email:delphibbs@yeah.net
(这里太慢,连不上啊。。。。。。)
 
以前的代码:
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.
 
lingxin>>这个就是我以前的那个啦,
在你站点下的啊,效率很低,而且限制很多啊.谁可以改一下呢?
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
form_hw:HWND;
rcw : Word;
cn:Pchar;
ic:TICON;
begin
rcw := WinExec('calc.exe', SW_SHOWNORMAL);//启动计算器
if rcw<=32 then //无法启动计算器
begin
Application.Terminate;
end

while true do//确保计算器启动
begin
form_hw:=FindWindow(nil,'计算器');
if boolean(form_hw) then break;
end;

cn:='大家的计算器';//修改后的标题
ic:=TICON.create;
ic.LoadFromFile('WINUPD.ICO');//修改后的图标
SendMessage(form_hw,WM_SETTEXT,0,Integer(cn));//修改标题
Sendmessage(form_hw,WM_SETICON,ICON_SMALL,ic.handle);//修改图标
freeandnil(ic); //释放ic
end;

end.
 
yanlei>>在房客那里看过了.我的意思不是要这个啊.
 
接受答案了.
 

Similar threads

D
回复
0
查看
943
DelphiTeacher的专栏
D
D
回复
0
查看
882
DelphiTeacher的专栏
D
D
回复
0
查看
959
DelphiTeacher的专栏
D
D
回复
0
查看
786
DelphiTeacher的专栏
D
S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
后退
顶部