CreateFile + VirtualAlloc -> Datei kopieren (geht/nicht)

[opfer.der.genauigkeit]

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.

Delphi-Quellcode:

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.

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: EE

[nicodex]

The Datei-Handles werden nur freigegeben wenn VirtualAlloc erfolgreich war. Und da beim Ziel kein FILE_SHARE_READ angeben wurde, kann man erst darauf zugreifen wenn die Anwendung beendet wurde.

BTW: try-finally wäre auch nützlich.

Edit: VirtualAlloc( nil, Size, ...) sollte wahrscheinlich VirtualAlloc( nil, 2048, ...) lauten. Wobei man sich das ganze sparen kann, falls die Datei 0 Byte groß ist.

[opfer.der.genauigkeit]

Zitat von nicodex:

The Datei-Handles werden nur freigegeben wenn VirtualAlloc erfolgreich war. Und da beim Ziel kein FILE_SHARE_READ angeben wurde, kann man erst darauf zugreifen wenn die Anwendung beendet wurde.

Danke...

Zitat von nicodex:

BTW: try-finally wäre auch nützlich.

Weil? Es ist doch keine Funktion dabei, die eine Exception erzeugen kann.

Zitat von nicodex:

Edit: VirtualAlloc( nil, Size, ...) sollte wahrscheinlich VirtualAlloc( nil, 2048, ...) lauten. Wobei man sich das ganze sparen kann, falls die Datei 0 Byte groß ist.

Danke...

Codeupdate:

Delphi-Quellcode:

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 );

[Luckie]

Zitat von opfer.der.genauigkeit:

Zitat von nicodex:

BTW: try-finally wäre auch nützlich.

Weil? Es ist doch keine Funktion dabei, die eine Exception erzeugen kann.

Es kan immer was unvorhergesehenes passieren und dann wird dein Speicher nicht mehr freigegeben, den du angefordert hast oder Handles werden nicht geschlossen.

[opfer.der.genauigkeit]

Nagut, aber wenn ich immer von der Prämisse ausgehe, dass etwas schief gehen könnte, müsste ich
ja um jeden Code, den ich schreibe ein try..finally setzen?
Aber es stimmt schon was du sagst.

Edit: Ich versuch mal herauszufinden, ob die Veränderungen am Code zum gewünschten Ergebnis führen, oder
ob das Verhalten weiterhin besteht.

Danke erst mal.

[nicodex]

Zitat von opfer.der.genauigkeit:

Weil? Es ist doch keine Funktion dabei, die eine Exception erzeugen kann.

In der Theorie, ja.
In der Praxis solle man keinem fremden Code jenseits der Dokumentation trauen (und manchmal nicht mal der Dokumentation ).

Es gibt von Microsoft zum Beispiel Tools um die "Stabilität" einer Anwendung zu testen. Ganz davon abgesehen, dass Delphi-Programe im Logo-Test ohnehin durchfallen (durch das globale Abfangen der unbehandelten Ausnahmen - was "früher" sicher eine gute Idee war, bis Microsoft sich für die integrierte Problemberichterstattung endschied, um von den Problemen beim "echten" Kunden zu erfahren)... ich schweife ab Wie auch immer, es schadet sicher nicht, kritische Ressourcen (und dazu zähle ich Datei-Handles) auch im Fall einer Ausnahme freizugeben. Durch try-finally wird die Ausnahme ja nicht unterdrückt.

Ich könnte mich noch länger über den (Un)sinn von try-except-Blöcken ohne 'on' (oder ganz leer) und die (Neben)wirkungen von Application.ProcessMessages unterhalten. Allerdings muss ich 'nebenbei' noch arbeiten

[himitsu]

Delphi-Quellcode:

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

PS: hSrcFile ist und bleibt bei einem Fehler hier ebenfalls geöffnet

Eine Lösung wäre zwar sowas, aber übersichtlich ist's nicht gerade.

