AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi CreateFile + VirtualAlloc -> Datei kopieren (geht/nicht)

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

Ein Thema von opfer.der.genauigkeit · begonnen am 10. Nov 2008 · letzter Beitrag vom 11. Nov 2008
Antwort Antwort
opfer.der.genauigkeit

Registriert seit: 14. Feb 2005
66 Beiträge
 
#1

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

  Alt 10. Nov 2008, 21:43
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
Stellen Sie sich bitte Zirkusmusik vor.
  Mit Zitat antworten Zitat
Benutzerbild von nicodex
nicodex

Registriert seit: 2. Jan 2008
Ort: Darmstadt
286 Beiträge
 
Delphi 2007 Professional
 
#2

Re: CreateFile + VirtualAlloc -> Datei kopieren (geht/nic

  Alt 10. Nov 2008, 21:50
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.
  Mit Zitat antworten Zitat
opfer.der.genauigkeit

Registriert seit: 14. Feb 2005
66 Beiträge
 
#3

Re: CreateFile + VirtualAlloc -> Datei kopieren (geht/nic

  Alt 10. Nov 2008, 22:06
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 );
Stellen Sie sich bitte Zirkusmusik vor.
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#4

Re: CreateFile + VirtualAlloc -> Datei kopieren (geht/nic

  Alt 10. Nov 2008, 23:36
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.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
opfer.der.genauigkeit

Registriert seit: 14. Feb 2005
66 Beiträge
 
#5

Re: CreateFile + VirtualAlloc -> Datei kopieren (geht/nic

  Alt 10. Nov 2008, 23:41
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.
Stellen Sie sich bitte Zirkusmusik vor.
  Mit Zitat antworten Zitat
Benutzerbild von nicodex
nicodex

Registriert seit: 2. Jan 2008
Ort: Darmstadt
286 Beiträge
 
Delphi 2007 Professional
 
#6

Re: CreateFile + VirtualAlloc -> Datei kopieren (geht/nic

  Alt 11. Nov 2008, 09:23
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
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.016 Beiträge
 
Delphi 12 Athens
 
#7

Re: CreateFile + VirtualAlloc -> Datei kopieren (geht/nic

  Alt 11. Nov 2008, 18:06
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!
> MSDN-Library durchsuchenGetFileSize


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?
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
opfer.der.genauigkeit

Registriert seit: 14. Feb 2005
66 Beiträge
 
#8

Re: CreateFile + VirtualAlloc -> Datei kopieren (geht/nic

  Alt 11. Nov 2008, 22:35
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.
Stellen Sie sich bitte Zirkusmusik vor.
  Mit Zitat antworten Zitat
Lasse2002

Registriert seit: 29. Nov 2004
79 Beiträge
 
RAD-Studio 2009 Pro
 
#9

Re: CreateFile + VirtualAlloc -> Datei kopieren (geht/nic

  Alt 11. Nov 2008, 23:02
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.
Lasse
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:20 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz