Sammenligne mapper og filer i to vaglte mapper?

hvorfor bruger du ikke bare windows's "Synchronize"

Fordi jeg gerne ville lave et selv :P Det er vel den eneste måde man lærer at programmere på ;)
Og så fik jeg for en gang skyld en idé til noget jeg også kunne bruge til noget ;)

Ok, du skal starte med en recursiv rutine til at scane alle dine filer/bib. ind i en stringlist evt. det gør du så for de to bib. du vil sync. og så skal du "bare" løbe dine to lister igennem og gøre det der skal gøres :)

PS. Du kan prøve at søge på diskscaner her på siden, lagde på et tidspunkt en scan rutine op :)

http://www.eksperten.dk/spm/593786
kan det være den? men jeg må indrømme at jeg ikke får synderligt meget ud af det :\ men jeg ved så heller ikke hvordan man "gennemløber" en mappe :\

Jeg bliver sku nødt til at gå i seng nu xD
men fandt det her:

----------

procedure TForm1.Button2Click(Sender: TObject);
var
  sr: TSearchRec;
  I: Integer;
  sl: TStringList;
begin
  sl := TStringList.Create;
  I := FindFirst(edtOrgFolder.Text+'\*.*', faAnyFile, sr);
  try
    while I = 0 do
    begin
      lbOrgList.Items.Add(sr.Name);
      I := FindNext(sr);
    end;
  finally
    FindClose(sr);
    sl.free;
  end;
end;

-----------

Men den skriver kun fil/mappenavnet ikke stien :\ og så får den ikke undermapper og filer med :(
men må lige kigge på det i morgen :)
Godnat

Sådan kort og hurtig, det kan måske give dig nogle ideer.

BEMÆRK: Koden virker, så pas på med hvilke mapper du angiver.

------------

procedure ListFiles(var IniPath : string; st : TStringList);

procedure Start(Path : string);
var
    Rec    : TSearchRec;
  FR    : integer;