Delphi-Quellcode:

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);  // <<<<<<<<<<<<<<<<<<<<<
  CloseHandle( hSrcFile );
  DoNotifyError( SysErrorMessage( GetLastError ) );   
  Exit;
end;

Size := ( UpSize shl 16 or LoSize ); Cardinal ist 32 Bit.

if ( Size.QuadPart > 0 ) then Schau dir bitte dringend mal die Definition der Rückgabewerte an!
> GetFileSize


Mein Weg sähe wohl etwa so aus:

Delphi-Quellcode:

var
  Size     : LARGE_INTEGER;
  Read     ,
  Written  ,
  GLE      : Cardinal;
  IO       : Pointer;
  hSrcFile ,
  hDestFile: THandle;
begin
  Result       := False;
  hSrcFile     := CreateFile( PAnsiChar(aSrcFile), 
                    GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  hDestFile    := CreateFile( PAnsiChar(aDestFile),
                    GENERIC_WRITE, FILE_SHARE_READ, nil, CREATE_ALWAYS, 0, 0 );
  Size.LowPart := GetFileSize( hSrcFile, @Size.HighPart);
  GLE          := GetLastError;
  IO           := VirtualAlloc( nil, 2048, MEM_COMMIT, PAGE_READWRITE );

  if ( hSrcFile <> INVALID_HANDLE_VALUE ) 
    and ( hDestFile <> INVALID_HANDLE_VALUE ) 
    and (( Size.QuadPart <> $ffffffff ) or (GLE = NO_ERROR))
    and Assigned( IO ) then
  begin
    Result  := True;
    Read    := 0;
    Written := 0;
   
    while ( Result and ( Read = Written ) and ( Size > 0 ) ) do
    begin
      Result := ReadFile( hSrcFile, IO^, 2048, Read, nil );
   
      if Result and ( Read > 0 ) then
      begin
        Result := WriteFile( hDestFile, IO^, Read, Written, nil );
        Size   := Size - Written;
      end;
    end;
   
    if not Result then DoNotifyError( SysErrorMessage( GetLastError ) );
  end else
  begin
    DoNotifyError( SysErrorMessage( GLE ) );
  end;
 
  VirtualFree( IO, 0, MEM_RELEASE );
  CloseHandle( hSrcFile );
  CloseHandle( hDestFile );
end;

Was macht eigentlich DoNotifyError?

[opfer.der.genauigkeit]

Wenn ich mir das so ansehe und alle meine Flüchtigkeitsfehler betrachte...
oh man...

Da der Code leider nicht die Ursache für mein Problem ist - wie ich feststellen musste -,
werde ich den erst mal die nächsten Tage nicht mehr ansehen.

Vielleicht wird man blind oder sieht den Wald vor lauter Bäumen nicht mehr, wenn man
zu lange vor einem Code sitzt.

Ich hatte die Kopierroutine in der Zwischenzeit über Filestreams realisiert, was zum
gleichen Ergebnis geführt hat.

Ich danke erst mal allen und werde nochmal die Dokus durchgehen.
Allein solche Fehler wie das falsche Shiften von Bits macht mir klar, dass
ich gerade anfällig für Anfängerfehler bin und unüberlegt arbeite.

Ich kümmer mich jetzt erst mal um ein anderes Projekt und werde in den nächsten Tagen
wieder auf diese Zeilen und das Thema zurückkommen.

MfG
odg


Edit:
@Himitsu: DoNotifyError gibt nur Fehlermeldungen an das Interface aus.

[Lasse2002]

Statt hSrcFile := CreateFile( PAnsiChar(aSrcFile), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 ); solltest du besser hSrcFile := CreateFile( PChar(aSrcFile), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 ); schreiben. Sonst mischt du string und PAnsiChar. CreateFile erwartet als Typ PChar, nicht PAnsiChar. In Delphi ≤ 2007 sind die beiden zufällig identisch.

Was spricht eigentlich gegen die Windows Funktion CopyFile? CopyFile hätte unter anderem auch den Vorteil, daß du die NTFS Streams mitkopieren würdest, falls die Datei die du kopierst, welche hat.