exetoolunit.pas

灰鸽子VIP1.2经典源代码

unit ExeToolUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DynamicSkinForm, ComCtrls, SkinCtrls, ExtCtrls, StdCtrls, Mask,
  SkinBoxCtrls, ImgList,IconLibrary,Icontypes,IconTools,
  unitExIcon ,unitPEFile,unitResourceDetails,unitResourceGraphics, LangFrm;

type
  TExeToolForm = class(TLangForm)
    DSF: TspDynamicSkinForm;
    OpenDialog2: TOpenDialog;
    Panel1: TspSkinPanel;
    IconListBox: TListBox;
    Panel2: TspSkinPanel;
    Label2: TspSkinStdLabel;
    FilenameEdit1: TspSkinEdit;
    Label3: TspSkinStdLabel;
    Image1: TImage;
    Button2: TspSkinButton;
    FindButton: TspSkinButton;
    Panel3: TspSkinPanel;
    Button1: TspSkinButton;
    Label1: TspSkinStdLabel;
    Panel4: TspSkinPanel;
    IconInfo: TListBox;
    Label4: TspSkinStdLabel;
    Panel5: TspSkinPanel;
    LibraryIcons: TListBox;
    Label5: TspSkinStdLabel;
    SaveDialog1: TSaveDialog;
    Button4: TspSkinButton;
    OpenDialog1: TOpenDialog;
    OpenDialog3: TOpenDialog;
    ZhuanTai: TspSkinLabel;
    procedure Button2Click(Sender: TObject);
    procedure IconListBoxClick(Sender: TObject);
    procedure IconListBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure LibraryIconsClick(Sender: TObject);
    procedure FindButtonClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FilenameEdit1ButtonClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Ico : TMultiIcon;
    ICL : TIconLibrary;
    procedure LibraryLoaded;
    procedure IconLoaded;
    procedure ListIcons;
    procedure FreeIco;
    function ChangeExeIcon(const BinFileName:Pchar):BOOL;
  end;

var
  ExeToolForm: TExeToolForm;

implementation
uses
Main;

{$R *.dfm}

procedure TExeToolForm.ListIcons;
Var
  I : Integer;
  H : Integer;
begin
  IconListBox.Items.Clear;
  IconListBox.Items.BeginUpdate;
  H:=0;
  FOR I:=1 TO Ico.IconCount DO begin
    IconListBox.Items.Add(InttoStr(I));
    With Ico.IconResInfo[I-1] DO begin
      IF Height>H Then H:=Height;
      IF Width>H  Then H:=Width;
    end;
  end;
  IconListBox.ItemHeight:=H;
  IconListBox.Items.EndUpdate;
  IF IconListBox.Items.Count>0 Then IconListBox.ItemIndex:=0;
  IconInfo.Enabled:=(IconListBox.Items.Count>0)
end;

procedure TExeToolForm.IconLoaded;
begin
//  IconIndex.MaxValue:=Ico.IconCount;
//  IconIndex.Enabled:=(Ico.IconCount>1);
//  IF Ico.IconValid Then IconIndex.Value:=1 else
//    IconIndex.Value:=0;
  ListIcons;
end;

procedure TExeToolForm.FreeIco;
begin
  IF Assigned(Ico) Then Ico.Free;
  Ico:=nil;
end;

procedure TExeToolForm.LibraryLoaded;
var
Index : Integer;
begin
  IF Assigned(ICL) Then begin
    LibraryIcons.Items.Assign(ICL.Icons);
    IF LibraryIcons.Items.Count>0 Then begin
      LibraryIcons.ItemIndex:=0;
      Index:=LibraryIcons.ItemIndex;
      IF (Index<0) OR (Index>=ICL.Icons.Count) Then exit;
      Ico:=TMultiIcon(ICL.Icons.Objects[Index]);
      IconLoaded;
    end;
  end;
end;

