kopiere filer fra mappe1 til mappe2

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Buttons, FileCtrl;

type
  TMainForm = class(TForm)
    EditFra: TEdit;
    EditTil: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    BarAktuel: TProgressBar;
    BarTotal: TProgressBar;
    Label3: TLabel;
    Label4: TLabel;
    BtnStart: TButton;
    BtnFra: TSpeedButton;
    BtnTil: TSpeedButton;
    LabelStatus: TLabel;
    Button1: TButton;
    procedure BtnFraClick(Sender: TObject);
    procedure BtnTilClick(Sender: TObject);
    procedure BtnStartClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    AntalFiler : integer;
    CancelIt : Boolean;

        procedure CopyFiles(DoCopy : boolean);
    procedure DoCopyFile(const SrcFile, DstFile: string);
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.BtnFraClick(Sender: TObject);
var
    Sti : string;
begin
    if Selectdirectory('Vælg mappe','',Sti) then
        EditFra.Text:=Sti;
end;

procedure TMainForm.BtnTilClick(Sender: TObject);
var
    Sti : string;
begin
    if Selectdirectory('Vælg mappe','',Sti) then
        EditTil.Text:=Sti;
end;

procedure TMainForm.DoCopyFile(const SrcFile, DstFile: string);
const
  bufSize = 16384; {Use a 16K buffer. You can use whatever size suits you, though.}
var
//  test : TFileStream;
  sStream,
  dStream : TFileStream;
  pBuf    : Pointer;
  cnt    : Integer;
  totCnt,
  strmSize    : LongInt;
begin
  totCnt := 0;
  {Open up the Source File to read it}

//  test := TFileStream.Create(SrcFile, fmShareExclusive);
    sStream := TFileStream.Create(SrcFile, fmOpenRead or fmShareDenyWrite);
//  test.Free;

  {Get the size of the entire stream to use for the progress gauge. Note
  we have to call FileSeek first because it will place the pointer
  at the end of the file when we get the file first return value.}
  strmSize := sStream.size;

  try
    { Create the destination file. If it already exists,
      overwrite it. }
    dStream := TFileStream.Create(DstFile, fmCreate or fmShareExclusive);
    try
      GetMem(pBuf, bufSize);
      try
        {Read and write first bufSize bytes from source into the buffer
        If the file size is smaller than the default buffer size, then
        all the user will see is a quick flash of the progress form.}
        cnt := sStream.Read(pBuf^, bufSize);
        cnt := dStream.Write(pBuf^, cnt);

        totCnt := totCnt + cnt;
        {Loop the process of reading and writing}
        while (cnt > 0) do begin
          {Let things in the background proceed while loop is processing}
          Application.ProcessMessages;

          {Read bufSize bytes from source into the buffer}
          cnt := sStream.Read(pBuf^, bufSize);

          {Now write those bytes into destination}
          cnt := dStream.Write(pBuf^, cnt);

          {Increment totCnt for progress and do arithmetic to update the
          gauge}
          totcnt := totcnt + cnt;
          if NOT CancelIt then
            with BarAktuel do begin
              Position:=Round((totCnt / strmSize) * 100);
              Update;
            end
          else
            Break;      {If user presses cancel button, then break out of loop}
                        {which will make program go to finally blocks}
        end;

      finally
        FreeMem(pBuf, bufSize);
      end;
    finally
      dStream.Free;
      if CancelIt then {If copying was cancelled, delete the destination file}
        DeleteFile(DstFile);  {after stream has been freed, which will close the file.}
    end;
  finally
    sStream.Free;
  end;
end;

procedure TMainForm.CopyFiles(DoCopy : boolean);

procedure Start(Sti : string);
var
    Rec    : tsearchrec;
  FindResult    : integer;
  SubDir : string;
