Нашел статью http://edn.embarcadero.com/article/27979
Сделал пробный проект
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
const
//our ExeBuffer signature
ExeBufSig = 'EB1.0';
type
//the Footer for our executable format
TExeBufFooter = record
OriginalSize : Integer;
Sig : Array[0..4] of char;
end;
TExeBuf = array of char;
TForm1 = class(TForm)
BitBtn1: TBitBtn;
OpenDialog1: TOpenDialog;
BitBtn2: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
procedure SetExeData (ExeName : String; ExeBuf : TExeBuf);
procedure GetExeData (ExeName : String; var ExeBuf : TExeBuf);
procedure StringToExeBuf (const S : String; var ExeBuf : TExeBuf);
function ExeBufToString (const ExeBuf : TExeBuf) : String;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.SetExeData (ExeName : String; ExeBuf : TExeBuf);
var
F : File;
BufSz,OrigSz : Integer;
Footer : TExeBufFooter;
begin
AssignFile (F,ExeName);
Reset (F,1);
try
//obtaining the original file size
OrigSz := FileSize(F);
//go to the EOF of the file
Seek (F,OrigSz);
//Writing our custom data beyond the EOF
BufSz := Length(ExeBuf);
BlockWrite (F,Pointer(ExeBuf)^,BufSz);
//Writing our footer
FillChar (Footer,SizeOf(Footer),0);
Footer.OriginalSize := OrigSz;
Footer.Sig := ExeBufSig;
BlockWrite (F,Footer,Sizeof(Footer));
finally
CloseFile (F);
end;
end;
procedure TForm1.GetExeData (ExeName : String; var ExeBuf : TExeBuf);
var
F : File;
CurrSz, BufSize : Integer;
OldFileMode : Integer;
Footer : TExeBufFooter;
begin
AssignFile (F,ExeName);
//Saving the old FileMode
OldFileMode := FileMode;
//Setting the FileMode to ReadOnly
FileMode := 0;
try
Reset (F,1);
try
//Getting the current file size
CurrSz := FileSize (F);
//Seeking to the footer position
//and reading it
Seek (F,CurrSz-SizeOf (Footer));
BlockRead (F,Footer,Sizeof(Footer));
//if there's no signature, boom!
//no data in this executable!
if Footer.Sig <> ExeBufSig then
//raise EExeBuf.Create
ShowMessage ('No Data in EXE!');
//calculating the buffer size that was written
//to this executable file
BufSize :=CurrSz-Footer.OriginalSize-SizeOf(Footer);
SetLength (ExeBuf,BufSize);
//seek and read!
Seek (F,Footer.OriginalSize);
BlockRead(F,Pointer(ExeBuf)^, BufSize);
finally
CloseFile (F);
end;
finally
//returning to the previous saved
//FileMode
FileMode := OldFileMode;
end;
end;
procedure TForm1.StringToExeBuf (const S : String; var ExeBuf : TExeBuf);
begin
SetLength(ExeBuf,Length(S)*SizeOf(Char));
Move (Pointer(S)^,Pointer(ExeBuf)^,Length(S)*SizeOf(Char));
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var
ExeBuf, ExeBuf2 : TExeBuf;begin
GetExeData(Application.ExeName, ExeBuf2);
ShowMessage(ExeBufToString(ExeBuf2));
end;
function TForm1.ExeBufToString (const ExeBuf : TExeBuf) : String;
begin
SetLength (Result,Length(ExeBuf) div SizeOf(Char));
Move (Pointer(ExeBuf)^,Pointer(Result)^,Length(ExeBuf)* SizeOf(Char));
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
ExeBuf, ExeBuf2 : TExeBuf;
begin
OpenDialog1.Execute;
StringToExeBuf('aa12345aa', ExeBuf);
SetExeData(OpenDialog1.FileName, ExeBuf);
GetExeData(OpenDialog1.FileName, ExeBuf2);
ShowMessage(ExeBufToString(ExeBuf2));
end;
end.
|
Информация пишется и читается. Файл подопытный запускается и работает, но при закрытии вылетает ошибка
---------------------------
Project1 - копия (2)
---------------------------
Access violation at address 004B8593 in module 'Project1 - копия (2).exe'. Read of address 00000010.
---------------------------
ОК
---------------------------
В чем проблемы?
Подопытный файл - копия данного exeшника. |