#11 2009-02-15 09:58

prologician
Member
Registered: 2009-01-30
Posts: 84

Re: UserInput Letters a to zz

As krtek pointed out, my script does have a disadvantage in that it's got a (largely) fixed padding. And a slightly more tangible drawback was that it could not fully replicate the a_zz.txt file.

So, with some revamping, and borrowing krtek's idea of a big array to hold values, here's a revised version that should work (hopefully) as well, with similar flexibility as you got from my earlier attempts.

const
  LETTERS = 'abcdefghijklmnopqrstuvwxyz';
  NUMBERS = '0123456789';
  BOTH = '0123456789abcdefghijklmnopqrstuvwxyz';
  ALPHA_FORMAT = 'll';

var
  SerialCount: Array[1..100] of Integer;

function NthInFormatToLetterset(I: Integer): String;
var
  format_char: Char;
begin
  if (I > length(ALPHA_FORMAT)) then
  begin
    result := NUMBERS;
    exit
  end
  else
    format_char := ALPHA_FORMAT[length(ALPHA_FORMAT) - I + 1];

  if (format_char = 'l') then
    result := LETTERS
  else
  begin
    if (format_char = 'b') then
      result := BOTH
    else
      result := NUMBERS
  end;
end;

procedure CheckCarries();
var
  I: Integer;
  letterset: String;
begin
  for I := 1 to length(SerialCount) do
  begin
    if (SerialCount[i] = -1) then
      exit;
    
    letterset := NthInFormatToLetterset(I);
    
    if (SerialCount[i] >= length(letterset)) then
    begin
      SerialCount[i] := SerialCount[i] - length(letterset);
      SerialCount[I+1] := SerialCount[I+1] + 1
    end;
  end;
end;

function AlphaSerialize(): String;
var
  I: Integer;
  letterset: String;
begin
  result := '';
  for I := 1 to length(SerialCount) do
  begin
    if (SerialCount[i] = -1) then
      exit;
    
    letterset := NthInFormatToLetterset(I);
    result := letterset[SerialCount[i] + 1] + result;
  end;
end;

var
  Initialized: Boolean;
  I: Integer;
begin
  if not Initialized then
  begin
    for I := 1 to length(SerialCount) do
      SerialCount[i] := -1;
    Initialized := True;
  end;
  SerialCount[1] := SerialCount[1] + 1;
  CheckCarries();
  FileName := WideExtractBaseName(FileName) + AlphaSerialize() + WideExtractFileExt(FileName);
end.

In this case, if you wanted to add more letter sets to this, you only need to tweak the NthInFormatToLetterset() function to return the letterset you want. smile

Offline

#12 2009-02-15 10:23

report
Member
Registered: 2009-01-05
Posts: 40

Re: UserInput Letters a to zz

I have not tested your newest code yet but played around with your second draft to enhance the lettersets:

const
  LETTERS_L = 'abcdefghijklmnopqrstuvwxyz';
  LETTERS_U = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  NUMBERS = '0123456789';
  BOTH_NL = '0123456789abcdefghijklmnopqrstuvwxyz';
  BOTH_NU = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  ALPHA_FORMAT = 'll';
// For each digit in ALPHA_FORMAT, use
// l for lower case letters,
// L for upper case letters,
// n for numbers,
// b for both numbers and lower case letters,
// B for both numbers and upper case letters.
// Excess leading digits are filled with numbers.

function AlphaSerialize(const i: Integer; const structure: String): String;
var
  single: Char;
  letterset: String;
  format_char: Char;
  format_r: String;
begin
  if (length(structure) > 0) then
    format_char := structure[length(structure)]
  else
  begin
    if (i = 0) then
    begin
      result := '';
      exit
    end
    else
    begin
      result := inttostr(i);
      exit
    end
  end;

  if (format_char = 'l') then letterset := LETTERS_L
  else
  begin
  if (format_char = 'L') then letterset := LETTERS_U
  else
  begin
  if (format_char = 'b') then letterset := BOTH_NL
  else
  begin
  if (format_char = 'B') then letterset := BOTH_NU
  else
  begin
  if (format_char = 'n') then letterset := NUMBERS
  else
  letterset := NUMBERS
  end
  end
  end
  end;

  single := letterset[(i mod length(letterset)) + 1];
  format_r := copy(structure, 1, length(structure) - 1);
  result := AlphaSerialize(i div length(letterset), format_r) + single;
