{*********************************************************

 SlavaNap source code.

 Copyright 2001,2002 by SlavaNap development team
 Released under GNU General Public License

 Latest version is available at
 http://www.slavanap.org

**********************************************************

 Unit: SlavaMasks

 Replacement for delphi's masks unit (Some code is taken from Masks.pas)

*********************************************************}
unit SlavaMasks;

interface

uses
  Windows, Classes2;

type
  TSMask = class
  private
    FMask: Pointer;
    FSize: Integer;
  public
    constructor Create(const MaskValue: string);
    destructor Destroy; override;
    procedure SetMask(const MaskValue: string);
    function Matches(const FileName: string): Boolean;
  end;

function MatchesMaskS(const FileName, Mask: string): Boolean;

implementation

uses SysUtils, RtlConsts, Vars;

const
  MaxCards = 30;

type
  PMaskSet = ^TSMaskSet;
  TSMaskSet = set of Char;
  TSMaskStates = (msLiteral, msAny, msSet, msMBCSLiteral);
  TSMaskState = record
    SkipTo: Boolean;
    case State: TSMaskStates of
      msLiteral: (Literal: Char);
      msAny: ();
      msSet: (
        Negate: Boolean;
        Charset: PMaskSet);
      msMBCSLiteral: (LeadByte, TrailByte: Char);
  end;
  PMaskStateArray = ^TSMaskStateArray;
  TSMaskStateArray = array[0..128] of TSMaskState;

var
  Masks: TMyList;

function IniTSMaskStates(const Mask: string;
  var MaskStates: array of TSMaskState): Integer;
var
  I: Integer;
  SkipTo: Boolean;
  Literal: Char;
  LeadByte, TrailByte: Char;
  P: PChar;
  Negate: Boolean;
  Charset: TSMaskSet;
  Cards: Integer;

  procedure InvalidMask;
  begin
    Raise Exception.CreateFmt(SInvalidMask, [Mask,
      P - PChar(Mask) + 1]);
  end;

  procedure Reset;
  begin
    SkipTo := False;
    Negate := False;
    Charset := [];
  end;

  procedure WriteScan(MaskState: TSMaskStates);
  begin
    if I <= High(MaskStates) then
    begin
      if SkipTo then
      begin
        Inc(Cards);
        if Cards > MaxCards then
          InvalidMask;
      end;
      MaskStates[I].SkipTo := SkipTo;
      MaskStates[I].State := MaskState;
      case MaskState of
        msLiteral: MaskStates[I].Literal := UpCase(Literal);
        msSet:
          begin
            MaskStates[I].Negate := Negate;
            New(MaskStates[I].Charset);
            MaskStates[I].Charset^ := Charset;
          end;
        msMBCSLiteral:
          begin
            MaskStates[I].LeadByte := LeadByte;
            MaskStates[I].TrailByte := TrailByte;
          end;
      end;
    end;
    Inc(I);
    Reset;
  end;

begin
  P := PChar(Mask);
  I := 0;
  Cards := 0;
  Reset;
  while P^ <> #0 do
  begin
    case P^ of
      '*': SkipTo := True;
      '?': if not SkipTo then
          WriteScan(msAny);
      //  '[':  ScanSet;
    else
      if P^ in LeadBytes then
      begin
        LeadByte := P^;
        Inc(P);
        TrailByte := P^;
        WriteScan(msMBCSLiteral);
      end
      else
      begin
        Literal := P^;
        WriteScan(msLiteral);
      end;
    end;
    Inc(P);
  end;
  Literal := #0;
  WriteScan(msLiteral);
  Result := I;
end;

function MatchesMaskStates(const FileName: string;
  MaskStates: array of TSMaskState): Boolean;
type
  TStackRec = record
    sP: PChar;
    sI: Integer;
  end;
