Vollständiges Icon extrahieren...

[FriFra]

Für alle die die Lösung Interessiert...

Der code ist zwar nicht auf meinen Mist gewachsen, aber gut zusammengesucht und in "kompakte" functions verpackt

Icon aus Exe in *.ico-Datei schreiben:

Delphi-Quellcode:

function SaveApplicationIconGroup(icofile: PChar; exefile: PChar): Boolean;
  function EnumResourceNamesProc(Module: HMODULE; ResType: PChar; ResName:
    PChar; lParam: TStringList): Integer; stdcall;
  var
    ResourceName: string;
  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 ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex:
    string): Boolean;

  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;
  type
    PICONDIRENTRY = ^TICONDIRENTRY;
    TICONDIRENTRY = packed record
      bWidth: Byte;
      bHeight: Byte;
      bColorCount: Byte;
      bReserved: Byte;
      wPlanes: Word;
      wBitCount: Word;
      dwBytesInRes: DWORD;
      dwImageOffset: DWORD;
    end;
  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;
    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 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;

  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;
var
  hExe: THandle;
  i: Integer;
  SL: TStringList;
begin
  Result := False;
  SL := TStringList.Create;
  hExe := LoadLibraryEx(PChar(exefile), 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;
  ExtractIconFromFile(exefile, icofile, SL.Strings[0]);
  FreeLibrary(hExe);
  SL.Free;
  Result := True;
end;

Icon (aus *.ico-Datei) in Exe einbinden:

Delphi-Quellcode:

function UpdateApplicationIconGroup(icofile: PChar; exefile: PChar; resID:
  PcHar; LangID: DWORD): Boolean;
type
  PICONDIRENTRYCOMMON = ^ICONDIRENTRYCOMMON;
  ICONDIRENTRYCOMMON = packed record
    bWidth: Byte; // Width, in pixels, of the image
    bHeight: Byte; // Height, in pixels, of the image
    bColorCount: Byte; // Number of colors in image (0 if >=8bpp)
    bReserved: Byte; // Reserved ( must be 0)
    wPlanes: Word; // Color Planes
    wBitCount: Word; // Bits per pixel
    dwBytesInRes: DWord; // How many bytes in this resource?
  end;
  PICONDIRENTRY = ^ICONDIRENTRY;
  ICONDIRENTRY = packed record
    common: ICONDIRENTRYCOMMON;
    dwImageOffset: DWord; // Where in the file is this image?
  end;
  PICONDIR = ^ICONDIR;
  ICONDIR = packed record
    idReserved: Word; // Reserved (must be 0)
    idType: Word; // Resource Type (1 for icons)
    idCount: Word; // How many images?
    idEntries: ICONDIRENTRY; // An entry for each image (idCount of 'em)
  end;
  PGRPICONDIRENTRY = ^GRPICONDIRENTRY;
  GRPICONDIRENTRY = packed record
    common: ICONDIRENTRYCOMMON;
    nID: Word; // the ID
  end;
  PGRPICONDIR = ^GRPICONDIR;
  GRPICONDIR = packed record
    idReserved: Word; // Reserved (must be 0)
    idType: Word; // Resource type (1 for icons)
    idCount: Word; // How many images?
    idEntries: GRPICONDIRENTRY; // The entries for each image
  end;
type
  PIconHeader = ^TIconHeader;
  TIconHeader = packed record
    idReserved: Word; // Reserved (must be 0)
    idType: Word; // Resource Type (1 for icons)
    idCount: Word; // How many images?
  end;
type
  PIconResInfoArray = ^TIconResInfoArray;
  TIconResInfoArray = packed record
    idReserved: Word; // Reserved (must be 0)
    idType: Word; // Resource Type (1 for icons)
    idCount: Word; // How many images?
    idEntries: array[0..(MaxInt div SizeOf(GRPICONDIRENTRY)) - 2] of
    GRPICONDIRENTRY;
  end;

  TIconOffsetArray = array[0..(MaxInt div SizeOf(DWORD)) - 1] of DWORD;
  PIconOffsetArray = ^TIconOffsetArray;
  TIconResIDArray = array[0..(MaxInt div SizeOf(Word)) - 1] of Word;
  PIconResIDArray = ^TIconResIDArray;
var
  hExeInst: HMODULE;
  hResInst: THANDLE;
  AIconHeader: TIconHeader;
  AIconResInfo: GRPICONDIRENTRY;
  AIconResInfoArray: PIconResInfoArray;
  AIconOffsetArray: PIconOffsetArray;
  AIconResIDArray: PIconResIDArray;
  i, CurResID: integer;
  //AIconOrdinals : array Of Word;

  hFile: THandle;
  id: ICONDIR;
  ide: ICONDIRENTRY;
  pid: PICONDIR;
  pgid: PGRPICONDIR;
  uRead: DWord;
  nSize: DWord;
  pvFile: PByte;

  hResSrc: HRSRC;
  hResGlob: HGLOBAL;
  pRes: Pointer;
  ResSize: DWORD;
begin
  result := False;

  hFile := CreateFile(icofile, GENERIC_READ, FILE_SHARE_READ, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  FillChar(id, sizeof(id), 0);
  if hFile <> INVALID_HANDLE_VALUE then
  try
    ReadFile(hFile, id, sizeof(id), uRead, nil);
  finally
    CloseHandle(hFile);
  end;

  AIconResIDArray := nil;
  FillChar(AIconHeader, SizeOf(AIconHeader), 0);

  hExeInst := LoadLibraryEx(exefile, 0, LOAD_LIBRARY_AS_DATAFILE);
  if (hExeInst <> 0) then
  begin
    hResSrc := FindResourceEx(hExeInst, RT_GROUP_ICON, resID, LangID);

    if (hResSrc <> 0) then
    begin
      // get resource size
      ResSize := SizeofResource(hInstance, hResSrc);

      if (ResSize <> INVALID_FILE_SIZE) then
      begin
        hResGlob := LoadResource(hExeInst, hResSrc);

        if (hResGlob <> 0) then
        begin
          pRes := LockResource(hResGlob);

          if (pRes <> nil) then
          begin
            // Collect information about old Icon group
            CopyMemory(@AIconHeader, pRes, SizeOf(AIconHeader));
            Inc(PChar(pRes), SizeOf(AIconHeader));

            {Form1.ListBox1.Items.Add('Type: ' + IntToStr(AIconHeader.idType) + ', '
                                   + 'Count: ' + IntToStr(AIconHeader.idCount));}

            FillChar(AIconResInfo, SizeOf(AIconResInfo), 0);
            //SetLength(AIconOrdinals, AIconHeader.wCount);

            if (AIconHeader.idCount < id.idCount) then
              GetMem(AIconResIDArray, id.idCount * SizeOf(Word))
            else
              GetMem(AIconResIDArray, AIconHeader.idCount * SizeOf(Word));

            FillChar(AIconResIDArray^, AIconHeader.idCount * SizeOf(Word), 0);
            for i := 1 to AIconHeader.idCount do
            begin
              CopyMemory(@AIconResInfo, pRes, SizeOf(AIconResInfo));
              Inc(PChar(pRes), SizeOf(AIconResInfo));

              AIconResIDArray^[i - 1] := AIconResInfo.nID;

              //If (AIconResInfo.common.wBitCount = 0) then
              //  AIconResInfo.common.wBitCount := Trunc(log2(AIconResInfo.common.bColorCount));
              {Form1.ListBox1.Items.Add(IntToStr(AIconResInfo.common.bWidth) + 'x' + IntToStr(AIconResInfo.common.bHeight)
                             + ', ' + IntToStr(AIconResInfo.common.bColorCount + (AIconResInfo.common.bReserved * $100)) + ' colors'
                             //+ ', ' + IntToStr(AIconResInfo.common.bReserved) + ' bReserved'
                             + ', ' + IntToStr(AIconResInfo.common.wPlanes) + ' planes'
                             + ', ' + IntToStr(AIconResInfo.common.wBitCount) + ' bit'
                             + ', ' + IntToStr(AIconResInfo.common.dwBytesInRes) + ' byte'
                             + ', ' + 'Ordinal ' + IntToStr(AIconResInfo.nID));}
            end;

            // Search for unused Icon resource IDs
            if (AIconHeader.idCount < id.idCount) then
            begin
              i := AIconHeader.idCount;
              CurResID := 1;
              while (i < id.idCount) and (CurResID < $7FFF) do
              begin
                hResSrc := FindResourceEx(hExeInst, RT_ICON,
                  MAKEINTRESOURCE(CurResID), LangID);

                if not (hResSrc <> 0) then
                begin
                  Inc(i);
                  AIconResIDArray^[i - 1] := CurResID;
                end;

                Inc(CurResID);
              end;
            end;
          end;
        end;
      end;
    end;
    FreeLibrary(hExeInst);
  end;

  if not ((AIconHeader.idCount > 0) and (id.idCount > 0)) then
    Exit;

  hFile := CreateFile(icofile, GENERIC_READ, FILE_SHARE_READ, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  if hFile <> INVALID_HANDLE_VALUE then
  try
    // Read Data from new icon group in file
    ReadFile(hFile, id, sizeof(id), uRead, nil);
    SetFilePointer(hFile, 0, nil, FILE_BEGIN);
    GetMem(pid, sizeof(ICONDIR) {+ sizeof(ICONDIRENTRY)});
    ReadFile(hFile, pid^, sizeof(ICONDIR) {+ sizeof(ICONDIRENTRY)}, uRead, nil);

    GetMem(pgid, sizeof(GRPICONDIR) {+ sizeof(GRPICONDIRENTRY)});
    move(pid^, pgid^, sizeof(GRPICONDIR));
    pgid^.idEntries.common := pid^.idEntries.common;
    pgid^.idEntries.nID := AIconResIDArray^[0];

    if (pgid^.idEntries.common.wBitCount = 0) then
      pgid^.idEntries.common.wBitCount :=
        Trunc(Log2(pgid^.idEntries.common.bColorCount +
        (pgid^.idEntries.common.bReserved * $100)));

    {Form1.ListBox1.Items.Add(IntToStr(uRead));}

    // Write new data to EXE resources
    hResInst := BeginUpdateResource(exefile, False);

    // Resource deletion doesn't really work
    {
    for i := 1 to AIconHeader.idCount do
    begin
      ShowMessage(IntToStr(AIconResIDArray^[i-1]));
      UpdateResource(hResInst, RT_Icon, MAKEINTRESOURCE(AIconResIDArray^[i-1]), LangID, nil, 0);
    end;
    }

    //CopyMemory(pgid, @AIconHeader, SizeOf(TIconHeader));
    //pgid^.idCount := 1;
    //If (AIconHeader.idCount < pgid^.idCount) then
    //  pgid^.idCount := AIconHeader.idCount;

    //SetFilePointer(hFile, SizeOf(TIconHeader), nil, FILE_BEGIN);

    GetMem(AIconResInfoArray, SizeOf(TIconHeader) + (SizeOf(GRPICONDIRENTRY) *
      pgid^.idCount));
    GetMem(AIconOffsetArray, SizeOf(DWORD) * pgid^.idCount);
    AIconResInfoArray^.idReserved := pgid^.idReserved;
    AIconResInfoArray^.idType := pgid^.idType;
    AIconResInfoArray^.idCount := pgid^.idCount;

    AIconResInfoArray^.idEntries[0] := pgid^.idEntries;
    AIconOffsetArray^[0] := pid^.idEntries.dwImageOffset;

    {Form1.ListBox1.Items.Add(IntToStr(AIconResInfoArray^.idEntries[0].common.bColorCount));}
    for i := 2 to pgid^.idCount do
    begin
      ReadFile(hFile, ide, sizeof(ICONDIRENTRY), uRead, nil);
      AIconResInfoArray^.idEntries[i - 1].common := ide.common;
      AIconResInfoArray^.idEntries[i - 1].nID := AIconResIDArray^[i - 1];
      AIconOffsetArray^[i - 1] := ide.dwImageOffset;

      {Form1.ListBox1.Items.Add(IntToStr(AIconResInfoArray^.idEntries[i-1].common.bColorCount + (AIconResInfoArray^.idEntries[i-1].common.bReserved*$100)));}

      if (AIconResInfoArray^.idEntries[i - 1].common.wBitCount = 0) then
        AIconResInfoArray^.idEntries[i - 1].common.wBitCount :=
          Trunc(Log2(AIconResInfoArray^.idEntries[i - 1].common.bColorCount +
          (AIconResInfoArray^.idEntries[i - 1].common.bReserved * $100)));
    end;

    pvFile := nil;
    result := true;
    for i := 1 to pgid^.idCount do
    begin
      nSize := AIconResInfoArray^.idEntries[i - 1].common.dwBytesInRes;
      GetMem(pvFile, nSize);
      SetFilePointer(hFile, AIconOffsetArray^[i - 1], nil, FILE_BEGIN);
      ReadFile(hFile, pvFile^, nSize, uRead, nil);

      result := result and UpdateResource(hResInst, RT_ICON,
        MAKEINTRESOURCE(AIconResInfoArray^.idEntries[i - 1].nID), LangID,
        pvFile,
        nSize);
    end;

    UpdateResource(hResInst, RT_Group_Icon, resID, LangID, AIconResInfoArray,
      SizeOf(TIconHeader) + (SizeOf(GRPICONDIRENTRY) * pgid^.idCount));

    EndUpdateResource(hResInst, False);

    FreeMem(AIconOffsetArray);
    FreeMem(AIconResInfoArray);
    FreeMem(pvFile);
    FreeMem(pgid);
    FreeMem(pid);
  finally
    CloseHandle(hFile);
  end;

  if Assigned(AIconResIDArray) then
    FreeMem(AIconResIDArray);
end;