begin
    FR:=FindFirst(IniPath+Path+'*.*',faAnyFile    ,Rec);
    while FR=0 do
    begin
    if (Rec.Name<>'.') and (Rec.Name<>'..') then
    begin
          if ((Rec.Attr and faDirectory)=faDirectory) then
          Start(Path+Rec.Name+'\')
      else
        st.Add(Path+Rec.Name);
    end;
    FR:=FindNext(Rec);
    end;
    FindClose(Rec);
end;

begin
  IniPath:=IncludeTrailingPathDelimiter(IniPath);
    Start('');
end;

procedure SyncFolders(Folder1, Folder2 : string);

procedure SyncFolder(F1, F2 : string; s1, s2 : TStringList);
var
  i : integer;
  Path : string;
begin
  for i:=0 to s1.Count-1 do
    if s2.IndexOf(s1[i])=-1 then
    begin
      if not CopyFile(PChar(F1+s1[i]),PChar(F2+s1[i]),false) then
      begin
        Path:=ExtractFilePath(s1[i]);
        ForceDirectories(F2+Path);
        if not CopyFile(PChar(F1+s1[i]),PChar(F2+s1[i]),false) then
          showmessage('Kan ikke kopiere '+s1[i]);
      end;
    end;
end;

var
  s1,s2 : TStringList;
begin
  s1:=TStringLIst.Create;
  s2:=TStringLIst.Create;

  ListFiles(Folder1, s1);
  ListFiles(Folder2, s2);

  SyncFolder(Folder1,Folder2,s1,s2);
  SyncFolder(Folder2,Folder1,s2,s1);

  s1.Free;
  s2.Free;
end;

-------------
Du kalder den f.eks. således:

SyncFolders('c:\hk\test1','c:\hk\test2');

Kunne ikke lade være. Sådan en opgave er perfekt til at gå amok i klasser og objekter.

unit FMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ContNrs;

type
  TSyncDirections = (sdList1To2, sdList2To1, sdBoth);

  TFileData = class;
  TFileList = class;
  TSyncFiles = class;

  TFileData = class
  strict private
    fName: string;
    fDate: TDateTime;
    fSize: int64;
    fOwner: TFileList;
  public
    constructor Create(aOwner: TFileList; const aSearchRec: TSearchRec);
    property Name: string read fName;
    property Date: TDateTime read fDate;
    property Size: int64 read fSize;
    function ToString: string; // Complete filename
  end;

  TFileList = class(TObjectList)
  strict private
    fDirectory: string;
    function GetFileData(const aIndex: integer): TFileData;
  public
    procedure Collect(const aDirectory: string = '');
    property Directory: string read fDirectory;
    function IndexOfFile(aFileData: TFileData): integer;
    property Items[const aIndex: integer]: TFileData read GetFileData; default;
  end;

  TSyncFiles = class
  strict private
    fFileList1: TFileList;
    fFileList2: TFileList;
    procedure Copy(const aSourceFilename, aDestinationFilename: string);
    procedure Delete(const aFilename: string);
    procedure Move(const aSourceFilename, aDestinationPath: string);
  public
    constructor Create(aFileList1, aFileList2: TFileList);
    procedure Syncronize(const aSyncDirection: TSyncDirections = sdBoth);
  end;

  TfrmMain = class(TForm)
    pFolders: TPanel;
    leDirectory1: TLabeledEdit;
    leDirectory2: TLabeledEdit;
    btnLookupDirectory1: TButton;
    btnLookupDirectory2: TButton;
    pButtons: TPanel;
    btnCollect: TButton;
    btnSyncronize: TButton;
    procedure btnCollectClick(Sender: TObject);
    procedure btnSyncronizeClick(Sender: TObject);
    procedure btnLookupDirectory1Click(Sender: TObject);
    procedure btnLookupDirectory2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    fFileList1, fFileList2: TFileList;
  public
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses
  Registry, FileCtrl;

const
  RegKey = '\Software\Abakus\SyncFolder';
  RegValueDir1 = 'directory1';
  RegValueDir2 = 'directory2';

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  fFileList1 := TFileList.Create;
  fFileList2 := TFileList.Create;

  with TRegistry.Create do
    try
      if OpenKeyReadOnly(RegKey) then
      begin
        if ValueExists(RegValueDir1) then
          leDirectory1.Text := ReadString(RegValueDir1);
        if ValueExists(RegValueDir2) then
          leDirectory2.Text := ReadString(RegValueDir2);
      end;
    finally
      Free
    end;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  with TRegistry.Create do
    try
      if OpenKey(RegKey,true) then
      begin
        WriteString(RegValueDir1, leDirectory1.Text);
        WriteString(RegValueDir2, leDirectory2.Text);
      end;
    finally
      Free
    end;

  fFileList2.Free;
  fFileList1.Free;
end;

procedure TfrmMain.btnLookupDirectory1Click(Sender: TObject);
var
  st: string;
begin
  GetDir(0,st);
  if leDirectory1.Text <> '' then
    st := leDirectory1.Text;
  if SelectDirectory('Select first directory','\',st) then
    leDirectory1.Text := st;
end;

procedure TfrmMain.btnLookupDirectory2Click(Sender: TObject);
var
  st: string;
begin
  GetDir(0,st);
  if leDirectory2.Text <> '' then
    st := leDirectory2.Text;
  if SelectDirectory('Select second directory','\',st) then
    leDirectory2.Text := st;
end;

procedure TfrmMain.btnCollectClick(Sender: TObject);
begin
  fFileList1.Collect(leDirectory1.Text);
  fFileList2.Collect(leDirectory2.Text);
end;

procedure TfrmMain.btnSyncronizeClick(Sender: TObject);
var
  SyncFiles: TSyncFiles;
begin
  SyncFiles := TSyncFiles.Create(fFileList1,fFileList2);
  try
    SyncFiles.Syncronize(sdBoth);
  finally
    SyncFiles.Free;
  end;
end;

{ TFileList }

procedure TFileList.Collect(const aDirectory: string);
var
  sr: TSearchRec;
  Found: boolean;
begin
  Clear;

  if aDirectory = '' then
    fDirectory := '.'
  else
    fDirectory := aDirectory;
  Found := FindFirst(IncludeTrailingPathDelimiter(fDirectory) + '*.*',faAnyFile,sr) = 0;
  try
    while Found do
    begin
      if sr.Name[1] <> '.' then
        Add(TFileData.Create(self,sr));
      Found := FindNext(sr) = 0;
    end;
  finally
    FindClose(sr);
  end;
end;

function TFileList.GetFileData(const aIndex: integer): TFileData;
begin
  result := inherited Items[aIndex] as TFileData;
end;

function TFileList.IndexOfFile(aFileData: TFileData): integer;
var
  i: integer;
  Found: boolean;
  FileData: TFileData;
begin
  result := -1; i := -1; Found := false;
  while (i < Count - 1) and not Found do
  begin
    inc(i);
    FileData := Items[i];
    Found := AnsiSameText(FileData.Name,aFileData.Name)
        and (FileData.Size = aFileData.Size);
  end;
  if Found then
    result := i;
end;

{ TFileData }

constructor TFileData.Create(aOwner: TFileList; const aSearchRec: TSearchRec);
begin
  inherited Create;
  fOwner := aOwner;
  fName := aSearchRec.Name;
  fSize := aSearchRec.Size;
  fDate := FileDateToDateTime(aSearchRec.Time);
end;

{ TSyncFile }

procedure TSyncFiles.Copy(const aSourceFilename, aDestinationFilename: string);
begin
  CopyFile(pchar(aSourceFilename),pchar(aDestinationFilename),false);
end;

constructor TSyncFiles.Create(aFileList1, aFileList2: TFileList);
begin
  inherited Create;
  fFileList1 := aFileList1;
  fFileList2 := aFileList2;
end;

procedure TSyncFiles.Delete(const aFilename: string);
begin
  DeleteFile(aFilename);
end;

procedure TSyncFiles.Move(const aSourceFilename, aDestinationPath: string);
begin
  MoveFile(pchar(aSourceFilename),
          pchar(IncludeTrailingPathDelimiter(aDestinationPath) +
                ExtractFileName(aSourceFilename)));
end;

procedure TSyncFiles.Syncronize(const aSyncDirection: TSyncDirections);
var
  i, index: Integer;
begin
  case aSyncDirection of
    sdList1To2 : for i := 0 to fFileList1.Count - 1 do
                begin
                  index := fFileList2.IndexOfFile(fFileList1[i]);
                  if index < 0 then
                    self.Copy(fFileList1[i].ToString,IncludeTrailingPathDelimiter(fFileList2.Directory) + fFileList1[i].Name);
                end;
    sdList2To1 : for i := 0 to fFileList2.Count - 1 do
                begin
                  index := fFileList1.IndexOfFile(fFileList2[i]);
                  if index < 0 then
                    self.Copy(fFileList2[i].ToString,IncludeTrailingPathDelimiter(fFileList1.Directory) + fFileList2[i].Name);
                end;
    sdBoth    : begin
                  Syncronize(sdList1To2);
                  fFileList2.Collect;
                  Syncronize(sdList2To1);
                end;
  end;
end;

function TFileData.ToString: string;
begin
  result := IncludeTrailingPathDelimiter(fOwner.Directory) + fName;
end;

end.


Jeg har testet at den synkroniserer to kataloger (begge veje). Programmet kan let udvides til at kigge på fildatoer (overskrive gamle med nye osv).

En anden måde var måske at overvåge kataloget for ændringer og synkrnonisere der. Måske endda implementere dette som en service i XP.

kroning >> Det virker sådan set rigtig godt. Kan lige forklare hvordan programmet skal bruges, det er fordi vi har et rum som vi bruger til fester, og hygge og sådan noget, og der smider jeg min gamle computer ud som "jukebox", men det er jo på min nye computer jeg lægger nyt musik ind, og så skulle jeg bruge det her program til at kunne sync, en gang imellem når rummet skal bruges. Og da det sikkert handler om en del filer så ville det være ret godt hvis den kunne skrive hvad den var igang med at kopiere? er det noget der kan lade sig gøre? og så brokkede den sig over det her tegn i et filnavn "o&#770;"

hrc >> Kan godt li du selv siger det "gå amok" :P jeg har ikke fået testet det endnu, og jeg forstår desværre ikke ret meget af klasser og alt sådan noget :\ men det ser sku ret fancy ud xD håber på at få tid til at få det testet i morgen/dag efter skole :)

Og mange tak for jeres svar begge to :) det er dejligt så hjælpsomme folk er herinde :)

