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:
105:

function datumsuchen(x:string; trenner:char; erstes,meldung,streng:boolean):string;
  // sucht ein Datum in x
  // trenner = trennzeichen zB . oder /
  // erstes = true = erstes vorhandenes Datum suchen, sonst letztes
  // meldung = Message, wenn kein Datum gefunden wird
  // streng = Jahr muss mindestens 2stellig sein (delphi akzeptiert auch einstellig)
  // Rückgabewert wenn kein Datum geunden wird ist leer

  var gefunden:boolean;
      posi:integer;
      res:string;

  function suchdatum (x:string; posi:integer):string;
    // posi = erstes trennzeiche, darum herum wird das datum gesucht
    var  res:string;
         posi2,anz,i:integer;
         fehler:boolean;
         test : tdate;

    begin
      res:='';
      fehler:=false;

      // erst nach links alle zeichen kopieren, die zahlen oder trenner sind
      posi2:=posi;
      while (posi2 > 0) and (x[posi2] in [trenner,'0'..'9']) do begin
        res := x[posi2] + res;
        dec(posi2)
      end;


      // dann nach rechts alle zeichen kopieren, die zahlen oder trenner sind
      posi2:=posi+1;
      while (posi2 <= length(x)) and (x[posi2] in [trenner,'0'..'9']) do begin
        res := res + x[posi2];
        inc(posi2)
      end;


      // jetzt prüfen, ob genau 2 trenner vorhanden sind
      anz:=0;
      for i:=1 to length(res) do if res[i]=trenner then inc(anz);
      if anz <> 2 then fehler:=true;

      // jetzt prüfen, ob es sich um ein gültiges datum handelt
      try
        if not fehler then test := strToDate(res);
      except fehler:=true; end;

      if fehler then result:='' else result:=res;

    end; // von function suchdatum



  begin
    gefunden:=false;


    if length(x) > 0 then begin

      if erstes then begin // erstes gültiges Datum suchen

        posi:=1;
        while (not gefunden) and (posi <= length(x)) do begin
          if x[posi] = trenner then begin
            res := suchdatum(x,posi);
            if res <> '' then gefunden := true;
          end;
          inc(posi);
        end;

      end else begin // letztes gültiges Datum suchen

        posi:=length(x);
        while (not gefunden) and (posi >0 ) do begin
          if x[posi] = trenner then begin
            res := suchdatum(x,posi);
            if res <> '' then gefunden := true;
          end;
          dec(posi);
        end;

      end;

    end; // von if length(x) > 0

    // prüfung of bei streng mindestesn 2stellige jahreszahl
    if gefunden and streng then begin
      posi:=length(res)+1;
      repeat
        dec(posi);
      until (posi=0) or (res[posi]=trenner);
      if posi > length(res)-2 then begin
        gefunden := false;
        res:='';
      end;

    end;

    if (not gefunden) and meldung then showmessage('Kein gültiges Datum in '+x+' gefunden.');

    result:=res

  end; // von function datumsuchen