Kopieren mit TProgressbar Ausserhalb des gültigen bereiches

[gee21]

Hallo alle zusammen.

Habe im netz (Bei Torry)
Den folgenden Code gefunden und minimal angepasst. Egentlich funktioniert auch alles. (Dateien, respektive Ordner Inhalt kopieren)
Aber je nach Dateigrösse die ich verwende zum kopieren, erhalte ich zum Teil (nicht immer) die Fehlermeldung:

"Eigenschaft TProgressbar ausserhalb der zulässigen Bereiches."

ich vermute das der Max Wert der Progressbar je nach Dateigrösse zu gross ist. Daher versuchte ich einfach den Wert zu dividieren durch 100
Aber irgendwie klappte auch dass nicht und die Fehlermeldung kommt weiterhinn

Delphi-Quellcode:

type
   TCallBack = procedure(Position, Size: Longint); { export; }

procedure FastFileCopy(const InFileName, OutFileName: string;
   CallBack: TCallBack);

implementation

uses Optionen, Unit3, Unit5, Unit6, Unit7, Unit8, uFTPServer;

{$R *.dfm}



procedure TForm1.WMSysCommand;
begin
if (Msg.CmdType = SC_MAXIMIZE) then
button6.Click ;
DefaultHandler(Msg) ;
if form1.WindowState=wsmaximized then form1.WindowState:=wsnormal;
end;


procedure FastFileCopyCallBack(Position, Size: longint);
begin



   Form1.ProgressBar1.Max := Size;
   Form1.ProgressBar1.Position := Position;

// BRINGT nichts
// Form1.ProgressBar1.Max := Size div 100; 
//   Form1.ProgressBar1.Position := Position div 100;


end;

procedure FastFileCopy(const InFileName, OutFileName: string;
   CallBack: TCallBack);
const
   BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results }
type
   PBuffer = ^TBuffer;
   TBuffer = array[1..BufSize] of Byte;
var
   Size: DWORD;
   Buffer: PBuffer;
   infile, outfile: file;
   SizeDone, SizeFile: LongInt;
begin
   if (InFileName <> OutFileName) then
   begin
     buffer := nil;
     Assign(infile, InFileName);
     Reset(infile, 1);
     try
       SizeFile := FileSize(infile);
       Assign(outfile, OutFileName);
       Rewrite(outfile, 1);
       try
         SizeDone := 0;
         New(Buffer);
         repeat
         application.ProcessMessages;
           BlockRead(infile, Buffer^, BufSize, Size);
           Inc(SizeDone, Size);
           CallBack(SizeDone, SizeFile);
           BlockWrite(outfile, Buffer^, Size)
         until Size < BufSize;
         FileSetDate(TFileRec(outfile).Handle,
         FileGetDate(TFileRec(infile).Handle));
       finally
         if Buffer <> nil then
           Dispose(Buffer);
         CloseFile(outfile)
       end;
     finally
       CloseFile(infile);
     end;
   end
   else
     raise EInOutError.Create('File cannot be copied onto itself')
end; {FastFileCopy}

Aufrufen tu ich es dann so:

