Icon einer Anwendung speichern

[ErazerZ]

hey leute,
ich hab da ein problem, ich weiß nicht wie ich es lösen kann, also, ich will ein icon einer exe datei auslesen und das in truecolor auf der festplatte speichern. Ich hab da einwenig rum getestet und auch etwas gemacht, jedoch funktioniert das nicht mit jeder ExeDatei, kA warum.

Hoffentlich kann mir jemand helfen, da mein code nur mit eigener und ein paar anderen anwendungen funkt, jedoch nicht mit Explorer.exe.

Ahja, das ganze sollte NonVCL sein. Nicht sowas wie TIcon :)

[turboPASCAL]

Darf man dich um einen kleinen Code-Schnipsel bitten, dass man mal Gucken kann ?

[Luckie]

Wie machst du es denn bisher? :roll:

[ErazerZ]

mein code bis jetzt ..

Delphi-Quellcode:

function SaveIcon(Filename: String; Savename: String): Boolean;
var
  lpResource, lpResource2, Buffer: PChar;
  hResource: HRSRC;
  ResSize, ResSize2, Written: LongWord;
  hMem, h, hExe: THandle;
  ID: Integer;
begin
  Result := False;
  bGotResource := False;
  bStringRes := False;
  hExe := LoadLibrary(PChar(Filename));

  EnumResourceNames(hExe, RT_GROUP_ICON, @ResourceNameCallback, hInstance); // les nur die namen heraus, immer nur den ersten, wegen testen ..

  if bStringRes then // wenns ein string ist, ansonsten integer
    hResource := FindResource(hExe, PChar(ResourceNameStr), RT_GROUP_ICON)
  else
    hResource := FindResource(hExe, MAKEINTRESOURCE(ResourceName), RT_GROUP_ICON);
  ResSize := sizeofResource(hExe, hResource);
  hMem := LoadResource(hExe, hResource);
  lpResource := LockResource(hMem);

// testen - erstes icon auslesen
//  ID := LookupIconIdFromDirectoryEx(PBYTE(lpResource), True, SM_CXICON, SM_CYICON, LR_DEFAULTCOLOR);
  ID := 1;
  hResource := FindResource(hExe, MAKEINTRESOURCE(ID), MAKEINTRESOURCE(RT_ICON));
  ResSize2 := sizeofResource(hExe, hResource);
  hMem := LoadResource(hExe, hResource);
  lpResource2 := LockResource(hMem);

  if lpResource <> nil then
  begin
    h := CreateFile(PChar(Savename), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    GetMem(Buffer, 1);
    // die hier hab mit nem hexeditor herausgefunden, indem ich eine datei (ico) mit reshack entpack habe und einfach eine binäre icon-datei mit der anderen icon datei verglichen habe
    // patch other stuff from Group Icon
    PByte(Cardinal(lpResource) + $7)^ := $40;
    PByte(Cardinal(lpResource) + $12)^ := $16;
    // zero offsets ( 2bytes )
    PByte(Cardinal(Buffer) + $0)^ := $00;
    PByte(Cardinal(Buffer) + $1)^ := $00;
    // write to file
    WriteFile(h, lpResource^, ResSize, Written, nil);
    WriteFile(h, Buffer^, 2, Written, nil);
    WriteFile(h, lpResource2^, ResSize2, Written, nil);
    CloseHandle(h);
    Result := True;
  end;
  FreeLibrary(hExe);
end;

[turboPASCAL]

Hi, hast Du mal deine Anwendung Gedebbug't?

Arbeitet die ResourceNameCallBack Funktion richtig (gibt sie ein Resourcen Namen zurück)?

[ErazerZ]

ja klar, es funktioniert sogar mit ein paar programmen, jedoch nicht mit allen, es liegt glaub ich an der farben oder menge der icons oder irgendwas, vielleicht sollt ich mir irgendwo Header von Icons oder was auch immer downloaden (weil es liegt an den Offsets die ich patche)

[turboPASCAL]

Hm, bei mir habe ich ein Probl. mit dem Auslesen von Icons als Intresource mit Strings als ResName klappt alles top. (Soweit ich das beurteilen kann)

(kann natürlich auch an meiner improv. function liegen :spin: )

[ErazerZ]

Ok leute, passt schon, ich habs schon gelöst, trotzdem thx

[Mystic]

Wär nett wenn du deine Lösung trotzdem hier posten würdest.

[Luckie]

Warum nimmst du nicht SHGetFileInfo?

[Harry M.]

Delphi-Quellcode:

Function GetIconFromFile(FileName: String; Index: Integer): Ticon;
Begin
  Result := TIcon.Create;
  Result.Handle := ExtractIcon(HInstance, PCHAR(FileName), Index);
End;

[Luckie]

Zitat:

Zitat von Harry M.

Delphi-Quellcode:

Function GetIconFromFile(FileName: String; Index: Integer): Ticon;
Begin
  Result := TIcon.Create;
  Result.Handle := ExtractIcon(HInstance, PCHAR(FileName), Index);
End;

Zitat:

Ahja, das ganze sollte NonVCL sein. Nicht sowas wie TIcon

;)

