Tips (1541)

Tip Bewertung (89):

{ 1. }

{
 You need a TProgressBar on your form for this tip.
 Für diesen Tip wird eine TProgressBar benötigt.
}


procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
begin
  AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Progressbar1 do
  begin
    Min := 0;
    Max := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      Position := Position + NumRead;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyFileWithProgressBar1('c:\Windows\Welcome.exe', 'c:\temp\Welcome.exe');
end;

{ 2. }

{***************************************}

// To show the estimated time to copy a file:

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
  t1, t2: DWORD;
  maxi: integer;
begin
  AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Progressbar1 do
  begin
    Min  := 0;
    Max  := FileLength;
    t1   := TimeGetTime;
    maxi := Max div 4096;
    while FileLength > 0 do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      t2  := TimeGetTime;
      Min := Min + 1;
      // Show the time in Label1
      label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100);
      Application.ProcessMessages;
      Position := Position + NumRead;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;

{ 3. }
{***************************************}
// To show the estimated time to copy a file, using a callback function:

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

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


implementation

procedure FastFileCopyCallBack(Position, Size: Longint);
begin
  Form1.ProgressBar1.Max := Size;
  Form1.ProgressBar1.Position := Position;
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
          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}




procedure TForm1.Button1Click(Sender: TObject);
begin
  FastFileCopy('c:\daten.txt', 'c:\test\daten2.txt', @FastFileCopyCallBack);
end;

{ 4. }
{***************************************}


function CopyFileWithProgressBar2(TotalFileSize,
  TotalBytesTransferred,
  StreamSize,
  StreamBytesTransferred: LARGE_INTEGER;
  dwStreamNumber,
  dwCallbackReason: DWORD;
  hSourceFile,
  hDestinationFile: THandle;
  lpData: Pointer): DWORD; stdcall;
begin
  // just set size at the beginning
  if dwCallbackReason = CALLBACK_STREAM_SWITCH then
    TProgressBar(lpData).Max := TotalFileSize.QuadPart;

  TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;
  Application.ProcessMessages;
  Result := PROGRESS_CONTINUE;
end;

function TForm1.CopyWithProgress(sSource, sDest: string): Boolean;
begin
  // set this FCancelled to true, if you want to cancel the copy operation
  FCancelled := False;
  Result     := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,
    ProgressBar1, @FCancelled, 0);
end;

end;

{***************************************}