Delphi-Quellcode:

 if directoryexists(form2.Edit2.Text+'\'+form1.ListBox1MAINLISTE.Items[form1.ListBox1MAINLISTE.ItemIndex])=false then forcedirectories(form2.Edit2.Text+'\'+form1.ListBox1MAINLISTE.Items[form1.ListBox1MAINLISTE.ItemIndex]);

repeat
application.ProcessMessages;

if fileexists(form1.FileListBox1.Items[0]) then begin
FastFileCopy(form1.FileListBox1.Items[0], form2.Edit2.Text+'\'+form1.ListBox1MAINLISTE.Items[form1.ListBox1MAINLISTE.ItemIndex]+'\'+form1.FileListBox1.Items[0],  @FastFileCopyCallBack);
application.ProcessMessages;
end;
if form1.FileListBox1.Items.Count>0 then  form1.FileListBox1.Items.Delete(0);

until form1.FileListBox1.Items.Count<1;
PlaySound(PChar(ExtractFilePath(Application.Exename)+'\Sounds\copy.wav'),0,SND_ASYNC);

Könnt ihr mir sagen wo der Fehler passiert? Respektive wie man ihn einfach lösen könnte?

Danke & Gruess

[Union]

Ich meine es müsste in dem Callback heissen:

Delphi-Quellcode:

Form1.ProgressBar1.Max := 100;
Form1.ProgressBar1.Position := Position div Size * 100;

[gee21]

Zitat von Union:

Ich meine es müsste in dem Callback heissen:

Delphi-Quellcode:

Form1.ProgressBar1.Max := 100;
Form1.ProgressBar1.Position := Position div Size * 100;

Ja Hallo und danke für die Antwort.

So geht's! Leider aber zeigt nun merkwürdigerweise die Progressbar den aktuellen Status nicht mehr an. Die Datei wir kopiert und anschliessend springt die Progressbar von 0 direkt auf 100 ??

[Union]

Dann bau doch ein Progressbar1.Update oder Application.Processmessages ein. Das könnte allerdings die Performance vernichten. Oder lass mal ein Debugprotokoll mitlaufen, in dem Du dann sehen kannst wie oft und mit welchen Parameter der Callback aufgerufen wird.

[gee21]

Ja ein application.proccessmesages hab ich noch zusätzlich bei deinem code eingebaut. Hat aber leider nichts gebracht.

debug weiss ich leider nicht wie es geht.

[Union]

Setz links neben dem Source im "Gutter" einen Breakpoint. Auf dem roten Pünktchen dann die rechte Maustaste klicken und "Haltepunkt Eigenschaften" auswählen.
Dort "erweitert" betätigen. "Anhalten" ausschalten. In Eval-Ausdruck z.b. Position eingeben. Programm starten. Im Protokoll wird dann der Wert jedes Mal geschrieben, wenn diese Stelle ausgeführt wird.

[Volker Z.]

Hi gee21,

versuch mal folgendes:

Delphi-Quellcode:

procedure FastFileCopyCallBack(Position, Size: longint);
begin
  Form1.ProgressBar1.Max      := Size;
  Form1.ProgressBar1.Position := Position;
  Form1.ProgressBar1.Update
end;

procedure FastFileCopy(const InFileName, OutFileName: string; CallBack: TCallBack);
const
   BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results }
type
   PBuffer = ^TBuffer;
   TBuffer = array[1..BufSize] of Byte;
var
   Size: DWORD;
   Buffer: PBuffer;
   infile, outfile: file;
   SizeDone, SizeFile: LongInt;
begin
  buffer := nil;
  if (InFileName <> OutFileName) then
    try
      try
        AssignFile(infile, InFileName);
        Reset(infile, 1);
        AssignFile(outfile, OutFileName);
        Rewrite(outfile, 1);

        SizeDone := 0;
        SizeFile := FileSize(infile);

        Callback (0, SizeFile);

        New(Buffer);
        repeat
          BlockRead(infile, Buffer^, BufSize, Size);
          Inc(SizeDone, Size);
          BlockWrite(outfile, Buffer^, Size);

          Callback (SizeDone, SizeFile)
        until Size < BufSize;

        FileSetDate(TFileRec(outfile).Handle, FileGetDate(TFileRec(infile).Handle));
      except
        // Exception behandeln
      end
    finally
      if Buffer <> nil then
        Dispose(Buffer);
      CloseFile(outfile);
      CloseFile(infile)
    end
  else
    raise EInOutError.Create('File cannot be copied onto itself')
end;

Sollte funktionieren.

Grüße in die Schweiz

[sx2008]

Exception abfangen, mit nützlichen Infos erweitern und dann neu auslösen:

Delphi-Quellcode:

procedure FastFileCopyCallBack(Position, Size: longint);
begin
  try
    Form1.ProgressBar1.Max := Size;
    Form1.ProgressBar1.Position := Position;
  except
    on E:Exception do
    begin
      E.Message := E.Message +#13#10 + Format('size=%d pos=%d', [Size, Position]);
      raise;
    end;
end;

[gee21]

Zitat von sx2008:

Exception abfangen, mit nützlichen Infos erweitern und dann neu auslösen:

Delphi-Quellcode:

procedure FastFileCopyCallBack(Position, Size: longint);
begin
  try
    Form1.ProgressBar1.Max := Size;
    Form1.ProgressBar1.Position := Position;
  except
    on E:Exception do
    begin
      E.Message := E.Message +#13#10 + Format('size=%d pos=%d', [Size, Position]);
      raise;
    end;
end;

Hi und danke für deine Hilfe. Vielleicht sollte ich noch erwähnen, dass ich ein ziemlicher Anfänger bin

Bekomme nun folgende Meldung.

Eigenschaft TProgressbar ausserhalb des zulässigen Bereichs
size=-1761105920 pos=49152

[gee21]

Zitat von Volker Z.:

Hi gee21,

versuch mal folgendes:

Delphi-Quellcode:

procedure FastFileCopyCallBack(Position, Size: longint);
begin
  Form1.ProgressBar1.Max      := Size;
  Form1.ProgressBar1.Position := Position;
  Form1.ProgressBar1.Update
end;

procedure FastFileCopy(const InFileName, OutFileName: string; CallBack: TCallBack);
const
   BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results }
type
   PBuffer = ^TBuffer;
   TBuffer = array[1..BufSize] of Byte;
var
   Size: DWORD;
   Buffer: PBuffer;
   infile, outfile: file;
   SizeDone, SizeFile: LongInt;
begin
  buffer := nil;
  if (InFileName <> OutFileName) then
    try
      try
        AssignFile(infile, InFileName);
        Reset(infile, 1);
        AssignFile(outfile, OutFileName);
        Rewrite(outfile, 1);

        SizeDone := 0;
        SizeFile := FileSize(infile);

        Callback (0, SizeFile);

        New(Buffer);
        repeat
          BlockRead(infile, Buffer^, BufSize, Size);
          Inc(SizeDone, Size);
          BlockWrite(outfile, Buffer^, Size);

          Callback (SizeDone, SizeFile)
        until Size < BufSize;

        FileSetDate(TFileRec(outfile).Handle, FileGetDate(TFileRec(infile).Handle));
      except
        // Exception behandeln
      end
    finally
      if Buffer <> nil then
        Dispose(Buffer);
      CloseFile(outfile);
      CloseFile(infile)
    end
  else
    raise EInOutError.Create('File cannot be copied onto itself')
end;

Sollte funktionieren.

Grüße in die Schweiz

Hi Volker

Danke dir für deine Hilfe. (Wieder einmal) es funktioniert!

Grüsse zurück