string inkrementieren

[Coffeecoder]

Zitat von Sir Rufo;1104080
Das geht doch so viel schicker:
[DELPHI:

Format( '%.*d', [ Len, Val ] )[/DELPHI].
SysUtils.Format

Das erinnert mich an Reguläre Ausdrücke

[shmia]

Hier kommt die ultimative Funktion um einen String zu inkrementieren.
Dabei wird nicht auf Integer umgewandelt, sondern es wird alles nur durch reine Stringverarbeitung erledigt.
Das hat folgende Vorteile:
* kein Integer Überlauf möglich
* über eine Maske kann genau gesteuert werden, welche Positionen erhöht werden dürfen

Delphi-Quellcode:

{**************************************************************************
 * NAME:    IncrementWithMask
 * DESC:    erhöht eine Nummer (die als String vorliegt) um Eins
 *          Dabei darf "Number" an bestimmten Stellen auch Buchstaben enthalten
 *          "Mask" bestimmt, an welchen Positionen Ziffern oder Buchstaben erlaubt sind
 * Mask:  0 = Ziffern     (0..9)
 *        A = Buchstaben  (A..Z)
 *        Z = Ziffern & Buchstaben
 *        H = Hex-Ziffern  (0..9, A..F)
 *          = diese Stelle bleibt
 * PARAMS:  [-]
 * RESULT:  die erhöhte Nummer
 *************************************************************************}
function IncrementWithMask(const Number, Mask:string):string;

   function IncrementDigit(x:PChar; m:Char):Boolean;
   begin
      Result := False;
      case m of
         '0':
         begin
            x^ := Succ(x^);
            if x^ > '9' then
            begin
               x^ := '0';
               Result := True;
            end;
         end;
         'A':
         begin
            x^ := Succ(x^);
            if x^ > 'Z' then
            begin
               x^ := 'A';
               Result := True;
            end;
         end;
         'Z':
         begin
            if x^ = '9' then
               x^ := 'A'
            else if x^ = 'Z' then
            begin
               x^ := '0';
               Result := True;
            end
            else
               x^ := Succ(x^);
         end;

         'H':
         begin
            if x^ = '9' then
               x^ := 'A'
            else if x^ = 'F' then
            begin
               x^ := '0';
               Result := True;
            end
            else
               x^ := Succ(x^);
         end;

         ' ':
            Result := True;
      else
         raise Exception.CreateFmt('IncrementWithMask(%s, %s) - invalid Mask', [Number, Mask]);
      end;
   end;

var
   i : Integer;
begin
   Result := Number;
   for i := Length(Result) downto 1 do
   begin
      if not IncrementDigit(@result[i], Mask[i]) then
         Break;
   end;
end;

// Aufruf
neueNummer := IncrementWithMask(alteNummer, '00000000');

[Lannes]

so etwas ähnliches suche ich schon länger

Hast Du es noch etwas ultimativer irgendwo herumliegen?:

Delphi-Quellcode:

function IncrementWithMask(const Number, Mask:string, n: Integer):string;

//
alteNummer := 'Z024D00F';
neueNummer := IncrementWithMask(alteNummer, 'A000A00A', 10000);

[shmia]

Nun ja, man kann's ja mal so machen:
(die Performance bei hohen Werten von n ist natürlich nicht so berauschend)

Delphi-Quellcode:

function IncrementWithMask2(const Number, Mask:string, n: Integer):string;
begin
   Result := Number;
   while n > 0 do
   begin
     Result := IncrementWithMask(Result, mask); 
     Dec(n);
   end;
end;

[Lannes]

ja, wegen der Performance hatte ich nachgefragt.

Meine Versuche eine Funktion zu erstellen, die direkt um einen Wert per Pointer-Arithmetik erhöht, haben bisher leider nicht zum Ziel geführt.

Trotzdem Danke, habe meine bisherige durch Deine ausgetauscht, ich werde dann mal meine Bemühungen fortsetzen.

[himitsu]

Um einen 8-stellige Hex-String ohne Überlauffehler hochzuzählen: Caption := GetIncStr('$1234ABCD', '~XXXXXXXX', i); .
oder einen Hex-String mit beliebig vielen Stellen Caption := GetIncStr('1234ABCD', '*X', i); .
oder 'ne GUID Caption := GetIncStr('{CDDB2E23-022D-47AA-B205-EEA2890E30A2}', '~_XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX_', i); .
oder

Delphi-Quellcode:

const TreeState: TIncStringFormat1 = ((Mode: ['T']; Chars: '012'; CaseSensitive: True));
Caption := GetIncStr('012', 'TTT', 16, TreeState);

oder mal ganz Krank eine schöne Base64-Hexadezimal-Dezimal-Oktal-Binär-Mischung

Delphi-Quellcode:

var
  S: String;
  i: Integer;
begin
  S := 'A0000';
  Memo1.Lines.BeginUpdate;
  try
    for i := 0 to 1000 do begin
      IncStr(S, '~ZDHCB', 1);
      Memo1.Lines.Add(S + ' = ' + IntToStr(i));
    end;
    IncStr(S, '~ZDHCB', 162800);
    Memo1.Lines.Add('');
    for i := 163800 to 163840 do begin
      IncStr(S, '~ZDHCB', 1);
      Memo1.Lines.Add(S + ' = ' + IntToStr(i));
    end;
  finally
    Memo1.Lines.EndUpdate;
  end;
end;

Delphi-Quellcode:

uses
  SysUtils, StrUtils;

type
  TIncStringFormatRec = record
    Mode: TSysCharSet;
    Chars: String;
    CaseSensitive: Boolean;
  end;
  TIncStringFormat  = array       of TIncStringFormatRec;
  TIncStringFormat1 = array[0..0] of TIncStringFormatRec;
  TIncStringFormat8 = array[0..7] of TIncStringFormatRec;

const
  NoneIncFormat: TIncStringFormat1 = (
    (Mode: ['-', '_']; Chars: ''; CaseSensitive: True));
  DecIncFormat: TIncStringFormat1 = (
    (Mode: ['D', '0']; Chars: '0123456789'; CaseSensitive: True));
  HexIncFormat: TIncStringFormat1 = (
    (Mode: ['X', 'H']; Chars: '0123456789ABCDEF'; CaseSensitive: False));
  AlphaIncFormat: TIncStringFormat1 = (
    (Mode: ['A'];      Chars: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; CaseSensitive: False));
  AlphaNumIncFormat: TIncStringFormat1 = (
    (Mode: ['N'];      Chars: '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; CaseSensitive: False));
  BinIncFormat: TIncStringFormat1 = (
    (Mode: ['B'];      Chars: '01'; CaseSensitive: True));
  OctIncFormat: TIncStringFormat1 = (
    (Mode: ['C'];      Chars: '01234567'; CaseSensitive: True));
  Base64IncFormat: TIncStringFormat1 = (
    (Mode: ['Z'];      Chars: 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; CaseSensitive: True));
  AllIncFormats: TIncStringFormat8 = (
    (Mode: ['-', '_']; Chars: '';                                     CaseSensitive: True),
    (Mode: ['D', '0']; Chars: '0123456789';                           CaseSensitive: True),
    (Mode: ['X', 'H']; Chars: '0123456789ABCDEF';                     CaseSensitive: False),
    (Mode: ['A'];      Chars: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';           CaseSensitive: False),
    (Mode: ['N'];      Chars: '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; CaseSensitive: False),
    (Mode: ['B'];      Chars: '01';                                   CaseSensitive: True),
    (Mode: ['C'];      Chars: '01234567';                             CaseSensitive: True),
    (Mode: ['Z'];      Chars: 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; CaseSensitive: True));

procedure IncStr(var Number: String; Format: String; Increment: UInt64; IncFormat: array of TIncStringFormatRec; RightAligned: Boolean = True); overload;
var
  N, F, M, D, i: Integer;
  NCNum: String;
  B: Boolean;
begin
  NCNum := UpperCase(Number);
  Format := UpperCase(Format);
  for F := Length(Format) downto 1 do begin
    B := Format[F] in [' ', '~', '*'];
    for i := High(IncFormat) downto 0 do
      if Format[F] in IncFormat[i].Mode then begin
        B := True;
        Break;
      end;
    if not B then
      raise Exception.CreateFmt('Ungültiger Format-Befehl "%s".', [Format[F]]);
  end;
  if not RightAligned then begin
    N := Length(Format);
    if ContainsStr(Format, '*') then
      raise Exception.Create('Format-Befehl "*" darf nicht verwendet werden.');
  end else
    N := Length(Number);
  F := Length(Format);
  while Increment > 0 do begin
    while (F > 0) and (Format[F] = ' ') do begin
      Dec(F);
      Dec(N);
    end;
    if F <= 0 then
      raise Exception.Create('Format-String zu kurz.');
    if Format[F] = '~' then  // Überlauf ignorieren
      break;
    M := -1;
    for i := High(IncFormat) downto 0 do
      if (Format[F] in IncFormat[i].Mode) or ((Format[F] = '*') and (Format[F + 1] in IncFormat[i].Mode)) then begin
        M := i;
        Break;
      end;
    if M < 0 then
      raise Exception.CreateFmt('Ungültiger Format-Befehl "%s".', [Copy(Format, F, 2)]);
    if N = 0 then begin
      Insert(IncFormat[M].Chars[1], Number, 1);
      Insert(' ', NCNum, 1);
    end else if N < 0 then
      raise Exception.Create('Number-String konnte nicht erweitert werden.');
    D := Length(IncFormat[M].Chars);
    if D <> 0 then begin
      if IncFormat[M].CaseSensitive then
        i := Pos(Number[N], IncFormat[M].Chars) - 1
      else
        i := Pos(NCNum[N], IncFormat[M].Chars) - 1;
      if i < 0 then
        raise Exception.CreateFmt('Ungültiger Wert "%s" in Number-String.', [Number[N]]);
      Inc(i, Increment mod D);
      Number[N] := IncFormat[M].Chars[i mod D + 1];
      Increment := Increment div D + i div D;
    end;
    if Format[F] <> '*' then
      Dec(F);
    Dec(N);
  end;
end;

procedure IncStr(var Number: String; const Format: String; Increment: UInt64 = 1; RightAligned: Boolean = True); overload;
begin
  IncStr(Number, Format, Increment, AllIncFormats, RightAligned);
end;

function GetIncStr(const Number, Format: String; Increment: UInt64; IncFormat: array of TIncStringFormatRec; RightAligned: Boolean = True): String; overload;
begin
  Result := Number;
  IncStr(Result, Format, Increment, IncFormat, RightAligned);
end;

function GetIncStr(const Number, Format: String; Increment: UInt64 = 1; RightAligned: Boolean = True): String; overload;
begin
  Result := Number;
  IncStr(Result, Format, Increment, AllIncFormats, RightAligned);
end;

function IncStrPos(const Str: String; Start, Length: Integer; Format: String; Increment: UInt64; IncFormat: array of TIncStringFormatRec; RightAligned: Boolean = True): String; overload;
begin
  Result := Copy(Str, 1, Start - 1) + GetIncStr(Copy(Str, Start, Length), Format, Increment, IncFormat, RightAligned) + Copy(Str, Start + Length);
end;

function IncStrPos(const Str: String; Start, Length: Integer; const Format: String; Increment: UInt64 = 1; RightAligned: Boolean = True): String; overload;
begin
  Result := Copy(Str, 1, Start - 1) + GetIncStr(Copy(Str, Start, Length), Format, Increment, RightAligned) + Copy(Str, Start + Length);
end;

Ich hoff es ist kein Fehler drin.

'~' um einen Überlauf zu ignorieren,
'*' wiederholt das letzte Formatzeichen,
' ', '-' und '_' als Nichtformatzeichen
und der Rest wird als Format interpretiert.

[FredlFesl]

Wofür doch so die Lebenszeit draufgeht...

[shmia]

Zitat von Lannes:

Hast Du es noch etwas ultimativer irgendwo

Gibt es eigentlich eine Steigerung zu "ultimativer" ?

Delphi-Quellcode:

function FastCharPos(const S: AnsiString; const C: AnsiChar): Integer;
begin
  for Result := 1 to Length(S) do
    if S[Result] = C then
       Exit;
  Result := 0;
end;

function IncSingleDigit(var c:AnsiChar; n : Integer; const d:string):Integer;
var
   z : Integer;
   len : Integer;
begin
   len := length(d);
   z := FastCharPos(d, c) - 1;
   if z < 0 then z := 0;
   z := z + n;

   c := d[(z mod len) +1];
   Result := z div len;
end;

function IncBinary(var x:Byte; n : Integer):Integer;
var
   z : Integer;
begin
   z := Ord(x) + n;
   x := z and $FF;
   Result := z div 256;
end;

{**************************************************************************
 * NAME:    IncrementWithMask
 * DESC:    erhöht eine Nummer (die als String vorliegt) um den Wert N
 *          Dabei darf "Number" an bestimmten Stellen auch Buchstaben enthalten
 *          "Mask" bestimmt, an welchen Positionen Ziffern oder Buchstaben erlaubt sind
 * Mask:  0 = Ziffern     (0..9)
 *        2 = Binär       (0..1)
 *        A = Buchstaben  (A..Z)
 *        a = Buchstaben  (a..z)
 *        Z = Ziffern & Gross-Buchstaben
 *        z = Ziffern & Klein-Buchstaben
 *        H = Hex-Ziffern  (0..9, A..F)
 *        h = Hex-Ziffern  (0..9, a..f)
 *        B = Zeichen wird binär erhöht
 *          = diese Stelle bleibt
 * PARAMS:  [-]
 * RESULT:  die erhöhte Nummer
 * CHANGED: 03-06-2011/shmia
 *************************************************************************}
function IncrementWithMask(const Number, Mask:AnsiString; N : Integer):AnsiString;

   function IncrementDigit(x:PAnsiChar; m:Char; n:Integer):Integer;
   const
      digits :   AnsiString = '0123456789';
      alpha :    AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
      hex :      AnsiString = '0123456789ABCDEF';
      numalpha : AnsiString = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
   begin
      case m of
         '0': Result := IncSingleDigit(x^, n, digits);
         '2': Result := IncSingleDigit(x^, n, '01');
         'A': Result := IncSingleDigit(x^, n, alpha);
         'a': Result := IncSingleDigit(x^, n, LowerCase(alpha));
         'Z': Result := IncSingleDigit(x^, n, numalpha);
         'z': Result := IncSingleDigit(x^, n, LowerCase(numalpha));
         'H': Result := IncSingleDigit(x^, n, hex);
         'h': Result := IncSingleDigit(x^, n, LowerCase(hex));
         'B': Result := IncBinary(PByte(x)^,n);
         ' ':
            Result := n;
      else
         begin
            Result := n;
            x^ := m;
         end
      end;
   end;

var
   i : Integer;
begin
   Result := Number;
   UniqueString(Result);
   for i := Length(Result) downto 1 do
   begin
      N := IncrementDigit(@result[i], Mask[i], N);
      if N = 0 then
         Break;
   end;
end;

PS: Ohhjee, jetzt haben wir 2 Implementierungen

[Stevie]

epeen contest?