begin
    SubDir:=copy(Sti,Length(EditFra.Text),MaxInt);
  if (SubDir<>'') and DoCopy then
        ForceDirectories(EditTil.Text+SubDir);
    FindResult:=FindFirst(Sti+'*.*',faAnyFile    ,Rec);
    while FindResult=0 do
    begin
        if ((Rec.Attr and faDirectory)=faDirectory) and (Rec.Name<>'.') and (Rec.Name<>'..') then
        Start(Sti+Rec.Name+'\')
    else
    if (Rec.Name<>'.') and (Rec.Name<>'..') then
    begin
        Inc(AntalFiler);
      LabelStatus.Caption:=IntToStr(AntalFiler);
      LabelStatus.Update;
      if DoCopy then
      begin
          try
                    DoCopyFile(Sti+Rec.Name,EditTil.Text+SubDir+Rec.Name);
        except
                    on E: Exception do begin
                        beep; //Application.MessageBox(PChar('Kan ikke kopiere filen: '+Rec.Name+' Fejl: '+E.Message),'Fejl',MB_OK or MB_ICONERROR);
                    end;
        end;
          BarTotal.Position:=AntalFiler;
        BarTotal.Update;
            end;
      end;
    FindResult:=FindNext(Rec);
    end;
    FindClose(Rec);
end;

begin
    AntalFiler:=0;
  if EditFra.Text[Length(EditFra.Text)]<>'\' then
        EditFra.Text:=EditFra.Text+'\';
  if EditTil.Text[Length(EditTil.Text)]<>'\' then
        EditTil.Text:=EditTil.Text+'\';

    Start(EditFra.Text);
end;

procedure TMainForm.BtnStartClick(Sender: TObject);
begin
    CancelIt:=false;
    CopyFiles(false);
    BarTotal.Max:=AntalFiler;
  CopyFiles(true);
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
    CancelIt:=true;
end;

end.

Men ellers kan du finde flere forslag her på eksperten hvis du søger lidt.

En kortere måde kunne være at løbe din mappe1 igennem for filer og så bruge MoveFileEx til at kopiere dem med. Slå den op i Delphi's hjælp, der er forskellige flag du kan sætte alt efter om de skal overskrive, flyttes, kopieres etc.

Jeg har lavet det her eksempel via nogle eksempler, men kopieringen virker ikke, får ingen fejl...

procedure TBackup.dxButton2Click(Sender: TObject);
var
  FOS :TSHFileOpStruct;
  AppPath : string;
function DoCopy(FromPath, ToPath : string) : boolean;
begin
  with FOS do
  begin
    Wnd  := 0;
    wFunc := FO_COPY;
    pFrom := pchar(FromPath+#0);
    pTo  := pchar(ToPath);
    fFlags:= FOF_NOCONFIRMATION;
  end;
  Result:=SHFileOperation(FOS)=0;

end;
begin
vinform.Table1.Close;
begin
  if DoCopy(AppPath + 'c:\programmer\Win\backup\vinlist*',AppPath + 'c:\programmer\\Win') then
  showmessagepos('Databasen er genoprettet',500,500);
  vinform.Table1.Open;
end;
end;

Måske fordi du har 2 \\ før Win ?

ups den var dum,,,men det giver så bare fejlen fra windows " det er ikke muligt at kopiere fil: kildefilen - eller disken kan ikke læses"

Fjern AppPath:

if DoCopy('c:\programmer\Win\backup\vinlist*','c:\programmer\Win') then
  showmessagepos('Databasen er genoprettet',500,500);

hmm det giver samme fejl
" det er ikke muligt at kopiere fil: kildefilen - eller disken kan ikke læses"

Det må så være fordi at mappen "c:\programmer\Win\backup\vinlist*" ikke findes.

Jeg har testet koden og det virker fint her.

Er det mig der har misforstået noget i min kode for vinlist er alle de forekomster af filer i mappen der skal kopieres.

Som du har skrevet det er det alle filer der starter med "vinlist" i mappen "c:\programmer\Win\backup\" der kopieres.

Løsningen var jo en absolut sti + at huske at lukke table ned...

var
  FOS :TSHFileOpStruct;
function DoCopy(FromPath, ToPath : string) : boolean;
begin
  with FOS do
  begin
    Wnd  := 0;
    wFunc := FO_COPY;
    pFrom := pchar(FromPath+#0);
    pTo  := pchar(ToPath);
    fFlags:= FOF_NOCONFIRMATION;
  end;
  Result:=SHFileOperation(FOS)=0;
end;

begin
Vinform.Table1.Close;
History.Table1.Close;
  if DoCopy('c:\programmer\win\mit program\backup\vinlist*','c:\programmer\win\mit program') then
    if DoCopy('c:\programmer\win\mit program\backup\history*', 'c:\programmer\win\mit program') then
    begin
          showmessagepos('databasen er gendannet',500,500);
Vinform.Table1.Open;
History.Table1.Open;
end;
end;

smid et svar hver især...

k

Det var ikke meget jeg bidrog med i den her, så giv dem bare til Kroning :)