home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug017.arc / WB-ESC.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  4KB  |  114 lines

  1.  
  2.  const
  3.    Name_length = 14;
  4.    Bufsize     = 250;
  5.    Bufbytesize = 32000;
  6.    Change_char = 94;  { ^ }
  7.  
  8.  Type
  9.    Name = String[Name_length];  { To save filenames in }
  10.  
  11.  Var
  12.    Filename                 : Name; { Where the filename is kept}
  13.    Master_File,
  14.    New_File                 : File; { File variables }
  15.  
  16.    { Buffer is where Blockread and Blockwrite keep the
  17.        information which has been read from the file   }
  18.    Buffer                    : Array[1..Bufbytesize] of Byte;
  19.  
  20.  
  21.       Recs_To_Read,  Remaining:
  22.    I                        : Integer;
  23.    No_Error                 : Boolean;
  24.  
  25. Function Exist(Filename :Name) :Boolean;
  26.  
  27.   {  Finds if the file already exists on the Disk. }
  28.   {   If so returns TRUE. }
  29.  var
  30.    Fil : file;
  31.  
  32.  Begin
  33.    Assign(Fil,Filename);
  34.    {$I-}  Reset(fil) {$I+}; { Errors are captured not reported }
  35.    if IOresult <> 0 then Exist := False else Exist := True;
  36.  end;
  37.  
  38. Begin
  39.   ClrScr;
  40.   Writeln('WordBee ESC Converter.':52);
  41.   writeln('~~~~~~~~~~~~~~~~~~~~~~':52);
  42.   Writeln(' By S.Jepson 20/1/85':78);
  43.   Writeln;Writeln;writeln;
  44.   Write('This Program will find a certain Character ');
  45.   Writeln('and convert it to the ESC character');
  46.   Write('in the Wordbee file. It also produces a Backup of ');
  47.   writeln('the original file.');
  48.   Writeln;writeln;writeln;writeln;
  49.   Writeln('Enter the name of the WordBee file , only the name.');
  50.   Writeln;
  51.   Write('eg  ''FRED''  NOT  ''FRED.WBF''   Filename :');
  52.   Filename:='                         ' ;
  53.   Readln(Filename);
  54.        { Change to Upper Case }
  55.   For I := 1 to Name_length do
  56.       Filename[I] := UpCase(Filename[I]);
  57.  
  58.   IF Exist(Filename+'.WBF') { See if file is on disk}
  59.      Then
  60.       Begin
  61.  
  62.        If Exist(Filename+'.BAK') { erase old backup}
  63.          then begin
  64.                 Assign(New_File,Filename+'.BAK');
  65.                 Erase(New_File);
  66.               end;
  67.  
  68.        Assign(Master_File,Filename+'.WBF'); {Create a backup   }
  69.        Rename(Master_File,Filename+'.BAK'); {file of masterfile}
  70.  
  71.        Assign(New_File,Filename+'.WBF'); {Open newfile in the }
  72.                                          { oldfiles name      }
  73.        Rewrite(New_File);  { clear the new file }
  74.        Reset(Master_File); { point to start of master file }
  75.  
  76.        No_Error := True;  { there are no errors }
  77.        Remaining := Filesize(Master_File); {what is size of file}
  78.  
  79.        While ( Remaining > 0 ) and No_Error do {do until EOF }
  80.         Begin
  81.              { how much can we read from master file ?? }
  82.          If Bufsize <= Remaining Then
  83.                                    Recs_To_Read := Bufsize
  84.                                  Else
  85.                                    Recs_To_Read := Remaining;
  86.  
  87.               { Read the block of file and disable I/O errors }
  88.          {$I-}  Blockread(Master_File,Buffer,Recs_To_Read)  {$I+};
  89.  
  90.               { If there was an error then EOF has occurred }
  91.          If  I or esult <> 0 Then No_Error := False;
  92.  
  93.               { Change all `change_char's to ESC }
  94.          For I:=1 To Recs_To_Read * 128 do
  95.               If Buffer[I] = Change_Char Then Buffer[I]:= 27;
  96.  
  97.               { Write the changed block of file to new file }
  98.          Blockwrite(New_File,Buffer,Recs_To_Read);
  99.  
  100.               { How much of Master File is left to read }
  101.          Remaining := Remaining - Recs_To_Read;
  102.         End; {of while loop}
  103.  
  104.        Close(Master_File); {close files}
  105.        Close(New_File);
  106.       End {of if then}
  107.  
  108.     Else {File does not exist. Produce Error.}
  109.      begin
  110.      writeln;writeln;
  111.      Writeln('..FILE_ERROR.. File ',filename,'.WBF does not exist.');
  112.      end;
  113. End. { of program }
  114.