[ErazerZ]

ja klar, hier ist die Unit mit einem Example,
den echten Source war in C, hab aber ne Unit auf einer Chinesischen seite gefunden und habs einwenig umgeändert.

Icons.pas

Delphi-Quellcode:

unit Icons;

interface

uses Windows;

type
  PByte = ^Byte;
  PBitmapInfo = ^BitmapInfo;

/// These first two structs represent how the icon information is stored
/// when it is bound into a EXE or DLL file. Structure members are WORD
/// aligned and the last member of the structure is the ID instead of
/// the imageoffset.

type
  PMEMICONDIRENTRY = ^TMEMICONDIRENTRY;
  TMEMICONDIRENTRY = packed record
    bWidth:           Byte;
    bHeight:          Byte;
    bColorCount:      Byte;
    bReserved:        Byte;
    wPlanes:          Word;
    wBitCount:        Word;
    dwBytesInRes:     DWORD;
    nID:              Word;
  end;

type
  PMEMICONDIR = ^TMEMICONDIR;
  TMEMICONDIR = packed record
    idReserved:       Word;
    idType:           Word;
    idCount:          Word;
    idEntries:        Array[0..15] of TMEMICONDIRENTRY;
  end;

/// These next two structs represent how the icon information is stored
/// in an ICO file.

type
  PICONDIRENTRY = ^TICONDIRENTRY;
  TICONDIRENTRY = packed record
    bWidth:           Byte;
    bHeight:          Byte;
    bColorCount:      Byte;
    bReserved:        Byte;
    wPlanes:          Word;
    wBitCount:        Word;
    dwBytesInRes:     DWORD;
    dwImageOffset:    DWORD;
  end;

type
  PICONDIR = ^TICONDIR;
  TICONDIR = packed record
    idReserved:       Word;
    idType:           Word;
    idCount:          Word;
    idEntries:        Array[0..0] of TICONDIRENTRY;
  end;

/// The following two structs are for the use of this program in
/// manipulating icons. They are more closely tied to the operation
/// of this program than the structures listed above. One of the
/// main differences is that they provide a pointer to the DIB
/// information of the masks.

type
  PICONIMAGE = ^TICONIMAGE;
  TICONIMAGE = packed record
    Width,
    Height,
    Colors:           UINT;
    lpBits:           Pointer;
    dwNumBytes:       DWORD;
    pBmpInfo:         PBitmapInfo;
  end;


type
  PICONRESOURCE = ^TICONRESOURCE;
  TICONRESOURCE = packed record
    nNumImages:       UINT;
    IconImages:       Array[0..15] of TICONIMAGE;
  end;

type
  TPageInfo = packed record
    Width:            Byte;
    Height:           Byte;
    ColorQuantity:    Integer;
    Reserved:         DWORD;
    PageSize:         DWORD;
    PageOffSet:       DWORD;
  end;