end;

var
  Initialized: boolean;
  I: Integer;
begin
  if not Initialized then
  begin
    I := 0;
    Initialized := True;
  end;
  FileName := WideExtractBaseName(FileName) + AlphaSerialize(I, ALPHA_FORMAT) + WideExtractFileExt(FileName);
  I := I + 1
end.

The next idea might be to offer a global constant start as a start value so that one does not always start with the first letter of a letterset.

Last edited by report (2009-02-15 10:25)

Offline

#13 2009-02-15 11:33

prologician
Member
Registered: 2009-01-30
Posts: 84

Re: UserInput Letters a to zz

If you want to try the new version, I made a change which makes extensibility a LOT easier. Namely, a case statement based on the format character. smile (You'll see what I mean....)

const
  LETTERS_L = 'abcdefghijklmnopqrstuvwxyz';
  LETTERS_U = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  NUMBERS = '0123456789';
  BOTH_NL = '0123456789abcdefghijklmnopqrstuvwxyz';
  BOTH_NU = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  ALPHA_FORMAT = 'lL';
// For each digit in ALPHA_FORMAT, use
// l for lower case letters,
// L for upper case letters,
// n for numbers,
// b for both numbers and lower case letters,
// B for both numbers and upper case letters.
// Excess leading digits are filled with numbers.

var
  SerialCount: Array[1..100] of Integer;

function NthInFormatToLetterset(I: Integer): String;
var
  format_char: Char;
begin
  if (I > length(ALPHA_FORMAT)) then
  begin
    result := NUMBERS;
    exit
  end;

  format_char := ALPHA_FORMAT[length(ALPHA_FORMAT) - I + 1];

  case format_char of
    'l': result := LETTERS_L;
    'L': result := LETTERS_U;
    'n': result := NUMBERS;
    'b': result := BOTH_NL;
    'B': result := BOTH_NU;
    else result := NUMBERS
  end;
end;

procedure CheckCarries();
var
  I: Integer;
  letterset: String;
begin
  for I := 1 to length(SerialCount) do
  begin
    if (SerialCount[i] = -1) then
      exit;
    
    letterset := NthInFormatToLetterset(I);
    
    if (SerialCount[i] >= length(letterset)) then
    begin
      SerialCount[i] := SerialCount[i] - length(letterset);
      SerialCount[I+1] := SerialCount[I+1] + 1
    end;
  end;
end;

function AlphaSerialize(): String;
var
  I: Integer;
  letterset: String;
begin
  result := '';
  for I := 1 to length(SerialCount) do
  begin
    if (SerialCount[i] = -1) then
      exit;
    
    letterset := NthInFormatToLetterset(I);
    result := letterset[SerialCount[i] + 1] + result;
  end;
end;

var
  Initialized: Boolean;
  I: Integer;
begin
  if not Initialized then
  begin
    for I := 1 to length(SerialCount) do
      SerialCount[i] := -1;
    Initialized := True;
  end;
  SerialCount[1] := SerialCount[1] + 1;
  CheckCarries();
  FileName := WideExtractBaseName(FileName) + AlphaSerialize() + WideExtractFileExt(FileName);
end.

As far as beginning at some non-first-letter starting point, a quickie thought on that would be to (1) use the format letter to get the letterset, and (2) search for the letter in the initial string inside the letterset, and (3) store that discovered location at the corresponding index in SerialCount (note that SerialCount begins at index 1 and works upwards, while the Format string is read right-to-left). Shouldn't be THAT hard to do.

Perhaps I'll leave this as an exercise to the reader. For now, anyway. wink

Offline

#14 2009-02-15 11:38

krtek
Senior Member
From: Łódź (Poland)
Registered: 2008-02-21
Posts: 262

Re: UserInput Letters a to zz

Thanks prologician for pointing out that stupid mistake (>= instead of >) tongue
I borrowed your idea of constants smile
When I was writing "simpler" about my script, I was thinking about "less functional";)
I haven't even notice, that your script works only with padding... big_smile

