unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
function WriteDirFile(
const aSrcFile, aDestFile:
string): Boolean;
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.WriteDirFile(
const aSrcFile:
string;
const aDestFile:
string): Boolean;
var
LoSize ,
UpSize : Cardinal;
Size : Int64;
Read ,
Written : Cardinal;
IO : Pointer;
hSrcFile ,
hDestFile: THandle;
Ok : Boolean;
begin
Result := False;
hSrcFile := CreateFile( PAnsiChar(aSrcFile), GENERIC_READ, FILE_SHARE_READ,
nil, OPEN_EXISTING, 0, 0 );
if ( hSrcFile = INVALID_HANDLE_VALUE )
then
begin
// DoNotifyError( SysErrorMessage( GetLastError ) );
Exit;
end;
hDestFile := CreateFile( PAnsiChar(aDestFile), GENERIC_WRITE, 0,
nil, CREATE_ALWAYS, 0, 0 );
if ( hDestFile = INVALID_HANDLE_VALUE )
then
begin
// DoNotifyError( SysErrorMessage( GetLastError ) );
CloseHandle( hSrcFile );
Exit;
end;
LoSize := GetFileSize( hSrcFile, @UpSize );
Size := ( UpSize
shl 16
or LoSize );
IO := VirtualAlloc(
nil, Size, MEM_COMMIT, PAGE_READWRITE );
if ( ( Assigned( IO ) ) )
then
begin
Ok := True;
Read := 0;
Written := 0;
while ( Ok
and (
Read = Written )
and ( Size > 0 ) )
do
begin
Ok := ReadFile( hSrcFile, IO^, 2048,
Read,
nil );
if ( Ok
and (
Read > 0 ) )
then
begin
Ok := WriteFile( hDestFile, IO^,
Read, Written,
nil );
Size := Size - Written;
end;
end;
// if ( not Ok ) then DoNotifyError( SysErrorMessage( GetLastError ) );
VirtualFree( IO, 0, MEM_RELEASE );
CloseHandle( hSrcFile );
CloseHandle( hDestFile );
Result := Ok;
end else
begin
// DoNotifyError( SysErrorMessage( GetLastError ) );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WriteDirFile( Edit1.Text, Edit2.Text );
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text := ParamStr( 0 );
Edit2.Text := ExtractFilePath( Edit1.Text ) + '
test.exe';
end;
end.