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

{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»}
{º TEMPLATE - Text File Parser                                       º}
{º   Steven Kerr, 1994                                               º}
{º                                                                   º}
{º Syntax : TEMPLATE Input Output                                    º}
{º                                                                   º}
{º   Where Input  = Input File                                       º}
{º         Output = Output File                                      º}
{ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ}
{$M 8192, 0, 0}
Program Template;
Uses DOS;
Const
  Null         : String = '';
  LeftControl  : Char   = '<'; { Left hand control character  }
  RightControl : Char   = '>'; { Right hand control character }
Var
  InputFile, OutputFile : Text;
  Checked, Error        : Boolean;

Function Upper (Parameter : String) : String;
Var
  I : Integer;
begin
  for I := 1 to Length(Parameter) do
    Parameter[I] := UpCase(Parameter[I]);
  Upper := Parameter
end {Function Upper};

Function File_Exists (Filename : String) : Boolean;
Var
  Attr : Word;
  F    : File;
begin
  Assign(F, Filename);
  GetFAttr(F, Attr);
  File_Exists := (DOSError = 0)
end { Function FileExists };

Procedure Display_Error (Message : String; Filename : String);
begin
  Writeln;
  Writeln('TEMPLATE - Text File Parser');
  Writeln('  Steven Kerr, 1994');
  Writeln;
  Writeln('Syntax : TEMPLATE Input Output');
  Writeln;
  Writeln('  Where Input  = Input File');
  Writeln('        Output = Output File');
  Writeln;
  Writeln('Error : ', Message, Filename)
end { Procedure Display_Help };

Function Check_Variable (Variable : String; Position : Byte) : Byte;
Var
  Valid : Boolean;
begin
  Valid := False;
  { Add in addition variables as below. If Valid = False, the variable }
  { is ignored and written "as is".                                    }
  if Upper(Variable) = LeftControl + 'DISKFREEC' + RightControl then begin
    Valid := True;
    Write(OutputFile, DiskFree(3))
  end { DiskFreeC };
  {}
  Checked := True;
  if Valid then
    Check_Variable := Position + Length(Variable) - 1
  else
    Check_Variable := Position - 1
end { Function Check_Variable };

Function Look_Ahead (Line : String; Position : Byte) : String;
Var
  Variable : String;
begin
  Variable := Line[Position];
  While (Length(Line) <> Position) and
        (Line[Position] <> RightControl) do begin
    Inc(Position);
    Variable := Variable + Line[Position]
  end { While };
  Look_Ahead := Variable
end { Function Look_Ahead };

Procedure Parse_File;
Var
  Line     : String;
  Position : Byte;
begin
  Position := 0;
  Checked := False;
  While (not EOF(InputFile)) do begin
    Readln(InputFile, Line);
      While Position < Length(Line) do begin
        Inc(Position);
        if (Line[Position] = LeftControl) and (not Checked) then begin
          Position := Check_Variable(Look_Ahead(Line, Position), Position)
        end else begin
          Write(OutputFile, Line[Position]);
          Checked := False
        end { if }
      end { While };
      Position := 0;
      Checked := False;
      Writeln(OutputFile)
  end { While }
end { Procedure Parse_File };

Function Files_Opened (InputF : String; OutputF : String) : Boolean;
Var
  Error : Boolean;
begin
  Error := False;
  Assign(InputFile, ParamStr(1));
  Assign(OutputFile, ParamStr(2));
  {$I-} ReWrite(OutputFile); {$I+}
  if IOResult <> 0 then begin
    Display_Error('Unable to write to ', Upper(ParamStr(2)));
    Error := True
  end { if IOResult };
  if (not Error) then begin
    {$I-} Reset(InputFile); {$I+}
    if IOResult <> 0 then begin
      Display_Error('Unable to read from ', Upper(ParamStr(1)));
      Error := True
    end { if IOResult }
  end { if };
  Files_Opened := (not Error)
end { Function Files_Opened };

begin { Program Template }
  if ParamCount = 2 then begin
    if File_Exists(ParamStr(1)) then begin
      if (not File_Exists(ParamStr(2))) then begin
        if Files_Opened(ParamStr(1), ParamStr(2)) then begin
          Parse_File;
          Close(InputFile);
          Close(OutputFile)
        end
      end else
        Display_Error('Output file already exists', '')
    end else
      Display_Error('Input file not found', '')
  end else
      Display_Error('Invalid number of parameters', '')
end { Program Template }.

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