home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / textfile.swg / 0037_Text File Parser.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-05  |  4.5 KB  |  149 lines
  1.  
  2. {╔═══════════════════════════════════════════════════════════════════╗}
  3. {║ TEMPLATE - Text File Parser                                       ║}
  4. {║   Steven Kerr, 1994                                               ║}
  5. {║                                                                   ║}
  6. {║ Syntax : TEMPLATE Input Output                                    ║}
  7. {║                                                                   ║}
  8. {║   Where Input  = Input File                                       ║}
  9. {║         Output = Output File                                      ║}
  10. {╚═══════════════════════════════════════════════════════════════════╝}
  11. {$M 8192, 0, 0}
  12. Program Template;
  13. Uses DOS;
  14. Const
  15.   Null         : String = '';
  16.   LeftControl  : Char   = '<'; { Left hand control character  }
  17.   RightControl : Char   = '>'; { Right hand control character }
  18. Var
  19.   InputFile, OutputFile : Text;
  20.   Checked, Error        : Boolean;
  21.  
  22. Function Upper (Parameter : String) : String;
  23. Var
  24.   I : Integer;
  25. begin
  26.   for I := 1 to Length(Parameter) do
  27.     Parameter[I] := UpCase(Parameter[I]);
  28.   Upper := Parameter
  29. end {Function Upper};
  30.  
  31. Function File_Exists (Filename : String) : Boolean;
  32. Var
  33.   Attr : Word;
  34.   F    : File;
  35. begin
  36.   Assign(F, Filename);
  37.   GetFAttr(F, Attr);
  38.   File_Exists := (DOSError = 0)
  39. end { Function FileExists };
  40.  
  41. Procedure Display_Error (Message : String; Filename : String);
  42. begin
  43.   Writeln;
  44.   Writeln('TEMPLATE - Text File Parser');
  45.   Writeln('  Steven Kerr, 1994');
  46.   Writeln;
  47.   Writeln('Syntax : TEMPLATE Input Output');
  48.   Writeln;
  49.   Writeln('  Where Input  = Input File');
  50.   Writeln('        Output = Output File');
  51.   Writeln;
  52.   Writeln('Error : ', Message, Filename)
  53. end { Procedure Display_Help };
  54.  
  55. Function Check_Variable (Variable : String; Position : Byte) : Byte;
  56. Var
  57.   Valid : Boolean;
  58. begin
  59.   Valid := False;
  60.   { Add in addition variables as below. If Valid = False, the variable }
  61.   { is ignored and written "as is".                                    }
  62.   if Upper(Variable) = LeftControl + 'DISKFREEC' + RightControl then begin
  63.     Valid := True;
  64.     Write(OutputFile, DiskFree(3))
  65.   end { DiskFreeC };
  66.   {}
  67.   Checked := True;
  68.   if Valid then
  69.     Check_Variable := Position + Length(Variable) - 1
  70.   else
  71.     Check_Variable := Position - 1
  72. end { Function Check_Variable };
  73.  
  74. Function Look_Ahead (Line : String; Position : Byte) : String;
  75. Var
  76.   Variable : String;
  77. begin
  78.   Variable := Line[Position];
  79.   While (Length(Line) <> Position) and
  80.         (Line[Position] <> RightControl) do begin
  81.     Inc(Position);
  82.     Variable := Variable + Line[Position]
  83.   end { While };
  84.   Look_Ahead := Variable
  85. end { Function Look_Ahead };
  86.  
  87. Procedure Parse_File;
  88. Var
  89.   Line     : String;
  90.   Position : Byte;
  91. begin
  92.   Position := 0;
  93.   Checked := False;
  94.   While (not EOF(InputFile)) do begin
  95.     Readln(InputFile, Line);
  96.       While Position < Length(Line) do begin
  97.         Inc(Position);
  98.         if (Line[Position] = LeftControl) and (not Checked) then begin
  99.           Position := Check_Variable(Look_Ahead(Line, Position), Position)
  100.         end else begin
  101.           Write(OutputFile, Line[Position]);
  102.           Checked := False
  103.         end { if }
  104.       end { While };
  105.       Position := 0;
  106.       Checked := False;
  107.       Writeln(OutputFile)
  108.   end { While }
  109. end { Procedure Parse_File };
  110.  
  111. Function Files_Opened (InputF : String; OutputF : String) : Boolean;
  112. Var
  113.   Error : Boolean;
  114. begin
  115.   Error := False;
  116.   Assign(InputFile, ParamStr(1));
  117.   Assign(OutputFile, ParamStr(2));
  118.   {$I-} ReWrite(OutputFile); {$I+}
  119.   if IOResult <> 0 then begin
  120.     Display_Error('Unable to write to ', Upper(ParamStr(2)));
  121.     Error := True
  122.   end { if IOResult };
  123.   if (not Error) then begin
  124.     {$I-} Reset(InputFile); {$I+}
  125.     if IOResult <> 0 then begin
  126.       Display_Error('Unable to read from ', Upper(ParamStr(1)));
  127.       Error := True
  128.     end { if IOResult }
  129.   end { if };
  130.   Files_Opened := (not Error)
  131. end { Function Files_Opened };
  132.  
  133. begin { Program Template }
  134.   if ParamCount = 2 then begin
  135.     if File_Exists(ParamStr(1)) then begin
  136.       if (not File_Exists(ParamStr(2))) then begin
  137.         if Files_Opened(ParamStr(1), ParamStr(2)) then begin
  138.           Parse_File;
  139.           Close(InputFile);
  140.           Close(OutputFile)
  141.         end
  142.       end else
  143.         Display_Error('Output file already exists', '')
  144.     end else
  145.       Display_Error('Input file not found', '')
  146.   end else
  147.       Display_Error('Invalid number of parameters', '')
  148. end { Program Template }.
  149.