type
  TPageDataHeader = packed record
    PageHeadSize:     DWORD;
    XSize:            DWORD;
    YSize:            DWORD;
    SpeDataPerPixSize: Integer;
    ColorDataPerPixSize: Integer;
    Reserved:         DWORD;
    DataAreaSize:     DWORD;
    ReservedArray:    Array[0..15] of char;
  end;

type
  TIcoFileHeader = packed record
    FileFlag:         Array[0..3] of byte;
    PageQuartity:     Integer;
    PageInfo:         TPageInfo;
  end;

function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;
function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;

implementation

function SysErrorMessage(ErrorCode: Integer): string;
var
  Len: Integer;
  Buffer: array[0..255] of Char;
begin
  Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer, SizeOf(Buffer), nil);
  while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do Dec(Len);
  SetString(Result, Buffer, Len);
end;

function StrToInt(X: String): Integer;
var
  V, Code: Integer;
begin
  Val(X, V, Code);
  StrToInt := V;
end;

function WriteICOHeader(hFile: THandle; nNumEntries: UINT): Boolean;
type
  TFIcoHeader = record
    wReserved: WORD;
    wType: WORD;
    wNumEntries: WORD;
  end;
var
  IcoHeader: TFIcoHeader;
  dwBytesWritten: DWORD;
begin
  Result := False;
  IcoHeader.wReserved := 0;
  IcoHeader.wType := 1;
  IcoHeader.wNumEntries := WORD(nNumEntries);
  if not WriteFile(hFile, IcoHeader, SizeOf(IcoHeader), dwBytesWritten, nil) then
  begin
    MessageBox(0, pchar(SysErrorMessage(GetLastError)), 'Error', MB_ICONERROR);
    Result := False;
    Exit;
  end;
  if dwBytesWritten <> SizeOf(IcoHeader) then
    Exit;
  Result := True;
end;

function CalculateImageOffset(lpIR: PICONRESOURCE; nIndex: UINT): DWORD;
var
  dwSize: DWORD;
  i: Integer;
begin
  dwSize := 3 * SizeOf(WORD);
  inc(dwSize, lpIR.nNumImages * SizeOf(TICONDIRENTRY));
  for i := 0 to nIndex - 1 do
    inc(dwSize, lpIR.IconImages[i].dwNumBytes);
  Result := dwSize;
end;

function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;
var
  i: UINT;
  dwBytesWritten: DWORD;
  ide: TICONDIRENTRY;
  dwTemp: DWORD;
begin
  Result := False;
  for i := 0 to lpIR^.nNumImages - 1 do
  begin
    /// Convert internal format to ICONDIRENTRY
    ide.bWidth := lpIR^.IconImages[i].Width;
    ide.bHeight := lpIR^.IconImages[i].Height;
    ide.bReserved := 0;
    ide.wPlanes := lpIR^.IconImages[i].pBmpInfo.bmiHeader.biPlanes;
    ide.wBitCount := lpIR^.IconImages[i].pBmpInfo.bmiHeader.biBitCount;
    if ide.wPlanes * ide.wBitCount >= 8 then
      ide.bColorCount := 0
    else
      ide.bColorCount := 1 shl (ide.wPlanes * ide.wBitCount);
    ide.dwBytesInRes := lpIR^.IconImages[i].dwNumBytes;
    ide.dwImageOffset := CalculateImageOffset(lpIR, i);
    if not WriteFile(hFile, ide, sizeof(TICONDIRENTRY), dwBytesWritten, nil) then
      Exit;
    if dwBytesWritten <> sizeof(TICONDIRENTRY) then
      Exit;
  end;
  for i := 0 to lpIR^.nNumImages - 1 do
  begin
    dwTemp := lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage;
    lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage := 0;
    if not WriteFile(hFile, lpIR^.IconImages[i].lpBits^, lpIR^.IconImages[i].dwNumBytes, dwBytesWritten, nil) then
      Exit;
    if dwBytesWritten <> lpIR^.IconImages[i].dwNumBytes then
      Exit;
    lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage := dwTemp;
  end;
  Result := True;
end;

