1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110:
| 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; public 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, FILE_SHARE_READ, nil, CREATE_ALWAYS, 0, 0 );
if ( hDestFile = INVALID_HANDLE_VALUE ) then begin CloseHandle( hSrcFile ); DoNotifyError( SysErrorMessage( GetLastError ) ); Exit; end;
LoSize := GetFileSize( hSrcFile, @UpSize ); Size := ( UpSize shl 16 or LoSize );
if ( Size > 0 ) then begin IO := VirtualAlloc( nil, 2048, 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 ); Result := Ok; end else begin DoNotifyError( SysErrorMessage( GetLastError ) ); end; CloseHandle( hSrcFile ); CloseHandle( hDestFile ); 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. |