[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]

    (* -------------------------------------------------------------- *)
    (* FileSpec.PAS v1.0a by Robert Walking-Owl November 1993         *)
    (* -------------------------------------------------------------- *)

    { Things to add...                                                 }
    { - have # and $ be symbols for ASCII chars in dec/hex?            }

    (* Buggie Things:                                                 *)
    (* - anti-sets don't work with variable lenght sets, since they   *)
    (*   end with the first character NOT in the set...               *)

    {$F+}

    unit FileSpec;

    interface

    uses Dos;

    const
      DosNameLen  = 12;     (* Maximum Length of DOS filenames        *)
      UnixNameLen = 32;     (* Maximum Length of Unix Filenames       *)

      MaxWildArgs = 32;     (* Maximum number of wildcard arguments   *)
      MaxNameLen  = 127;

      fCaseSensitive = $01; (* Case Sensitive Flag                    *)
      fExtendedWilds = $02; (* Use extented wildcard forms (not,sets  *)
      fUndocumented  = $80; (* Use DOS 'undocumented' filespecs       *)

    type
      SpecList   = array [1..MaxWildArgs] of record
                       Name:  string[ MaxNameLen ];  (* or use DOS ParamStr?  *)
                       Truth: Boolean
                       end;
      PWildCard  = ^TWildCard;
      TWildCard  = object
                     private
                       FileSpecs: SpecList;     (* List of filespecs      *)
                       NumNegs,                 (* Number of "not" specs  *)
                       FSpCount:  word;         (* Total number of specs  *)
                       function StripQuotes( x: string ): string;
                       procedure   FileSplit(Path: string;
                                       var Dir,Name,Ext: string);
                     public
                       PathChar,                (* path seperation char   *)
                       NotChar,                 (* "not" char - init '~'  *)
                       QuoteChar:     Char;     (* quote char - init '"'  *)
                       Flags,                   (* Mode flags ...         *)
                       FileNameLen:   Byte;     (* MaxLength of FileNames *)
                       constructor Init;
                       procedure   AddSpec( name: string);
                       function    FitSpec( name: string): Boolean;
                       destructor  Done;
                   (* Methods to RemoveSpec() or ChangeSpec() aren't added *)
                   (* since for most applications they seem unnecessary.   *)
                   (* An IsValid() spec to see if a specification is valid *)
                   (* syntax is also unnecessary, since no harm is done,   *)
                   (* and DOS and Unix ignore them anyway ....             *)
                   end;

    implementation

    procedure UpCaseStr( var S: string); assembler;
    asm
                    PUSH    DS
                    LDS     SI,S
                    MOV     AL,BYTE PTR DS:[SI]
                    XOR     CX,CX
                    MOV     CL,AL
    @STRINGLOOP:    INC     SI
                    MOV     AL,BYTE PTR DS:[SI]
                    CMP     AL,'a'
                    JB      @NOTLOCASE
                    CMP     AL,'z'
                    JA      @NOTLOCASE
                    SUB     AL,32
                    MOV     BYTE PTR DS:[SI],AL
    @NOTLOCASE:     LOOP    @STRINGLOOP
                    POP     DS
    end;

    constructor TWildCard.Init;
    begin
      FSpCount  := 0;
      NumNegs   := 0;
      NotChar   := '~';
      QuoteChar := '"';
      Flags := fExtendedWilds or fUndocumented;
      FileNameLen := DosNameLen;
      PathChar := '\';
    end;

    destructor TWildCard.Done;
    begin
      FSpCount := 0
    end;

    function TWildCard.StripQuotes( x: string ): string;
    begin
      if x<>''
        then if (x[1]=QuoteChar) and (x[length(x)]=QuoteChar)
          then StripQuotes := Copy(x,2,Length(x)-2)
          else StripQuotes := x
    end;

    procedure TWildCard.AddSpec( Name: string);
    var
      Truth: Boolean;
    begin
      if Name <> '' then begin
      Truth := True;
      if (Flags and fExtendedWilds)<>0
        then begin
          if Name[1]=NotChar
            then begin
              inc(NumNegs);
              Truth := False;
              Name  := Copy( Name , 2, Pred(Length(Name)) );
             end;
          Name := StripQuotes( Name );
        end;
      if (FSpCount<>MaxWildArgs) and (Name<>'')
        then begin
          inc( FSpCount );
          FileSpecs[ FSpCount ].Name := Name;
          FileSpecs[ FSpCount ].Truth := Truth
          end;
      end
    end;

    procedure TWildCard.FileSplit(Path: string; var Dir,Name,Ext: string);
    var
      i,p,e: byte;
      InSet: Boolean;
    begin
      p:=0;
      if (Flags and fCaseSensitive)=0
        then UpCaseStr(Path);
      for i:=1 to length(Path) do if Path[i]=PathChar then p:=i;
      i:=Length(Path);
      InSet := False;
      e := succ(length(Path));
      repeat
        if not Inset
           then case Path[i] of
                  '.': e := i;
                  ']',
                  '}',
                  ')': InSet := True;
                end
           else if Path[i] in ['[','{','('] then InSet := False;
        dec(i);
      until i=0;
      if p=0
        then Dir := ''
        else Dir := Copy(Path,1,p);
      Name := Copy(Path,Succ(p),pred(e-p));
      if e<=length(Path)
        then Ext := Copy(Path,e,succ(Length(Path)-e))
        else Ext := '';
    end;

    function TWildCard.FitSpec( name: string): Boolean;

    procedure Puff(var x: string); (* Pad filename with spaces *)
    begin
      while length(x)<FileNameLen do x:=x+' ';
    end;

    var x,b: set of char;
    procedure GetSet(s: string; EndSet: char; var k: byte);
    var
        c: char;
        u: string;
        i: byte;
        A: Boolean;
    begin
      A := False;
      if s[k]=',' then repeat
          inc(k)
        until (k>=FileNameLen) or (s[k]=EndSet) or (s[k]<>',');
      u := '';
      if (k<FileNameLen) and (s[k]<>EndSet) then begin
        repeat
          u := u + s[k];
          inc(k);
        until (k>=FileNameLen) or (s[k]=EndSet) or (s[k]=',');
        if u<>'' then begin
          if u[1]=NotChar
            then begin
              A := True;
              u := Copy(u,2,pred(length(u)));
              end;
          u := StripQuotes(u);
          if (length(u)=3) and (u[2]='-')
            then begin
               for c := u[1] to u[3]
                 do if A then b := b+[ c ]
                       else x := x+[ c ]
               end
            else begin
               for i:=1 to length(u)
                 do if A then b := b+[ u[i] ]
                       else x:=x+[ u[i] ];
               end
        end;
      end;
    end;

    function Match(n,s: string): Boolean;  (* Does a field match? *)
    var i,j,k: byte;
        c: char;
        T: Boolean;
        Scrap: string;
    begin
      i := 1; (* index of filespec *)
      j := 1; (* index of name     *)
      T := True;
      Puff(n);
      Puff(s);
      repeat
        if s[i]='*' then i:=FileNameLen (* Abort *)
          else
             case s[i] of
             '(' : if ((Flags and fExtendedWilds)<>0) then begin
                     Scrap := '';
                     inc(i);
                     repeat
                       Scrap := Scrap + s[i];
                       inc(i);
                     until (i>=FileNameLen) or (s[i]=')');
                     Scrap := StripQuotes(Scrap);
                     if Pos(Scrap,Copy(n,j,Length(n)))=0
                       then T := False;
                   end;
             '[' : if ((Flags and fExtendedWilds)<>0) then begin
                    x := [];  b := [];
                    k:=succ(i);
                    repeat
                      GetSet(s,']',k);
                    until (k>=FileNameLen) or (s[k]=']');
                    i := k;
                    if x=[] then FillChar(x,SizeOf(x),#255);
                    x := x-b;
                    if not (n[j] in x) then T := False;
                   end;
              '{' : if ((Flags and fExtendedWilds)<>0) then begin
                      x := [];  b := [];
                      k:=succ(i);
                      repeat
                       GetSet(s,'}',k);
                      until (k>=FileNameLen) or (s[k]='}');
                      i := succ(k);
                      if x=[] then FillChar(x,SizeOf(x),#255);
                      x := x-b;
                      while (n[j] in x) and (j<=FileNameLen)
                        do inc(j);
                   end;
           else if T and (s[i]<>'?')
              then if s[i]<>n[j] then  T := False;
           end;
        inc(i);
        inc(j);
      until (not T) or (s[i]='*') or (i>FileNameLen) or (j>FileNameLen);
      Match := T;
    end;

    var i,
        NumMatches : byte;
        dn,de,nn,ne,sn,se: string;
        Negate : Boolean;
    begin
      Negate := False;
      if FSpCount=0 then NumMatches := 1
        else begin
          NumMatches := 0;
          for i:=1 to FSpCount
            do begin
              FileSplit(name,dn,nn,ne);
              FileSplit(FileSpecs[i].Name,de,sn,se);
                if ne='' then ne:='.   ';
              if (Flags and fUnDocumented)<>0 then begin
                if sn='' then sn:='*';
                if se='' then se:='.*';
                if dn='' then dn:='*';
                if de='' then de:='*';
              end;
              if (Match(dn,de) and Match(nn,sn) and Match(ne,se))
                 then begin
                   inc(NumMatches);
                   if not FileSpecs[i].Truth
                      then Negate := True;
                   end;
              end;
          end;
      if (NumNegs=FSpCount) and (NumMatches=0)
        then FitSpec := True
        else FitSpec := (NumMatches<>0) xor Negate;
    end;

    end.

    {---------------------  DEMO ------------------------- }

    (* Demo program to "test" the FileSpec unit                             *)
    (* Checks to see if file matches filespec... good for testing/debugging *)
    (* the FileSpec object/unit, as well as learning the syntax of FileSpec *)

    program FileSpec_Test(input, output);
      uses FileSpec;
    var p,                                       (* User-entered "filespec"  *)
        d:  String;                              (* Filename to "test"       *)
        FS: TWildCard;                           (* FileSpec Object          *)
    begin
      FS.Init;                                   (* Initialize               *)
      WriteLn;
      Write('Enter filespec -> '); ReadLN(p);    (* Get filespec...          *)
      FS.AddSpec(p);                             (* ... Add Spec to list ... *)
      Write('Enter file -----> '); ReadLN(d);    (* ... Get Filename ...     *)
      if FS.FitSpec(d)                           (* Is the file in the list? *)
        then WriteLN('The files match.')
        else WriteLN('The files don''t match.');
      FS.Done;                                   (* Done... clean up etc.    *)
    end.

    FileSpec v1.0a
    --------------

    "FileSpec" is a public domain Turbo Pascal unit that gives you advanced,
    Unix-like filespecs and wildcard-matching capabilities for your software.
    This version should be compatible with Turbo Pascal v5.5 upwards (since
    it uses OOP).

    The advantage is that you can check to see if a filename is within the
    specs a user has given--even multiple filespecs; thus utilities like
    file-finders or archive-viewers can have multiple file-search specif-
    ications.

    To use, first initialize the TWildCard object (.Init).

    You then use .AddSpec() to add the wildcards (e.g. user-specified) to the
    list; and use .FitSpec() to see if a filename "fits" in that list.

    When done, use the .Done destructor. (Check your TPascal manual if you do
    not understand how to use objects).

    "FileSpec" supports standard DOS wilcards (* and ?); also supported are the
    undocumented DOS wildcards (eg. FILENAME = FILENAME.* and .EXT = *.EXT).

    However, "FileSpec" supports many extended features which can make a program
    many times more powerful.  Filenames or wildcards can be in quotes (eg. "*.*"
    is equivalent to *.*).

    Also supported are "not" (or "but") wildcards using the ~ character.  Thus
    a hypothetical directory-lister with the argument ~*.TXT would list all
    files _except_ those that match *.TXT.

    Fixed and variable length "sets" are also supported:

    [a-m]*.*           <- Any files beginning with letters A-M
    [a-z,~ux]*.*       <- Any files beginning with a any letter except X or U
    *.?[~q]?           <- Any files except those that match *.?Q?
    foo[abc]*.*        <- Files of FOO?*.* where '?' is A,B or C
    foo["abc"]*.*      <- Same as above.
    foo[a-c]*.*        <- Same as above.
    test{0-9}.*        <- Files of TEST0.* through TEST9999.*
    x{}z.*             <- Filenames beginning with X and ending with Z
    x{0123456789}z.*   <- Same as above, only with numbers between X and Z.
    ("read")*.*        <- Filenames that contain the text "READ"

    If this seems confusing, use the FS-TEST.PAS program included with this
    archive to experiment and learn the syntax used by "FileSpec".

    Playing around with the included demos (LS.PAS, a directory lister; and
    XFIND, a file-finder) will also give you an idea how to use the FileSpecs
    unit.

    One Note: if you use the FileSpec unit with your software, please let users
    know about it in the documentation, so that they know they can take full
    advantage of the added features.

[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]