hrc: Nu har jeg kun hurtig kikket ned gennem din kode, men har du ikke glemt undermapper?

kroning: Åhh skulle de med? Det komplicerer det jo en smule. Det må være noget med rekursive lister, eller ved at lade TFileData nedarve fra TObjectList og så bygge strukturen op der. The quick og egentlig ikke særlig dirty løsning er din (den er pænt lavet, men nu ville jeg lave en sætning med "quick-and-dirty").

dilling-h: Hvis du har en email kan jeg sende dig programmet i aften (det er lavet i D2006 men indeholder ikke ret meget en ældre version ikke ville kunne kapere). Måske kan du få startet med klasser og den slags. Noget af det er indforstået, såsom dekretet "default", men måske...

Humlen i det er at jeg henter alle de fundne filer over i en liste (TObjectList -> TFileList). Hver fil da ligger i et TFileData-objekt. Alt det her gemmes jo i hukommelsen men da alle TFileData-objekter gemmes i nedarvinger af TObjectList bliver de alle frigivet når listerne bliver. Jeg bruger den liste meget (prøv bare at søge på Eksperten).

Min mail er drakedrake @ hotmail.co.uk :)
jeg kan alligevel først få kigget på det i aften, så det er helt iorden ;)
men igen, så forstår jeg ikke meget af din kode, men er der mulighed for at man kan lave en processbar, og skrive hvad for en fil den er igang med? for da computerne ikke er forbundet altid, så kan det godt ende med at det kommer op i at par gb den skal sync :\ og så er det ikke ret smart hvis programmet bare ligner det er frosset :)

