DBR Delphi-Ecke

// Wenn der User zur Laufzeit selbst einen Datei-Namen festlegen soll, und
// man möchte die volle Kontrolle darüber, was der Kerl für einen "Mist"
// eingibt, könnte man das wie folgt gestalten:

// Getestet mit D4 unter XP

// 1. Kontrolle der einzelnen Tastenanschläge

function KeyOK(Key: Char): Boolean; 
begin 
  result := key in ['0'..'9', 'A'..'Z', 'a'..'z', '$', '.', '+', ';', '=', 
    '%', '@', '-', '_', '~', '!', '(', ')', '{', '}', '[', ']', '#', ',', 
    #32, #39, #96, #128..#255]; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 
begin
  if (not KeyOK(Key)) and (key <> #8) then Key := #0; 
end;

// ---------------------------------------------------------------

// 2. Kontrolle eines Dateinamens
//    (Es wird nicht geprüft, ob die Datei auch wirklich existiert)
//    Falls man über die Zwischenablage Strings einfügt, nützt die
//    Überwachung von Tastenbetätigungen nichts. Dafür muss man eine
//    Funktion wie die folgende verwenden.
//    Die obige Funktion "KeyOK" dient als Grundlage für den Code.

function NameOK(fn: string): Boolean; 
var x: integer; 
begin 
  result := false; 
  if (fn = '') or (length(fn) >= 255) then exit; 
  for x := 1 to length(fn) do 
    if not KeyOK(fn[x]) 
      then exit; 
  result := true; 
end; 
 
 
// Beispielaufruf 
 
const 
  merktxt: string = ''; 
 
function NameTesten(n: string): string; 
begin 
  if NameOk(n) then merktxt := n; 
  result := merktxt; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Edit1.text := NameTesten(Edit1.text); 
end; 
 
procedure TForm1.Edit1Change(Sender: TObject); 
begin 
  Edit1.text := NameTesten(Edit1.text); 
end;

// ---------------------------------------------------------------

// 3. Kontrolle einer kompletten Pfadbezeichnung
//    Relative Pfad-Bezeichnungen, wie beispielsweise "..\TEST"
//    werden hierbei nicht zugelassen. Es wird auch nicht geprüft,
//    ob die Datei bzw. der Ordner überhaupt existiert. Mit der
//    Variablen "isOrdner" wird gesteuert, ob man einen Datei- oder
//    einen Ordnernamen prüfen möchte, da bekanntermaßen bei Ordnern
//    am Ende ein Backslash stehen kann.
//    Die oberen Funktionen "KeyOK" und "NameOK" dienen hier als Grundlage.

function PfadOK(pf: string; isOrdner: boolean): boolean; 
var 
  p, n: string; 
  x, lg: integer; 
begin 
  result := false; 
  lg := length(pf); 
  if (lg = 0) or (lg >= 260) or (not (upcase(pf[1]) in ['A'..'Z'])) 
    or (copy(pf, 2, 2) <> ':\') then exit 
  else begin 
    p := extractfilepath(pf); 
    n := extractfilename(pf); 
    if (length(n) >= 255) then exit; 
    for x := 3 to length(p) do begin 
      if p[x] = '\' then begin 
        if (p[x - 1] = '\') or (x = lg) 
          and (not isOrdner) then exit; 
      end else if not KeyOK(p[x]) then exit; 
    end; 
    result := true; 
    if n = '' then exit; 
    result := result and NameOk(n); 
  end; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Edit1Change(Sender: TObject); 
begin 
  Button1.enabled := PfadOK(Edit1.Text, false); 
end;