BTW, I should have guessed earlier that Delphi allows dynamic arrays.
A huge array was a really dirty solution wink
I guess you should use a dynamic array in your script as well, prologician.
Now it works fine without any boundaries (apart of what your computer allows).

I also added a start letter (but only for the first letter by now). So (at least for now) you can start from "d", but you can't start from "ad"...

Working version:

CONST 
LETTERS = 'abcdefghijklmnopqrstuvwxyz';
NUMBERS = '0123456789';
BOTH = '0123456789abcdefghijklmnopqrstuvwxyz';
TEST = 'abcde';

SERIALIZE = LETTERS;
START = 1;

var
  i,k,p: Integer;
  Pad: Array of Integer;  // dynamic arrays are 0 indexed
  Initialized: Boolean;
  Serialization : String;


procedure CheckZ(x:Integer; var p: Integer);
begin

if Pad[x] > Length(SERIALIZE) then
begin
  Pad[x]:=1;
  if x > 0 then
  begin
    Pad[x-1]:=Pad[x-1]+1;
    CheckZ(x-1, p);
  end
  else
  begin
    p:=p+1;
    SetLength(Pad, p+1);
  end;
end;

end;



begin
  if not Initialized then
  begin
    Initialized := True;
    i := START;  
    p := 0;     // Pad array is 0 indexed
    SetLength(Pad, 1);
  end;

  
  if i > Length(SERIALIZE) then
  begin
    Pad[p]:=i;
    CheckZ(p,p); 
    i:=1;
  end;
  
  Pad[p]:=i;


  Serialization:='';
  for k:=0 to p do                       // Pad array is 0 indexed
    Serialization:=Serialization + SERIALIZE[Pad[k]];
  
  
  FileName := WideStripExtension(FileName)+ Serialization + WideExtractFileExt(FileName);  
  i := i + 1;
end.

Last edited by krtek (2009-02-15 12:06)


Regular Expressions are not as hard to understand as you may think. Check ReNamer's manual or nice Regular Expressions tutorial for more info and start to use full power of applications that use them (like ReNamer, Mp3Tag and so on).

Offline

#15 2009-02-15 12:21

report
Member
Registered: 2009-01-05
Posts: 40

Re: UserInput Letters a to zz

prologician, your version from 9:58 works only with at least two digits in ALPHA_FORMAT. Why? (I haven't tried your newer version yet.)

When lettering is done with increasing length of the added string (like in the initial text file), this is something different from fixed length. Maybe, to avoid confusion, the function should have a
different name, too? AlphaIncreasingLength() instead of AlphaSerialize().

Anyway, I want to test your latest versions, too.. My favourite testing is to cut each letterset to just two elements:)

Yes, when offering a start string, the format should be derived from it so that the user does not need to specify it.

Offline

#16 2009-02-15 20:23

prologician
Member
Registered: 2009-01-30
Posts: 84

Re: UserInput Letters a to zz

I don't know what you mean from "9:58".... I assume that's referring to posting time. Which I have my user account set to my local timezone, so I don't see that post. I'm gonna assume, though, that you were referring to post #11 of this thread.

Huh, that is pretty weird, though, Report. After a bit of fiddling, and seeing that an ALPHA_FORMAT of length 0 works, as well as length 2, I'm going to guess that the error is that, in the CONST area, defining an ALPHA_FORMAT of length 1 makes it get treated as a Char by default, not as a String like we want. I got that pached up now, by using a Format parameter of type String to the function and passing in ALPHA_FORMAT.

Hehe, good call, krtek, on the dynamic arrays. I figured that there were in PascalScript.... and assumed that you did what you did so that the array began 1-indexed. <Shrug> Fixed up now. smile

As far as the naming.... it's semantics, really. If you want to name it something or other, by all means.... I'm calling it AlphaSerialize, just to indicate that this is serialization using alphanumerics and whatnot. <Shrug>