Her er en løsning med en InfoLabel og en ProgressBar

--------


procedure ListFiles(var IniPath : string; st : TStringList);

procedure Start(Path : string);
var
    Rec    : TSearchRec;
  FR    : integer;
begin
    FR:=FindFirst(IniPath+Path+'*.*',faAnyFile    ,Rec);
    while FR=0 do
    begin
    if (Rec.Name<>'.') and (Rec.Name<>'..') then
    begin
          if ((Rec.Attr and faDirectory)=faDirectory) then
          Start(Path+Rec.Name+'\')
      else
        st.Add(Path+Rec.Name);
    end;
    FR:=FindNext(Rec);
    end;
    FindClose(Rec);
end;

begin
  IniPath:=IncludeTrailingPathDelimiter(IniPath);
    Start('');
end;

function CopyProgressRoutine(
    TotalFileSize : Int64;    // total file size, in bytes
    TotalBytesTransferred : Int64;    // total number of bytes transferred
    StreamSize : Int64;    // total number of bytes for this stream
    StreamBytesTransferred : Int64;    // total number of bytes transferred for this stream
    dwStreamNumber : DWORD;    // the current stream
    dwCallbackReason : DWORD;    // reason for callback
    hSourceFile : THandle;    // handle to the source file
    hDestinationFile : THandle;    // handle to the destination file
    lpData : pointer) : DWORD; stdcall; // passed by CopyFileEx
begin
  TProgressBar(lpData).Max:=TotalFileSize;
  TProgressBar(lpData).Position:=TotalBytesTransferred;
  TProgressBar(lpData).Update;
  Result:=PROGRESS_CONTINUE;
end;

procedure SyncFolders(Folder1, Folder2 : string;InfoLabel : TLabel;ProgressBar : TProgressBar);

procedure SyncFolder(F1, F2 : string; s1, s2 : TStringList);

function CopyFile(FromName, ToName : string) : boolean;
var
  pbCancel : BOOL;
begin
  pbCancel:=false;
  Result:=CopyFileEx(PChar(FromName),PChar(ToName),@CopyProgressRoutine,ProgressBar,@pbCancel,0);
end;

var
  i : integer;
  Path : string;
begin
  for i:=0 to s1.Count-1 do
    if s2.IndexOf(s1[i])=-1 then
    begin
      InfoLabel.Caption:=F1+s1[i];
      Application.ProcessMessages;
      if not CopyFile(F1+s1[i],F2+s1[i]) then
      begin
        Path:=ExtractFilePath(s1[i]);
        ForceDirectories(F2+Path);
        if not CopyFile(F1+s1[i],F2+s1[i]) then
          showmessage('Kan ikke kopiere '+s1[i]);
      end;
    end;
end;

var
  s1,s2 : TStringList;
begin
  s1:=TStringLIst.Create;
  s2:=TStringLIst.Create;

  ListFiles(Folder1, s1);
  ListFiles(Folder2, s2);

  SyncFolder(Folder1,Folder2,s1,s2);
  SyncFolder(Folder2,Folder1,s2,s1);

  s1.Free;
  s2.Free;
  InfoLabel.Caption:='Sync. afslutter';
end;

-----------

Smid en TLabel og en TProgressBar på din form og kald den således:

SyncFolders('c:\hk\test1','c:\hk\test2',Label1,ProgressBar1);

Glemte at nævne at det _ikke_ vil virke på en Win98 eller mindre computer.

mange mange tak, bliver testet når jeg kommer hjem, skolen vil desvæære ikke blive så glad hvis jeg installere delphi her oppe xD og så er det også iorden det ikke virker på 98 :P er der overhoved nogen der bruger det mere :\

kroning >> testet, virker skide godt ;) er det muligt at få en Cancel knap til at virke?