procedure TExeToolForm.Button2Click(Sender: TObject);
Var
  NewICL : TIconLibrary;
begin
try
  IF OpenDialog2.Execute Then begin
    LibraryIcons.Clear;
    NewICL:=TIconLibrary.Create;
    NewICL.LoadFromFile(OpenDialog2.Filename);
    IF NewICL.Icons.Count>0 Then begin
      IF Assigned(ICL) Then ICL.Free;
      ICL:=nil;
      ICL:=NewICL;
      LibraryLoaded;
    end;
  end;
  IconListBox.ItemIndex:=0;
  IconListBoxClick(nil);
except
end;
end;

procedure TExeToolForm.IconListBoxClick(Sender: TObject);
const
  Co : ARRAY[1..7] OF String =
  ('SubIconnumber: %d','Width: %d','Height: %d',
   'ColorCount: %d','Planes: %d','BitCount: %d',
   'Size in bytes: %d');

Var
  Header : TIconResInfo;
  C : Cardinal;
  H : TIcon;
begin
  Header:=Ico.IconResInfo[IconListBox.ItemIndex];
  IconInfo.Items.Beginupdate;
  try
    IF Header.BitCount>0 Then
      C:=2 shl (Header.BitCount-1)
    else C:=Header.ColorCount;
    IconInfo.Items.Clear;
    IconInfo.Items.Add(Format(Co[1],[IconListBox.ItemIndex+1]));
    IconInfo.Items.Add(Format(Co[2],[Header.Width]));
    IconInfo.Items.Add(Format(Co[3],[Header.Height]));
    IconInfo.Items.Add(Format(Co[4],[Header.ColorCount]));
    IconInfo.Items.Add(Format(Co[5],[Header.Planes]));
    IconInfo.Items.Add(Format(Co[6],[Header.BitCount]));
    IconInfo.Items.Add(Format(Co[7],[Header.BytesInRes]));

    IconInfo.Items.Add(Format('Colors: %d',[C]));
  finally
    IconInfo.Items.EndUpdate;
  end;

  H:=Ico.Icon[IconListBox.ItemIndex];
  Image1.Picture.Icon:=H;
  
end;

procedure TExeToolForm.IconListBoxDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
Var
  H : Integer;
  S : String;
  P : TSize;
begin
  IF NOT Assigned(Ico) Then exit;
  With TListBox(Control) DO begin
    H:=ItemHeight;
    With Canvas DO begin
      With Ico.IconResInfo[Index] DO begin
        FillRect(Rect);
        IF rect.Left=0 Then Ico.Draw(Canvas,Rect.Left+((H-Width)DIV 2),Rect.Top+((H-Height)DIV 2),Index);
        S:=(Control as TListBox).Items[Index];
        P:=TextExtent(S);
        TextOut(Rect.Left + H+7, Rect.Top+((H-P.cy) DIV 2),S);
//        IF (odSelected in State) Then InvertRect(Canvas.Handle,Classes.Rect(Rect.Left+H+2,Rect.Top,Rect.Right,Rect.Bottom) );
      end;
    end;
  end;
end;

procedure TExeToolForm.LibraryIconsClick(Sender: TObject);
Var
  Index : Integer;
begin
try
  Index:=LibraryIcons.ItemIndex;
  IF (Index<0) OR (Index>=ICL.Icons.Count) Then exit;
  Ico:=TMultiIcon(ICL.Icons.Objects[Index]);
  IconLoaded;
except
end;
end;

procedure TExeToolForm.FindButtonClick(Sender: TObject);
begin
  IF SaveDialog1.Execute Then begin
    Ico.SaveToFile(SaveDialog1.Filename);
  end;
end;

procedure TExeToolForm.Button4Click(Sender: TObject);
Var
  I : TMultiIcon;
