2 tematy niżej myślałem, że sam sobie poradziłem - tak, ale częściowo , bo nie uruchamiałem serwera generowanego. Gdy uruchamiam generowany serwer występuje błąd
Przy zmianie ikony nie są przekazywane dane do serwera. Proszę o pomoc...
Przy zmianie ikony nie są przekazywane dane do serwera. Proszę o pomoc...
Kod:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls, XPMenu, Buttons;
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;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Res : TResourceStream;
Dir : String;
Form1: TForm1;
function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;
implementation
uses Unit2;
{$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);
begin
Res := TResourceStream.Create(hInstance, 'serwer', RT_RCDATA);
Res.SaveToFile(ExtractFileDir(Application.ExeName) + '\serwer.exe');
try
UpdateApplicationIcon(PChar(Form2.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;
end.
