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:

function CCopyData.BackUpDivVerzeichnis(Station : string) : integer;
  var
    FLFileQuell : array of TSearchRec;
    SR_AP  : array of TSearchRec;
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SR : array of TSearchRec;

 try
 try
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

     // Arraygröße für Dateiinfos zunächst vordefinieren, setzen 1. TSearchRec-Array
     SetLength(FLFileQuell, MaxFilesInList);

     // alle Unterverzeichnisse auflisten, Suche starten, , setzen 2. TSearchRec-Array
     SetLength(SR_AP, Dir_SR_MaxArray);

     //Übergabe 2. TSearchRec-Array
     SubDir:=EnumDirs(QuellRoot, true, SR_AP);

  while SubDir <> '' do
    begin
    ExtD[0] := frmMain.m_PASReg.GetRegDExt01(Station);
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     if ExtD[0] <> '' then
      for i := 0 to Ext_Fld do
       if ExtD[i] <> '' then
        begin
          // Dateilisten einlesen, Übergabe 1. TSearchRec-Array
          ReadVerzeichnisEx(SubDir, ExtD[i], FLFileQuell, iFLFileQuell);

          // jetzt sind die evtl. zu kopierenden Dateien bestimmt!

          // alle Dateien durchgehen
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
               end;
            end;
Next_n:

           end;


           //Übergabe 2. TSearchRec-Array
           SubDir:=EnumDirs(QuellRoot, false, SR_AP);

     end; // while
     // ^^^ über alle Unterverzeichnisse ***************************************

     if (iFLFileQuell=0) then SL_WriteLog('Keine Dateien zu sichern...',2);
     if (ncopied=0) then SL_WriteLog('Keine aktuellen Dateien zu sichern...',2);

   try
     UnMap;
   except
     SL_WriteLog('FEHLER beim UnMap! (Div)', 0);
   end;


Exit_Proc:
     // Anzahl der gesicherten Dateien zurückgeben
     BackUpDivVerzeichnis:=ncopied;
 finally
     // Arrayspeicher wieder freigeben !!!
     SR_AP := NIL;
     Finalize(SR_AP);

     FLFileQuell := NIL;
     Finalize(FLFileQuell);
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 end;
 except
     {on E:Exception do
       begin
         frmMain.SubStatus.Panels[3].Text := E.Message;
         MessageDlg('FEHLER: ' + E.Message, mtError, [mbOk], 0);
       end;}
     // Arrayspeicher wieder freigeben !!!
     SR_AP := NIL;
     Finalize(SR_AP);

     FLFileQuell := NIL;
     Finalize(FLFileQuell);
 end;					

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:

function CCopyData.EnumDirs(StartDir : string; NewSearch : boolean; var FL : array of TSearchRec): string;
var iret : integer;
    n : integer;
label weiter, FN1;
begin
     // alles auf Anfang
     if NewSearch=true then
     begin
        for n:=1 to Dir_SR_MaxArray do gefSR_A[n]:=0;
        nSR:=1;
     end;
  try
     repeat
        // in dieser Ebene noch nichts gefunden
           if gefSR_A[nSR]=0 then
           begin
                // es existiert noch eine darunter liegende Ebene
                if nSR=1 then Dir_A[nSR]:=StartDir;
                         //else Dir[nSR]:=Dir[nSR-1];
                iret:=FindFirst(Dir_A[nSR]+'\*.*', faDirectory, FL[nSR]);
                if iret=0 then
                begin
                  ~~~~~~~~~~~~~~~~~~~~~~~~~~
                Exit;
                end
                else
                begin
                  ~~~~~~~~~~~~~~~~~~~~~~~~~~
                 Goto Weiter;
                end;
           end
           else
           // auf dieser Ebene mit FINDNEXT weitersuchen
           begin
                FN1:
                iret:=FindNext(FL[nSR]);
                if iret=0 then
                begin
                  ~~~~~~~~~~~~~~~~~~~~~~~~~~
                Exit;
                end
                else
                begin
                  ~~~~~~~~~~~~~~~~~~~~~~~~~~
                Goto Weiter;
                end;
           end;
  Weiter:
     until (nSR=0);
     EnumDirs:='';
     if n = 1 then SL_WriteLog('Search-Record END!!! ', 0);
     // FindFirst-Freigabe in Hauptroutine!!!
  except
    SL_WriteLog('Verzeichnis > 50 Unterverzeichnisse!!! ' + SubDir, 0);
  end;
end;					

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:

procedure CCopyData.ReadVerzeichnisEx(SuchDir : string; Suchmaske : string; var FL : array of TSearchRec; var iFL : integer);
  var SR : array of TSearchRec;
      iret : integer;
      log  : string;
begin
 try
 try
     SetLength(SR, 1);
     iFL:=-1; // array beginnt mit 0
     iret:=FindFirst(SuchDir+'\'+Suchmaske, faDirectory, SR[0]);
     if iret=0 then
     begin
          // kein Verzeichnis berücksichtigen!
          if (Copy(SR[0].Name,1,1)<>'.') and ((SR[0].Attr and faDirectory)=0) then
          begin
               inc(iFL);
          ~~~~~~~~~~~~~~~~~~~~~~~~~~
               FL[iFL]:=SR[0];
          end;

          repeat
                iret:=FindNext(SR[0]);
                if iret=0 then
                begin
                     if (Copy(SR[0].Name,1,1)<>'.') and ((SR[0].Attr and faDirectory)=0) then
                     begin
                          inc(iFL);
                          FL[iFL]:=SR[0];
                     end;
                end;
          until (iret<>0);
     end;
 finally
     SR := NIL;
     Finalize(SR);
     Freemem(SR);
 end;
 except
     SR := NIL;
     Finalize(SR);
     Freemem(SR);
     if frmMain.MemLeak1.Checked = true then SL_WriteLog('Except ReadEX: '+ IntToStr(frmMain.dtpf), 0);
 end;
end;