String intelligent Kürzen

[himitsu]

Das ist eine Bitmaske, wenn ein Name schon vorhanden ist, dann werden über diese Maske, beim nächsten Durchgang, Löschaktionen übersprungen, so daß ein anderer Name entsteht.

Obwohl noch ein i := Length(S); bei // ungültige Zahlen entfernen fehlt, sollte dennoch die Zahl erhalten bleiben, da das Ganze ohne mit 0 initialisiert würde (durch die vorherige For-Schleife)

[edit]
ah, hatte hier nur eine zweistellige Zahl drin, wlche erfolgreich durchkam

Delphi-Quellcode:

type TKueDatErlaubt = function(S: String): Boolean;

function KuerzeDateiname(S: String; Len: Integer; Erlaubt: TKueDatErlaubt): String;
var
  i, i2, u: Integer;
  SL: TStrings;
  US: record
    case Integer of
      0: (i: Int64);
      1: (s: Set of 0..63);
  end;
begin
  // ungültige Zeichen entfernen
  for i := Length(S) downto 1 do
    if not (S[i] in [' ', 'a'..'z', 'A'..'Z', '0'..'9']) then
      Delete(S, i, 1);
  // ungültige Zahlen entfernen
  i := Length(S);
  while (i > 0) and (S[i] in ['0'..'9']) do
    Dec(i);
  for i := i downto 1 do
    if (S[i] in ['0'..'9']) then
      Delete(S, i, 1);
  //
  SL := TStringList.Create;
  try
    US.s := [];
    repeat
      U := 0;
      // String aufsplitten
      SL.LineBreak := '';
      SL.Delimiter := ' ';
      SL.StrictDelimiter := True;
      SL.DelimitedText := S;
      // längstes Wort suchen + Capitalize
      i2 := 0;
      for i := SL.Count -1 downto 0 do begin
        SL[i] := UpperCase(Copy(SL[i], 1, 1)) + LowerCase(Copy(SL[i], 2));
        i2 := Max(i2, Length(SL[i]));
      end;
      // Anzahl der zu entfernenden Zeichen
      Len := Length(SL.Text) - Len;
      // kurze Wörter (Einzelbuchstaben) entfernen
      i := SL.Count - 1;
      while (Len > 0) and (i >= 0) do begin
        if (Length(SL[i]) = 1) and (SL[i][1] in ['a'..'z', 'A'..'Z']) then begin
          if not (U in US.s) then begin
            SL.Delete(i);
            Dec(Len);
          end;
          Inc(U);
        end;
        Dec(i);
      end;
      // Wörter kürzen
      i := -1;
      while (Len > 0) do begin
        if i < 0 then begin
          i := SL.Count - 1;
          Dec(i2);
        end;
        if Length(SL[i]) > i2 then begin
          if not (U in US.s) then begin
            SL[i] := Copy(SL[i], 1, i2) + Copy(SL[i], i2 + 2);
            Dec(Len);
          end;
          Inc(U);
        end;
        Dec(i);
      end;
      // nächstes Set, für's Überspringen
      Inc(US.i);
      // Text zusammensetzen und ausgeben
      Result := SL.Text;
    until Erlaubt(Result);
  finally
    SL.Free;
  end;
end;

Dürfen die Zahlen eigentlich ebenfalls gekürzt werden?
Längere Zahlen werden es ja aktuell noch.