og nu lige nogen ikke livsnødvændige spørgsmål ;) som du bare skal ignorere hvis det er noget der er meget besværligt ;)
Er det meget svært at få en "total" progressbar med?

Og prøv at kalde en fil det her og få programmet til at kopiere den
"12 Jo&#770;gashima No Ame.flac"
er det noget der kan komme til at virke?

Jeg har kaldt en fil 12 Jo&#770;gashima No Ame.flac og den bliver kopieret uden problemer.
Hvilken fejl får du?

hov når jeg poster navnet skriver den noget andet.
jeg har lige fjernet indholdet i filen, da den fyldte 15 mb, men prøv med den her fil:
http://www.myupload.dk/showfile/242188eac3.flac

Ja nu får jeg også en fejl, det er åbenbart fordi nogle af de elementer der bruges som f.eks. TStringList ikke understøtter det underlige tegn der er i navnet.
Når der kommer ind i TStringlist bliver det til:
12 Jo^gashima No Ame.flac

Har ikke lige en løsning på det, jeg skal på arbejde nu men kikker på det i morgen aften.

som jeg også skrev så er det ikke vigtigt, det var mere hvis du bare lige kendte svaret, det kan jeg jo se her på eksperten at du gør nogen gange ;)
tænkte mere på en cancel knap ? den kan jo nok være ret smart at have :P

Her er en løsning med en cancel knap, men det er jo noget fusk man burde jo smide det ind i en tråd.

Men definer denne var global:
pbCancel : BOOL;

Smid en knap på din form og skriv denne kode i OnClick:
pbCancel:=true;

------------------

procedure ListFiles(var IniPath : string; st : TStringList);

procedure Start(Path : string);
var
    Rec    : TSearchRec;
  FR    : integer;
