home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / VALIDFIL.ZIP / VALIDFIL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-11-01  |  9.3 KB  |  194 lines
  1. {     LINES BETWEEN ******* ARE A FRAME FOR TESTING  --  INCLUDE "VALIDFIL.BOX" IN YOUR PROGRAM    }
  2. {***********************************************************************************************************}
  3.  
  4. program TESTIT ;
  5.  
  6. type
  7.    TempStr = String [14] ;
  8. var
  9.    FileFlag : Boolean ;
  10.    TempName : TempStr ;
  11.  
  12. {***********************************************************************************************************}
  13.  
  14. {    function CheckFileName (Name : NameString) : Boolean ;    }
  15.  
  16. (*  A TURBO PASCAL function to parse a DOS filename for validity.  The function accepts a string of
  17.       maximum length 14 containing a file name with (optional) extension and/or (optional) drive
  18.       designator.  The function returns a Boolean value, TRUE if the file name is valid, FALSE if
  19.       it is not.  Example:
  20.  
  21.             FileFlag := CheckFileName ('B:$TEMP_FL.{%}') ;
  22.             FileFlag := CheckName (TempName) ;
  23.  
  24.       where FileFlag is a variable defined as Boolean.  Note that the string length of the parameter passed to
  25.       the function (in this case "TempName") need not match the string length of the formal parameter of the
  26.       function.  The parameter is passed by value rather than by variable.  However, it the string passed exceeds
  27.       40 characters in length, it will be truncated upon passage.
  28.  
  29.     If there is an error an explanatory message is presented on the screen.
  30.  
  31.         This function is valid under all TURBO Versions.
  32.  
  33.                         Bruce Cameron
  34.                         4067 Rose Hill
  35.                         Cincinnati  OH  45229
  36.  
  37.             (On  FIDO 108/10)                                    *)
  38.  
  39. type
  40.    NameString = String [40] ;         { String to contain input file name }
  41.  
  42. const
  43.    HighestValidDrive : Char = 'B' ;     { The function checks for validity of the drive designator if one
  44.                                              is included, a test which also tests if the drive is in the system.
  45.                                              This test compares the drive designator specified with the constant
  46.                                              "HighestValidDrive" as defined here.  Before use in your system,
  47.                                              this constant must be set correctly, either by changing this line,
  48.                                              or by assigning the correct value to this typed constant within
  49.                                              your code }
  50.  
  51. function CheckFileName (Name : NameString) : Boolean ;
  52.                  { Check a file name for validity; i.e., characters are valid for a file
  53.                       name, drive and/or name and/or extension all individually of valid
  54.                       length.  Valid characters for a filename are the complete set as
  55.                       defined under DOS 2.x.  If you wish to use this routine for a more
  56.                       restricted set of valid characters, redefine the constant "FileChars"
  57.                       to your specifications.  NOTE: this function examines file names only
  58.                       and does not parse a PATH for validity. }
  59.  
  60. type
  61.    Valid = Set of Char ;
  62.  
  63. const
  64.    Colon = ':' ;
  65.    Period = '.' ;
  66.    FileChars : Valid = ['@'..'Z', '0'..'9', '!', '#'..')', '-', '_', '`', '{', '}'] ;
  67.            { Define complete set of valid characters in a DOS filename, as specified for DOS 2.x }
  68.    Blank = ' ' ;
  69.  
  70. type
  71.    GenStr = String [60] ;       { String for error messages }
  72.  
  73. var
  74.    NameChars : Valid ;          { Set of characters in the name passed to the function }
  75.    OK : Boolean ;               { Result flag of test }
  76.    I : Byte ;                   { Index }
  77.    AllBlanks : Boolean ;        { Flag, name string all blanks }
  78.  
  79.    procedure BlankStrip (var Str : NameString) ;             { Strips leading and/or trailing blanks }
  80.  
  81.    var
  82.       I, J : Byte ;          { Indices }
  83.  
  84.    begin
  85.       repeat                         { Close up over any leading blanks }
  86.          for I := 1 to Length (Str) do if Str [I] = Blank then for J := (I + 1) to Length (Str) do Str [J - 1] := Str [J] ;
  87.       until Str [1] <> Blank ;
  88.       J := Length (Str) ;            { Copy leaving out any trailing blanks }
  89.       if J > 14 then for I := J downto 14 do if Str [I] = Blank then Str := Copy (Str, 1, (I - 1)) ;
  90.    end ;
  91.  
  92.    procedure FormSet (var ChSet : Valid ; Name : NameString) ;  { Form set of characters in the filename }
  93.  
  94.    var
  95.       I : 1..14 ;         { Index }
  96.       Ch : Char ;         { Individual character in the name }
  97.  
  98.    begin
  99.       ChSet := [] ;                              { Initialize the set empty }
  100.       for I := 1 to Length (Name) do begin       { For number of characters in the name }
  101.          Ch := Name[I] ;
  102.          ChSet := ChSet + [Ch] ;                 { Place them into the name character set }
  103.       end ;
  104.    end ;
  105.  
  106.  
  107.    procedure NameErr (var NameErr : Boolean ; Errms : GenStr) ;  { Error message if filename in error }
  108.  
  109.    begin
  110.       NameErr := False ;              { Set function return flag, error }
  111.       Writeln (Output) ;
  112.       Write (Output, ^G) ;            { Beep the speaker }
  113.       Writeln (Output, Errms) ;
  114.    end ;
  115.  
  116.    procedure ParseName (ChSet : Valid ; Name : NameString ; var Flag : Boolean) ;
  117.  
  118.    var
  119.       TStr : NameString ;            { Temporary name string }
  120.  
  121.       procedure CheckExt (Name : NameString ; var Errf : Boolean) ;  { Check name and extension lengths }
  122.  
  123.       var
  124.          I, Len : Byte ;         { Position / length parameters of name }
  125.          MSvar : GenStr ;        { Specific error message identifying text }
  126.  
  127.       begin
  128.          I := Pos (Period, Name) ;                   { Where is '.' in the name }
  129.          Len := Length (Name) ;                      { How long is the name }
  130.                                     { If '.' is beyond the 9th character then the name is too long; if '.' is
  131.                                        closer to the end than 3 then the extension is too long }
  132.          if ((Len - I) > 3) or (I > 9) then begin
  133.             if I > 9 then MSvar := 'name' else MSvar := 'extension' ;
  134.             NameErr (Errf, 'Invalid length, ' + MSvar) ;
  135.          end ;
  136.       end ;
  137.  
  138.    begin                                  {    PROC  ParseName    }
  139.       Flag := True ;                                { Set file name flag valid }
  140.       if Colon in ChSet then begin                  { Name includes a drive designator }
  141.          if Name[2] <> Colon then NameErr (Flag, 'Invalid drive specifier') ;    { The ':' must be in position 2 }
  142.                                                     { Check that drive requested is actually in the system }
  143.          if not (Name[1] in ['A'..HighestValidDrive]) then NameErr (Flag, 'Drive specified not in system') ;
  144.          Tstr := Copy (Name, 3, 14) ;               { Copy, stripping out drive ID }
  145.       end
  146.       else Tstr := Copy (Name, 1, 14) ;                  { No drive, copy entire name }
  147.       if Period in ChSet then CheckExt (Tstr, Flag)      { Name includes an extension }
  148.                                                      { If no extension, name must not exceed 8 characters }
  149.       else if Length (Tstr) > 8 then NameErr (Flag, 'Invalid length, name') ;
  150.    end ;
  151.  
  152.  
  153. begin                                      {    FUNC  CheckFileName    }
  154.    AllBlanks := True ;          { Set flag, default name is all blanks }
  155.                          { Check name, if any character not a blank then flag reset }
  156.    for I := 1 to Length (Name) do if Name [I] <> Blank then AllBlanks := False ;
  157.    if not AllBlanks then begin     { Name exists, process }
  158.       BlankStrip (Name) ;          { Clear leading and/or trailing blanks }
  159.       if Length (Name) > 14 then NameErr (OK, 'Input name string too long')
  160.       else begin             { Within maximum possible valid length of 14 }
  161.                        { Add to valid set the characters for drive and extension separators, ':' and '.' }
  162.          FileChars := FileChars + [Colon] + [Period] ;
  163.          FormSet (NameChars, Name) ;          { Form set of characters in the name }
  164.          if NameChars - FileChars <> [] then NameErr (OK, 'Invalid characters in name')  { Any invalid, error }
  165.          else ParseName (NameChars, Name, OK) ;        { All valid, check for length, valid drive }
  166.       end ;
  167.    end
  168.    else NameErr (OK, 'Non-existent name, all blanks') ;
  169.    CheckFileName := OK ;    { Return result }
  170. end ;
  171.               {  The return flag is set TRUE (valid) within the procedure "ParseName"; it there is
  172.                    any error, it is set FALSE (invalid) by execution of "NameErr"  }
  173.  
  174. {***********************************************************************************************************}
  175.  
  176. begin
  177.    HighestValidDrive := 'D' ;
  178.    FileFlag := CheckFileName ('B:$TEMP_FL.{%}') ;
  179.    Writeln (FileFlag) ;
  180.    TempName := 'E:VARFIL.1' ;
  181.    FileFlag := CheckFileName (TempName) ;
  182.    Writeln (FileFlag) ;
  183.    FileFlag := CheckFileName ('A:PATH\FIL.EXT') ;
  184.    Writeln (FileFlag) ;
  185.    FileFlag := CheckFileName ('FILE.EXTBAD') ;
  186.    Writeln (FileFlag) ;
  187.    FileFlag := CheckFileName ('          B:MAXIFILE.EXT   ') ;
  188.    Writeln (FileFlag) ;
  189.    FileFlag := CheckFileName ('                           ') ;
  190.    Writeln (FileFlag) ;
  191. end .
  192.  
  193. {***********************************************************************************************************}
  194.