I also added in a few tweaks, so you can adjust the step size.... instead of incrementing by 1, you can increment by any positive number (including things bigger than the size of the alphabet). In this sense, I'm trying to capture the essence of what the official "serialize" rule accomplishes, by allowing for a similarly arbitrary step size. smile

const
  LETTERS_L = 'abcdefghijklmnopqrstuvwxyz';
  LETTERS_U = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  NUMBERS = '0123456789';
  BOTH_NL = '0123456789abcdefghijklmnopqrstuvwxyz';
  BOTH_NU = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  ALPHA_FORMAT = 'lL';
  STEP_SIZE = 1;
// For each digit in ALPHA_FORMAT, use
// l for lower case letters,
// L for upper case letters,
// n for numbers,
// b for both numbers and lower case letters,
// B for both numbers and upper case letters.
// Excess leading digits are filled with numbers.

var
  SerialCount: Array of Integer;   // 0-indexed thingamabob

function NthInFormatToLetterset(const Format: String; const I: Integer): String;
var
  format_char: Char;
begin
  if (I >= length(Format)) then
  begin
    result := NUMBERS;
    exit
  end;

  format_char := Format[length(Format) - I];

  case format_char of
    'l': result := LETTERS_L;
    'L': result := LETTERS_U;
    'n': result := NUMBERS;
    'b': result := BOTH_NL;
    'B': result := BOTH_NU;
    else result := NUMBERS
  end;
end;

procedure CheckCarries();
var
  I: Integer;
  letterset: String;
begin
  for I := 0 to length(SerialCount)-1 do
  begin
    letterset := NthInFormatToLetterset(ALPHA_FORMAT, I);
    
    if (SerialCount[i] >= length(letterset)) then
    begin
      if (I = length(SerialCount) - 1) then
      begin
        SetLength(SerialCount, length(SerialCount) + 1);
        SerialCount[I+1] := -1
      end;

      SerialCount[I+1] := SerialCount[I+1] + (SerialCount[i] div length(letterset));
      SerialCount[i] := SerialCount[i] mod length(letterset);
    end;
  end;
end;

function AlphaSerialize(): String;
var
  I: Integer;
  letterset: String;
begin
  result := '';
  for I := 0 to length(SerialCount)-1 do
  begin
    letterset := NthInFormatToLetterset(ALPHA_FORMAT, I);
    result := letterset[SerialCount[i] + 1] + result;
  end;
end;

var
  Initialized: Boolean;
begin
  if not Initialized then
  begin
    SetLength(SerialCount, 1);
    SerialCount[0] := 0;
    Initialized := True;
  end;
  CheckCarries();
  FileName := WideExtractBaseName(FileName) + AlphaSerialize() + WideExtractFileExt(FileName);
  SerialCount[0] := SerialCount[0] + STEP_SIZE;
end.

Offline

#17 2009-02-15 20:30

report
Member
Registered: 2009-01-05
Posts: 40

Re: UserInput Letters a to zz

I have tested both prologician's and krtek's recent scripts and think they work. In krtek's script, you are supposed to insert the used letterset in the

SERIALIZE =

line and you can also try a higher START number.

So for now we know how to serialize an either fixed or increasing number of digits on some chosen letterset and have some working scripts with obvious restrictions. At least, I think, den4b can have some idea now how to program a generalized Serialize that continues to offer the current options.

prologician, just see your new message; yes, post #11.

Last edited by report (2009-02-15 20:31)

Offline

#18 2009-02-15 21:28

krtek
Senior Member
From: Łódź (Poland)
Registered: 2008-02-21
Posts: 262

Re: UserInput Letters a to zz

Gosh, I was fighting for more than an hour with the problem of treating one-letter constant as a char and not as a string.
And all I could do with that is a workaround with a variable... But it works. Now you can start from any place you want. Just set the START_PATTERN constant (eg. for 'zab').
It goes throug letters by default. But it is enough to change the SERIALIZED constant to get anything else.

prologician, I borrowed your idea again wink This time it's STEP. It works if the step is lower than length of SERIALIZE constant.

