[giko]

Hola

Efectivamente, no es un paquete standard. El módulo CitiPatterns.pas es el que estoy intentando compilar (el proyecto contiene otros módulos, pero parece que sólo éste genera errores y advertencias). Una vez compilado, debo proceder a instalarlo. Adjunto el código, por si aporta algo de información.

Muchas gracias.

Código Delphi [-]
unit CitiPatterns;

interface

uses Windows, SysUtils;

type
  TCitiCharSet = set of Char;
  TCitiValidateState = (vsOk, vsIncomplete, vsError);
  TCitiDateKind = (dkDate, dkDateTime, dkTime);

  EPatternException = class(Exception);

  TCitiPattern = class
  private
    FExpression: string;
    function GetCharSet: TCitiCharSet;
    procedure SetExpression(const Value: string);
  protected
    FPattern, FControl: string;
    FPatternPrefix, FControlPrefix: string;
    FCharSet, FCharSetPrefix: TCitiCharSet;
    procedure SetRegularExpr(RE: string);
  public
    // Construction
    constructor Create;
    // Pattern matching
    function Match(const Data: string; var Tail: string; var Jump: Boolean): TCitiValidateState;
    // Pattern configuration
    procedure SetDateTimePattern(AKind: TCitiDateKind; ATwoDigitYear, AReqSeconds: Boolean);
    procedure SetFloatPattern(ADigits, ADecimals: Integer; Neg, Dot: Boolean);
    procedure SetIntegerPattern(AMin, AMax: Integer);
    procedure SetPrefix(const PatPref, CtlPref: string; const CSet: TCitiCharSet);
  public
    property CharSet: TCitiCharSet read GetCharSet;
    property Expression: string read FExpression write SetExpression;
  end;

procedure PatternException(const Msg: string);

resourcestring
  SInvalidPattern = 'Invalid pattern';

implementation

var
  AlphaChars: TCitiCharSet = [];
  AlphaNums: TCitiCharSet = [];

// Exceptions

procedure PatternException(const Msg: string);
begin
  raise EPatternException.Create(Msg);
end;

// TCitiPattern: construction