function AWriteIconToFile(bitmap: hBitmap; Icon: hIcon; szFileName: string): Boolean;
var
  fh: file of byte;
  IconInfo: _ICONINFO;
  PageInfo: TPageInfo;
  PageDataHeader: TPageDataHeader;
  IcoFileHeader: TIcoFileHeader;
  BitsInfo: tagBITMAPINFO;
  p: pointer;
  PageDataSize: integer;
begin
  Result := False;
  GetIconInfo(Icon, IconInfo);
  AssignFile(fh, szFileName);
  FileMode := 1;
  Reset(fh);

  GetDIBits(0, Icon, 0, 32, nil, BitsInfo, DIB_PAL_COLORS);
  GetDIBits(0, Icon, 0, 32, p, BitsInfo, DIB_PAL_COLORS);
  PageDataSize := SizeOf(PageDataHeader) + BitsInfo.bmiHeader.biBitCount;

  PageInfo.Width := 32;
  PageInfo.Height := 32;
  PageInfo.ColorQuantity := 65535;
  Pageinfo.Reserved := 0;
  PageInfo.PageSize := PageDataSize;
  PageInfo.PageOffSet := SizeOf(IcoFileHeader);

  IcoFileHeader.FileFlag[0] := 0;
  IcoFileHeader.FileFlag[1] := 0;
  IcoFileHeader.FileFlag[2] := 1;
  IcoFileHeader.FileFlag[3] := 0;
  IcoFileHeader.PageQuartity := 1;
  IcoFileHeader.PageInfo := PageInfo;

  FillChar(PageDataHeader, SizeOf(PageDataHeader), 0);
  PageDataHeader.XSize := 32;
  PageDataHeader.YSize := 32;
  PageDataHeader.SpeDataPerPixSize := 0;
  PageDataHeader.ColorDataPerPixSize := 32;
  PageDataHeader.PageHeadSize := SizeOf(PageDataHeader);
  PageDataHeader.Reserved := 0;
  PageDataHeader.DataAreaSize := BitsInfo.bmiHeader.biBitCount;

  BlockWrite(fh, IcoFileHeader, SizeOf(IcoFileHeader));
  BlockWrite(fh, PageDataHeader, SizeOf(PageDataHeader));
  BlockWrite(fh, p, BitsInfo.bmiHeader.biBitCount);
  CloseFile(fh);
end;

function AdjustIconImagePointers(lpImage: PICONIMAGE): Bool;
begin
  if lpImage = nil then
  begin
    Result := False;
    exit;
  end;
  lpImage.pBmpInfo := PBitMapInfo(lpImage^.lpBits);
  lpImage.Width := lpImage^.pBmpInfo^.bmiHeader.biWidth;
  lpImage.Height := (lpImage^.pBmpInfo^.bmiHeader.biHeight) div 2;
  lpImage.Colors := lpImage^.pBmpInfo^.bmiHeader.biPlanes * lpImage^.pBmpInfo^.bmiHeader.biBitCount;
  Result := true;
end;

function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;
var
  h: HMODULE;
  lpMemIcon: PMEMICONDIR;
  lpIR: TICONRESOURCE;
  src: HRSRC;
  Global: HGLOBAL;
  i: integer;       
  hFile: hwnd;
