1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:

Procedure TForm1.FindFiles (aPath, aFindMask: String; aWithSub: Boolean; aResult: tStrings);
Var  FindRec                       : tSearchRec;
     existingfilename, pr_filename : string;
     dname, uvname                 : string;
     n, erg                        : integer;
     raus                          : boolean;
Begin
  raus := false;
  If (aPath = '') or (aFindMask = '') or Not Assigned (aResult) Then  Exit;
  If aPath[Length(aPath)] <> '\' Then  aPath := aPath + '\';
  meldung := '';
  If FindFirst (aPath + aFindMask, faAnyFile - faDirectory, FindRec) = 0 Then
  Repeat
    If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
    begin
      if IsfileInUse(aPath + findrec.Name) = true then
      begin
        dname := Findrec.Name;
        if extractfileext(dname) = '.dbf' then schliesse_DBTab(self);
      end;
      if IsfileInUse(aPath + findrec.Name) = false then //prüfen, ob Datei in Benutzung ist
        aResult.Add (aPath + FindRec.Name);  // ...Ergebnis in die Stringlist einfügen
// showmessage(findrec.Name+' *** '+ Datetostr(FileDateToDateTime(FileAge(apath+FindRec.Name)))+'+++'+datetostr(now));
      if FileDateToDateTime(FileAge(apath+FindRec.Name)) < now //or
        {(daysbetween(FileDateToDateTime(FileAge(apath+'\'+FindRec.Name)), now) <= strtoint(edit5.Text))} then
      begin  //incDay(
        if (FindRec.Name[1] = '_') or (pos('.~', FindRec.Name) > 0) then
        begin
          showmessage(apath + findrec.name + ' wird gelöscht');
          DeleteFile(apath + FindRec.name)
        end
        else
        if (pos('.pas', FindRec.Name) > 0) or (pos('.dfm', FindRec.Name) > 0) or
           (pos('.dcu', FindRec.Name) > 0) or (pos('.exe', FindRec.Name) > 0) or
           (pos('.dpr', FindRec.Name) > 0) or (pos('.ddp', FindRec.Name) > 0) or
           (pos('.dof', FindRec.Name) > 0) or (pos('.dsk', FindRec.Name) > 0) then begin end
        else
        begin
          uvname := '';
          for n := pos('Buecherei\', apath)+10 to length(apath) do
            uvname := uvname + apath[n];

          ExistingFilename := apath + FindRec.name;

          if apath[1] = label38.Caption[1] then  // von zB. F: nach zB. C: = Rücksicherung
          begin                                          // Stick nach Platte(oder 2.Stick)
            if label30.Caption[length(label30.Caption)] = '\' then
              Pr_FileName := label30.caption + uvname + FindRec.name
            else
              Pr_FileName := label30.caption + '\' + uvname + FindRec.name  // zu Beginn
          end
          else
          if apath[1] = label30.Caption[1] then  // von zB. C: nach zB. F: = Datensicherung
          begin                                          // Platte(oder 2.Stick) nach Stick)
            if label38.Caption[length(label38.Caption)] = '\' then
              Pr_FileName := label38.caption + uvname + FindRec.Name
            else
              Pr_FileName := label38.caption + '\' + uvname + FindRec.Name; // am Ende
          end;

          if fileexists(Pr_FileName) then
          begin
            if FileDateToDateTime(FileAge(Pr_FileName)) <> FileDateToDateTime(FileAge(existingfilename)) then
            begin
              erg := xmessagedlg('Soll    ' + pr_filename+ ' '+datetimetostr(filedatetodatetime(FileAge(Pr_Filename))) +#13+
                          'durch '   + existingfilename+ ' '+datetimetostr(filedatetodatetime(FileAge(ExistingFileName))) +#13+
                          ' ersetzt werden?', mtConfirmation, [mbYes, mbno, mbcancel], ['ja', 'nein', 'Abbrechen'], self.font);

              case erg of mryes    : CopyFile(PChar(ExistingFileName), PChar(Pr_FileName), FALSE);
                          mrcancel : raus := true;  //EXIT;
              end;
            end;
          end
          else
          begin
            if not (label30.Caption[length(label30.Caption)] = '\') then
              label30.Caption := label30.Caption + '\';
            erg := xmessagedlg('Soll '+ pr_filename + ' angelegt werden?', mtConfirmation,
                     [mbYes, mbNo, mbcancel], ['ja', 'nein', 'Abbrechen'], self.font);
            case erg of mryes    : begin
                                     if not directoryexists(label30.caption+uvname) then
                                       forcedirectories(label30.caption+uvname);
                                     CopyFile(PChar(ExistingFileName), PChar(Pr_FileName), TRUE);
                                   end;
                        mrcancel : raus := true;  //EXIT;
            end;
          end;
        end;
      end
      else showmessage('???');
    end;
  Until FindNext (FindRec) <> 0;
  FindClose (FindRec);

  If (Not aWithSub) or (raus) Then  Exit;    // keine Unterverzeichnisse vorhanden dann raus
  If FindFirst (aPath + '*.*', faAnyFile, FindRec) = 0 Then
  Repeat     // In Unterverzeichnissen weiter suchen
    If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
      If Boolean (FindRec.Attr and faDirectory) Then  // ob es sich um ein Verzeichnis handelt
        If ((FindRec.Attr and faDirectory) <> 0) then
          FindFiles (aPath + FindRec.Name, aFindMask, aWithSub, aResult); // Rekursion
  Until FindNext (FindRec) <> 0;
  FindClose (FindRec);   // showmessage(meldung);
End;                    

1:
2:
3:
4:
5:

If ((FindRec.Attr and faDirectory) <> 0) then
        begin
          FindFiles (aPath + FindRec.Name, aFindMask, aWithSub, aResult); // Rekursion
          if raus then Exit;
        end;