constructor TCitiPattern.Create;
begin
  inherited Create;
  FCharSet := [#0..#255];
end;

// TCitiPattern: access methods for properties

function TCitiPattern.GetCharSet: TCitiCharSet;
begin
  Result := FCharSet + FCharSetPrefix;
end;

procedure TCitiPattern.SetExpression(const Value: string);
begin
  if Value <> FExpression then
  begin
    SetRegularExpr(Value);
    FExpression := Value;
  end;
end;

// TCitiPattern: parsing expressions into pattern programs

function ProcessGroups(const S: string): string;
var
  Stack: array [1..100] of string;
  Temp: string;
  Top: Integer;
  I, J, Times: Integer;
begin
  Top := 1;
  Stack[1] := '';
  I := 1;
  while I <= Length(S) do
    case S[i] of
      '[':
        begin
          Inc(Top);
          Stack[Top] := '[';
          Inc(I);
        end;
      ']':
        begin
          if Top = 1 then
            PatternException(SInvalidPattern);
          Temp := Stack[Top] + ']';
          Dec(Top);
          Inc(I);
          Times := 0;
          while (I <= Length(S)) and (S[i] in ['0'..'9']) do
          begin
            Times := Times * 10 + Ord(S[i]) - Ord('0');
            Inc(I);
          end;
          if Times = 0 then Times := 1;
          for J := 1 to Times do
            //AppendStr(Stack[Top], Temp);
            Stack[Top] := Stack[Top] + Temp
        end;
    else
      //AppendStr(Stack[Top], S[i]);
      Stack[Top] := Stack[Top] + S[i];
      Inc(I);
    end;
  if Top <> 1 then
    PatternException(SInvalidPattern);
  Result := Stack[1];
end;

procedure TCitiPattern.SetRegularExpr(RE: string);
var
  I, Top, J: Integer;
  P, C: string;
  Ch: Char;
  Stack, Patch: array [1..100] of Integer;
  CS: TCitiCharSet;
begin
  P := '';
  C := '';
  CS := [];
  if RE <> '' then
  begin
    if Pos('[', RE) <> 0 then
      RE := ProcessGroups(RE);
    Top := 0;
    I := 1;
    while I <= Length(RE) do
    begin
      Ch := RE[i];
      case Ch of
        '[':
          begin
            Inc(Top);
            Stack[Top] := Length(P) + 1;
            Patch[Top] := 0;
          end;
        '|':
          begin
            if Top = 0 then
              PatternException(SInvalidPattern);
            //AppendStr(P, #1);
            P := P + #1;
            //AppendStr(C, #0);
            C := C + #0;
            C[Stack[Top]] := Char(Length(P) + 1 - Stack[Top]);
            Stack[Top] := Length(P) + 1;
            C[Length(C)] := Chr(Patch[Top]);
            Patch[Top] := Length(C);
          end;
        ']':
          begin
            if Top = 0 then
              PatternException(SInvalidPattern);
            C[Stack[Top]] := Chr(Length(P) + 1 - Stack[Top]);
            while Patch[Top] <> 0 do
            begin
              J := Patch[Top];
              Patch[Top] := Ord(C[J]);
              C[J] := Chr(Length(C) + 1 - J);
            end;
            Dec(Top);
          end;
      else
        //AppendStr(P, Ch);
        P := P + Ch;
        //AppendStr(C, #0);
        C := C + #0;
        case Ch of
          '_': CS := [#0..#255];
          '#': CS := CS + ['0'..'9'];
          '@': CS := CS + AlphaChars;
          '%': CS := CS + AlphaNums;
        else
          Include(CS, Ch);
        end;
      end;
      Inc(I);
    end;
    //AppendStr(P, #0);
    P := P + #0;
    //AppendStr(C, #0);
    C := C + #0;
  end;
  FPattern := P;
  FControl := C;
  FCharSet := CS;
end;

// TCitiPattern: special patterns

procedure TCitiPattern.SetDateTimePattern(AKind: TCitiDateKind; ATwoDigitYear,
  AReqSeconds: Boolean);
var
  S: string;
begin
  S := '';
  if AKind <= dkDateTime then // AKind is dkDate, dkDateTime, dkTime
  begin
    S := '#[#]' + DateSeparator + '#[#]' + DateSeparator + '##';
    if ATwoDigitYear then
      //AppendStr(S, '[##]')
      S := S + '[##]'
    else
      //AppendStr(S, '##');
      S := S + '##';
  end;
  if AKind = dkDateTime then
    //AppendStr(S, ' [ ]');
    S := S + ' [ ]';
  if AKind >= dkDateTime then
  begin
    //AppendStr(S, '#[#]' + TimeSeparator + '#[#]');
    S := S + '#[#]' + TimeSeparator + '#[#]';
    if AReqSeconds then
      //AppendStr(S, TimeSeparator + '#[#]')
      S := S + TimeSeparator + '#[#]'
    else
      //AppendStr(S, '[' + TimeSeparator + '#[#]]');
      S := S + '[' + TimeSeparator + '#[#]]';
  end;
  SetRegularExpr(S);
end;

procedure TCitiPattern.SetFloatPattern(ADigits, ADecimals: Integer; Neg,
  Dot: Boolean);
var
  S, S1: string;
begin
  if Neg then
    S := '[-]#'
  else
    S := '#';
  if ADigits > 1 then
  begin
    //AppendStr(S, '[#]');
    S := S + '[#]';
    //AppendStr(S, IntToStr(ADigits - 1));
    S := S + IntToStr(ADigits - 1);
  end;
  if ADecimals > 0 then
  begin
    S1 := DecimalSeparator;
    repeat
      if Dot then
        //AppendStr(S1, '#')
        S1 := S1 + '#'
      else
        //AppendStr(S1, '[#]');
        S1 := S1 + '[#]';
      Dot := False;
      Dec(ADecimals);
    until ADecimals = 0;
    if Dot then
      //AppendStr(S, S1)
      S := S + S1
    else
      //AppendStr(S, '[' + S1 + ']');
      S := S + '[' + S1 + ']';
  end;
  SetRegularExpr(S);
end;

procedure TCitiPattern.SetIntegerPattern(AMin, AMax: Integer);
var
  S: string;
begin
  if AMin >= AMax then
    AMin := -MaxLongInt;
  if AMin < 0 then
    S := '[-]#'
  else
    S := '#';
  AMin := Abs(AMin);
  AMax := Abs(AMax);
  if AMin > AMax then AMax := AMin;
  while AMax >= 10 do
  begin
    AMax := AMax div 10;
    //AppendStr(S, '[#]');
    S := S + '[#]';
  end;
  SetRegularExpr(S);
end;

// TCitiPattern: prefixed expression for filter patterns

procedure TCitiPattern.SetPrefix(const PatPref, CtlPref: string;
  const CSet: TCitiCharSet);
begin
  FPatternPrefix := PatPref;
  FControlPrefix := CtlPref;
  FCharSetPrefix := CSet;
end;

// TCitiPattern: the match engine

function MatchChar(PatChar, DataChar: Char): Boolean;
begin
  case PatChar of
    '#': Result := DataChar in ['0'..'9'];
    '_': Result := True;
    '@': Result := IsCharAlpha(DataChar);
    '%': Result := IsCharAlphaNumeric(DataChar);
  else
    Result := (PatChar = DataChar);
  end;
end;

function TCitiPattern.Match(const Data: string; var Tail: string;
  var Jump: Boolean): TCitiValidateState;
var
  I, J: Integer;
  Pat, Con: string;
begin
  Jump := False;
  if FPattern = '' then
  begin
    Result := vsOk;
    Exit;
  end;
  Pat := FPatternPrefix + FPattern;
  Con := FControlPrefix + FControl;
  ASSERT(Length(Pat) = Length(Con));
  Tail := '';
  I := 1;
  J := 1;
  while J <= Length(Data) do  // For each character in Data
    if Pat[i] = #0 then       // Halt pattern matching
    begin
      Result := vsError;      // Data string is longer than pattern
      Exit;
    end
    else if MatchChar(Pat[i], Data[J]) then
    begin
      Inc(I);
      Inc(J);
    end
    else if Con[i] = #0 then
    begin                     // Data mismatch; no jump available
      Result := vsError;
      Exit;
    end
    else                      // Jump to alternative
      Inc(I, ShortInt(Con[i]));
  if Pat[i] = #1 then         // Skip vertical bar (|)
    Inc(I, ShortInt(Con[i]));
  J := I;
  while Con[i] <> #0 do       // Skip optional strings
    Inc(I, ShortInt(Con[i]));
  if Pat[i] = #0 then
  begin
    Result := vsOk;
    Jump := I = J;            // No optional strings at pattern's end
  end
  else
  begin
    Result := vsIncomplete;   // Data string is shorter than pattern
    repeat
      if Pat[J] = #1 then
        Inc(J, ShortInt(Con[J]))
      else if (Con[J] = #0) and
        not (Pat[J] in [#0, '#', '@', '%', '_']) then
      begin
        //AppendStr(Tail, Pat[J]);
        Tail := Tail + Pat[J];
        Inc(J);
      end
      else
        Break;
    until False;
  end;
end;

// Initialization & finalization

var
  Ch: Char;
initialization
  for Ch := #32 to #255 do
  begin
    if IsCharAlpha(Ch) then
      Include(AlphaChars, Ch);
    if IsCharAlphaNumeric(Ch) then
      Include(AlphaNums, Ch);
  end;
end.