begin
  Result := False;
  hFile := CreateFile(pchar(IcoFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  if hFile = INVALID_HANDLE_VALUE then Exit;
  h := LoadLibraryEx(pchar(ResFileName), 0, LOAD_LIBRARY_AS_DATAFILE);
  if h = 0 then exit;
  try
    src := FindResource(h, pchar(nIndex), RT_GROUP_ICON);
    if src = 0 then
      Src := FindResource(h, Pointer(StrToInt(nIndex)), RT_GROUP_ICON);
    if src <> 0 then
    begin
      Global := LoadResource(h, src);
      if Global <> 0 then
      begin
        lpMemIcon := LockResource(Global);
        if Global <> 0 then
        begin
          try
            lpIR.nNumImages := lpMemIcon.idCount;
            // Write the header
            for i := 0 to lpMemIcon^.idCount - 1 do
            begin
              src := FindResource(h, MakeIntResource(lpMemIcon^.idEntries[i].nID), RT_ICON);
              if src <> 0 then
              begin
                Global := LoadResource(h, src);
                if Global <> 0 then
                begin
                  try
                    lpIR.IconImages[i].dwNumBytes := SizeofResource(h, src);
                  except
                    MessageBox(0, PChar('Unable to Read Icon'), 'NTPacker', MB_ICONERROR);
                    Result := False;
                    ExitProcess(0);
                  end;
                  GetMem(lpIR.IconImages[i].lpBits, lpIR.IconImages[i].dwNumBytes);
                  CopyMemory(lpIR.IconImages[i].lpBits, LockResource(Global), lpIR.IconImages[i].dwNumBytes);
                  if not AdjustIconImagePointers(@(lpIR.IconImages[i])) then exit;
                end;
              end;
            end;
            if WriteICOHeader(hFile, lpIR.nNumImages) then
              if WriteIconResourceToFile(hFile, @lpIR) then
                Result := True;
          finally
            for i := 0 to lpIR.nNumImages - 1 do
              if assigned(lpIR.IconImages[i].lpBits) then
                FreeMem(lpIR.IconImages[i].lpBits);
          end;
        end;
      end;
    end;
  finally
    FreeLibrary(h);
  end;
  CloseHandle(hFile);
end;

end.

und hier ein example NonVCL code:

Delphi-Quellcode:

program Project1;

uses
  Windows, Icons;

// Die StringList die man braucht um alle Resourcenamen zu speichern
type
  TStringList = class(TObject)
    private
      SList: Array of String;
    public
      Count: Integer;
      constructor Create;
      procedure Add(S: String);
      function Strings(Index: Integer): String;
  end;

constructor TStringList.Create;
begin
  Count := 0;
  SetLength(SList, Count +1);
end;

procedure TStringList.Add(S: String);
begin
  SetLength(SList, Count +1);
  SList[Count] := S;
  Inc(Count);
end;

function TStringList.Strings(Index: Integer): String;
begin
  Result := SList[Index];
end;

///////////////////////////////////////////////////////////

var
  ResourceName: String;

function IntToStr(X: Integer): String;
var
  S: String;
begin
  Str(X, S);
  IntToStr := S;
end;

function ExtractFilePath(FileName: string): string;
begin
  Result := '';
  while Pos('\', FileName) <> 0 do
  begin
    Result := Result + Copy(FileName, 1, 1);
    Delete(FileName, 1, 1);
  end;
end;

function EnumResourceNamesProc(Module: HMODULE; ResType: PChar; ResName: PChar; lParam: TStringList): Integer; stdcall;
begin
  if hiword(Cardinal(ResName)) = 0 then
  begin
    ResourceName := IntToStr(loword(Cardinal(ResName)));
  end else
  begin
    ResourceName := ResName;
  end;
  lParam.Add(ResourceName);
  Result := 1;
end;

function SaveIcon(Filename: String): Boolean;
var
  hExe: THandle;
  i: Integer;
  SL: TStringList;
begin
  Result := False;
  SL := TStringList.Create;
  hExe := LoadLibraryEx(PChar(Filename), 0, LOAD_LIBRARY_AS_DATAFILE);
  if hExe = 0 then Exit;
  EnumResourceNames(hExe, RT_GROUP_ICON, @EnumResourceNamesProc, Integer(SL));
  if SL.Count = 0 then
  begin
    SL.Free;
    MessageBox(0, 'No Icons found in the EXE/DLL', 'Error', MB_ICONERROR);
    Exit;
  end;
  for i := 0 to SL.Count -1 do
  begin
    Icons.ExtractIconFromFile(Filename, ExtractFilePath(Filename) + SL.Strings(i) + '.ico', SL.Strings(i));
  end;
  FreeLibrary(hExe);
  SL.Free;
  Result := True;
end;

begin
  SaveIcon('C:\Windows\System32\shell32.dll');
end.