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.