DBR Delphi-Ecke

// Getestet mit D4 unter Win98

// 1. Kopieren mit dem Befehl "copyfile"

procedure Dateicopy(von, nach: string); 
begin 
  if not copyfile(pchar(von), pchar(nach), true) 
    then if application.messagebox(pchar('Soll die Datei ' + nach + 
      ' überschrieben werden?'), 'Datei bereits vorhanden', mb_yesno or 
      mb_iconerror) = idyes then copyfile(pchar(von), pchar(nach), false); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  dateicopy('c:\autoexec.bat', 'c:\test.txt'); 
end;

//-------------------------------------------------------------

// 2. Kopieren einer Datei mittels "LZCopy"
// Falls die Ausgangsdatei nicht vorhanden ist, wird eine Meldung ausgegeben.
// Die Zieldatei wird überschrieben.

uses LZExpand; 
 
function CPYF(Quelle, Ziel: string): longint; 
var 
  Q, Z: Integer; 
  Buf: TOFStruct; 
begin 
  Q := LZOpenFile(pchar(Quelle), Buf, of_Read or of_Prompt); 
  Z := LZOpenFile(pchar(Ziel), Buf, of_Create); 
  result := LZCopy(Q, Z); 
  LZClose(Q); 
  LZClose(Z); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var b: longint; 
begin 
  b := cpyf('c:\autoexec.bat', 'c:\test.txt'); 
  if b < 0 then showmessage('Fehler') else begin 
    showmessage(formatfloat('0.0 KB kopiert', b / 1024)); 
  end; 
end;

//-------------------------------------------------------------

// 3. Kopieren mit eigener Fortschrittsanzeige
//    Der Stand beim Kopieren wird mit einer Progressbar und einem Label
//    angezeigt. Bei großen Dateien kann während des Kopierens Systemzeit
//    freigegeben werden.

const bufgr = 1000; 
 
function masseinheit(zahl: longint): string; 
begin 
  if zahl >= 1048576 then 
    result := formatfloat('0.0 MB', zahl / 1048576) 
  else 
    result := formatfloat('0.0 KB', zahl / 1024); 
end; 
 
procedure
datcop(von, nach: string; prgrb: TProgressbar; Freigabe: boolean; lbl: TLabel); 
var
  quelle, ziel: file; 
  anzahl, geschrieben: integer; 
  buf: array[1..bufgr] of Char; 
  s: string; 
begin 
  prgrb.position := 0; 
  prgrb.min := 0; 
  assignfile(quelle, von); 
  assignfile(ziel, nach); 
  reset(quelle, 1); 
  rewrite(ziel, 1); 
  prgrb.max := filesize(quelle); 
  s := masseinheit(prgrb.max); 
  repeat 
    BlockRead(quelle, Buf, SizeOf(Buf), anzahl); 
    BlockWrite(ziel, Buf, anzahl, geschrieben); 
    prgrb.position := prgrb.position + geschrieben; 
    lbl.caption := masseinheit(prgrb.position) + ' von ' + s; 
    if freigabe then 
      application.processmessages 
    else lbl.refresh; 
  until (anzahl = 0) or (geschrieben <> anzahl); 
  closefile(quelle); 
  closefile(ziel); 
  prgrb.position := 0; 
end; 
 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  datcop('D:\bilder\corel004.bmp', 'C:\test.bmp', progressbar1, true, Label1); 
end;

//-------------------------------------------------------------

// 4. Kopieren von ein oder mehreren Dateien mittels API
//    Ist der Zielordner nicht vorhanden, wird gefragt, ob er angelegt
//    werden soll. Bei größeren Datenmengen wird eine Fortschrittsanzeige
//    angezeigt.

uses shellapi; 
 
function Kopiere(qa: array of string; z: string; Kopie: boolean): integer; 
var 
  sfo: tshfileopstruct; 
  x: integer; 
  q: string; 
begin 
  z := z + #0#0; 
  q := ''; 
  for x := 0 to high(qa) do q := q + qa[x] + #0; 
  q := q + #0; 
  zeromemory(@sfo, sizeof(sfo)); 
  with sfo do begin 
    wnd := application.handle; 
    wfunc := fo_copy; 
    fflags := FOF_FILESONLY or FOF_ALLOWUNDO; 
    if kopie then 
      fflags := fflags or FOF_RENAMEONCOLLISION; 
    pfrom := @q[1]; 
    pto := @z[1]; 
  end; 
  result := shfileoperation(sfo); 
end; 
 
 
// --- Beispielaufrufe --- 
 
// Eine einzelne Datei kopieren: 
// Ist die Zieldatei bereits vorhanden, wird eine neue Datei mit 
// dem Namen "Kopie von..." bzw. "Kopie (2) von..." usw. angelegt. 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  if kopiere(['C:\test.bmp'], 'C:\MyFolder\versuch.bmp', true) <> 0 then 
    showmessage('Kopieren nicht vollständig'); 
end; 
 
 
// Alle Bitmaps kopieren. Wenn es schon einen Namen gibt, 
// wird abgefragt, ob die Datei überschrieben werden soll. 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  if kopiere(['D:\Bilder\*.bmp'], 'C:\MyFolder\', false) <> 0 then 
    showmessage('Kopieren nicht vollständig'); 
end; 
 
 
// Verschiedene Einzel-Datei in einen Ordner kopieren: 
// Ist eine Datei vorhanden, wird abgefragt, ob sie 
// überschrieben werden soll. 
 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  if kopiere(['D:\Bilder\Corel004.bmp', 'D:\Uhr.exe', 'C:\test.bmp'], 
    'C:\MyFolder\', false) <> 0 then 
      showmessage('Kopieren nicht vollständig'); 
end; 
 
 
// Kopie einer Datei ("Kopie von...") im selben Ordner erzeugen 
 
procedure TForm1.Button8Click(Sender: TObject); 
begin 
  if kopiere(['C:\test.bmp'], 'C:\test.bmp', true) <> 0 then 
    showmessage('Kopieren nicht vollständig'); 
end;