Autor Beitrag
opfer.der.genauigkeit
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 754
Erhaltene Danke: 1



BeitragVerfasst: Mo 10.11.08 22:41 
Hallo,

ich habe derzeit ein kurioses Problem. Zumindest kurios, da ich anscheinend von einem Mechanismus nichts weiß, der
mir bei folgendem Code einen Strich durch die Rechnung macht.
Der Code ist teil eines größeren Projektes.

Ich habe den Code mal so aufbereitet, dass man nur noch eine VCL-Form erstellen muss.
Copy & Paste + Zwei Edits + 1 Button.

Edit: Codeupdate
ausblenden volle Höhe Delphi-Quelltext
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;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.WriteDirFile(const aSrcFile: stringconst 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, 00 );

  if ( hSrcFile = INVALID_HANDLE_VALUE ) then
  begin
    DoNotifyError( SysErrorMessage( GetLastError ) );
    Exit;
  end;

  hDestFile := CreateFile( PAnsiChar(aDestFile), GENERIC_WRITE, FILE_SHARE_READ, nil, CREATE_ALWAYS, 00 );

  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( nil2048, 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.


Bei allen meiner Testsysteme (WinXP, Vist32, Vista64) treten keine Fehler auf.

Im Prinzip sollte nichts anderes passieren, als dass die Datei A nach B kopiert wird.

Bei anderen Nutzern tritt der Fehler auf, dass die Datei zwar kopiert wurde, aber darauf nicht mehr zugegriffen werden kann.
Leider kann ich den Fehler nicht reproduzieren, aber vielleicht hat jemand von euch eine Idee, warum dieser Fehler
auftritt, oder auftreten könnte.

MfG
odg

Crosspost: DP

_________________
Stellen Sie sich bitte Zirkusmusik vor.