begin
    FR:=FindFirst(IniPath+Path+'*.*',faAnyFile    ,Rec);
    while FR=0 do
    begin
    if (Rec.Name<>'.') and (Rec.Name<>'..') then
    begin
          if ((Rec.Attr and faDirectory)=faDirectory) then
          Start(Path+Rec.Name+'\')
      else
        st.Add(Path+Rec.Name);
    end;
    FR:=FindNext(Rec);
    end;
    FindClose(Rec);
end;

begin
  IniPath:=IncludeTrailingPathDelimiter(IniPath);
    Start('');
end;

function CopyProgressRoutine(
    TotalFileSize : Int64;    // total file size, in bytes
    TotalBytesTransferred : Int64;    // total number of bytes transferred
    StreamSize : Int64;    // total number of bytes for this stream
    StreamBytesTransferred : Int64;    // total number of bytes transferred for this stream
    dwStreamNumber : DWORD;    // the current stream
    dwCallbackReason : DWORD;    // reason for callback
    hSourceFile : THandle;    // handle to the source file
    hDestinationFile : THandle;    // handle to the destination file
    lpData : pointer) : DWORD; stdcall; // passed by CopyFileEx
begin
  TProgressBar(lpData).Max:=TotalFileSize;
  TProgressBar(lpData).Position:=TotalBytesTransferred;
  TProgressBar(lpData).Update;
  Application.ProcessMessages;
  if pbCancel then
    Result:=PROGRESS_CANCEL
  else
    Result:=PROGRESS_CONTINUE;
end;

procedure SyncFolders(Folder1, Folder2 : string;InfoLabel : TLabel;ProgressBar : TProgressBar);

procedure SyncFolder(F1, F2 : string; s1, s2 : TStringList);

function CopyFile(FromName, ToName : string) : boolean;
begin
  Result:=CopyFileEx(PAnsiChar(FromName),PAnsiChar(ToName),@CopyProgressRoutine,ProgressBar,@pbCancel,0);
end;

var
  i : integer;
  Path : string;
begin
  for i:=0 to s1.Count-1 do
    if s2.IndexOf(s1[i])=-1 then
    begin
      InfoLabel.Caption:=F1+s1[i];
      if not CopyFile(F1+s1[i],F2+s1[i]) then
      begin
        if pbCancel then
          Break;
        Path:=ExtractFilePath(s1[i]);
        ForceDirectories(F2+Path);
        if not CopyFile(F1+s1[i],F2+s1[i]) then
          showmessage('Kan ikke kopiere '+s1[i]);
      end;
    end;
end;

var
  s1,s2 : TStringList;
begin
  s1:=TStringLIst.Create;
  s2:=TStringLIst.Create;

  ListFiles(Folder1, s1);
  ListFiles(Folder2, s2);

  pbCancel:=false;
  SyncFolder(Folder1,Folder2,s1,s2);
  SyncFolder(Folder2,Folder1,s2,s1);

  s1.Free;
  s2.Free;
  InfoLabel.Caption:='Sync. afslutter';
end;

Jeg har en anden løsning som dog kræver du må ud i kommandoprompten og lave en cmd-fil. Kom til at tænke på XCopy og hvis du skriver

  xcopy <source>\*.* <destination> /S /M

vil den første gang kopiere alle filer. Dernæst vil den kun kopiere de med "archive" flaget sat. Hver gang du op-/retter en fil sættes flaget. Så når du genererer nye filer er det kun de der kopieres.

Hvis du ikke gider se den kopiere alt første gang, kan du fyre denne kommando af i dit <source> katalog:

  attrib *.* -a /s

.. så nulstiller du archive-flaget.

kroning >> mange tak, prøver lige når jeg kommer hjem :)

hrc >> Grunden til at jeg vælger at lave det i delphi er jo også at jeg kan øve mig vil i det, og (er da også tilfældet denne gang) lære noget nyt ;) men tak alligevel, nu har jeg så også lært noget batch som jeg ikke vidste :P og tak for mailen, den skal jeg lige finde lidt tid til at kigge igennem, der står jo meget xD

Hvis i vil se færdige resultat:
http://www.myupload.dk/showfile/26678812e7.7z

og rigtig mange tak for hjælpen kroning, så mangler jeg bare lige et svar, så skal du nok få dine point :)

og også tak til hrc, var ikke lige planen, men lærte da lidt om batch :P heh

Og et svar