CONST 
LETTERS = 'abcdefghijklmnopqrstuvwxyz';
NUMBERS = '0123456789';
BOTH = '0123456789abcdefghijklmnopqrstuvwxyz';
TEST = 'abcde';



//CONTROLS FOR THE SCRIPT:
SERIALIZE = LETTERS;
START_PATTERN = 'a';             //anything you want to start with, eg. 'bba'
STEP = 1;                       //step MUST be lower than length of SERIALIZE string


var
  i, k,p: Integer;
  Pad: Array of Integer;  // dynamic arrays are 0 indexed
  Initialized: Boolean;
  Start, Serialization : String;



procedure Initialize;
begin
  Initialized := True;
  Start:='';
  Start:=Start+START_PATTERN;
    
        
  SetLength(Pad, Length(Start));
  p := Length(Start)-1;   
  

  if p < 0 then
    ShowMessage('Error:'+#13+'START_PATTERN constant not defined.'+#13+'Set START_PATTERN constant to '+#39+'a'+#39)
  else if p = 0 then
    begin
      Pad[0] := WidePos(Start[1], SERIALIZE);
      If Pad[0] = 0 then 
        ShowMessage('Error:'+#13+'START_PATTERN constant contains a char ('+#39+Start[1]+#39+'), that is not present in SERIALIZE constant!');
    end
  else
    for k:=0 to p do  
      begin
        Pad[k] := WidePos(Start[k+1], SERIALIZE);
        if Pad[k] = 0 then 
          ShowMessage('Error:'+#13+'START_PATTERN constant contains a char ('+#39+Start[k+1]+#39+'), that is not present in SERIALIZE constant!');
      end;
  ;

  i := WidePos(Start[p+1], SERIALIZE);  
end;



procedure CheckZ(x:Integer; var p: Integer);
begin

if Pad[x] > Length(SERIALIZE) then
begin
  Pad[x]:=1;
  if x > 0 then
  begin
    Pad[x-1]:=Pad[x-1]+1;
    CheckZ(x-1, p);
  end
  else
  begin
    p:=p+1;
    SetLength(Pad, p+1);
  end;
end;

end;


begin
  if not Initialized then Initialize;


  Pad[p]:=i;  
  if i > Length(SERIALIZE) then
  begin
    CheckZ(p,p); 
    i:=i-Length(SERIALIZE);
    Pad[p]:=i;
  end;
  



  Serialization:='';
  for k:=0 to p do                       // Pad array is 0 indexed
    Serialization:=Serialization + SERIALIZE[Pad[k]];
  
  
  FileName := WideStripExtension(FileName)+ Serialization + WideExtractFileExt(FileName);  
  i := i + STEP;
end.

Last edited by krtek (2009-02-15 21:55)


Regular Expressions are not as hard to understand as you may think. Check ReNamer's manual or nice Regular Expressions tutorial for more info and start to use full power of applications that use them (like ReNamer, Mp3Tag and so on).

Offline

#19 2009-02-16 02:24

prologician
Member
Registered: 2009-01-30
Posts: 84

Re: UserInput Letters a to zz

<LOL> So in my ever continuing efforts to keep pace with krtek, I've now incorporated a thingy now to set the initial starting serialization value. Note that the starting string is still bound by the format string, and if a particular character mismatches, it's replaced with the first character in the letter set specified by the format string (that is, if Initial String and Format String don't agree, Format String wins.) wink

const
  ALPHA_FORMAT = 'lL';
  STEP_SIZE = 1;
  INITIAL_STRING = 'bA';

  LETTERS_L = 'abcdefghijklmnopqrstuvwxyz';
  LETTERS_U = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  NUMBERS = '0123456789';
  BOTH_NL = '0123456789abcdefghijklmnopqrstuvwxyz';
  BOTH_NU = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
// For each digit in ALPHA_FORMAT, use
// l for lower case letters,
// L for upper case letters,
// n for numbers,
// b for both numbers and lower case letters,
// B for both numbers and upper case letters.
// Excess leading digits are filled with numbers.

var
  SerialCount: Array of Integer;   // 0-indexed thingamabob

function NthInFormatToLetterset(const Format: String; const I: Integer): WideString;
var
  format_char: Char;
begin
  if (I >= length(Format)) then
  begin
    result := NUMBERS;
    exit
  end;

  format_char := Format[length(Format) - I];

  case format_char of
    'l': result := LETTERS_L;
    'L': result := LETTERS_U;
    'n': result := NUMBERS;
    'b': result := BOTH_NL;
    'B': result := BOTH_NU;
    else result := NUMBERS
  end;
end;

function IndexInString(const letter: WideChar; const wholestring: WideString): Integer;
var
  I: Integer;
begin
  result := 1;    //Not correct in general, but useful for this program
  for I := 1 to length(wholestring) do
  begin
    if (wholestring[i] = letter) then
    begin
      result := I;
      exit
    end;
  end;
end;

procedure TranslateToArray(const initial: WideString);
var
  I: Integer;
  letterset: WideString;
begin
  for I := 0 to length(SerialCount)-1 do
  begin
    letterset := NthInFormatToLetterset(ALPHA_FORMAT, I);
    
    SerialCount[i] := IndexInString(initial[length(initial) - i], letterset) - 1;
  end;
end;

procedure CheckCarries();
var
  I: Integer;
  letterset: WideString;
begin
  for I := 0 to length(SerialCount)-1 do
  begin
    letterset := NthInFormatToLetterset(ALPHA_FORMAT, I);
    
    if (SerialCount[i] >= length(letterset)) then
    begin
      if (I = length(SerialCount) - 1) then
      begin
        SetLength(SerialCount, length(SerialCount) + 1);
        SerialCount[I+1] := -1
      end;

      SerialCount[I+1] := SerialCount[I+1] + (SerialCount[i] div length(letterset));
      SerialCount[i] := SerialCount[i] mod length(letterset);
    end;
  end;
end;

function AlphaSerialize(): WideString;
var
  I: Integer;
  letterset: WideString;
begin
  result := '';
  for I := 0 to length(SerialCount)-1 do
  begin
    letterset := NthInFormatToLetterset(ALPHA_FORMAT, I);
    result := letterset[SerialCount[i] + 1] + result;
  end;
end;

var
  Initialized: Boolean;
  InitString: WideString;
begin
  if not Initialized then
  begin
    InitString := INITIAL_STRING;
    
    if (length(InitString) = 0) then
    begin
      SetLength(SerialCount, 1);
      SerialCount[0] := 0;
    end
    else
    begin
      SetLength(SerialCount, length(InitString));
      TranslateToArray(InitString);
    end;
    
    Initialized := True;
  end;
  CheckCarries();
  FileName := WideExtractBaseName(FileName) + AlphaSerialize() + WideExtractFileExt(FileName);
  SerialCount[0] := SerialCount[0] + STEP_SIZE;
end.

Offline

#20 2009-02-16 08:37

report
Member
Registered: 2009-01-05
Posts: 40

Re: UserInput Letters a to zz

Although I have still not quite understood why prologician's latest script works and I have not programmed for almost 20 years and never before in Pascal (and for sure I faced the String versus Char type mismatches, too...), I have altered his code to let AlphaFormat be calculated automatically. Mixed lettersets are not possible but so far this comes the closest to my feature suggestion of alphanumeric serialization: Each digit is either a lower case letter, upper case letter, or number; an arbitrary starting string of arbitrary length is possible (if you choose more and a sufficient number of leading digits, then you get a fixed width of all your filenames); the step size can be chosen. So I encourage you to alter the values of STEP_SIZE and INITIAL_STRING to whichever you might need. The values 0 and '' also work for some reason but are, of course, only interesting for us programmers.

Working:

const
  STEP_SIZE = 1;
  INITIAL_STRING = 'aa';

  LETTERS_L = 'abcdefghijklmnopqrstuvwxyz';
  LETTERS_U = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  NUMBERS = '0123456789';
// Excess leading digits are filled with numbers.

var
  SerialCount: Array of Integer;   // 0-indexed

function IsLowerCaseLetter(const TestedChar: String): Boolean;
var
  I: Integer;
begin
  result := FALSE;
  for I := 1 to length(LETTERS_L) do
  begin
    if (TestedChar = LETTERS_L[i]) then
    begin
      result := TRUE;
      exit;
    end;
  end;
end;

function IsUpperCaseLetter(const TestedChar: String): Boolean;
var
  I: Integer;
begin
  result := FALSE;
  for I := 1 to length(LETTERS_U) do
  begin
    if (TestedChar = LETTERS_U[i]) then
    begin
      result := TRUE;
      exit;
    end;
  end;
end;

function IsNumber(const TestedChar: String): Boolean;
var
  I: Integer;
begin
  result := FALSE;
  for I := 1 to length(NUMBERS) do
  begin
    if (TestedChar = NUMBERS[i]) then
    begin
      result := TRUE;
      exit;
    end;
  end;
end;

function GetAlphaFormat(const wholestring: WideString): String;
var
  I: Integer;
begin
  result := '';
  for I := 1 to length(wholestring) do
  begin
    // Only one of these conditions can be true because there are no mixed lettersets.
    if (IsLowerCaseLetter(wholestring[i])) then result := result + 'l';
    if (IsUpperCaseLetter(wholestring[i])) then result := result + 'u';
    if (IsNumber(wholestring[i])) then result := result + 'n';
  end;
end;

function NthInFormatToLetterset(const Format: String; const I: Integer): WideString;
var
  format_char: Char;
begin
  if (I >= length(Format)) then
  begin
    result := NUMBERS;
    exit
  end;

  format_char := Format[length(Format) - I];

  case format_char of
    'l': result := LETTERS_L;
    'u': result := LETTERS_U;
    'n': result := NUMBERS;
  end;
end;

function IndexInString(const letter: WideChar; const wholestring: WideString): Integer;
var
  I: Integer;
begin
  result := 1;    //Not correct in general, but useful for this program
  for I := 1 to length(wholestring) do
  begin
    if (wholestring[i] = letter) then
    begin
      result := I;
      exit
    end;
  end;
end;

procedure TranslateToArray(const initial: WideString; const Format: String);
var
  I: Integer;
  letterset: WideString;
begin
  for I := 0 to length(SerialCount)-1 do
  begin
    letterset := NthInFormatToLetterset(Format, I);
    
    SerialCount[i] := IndexInString(initial[length(initial) - i], letterset) - 1;
  end;
end;

procedure CheckCarries(const Format: String);
var
  I: Integer;
  letterset: WideString;
begin
  for I := 0 to length(SerialCount)-1 do
  begin
    letterset := NthInFormatToLetterset(Format, I);
    
    if (SerialCount[i] >= length(letterset)) then
    begin
      if (I = length(SerialCount) - 1) then
      begin
        SetLength(SerialCount, length(SerialCount) + 1);
        SerialCount[I+1] := -1
      end;

      SerialCount[I+1] := SerialCount[I+1] + (SerialCount[i] div length(letterset));
      SerialCount[i] := SerialCount[i] mod length(letterset);
    end;
  end;
end;

function AlphaSerialize(const Format: String): WideString;
var
  I: Integer;
  letterset: WideString;
begin
  result := '';
  for I := 0 to length(SerialCount)-1 do
  begin
    letterset := NthInFormatToLetterset(Format, I);
    result := letterset[SerialCount[i] + 1] + result;
  end;
end;

var
  Initialized: Boolean;
  InitString: WideString;
  AlphaFormat: String;
begin
  if not Initialized then
  begin
    InitString := INITIAL_STRING;
    
    if (length(InitString) = 0) then
    begin
      SetLength(SerialCount, 1);
      SerialCount[0] := 0;
    end
    else
    begin
      SetLength(SerialCount, length(InitString));
      AlphaFormat := GetAlphaFormat(InitString);
      TranslateToArray(InitString, AlphaFormat);
    end;
    
    Initialized := True;
  end;
  CheckCarries(AlphaFormat);
  FileName := WideExtractBaseName(FileName) + AlphaSerialize(AlphaFormat) + WideExtractFileExt(FileName);
  SerialCount[0] := SerialCount[0] + STEP_SIZE;
end.

Offline

Board footer

Powered by FluxBB