var
  T: Integer;
  S: array[0..MaxCards - 1] of TStackRec;
  I: Integer;
  P: PChar;

  procedure Push(P: PChar; I: Integer);
  begin
    with S[T] do
    begin
      sP := P;
      sI := I;
    end;
    Inc(T);
  end;

  function Pop(var P: PChar; var I: Integer): Boolean;
  begin
    if T = 0 then
      Result := False
    else
    begin
      Dec(T);
      with S[T] do
      begin
        P := sP;
        I := sI;
      end;
      Result := True;
    end;
  end;

  function Matches(P: PChar; Start: Integer): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := Start to High(MaskStates) do
      with MaskStates[I] do
      begin
        if SkipTo then
        begin
          case State of
            msLiteral:
              while (P^ <> #0) and (UpperCase(P^) <> Literal) do
                Inc(P);
            msSet:
              while (P^ <> #0) and not (Negate xor (UpCase(P^) in Charset^)) do
                Inc(P);
            msMBCSLiteral:
              while (P^ <> #0) do
              begin
                if (P^ <> LeadByte) then
                  Inc(P, 2)
                else
                begin
                  Inc(P);
                  if (P^ = TrailByte) then Break;
                  Inc(P);
                end;
              end;
          end;
          if P^ <> #0 then
            Push(@P[1], I);
        end;
        case State of
          msLiteral: if UpperCase(P^) <> Literal then Exit;
          msSet: if not (Negate xor (UpCase(P^) in Charset^)) then Exit;
          msMBCSLiteral:
            begin
              if P^ <> LeadByte then Exit;
              Inc(P);
              if P^ <> TrailByte then Exit;
            end;
        end;
        Inc(P);
      end;
    Result := True;
  end;

begin
  Result := True;
  T := 0;
  P := PChar(FileName);
  I := Low(MaskStates);
  repeat
    if Matches(P, I) then Exit;
  until not Pop(P, I);
  Result := False;
end;

procedure DoneMaskStates(var MaskStates: array of TSMaskState);
var
  I: Integer;
begin
  for I := Low(MaskStates) to High(MaskStates) do
    if MaskStates[I].State = msSet then
      Dispose(MaskStates[I].Charset);
end;

{ TSMask }

constructor TSMask.Create(const MaskValue: string);
var
  A: array[0..0] of TSMaskState;
begin
  FSize := IniTSMaskStates(MaskValue, A);
  FMask := AllocMem(FSize * SizeOf(TSMaskState));
  IniTSMaskStates(MaskValue, Slice(PMaskStateArray(FMask)^, FSize));
end;

procedure TSMask.SetMask(const MaskValue: string);
var
  FOldSize: Integer;
  A: array[0..0] of TSMaskState;
begin
  FOldSize := FSize;
  if FMask <> nil then
    DoneMaskStates(Slice(PMaskStateArray(FMask)^, FSize));
  FSize := IniTSMaskStates(MaskValue, A);
  if FSize <> FOldSize then
    ReallocMem(FMask, FSize * SizeOf(TSMaskState));
  IniTSMaskStates(MaskValue, Slice(PMaskStateArray(FMask)^, FSize));
end;

destructor TSMask.Destroy;
begin
  if FMask <> nil then
  begin
    DoneMaskStates(Slice(PMaskStateArray(FMask)^, FSize));
    Finalize(FMask^);
    FreeMem(FMask, FSize * SizeOf(TSMaskState));
  end;
end;

function TSMask.Matches(const FileName: string): Boolean;
begin
  Result := MatchesMaskStates(FileName, Slice(PMaskStateArray(FMask)^, FSize));
end;

function CreateSMask(const Mask: string): TSMask;
var
  S: TSMask;
begin
  if Masks.Count > 0 then
  begin
    S := Masks.Items[Masks.Count - 1];
    Masks.Delete(Masks.Count - 1);
    S.SetMask(Mask);
  end
  else
    S := TSMask.Create(Mask);
  Result := S;
end;

procedure FreeSMask(Mask: TSMask);
begin
  if (Masks.Count < 16) and Running then
    Masks.Add(Mask)
  else
    Mask.Free;
end;

procedure FreeAllMasks;
var
  I: Integer;
begin
  for I := 0 to Masks.Count - 1 do
    TSMask(Masks.Items[I]).Free;
  Masks.Clear;
end;

function MatchesMaskS(const FileName, Mask: string): Boolean;
var
  CMask: TSMask;
begin
  CMask := CreateSMask(Mask);
  try
    Result := CMask.Matches(FileName);
  finally
    FreeSMask(CMask);
  end;
end;

initialization
  begin
    Masks := TMyList.Create;
  end;

finalization
  begin
    FreeAllMasks;
    Masks.Free;
  end;

end.
