www.pudn.com > HgzVip1.2_code.rar > ExeToolUnit.pas

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.