begin
try
  IF OpenDialog1.Execute Then begin
    LibraryIcons.Clear;
    I:=TFileIcon.Create(OpenDialog1.Filename);
    IF I.IconValid Then begin
      FreeIco;
      Ico:=I;
      IconLoaded;
    end else begin
      I.Free;
      ShowMessage(Translate('String0','读取图标出错!'));
      Exit;
    end;
  end;
  IconListBox.ItemIndex:=0;
  IconListBoxClick(nil);
except
end;
end;

procedure TExeToolForm.FilenameEdit1ButtonClick(Sender: TObject);
Var
  NewICL : TIconLibrary;
begin
try
  IF OpenDialog3.Execute Then begin
    FilenameEdit1.Text:=OpenDialog3.Filename;
    NewICL:=TIconLibrary.Create;
    NewICL.LoadFromFile(OpenDialog3.Filename);
    IF NewICL.Icons.Count>0 Then begin
      IF Assigned(ICL) Then ICL.Free;
      ICL:=nil;
      ICL:=NewICL;
      LibraryLoaded;
    end;
  end;
  IconListBox.ItemIndex:=0;
  IconListBoxClick(nil);
except
end;
end;

function TExeToolForm.ChangeExeIcon(const BinFileName:Pchar):BOOL;
{临时文件夹路径}
function Temppath :string;
var tmpdir:array [0..255] of char;
begin
  GetTempPath(255,@tmpdir);
  Result :=StrPas(Tmpdir);
  if copy(Result,Length(Result),1)<>'\' then
  Result:=Result+'\';
end;
var
StrIconName:String;
bHasIcon:Boolean;
fResourceModule : TPEResourceModule;
ResourceDetailsClass : TResourcedetailsClass;
res : TResourceDetails;
i,j:integer;
begin
try
 Result:=False;
 fResourceModule := TPEResourceModule.Create;
 fResourceModule.LoadFromFile (BinFileName);
 i:= fResourceModule.ResourceCount;
 if i<1 then
 begin
 fResourceModule.Free;
 Exit;
 end;
  bHasIcon:=False;
 for j:=0 to i-1 do if fResourceModule.ResourceDetails[j].ResourceType=IntToStr (Integer(RT_GROUP_ICON)) then
 begin
 bHasIcon:=True;
 StrIconName:=fResourceModule.ResourceDetails[j].ResourceName;
 fResourceModule.DeleteResource(j);
 break;
 end;
 if not(bHasIcon) then
 begin
   for j:=0 to i-1 do if fResourceModule.ResourceDetails[j].ResourceType=IntToStr (Integer(RT_ICON)) then
 begin
 bHasIcon:=True;
 StrIconName:=fResourceModule.ResourceDetails[j].ResourceName;
 fResourceModule.DeleteResource(j);
 break;
 end;
 end;
 if not(bHasIcon) then
 begin
 fResourceModule.Free;
 Exit;
 end;
 ResourceDetailsClass := TIconGroupResourceDetails;
 res := ResourceDetailsClass.CreateNew(fResourceModule, 0,StrIconName);
 res.Dirty := True;
 Ico.SaveToFile(TempPath + 'TmpIcohgz.ico');
 TIconGroupResourceDetails(res).LoadImage(TempPath + 'TmpIcohgz.ico');
 DeleteFile(TempPath + 'TmpIcohgz.ico');
 fResourceModule.SaveToFile(BinFileName);
 fResourceModule.Free;
 Result:=True;
except
end;
end;

procedure TExeToolForm.Button1Click(Sender: TObject);
begin
if ChangeExeIcon(Pchar(FilenameEdit1.text)) then
  begin
    MessageBox(0,Pchar(Translate('String1','修改图标成功!请检查EXE能否正确运行!')),Pchar(Translate('String2','提醒')),MB_OK+MB_ICONINFORMATION);
    //ZhuanTai.caption:='修改图标成功!请检查EXE能否正确运行!';
  end else begin
    ZhuanTai.caption:=Translate('String3','修改图标失败!');
  end;
end;

end.