Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/txtutl/strip21.arc/STRIP.PAS

Pascal/Delphi Source File | 1986-02-08 | 4.9 KB | 223 lines

{$c+}
program strip;

{
 This is a program to strip off the high bit of each byte of a text file.
 The high bit is used by WordStar for document formatting.  This conversion
 allows the user to use WS to create document files and still 'type' them or
 send them to CIS.  (After the document has been stripped, of course.)
}

type
   s255 = string[255];
var
   FilVarIn,
   FilVarOut       : file of byte;
   FilenameIn,
   FilenameOut,
   temp            : s255;
   ChrIn,
   ChrOut          : byte;
   Stats,
   Scrn            : boolean;
   i,j,
   code,
   line,chrcnt,bite,
   r1,c1,
   r2,c2           : integer;
const
   dl : Char = '═';
   ls : Char = '╡';
   rs : Char = '╞';
   up : Char = #24;
   dn : Char = #25;
   sl : Char = '─';

   cr : Char = #13;
   lf : Char = #12;

function FileParse(var temp : s255) : s255;
var
  j : integer;
begin
  j:=pos('/',temp);
  if j=0 then
    FileParse := temp
  else
    FileParse := copy(temp,1,j-1);
end;

procedure ParamParse(temp : s255);
var
  switch : char;
  i      : integer;
begin
  i:=pos('/',temp);
  if i<>0 then begin
    switch:=temp[i+1];
    case switch of
      's','S' : Stats:=false;
      'd','D' : Scrn:=false;
    end;
    temp:=copy(temp,i+2,length(temp));
    ParamParse(temp);
  end;
end;

procedure GetInName(var FileNameIn : s255);
begin
   write('Enter the name of the input file: ');
   readln(FileNameIn);
   ParamParse(FileNameIn);
   FileNameIn := FileParse(FileNameIn);
end;

procedure GetOutName(var FileNameOut : s255);
begin
   write('Enter the name of the output file: ');
   readln(FileNameOut);
   ParamParse(FileNameOut);
   FileNameOut := FileParse(FileNameOut);
writeln(FileNameOut);
end;

BEGIN
ClrScr;
FileNameIn:='';   { Set names to nul to ensure that they are empty }
FileNameOut:='';  { on start-up                                    }
i := paramCount;

(***************************************
   Parse command line
***************************************)
Stats:=true;
Scrn:=true;
if i>0 then for j:=1 to i do begin
   temp:=paramstr(j);
   ParamParse(temp);
end;
case i of
0 : begin
      GetInName(FileNameIn);
      GetOutName(FileNameOut);
    end;
1 : begin
      temp:=paramstr(1);
      FileNameIn := FileParse(temp);
      GetOutName(FileNameOut);
    end;
2 : begin
      temp:=paramstr(1);
      FileNameIn := FileParse(temp);
      temp:=paramstr(2);
      FileNameOut := FileParse(temp);
    end;
end; {case}

(***************************************
    open text files
***************************************)
assign(FilVarIn,FilenameIn);
{$I-} reset(FilVarIn) {$I+} ;
if IOresult<>0 then begin    {source file does not exist, end program}
   writeln('');
   TextColor(31);
   write(^G^G'ERROR:');
   TextColor(15);
   writeln(' File ',FileNameIn,' cannot be found.');
   HALT;
   end;
assign(FilVarOut,FilenameOut);
rewrite(FilVarOut);

(***************************************
    format screen
***************************************)
clrscr;
GotoXY(1,13);
write(#17);
for i:=1 to 78 do write(dl);
write(#16);
GotoXY(6,13);
write(ls,up,' Original ',up,rs);
GotoXY(68,13);
write(ls,dn,' New ',dn,rs);

GotoXY(1,1);
write(FileNameIn,' ',#26,' ',FileNameOut);

LowVideo;
GotoXY(1,2);
for i:=1 to 80 do write(sl);
GotoXY(1,24);
for i:=1 to 80 do write(sl);

r1:= 1 ; c1:=1;
r2:= 1 ; c2:=1;
i:=0;
line:=1 ; chrcnt:=0; bite:=0;

GotoXY(20,24); write('┬');
GotoXY(20,25); write('│');
TextColor(0); TextBackground(7);
GotoXY(1,25); write('     STRIP v2.1    '); {<<<< VERSION NUMBER}
TextColor(15); TextBackground(0);

if Stats then begin
   GotoXY(23,25);
   write('Text line:');
   GotoXY(42,25);
   write('Column:');
   GotoXY(64,25);
   write('Byte:');
   end;

LowVideo;

(***************************************
    start strip routine
       check for EOF marker and CR
       and treat accordingly
***************************************)
while not(eof(FilVarIn)) do begin
  read(FilVarIn,ChrIn);
  if ChrIn>127 then ChrOut:=ChrIn-128 else ChrOut:=ChrIn;
  write(FilVarOut,ChrOut);
  if Scrn and (ChrOut<>$1a) then begin
     window(1,3,80,12);
     GotoXY(c1,r1);
     write(Chr(ChrIn));
     c1:=WhereX ; r1:=WhereY;
     window(1,14,80,23);
     GotoXY(c2,r2);
     write(Chr(ChrOut));
     c2:=WhereX ; r2:=WhereY;
   end;

  if Stats then begin
     bite:=bite+1;
     if ChrOut<>$1a then
        if ChrOut=13 then begin line:=line+1; chrcnt:=0; end
        else begin chrcnt:=chrcnt+1; end;
     NormVideo;
     window(1,1,80,25);
     GotoXY(34,25);
     write(line);
     GotoXY(50,25);
     write(chrcnt,'      ');
     GotoXY(70,25);
     write(bite);
     LowVideo;
     end;

end;

(***************************************
      Terminate
***************************************)
close (FilVarIn);
close (FilVarOut);
window(1,1,80,25);
GotoXY(80,24);
END.