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

{
The following 3 messages will include two units [files,freebuff] and one
driver program [CTP]. The purpose of CTP is to reformate you source code's
case use, Exampe:   change 'writeln' to 'WriteLn'. It includes all reserved
words.

FREEBUFF is where most of the speed increase comes from. It is a free
read buffer styled much like blockRead and BlockWrite. It does the job of a
disk cache by NOT writing until the write buffer is full, and NOT reading
until the read buffer is empty. It can be used for any program in place of
blockread&write where small pieces of information need to be extracted.
    remeber memory is fast, drives are slow.

    CTP still needs some optimizing [and inclusion of the (* *) comments
Words in quotes '' or Comments {  WILL be skipped. If you can speed it up,
re-post the optimized version.
}

UNIT FILES;
INTERFACE
USES DOS;
FUNCTION FileExists(FileName: String): Boolean;
FUNCTION OpenFile(VAR f: file; fileName:string): Boolean;
FUNCTION FileExistsWild(FileName: String): Boolean;

IMPLEMENTATION

FUNCTION FileExists(FileName: String): Boolean;
VAR   F: file;
begin
  {$I-}
  Assign(F, FileName);
  Reset(F);
  Close(F);
  {$I+}
  FileExists:=(IOResult = 0) and (FileName <> '')
 end;  { FileExists }
FUNCTION OpenFile(VAR f: file; fileName:string): Boolean;
BEGIN
   IF fileExists(FileName) then BEGIN
      Assign(f,filename);
      Reset(f,1);
      Openfile:=True;
   END
   ELSE OpenFile:=False;
END;
 
FUNCTION FileExistsWild(FileName: String): Boolean;
VAR   Fil: SearchRec;
begin
  FindFirst(FileName,anyFile,Fil);
  FileExistsWild:=(DosError=0) and (FileName <> '');
end;  { FileExists }
 
BEGIN
END.

{UNIT FREEBUFF}
{12/7/94}
{v4.0 ... Changing into a unit }
Unit FreeBuff;
INTERFACE
VAR TrueFileEnd : Boolean;
PROCEDURE B_Read( var F: file; var userObject;
                  ObjSize: Word; VAR bytesREAD: Word);
PROCEDURE B_Write( var FW: file; var userObject; ObjSize: Word);
PROCEDURE B_Skip( var F: File; SkipSize: Integer);
            {user may skip any size}
PROCEDURE InitBuffers(Var F: File; Var FW : File);
PROCEDURE FlushWRITEBuffer(Var FW : File);
IMPLEMENTATION
CONST rBufSize=8192;                        {buffer size for B_read}
      wBufSize=8192;                          {buffer size for B_write}
VAR rBuffer: array [1..rBufSize] of char; {buffer for B_read}
    rCurrent: word;   {8192 < word max}   {current position in rBuffer}
    rEnd: Integer;                        {Logical end of buffer}
    FileEnd: Boolean;                     {Actual file end}
    wBuffer: array [1..wBufSize] of char; {buffer for B_Write}
    wCurrent: word;                       {current position in wBuffer}
Function WhatsLeft : Word;
BEGIN
  If  rEnd> (rCurrent -1) THEN BEGIN
      WhatsLeft:= rEnd - (rCurrent - 1);  {last position - (Current-1)   }
  END ELSE BEGIN
      WhatsLeft:=0;
  END;
END;
FUNCTION WhatsLeftinWRITE: Word;
BEGIN
   WhatsLeftinWRITE:=wBufSize - (wCurrent - 1);
END;
PROCEDURE  ReadBuffer(Var f: file; Var UserObject;
                      ObjSize: Word; VAR BytesRead: word);
BEGIN
   BLockRead(F,UserObject,ObjSize,BytesRead);
   rEnd:=(rCurrent-1) + BytesRead;
   IF (BytesRead <> ObjSize) Then BEGIN
      FileEnd:=True;
   END;
END;
PROCEDURE WriteBuffer(Var FW: File; var UserObject; ObjSize: word);
VAR wDummy: Word;
BEGIN
     BlockWrite(FW,UserObject,ObjSize,wDummy);
END;
PROCEDURE InitReadBuffer(Var F: File);
VAR Dummy: Word;
BEGIN
   rCurrent:=1;
   ReadBuffer(F,rBuffer[1],rBufSize,Dummy);
END;
PROCEDURE InitWRITEBuffer;
BEGIN
   wCurrent:=1;
END;
PROCEDURE  InitBuffers(Var F: File; Var FW : File);
BEGIN
   FileEnd:=False;
   TrueFileEnd:=False;
   InitReadBuffer(F);
   InitWriteBuffer;
END;
PROCEDURE FlushWRITEBuffer(Var FW : File);
BEGIN
   WriteBuffer(FW, wBuffer[1], wCurrent-1);
   initWriteBuffer;
END;
PROCEDURE B_Read( var F: file; var userObject;
                  ObjSize: Word; VAR bytesREAD:Word);
VAR LeftInBuf: Word;  Temp: Word; BytesMoved: Word;
BEGIN
  LeftInBuf:= WhatsLeft;
  IF  ObjSize < LeftInBuf then BEGIN     {Same case for if FileEnd}
      {CASE 1  MOST COMMON}
      Move(rBuffer[rCurrent], UserObject, ObjSize);
      rCurrent:=rCurrent+ ObjSize;
      BytesRead:=ObjSize;
  END ELSE IF  ObjSize > LeftInBuf then BEGIN
      {CASE 2  SECOND MOST COMMON}
      IF  FileEnd then BEGIN
          LeftInBuf:=WhatsLeft;
          Move(rBuffer[rCurrent], UserObject, LeftInBuf);
          BytesRead:=LeftInBuf;
          TrueFileEnd:=true;
      END ELSE BEGIN
          LeftInBuf:=WhatsLeft;
          BytesMoved:=LeftInBuf;
          Move(rBuffer[rCurrent], rBuffer[1], LeftInBuf);
          rCurrent:=LeftInBuf+1; rEnd:= rBufSize;
          LeftInBuf:=WhatsLeft;
          ReadBuffer(F, rBuffer[rCurrent], LeftInBuf, BytesRead);
          IF  FIleEnd Then BEGIN
              BytesRead:=BytesRead+BytesMoved;
              IF  BytesRead < ObjSize THEN BEGIN
                  move(rBuffer[1],UserObject, BytesRead);
                  TrueFileEnd:=True;
              END ELSE BEGIN
                  move(rBuffer[1],UserObject, ObjSize);
                  rCurrent:=ObjSize+1;
                  BytesRead:=ObjSize;
              END;
          END ELSE BEGIN
              move(rBuffer[1],UserObject, ObjSize);
              BytesRead:=ObjSize;
              rCurrent:=ObjSize+1;
          END;
      END;
  END ELSE IF  ObjSize = LeftInBuf then BEGIN
      {CASE 3 MOST UNCOMMON}
      IF  FileEnd then BEGIN
          move(rBuffer[rCurrent], UserObject, objSize);
          BytesRead:=ObjSize;
          TrueFileEnd:=True;
      END ELSE BEGIN
          move(rBuffer[rCurrent], UserObject, objSize);
          InitReadBuffer(f);
          BytesREad:=ObjSize;
      END;
  END;
END;
PROCEDURE B_Skip( var F: File; SkipSize: Integer); {user may skip any size}
var LeftInBuffer :Word;
BEGIN
   LeftInBuffer:= WhatsLeft;
   IF  LeftInBuffer > SkipSize THEN BEGIN
       Seek(F, FilePos(F) + ( SkipSize - LeftINBuffer));
       InitREADBuffer(F);
   END ELSE BEGIN
       IF  LeftINBuffer = SkipSize THEN BEGIN
           InitREADBuffer(F);
       END ELSE BEGIN
           rCurrent:=rCurrent + SkipSize;
       END;
   END;
END;
PROCEDURE B_Write( var FW: file; var userObject; ObjSize: Word);
var LeftINBuffer: Word;
BEGIN
     LeftInBuffer:=WhatsLeftinWRITE;
     IF ObjSize < LeftInBuffer THEN BEGIN
        move(UserObject, wBuffer[wCurrent], ObjSize);
        wCurrent:=wCurrent+ ObjSize;
     END ELSE BEGIN
         IF  ObjSize=LeftInbuffer THEN BEGIN
             move(UserObject, wBuffer[wCurrent], ObjSize);
             wCurrent := wCurrent + ObjSize;
             FlushWriteBuffer(FW);
         END ELSE BEGIN
             FlushWriteBuffer(FW);
             move(UserObject, wBuffer[wCurrent], ObjSize);
             wCurrent:=wCurrent+ ObjSize;
         END;
     END;
END;
BEGIN
END.

{PROGRAM C-TP-format} {SLOWWWWWWWW}
{$A+,B-,D+,E-,F-,G-,I-,K-,L-,N-,P-,R+,S-,T-,V-,W-,X+,Y-}
{12/07/94 FIXED FreeBuff : and used it as a unit!!!!!!!!!!!!!!!}
{         Passes Dos's comp test for a 200k file }

Uses crt,dos,FREEbuff,FILES;
CONST BufSize=8192;
      ResSize=53;{Words to Reformat}
      {Edit these to fit personal capital & lowerCase mixture preferences}
TYPE  rWords = array[1..ResSize]  OF String;
{Crt,Graph,Graph3,Overlay,Printer,Strings,System,Turbo3,WinAPI,WinCrt
WinDOS,WinPrn,WinProcs,WinTypes ...}
{BOOCOOS of typing!!}
CONST  Reserved      : rWords =(
'ABSOLUTE','AND','ASM','ARRAY','BEGIN','CASE','CONST','CONSTRUTOR',
'DESTRUCTOR','DIV','DO','DOWNTO','ELSE','END','EXPORTS','FILE','FOR',
'FUNCTION','GOTO','IF','IMPLEMENTATION','IN','INHERITED','INLINE',
'INTERFACE','LABEL','LIBRARY','MOD','NIL','NOT','OBJECT','OF','OR','PACKED',
'PROCEDURE','PROGRAM','RECORD','REPEAT','SET','SHL','SHR','STRING','THEN',
'TO','TYPE','UNIT','UNTIL','USES','VAR','WHILE','WriteLN','WITH','XOR');
VAR F,OUTf        : file;
    tB            : array[1..BufSize] of CHAR;
    {I, J          : integer;}
    Quote         : Boolean;   {temp boolean use to skip quoted material}
    Path,Name,Ext : String;    {used for opening input file}
    Look          : SearchRec; {used for opening input file}
    Dummy         : String;    {Built string to search for}
    TB1           : Char;      {Temp B_READ byte}
    tb2           : integer;   {Counter}
    BytesRead     : Word;      {Dummy: not used in logic}
    INPUTsize,                 { used to compare final sizes}
    OUTPUTsize    : LongInt;
    Capitals      : rWords;   {used to capitalize all reserved words for}
                              {Speed efficient ONLY comparison }
PROCEDURE Announce;
BEGIN
  Writeln('C-TP-Format v1.0    coded by    þMr. Krinkleþ');
  Writeln('Property of Clark Enterprizes.    Sept 5 1994');
  WriteLN;
END;
PROCEDURE NEEDhelp;
BEGIN
  WriteLN('Usage:    CTP [FileName.in] [FileName.out]');
  WriteLN('Example:  CTP Onefile.pas NewOne.pas');
  HALT;
END;
PROCEDURE INITcapitals;
{Make a Capitalized array of reserved word}
VAR I,J :integer;
BEGIN
FOR I:=1 to ResSize DO BEGIN
    Capitals[I][0]:=Reserved[i][0]; {init lengths}
    FOR J:=1 to ORD(Reserved[I][0]) {LENGTH} DO
        Capitals[I][j]:= UPCASE(Reserved[I][J]);
END;
END;
 
FUNCTION Sfind( Name : string; Dum:String): boolean;
VAR k : integer; ch: char;
BEGIN
  IF  Name[0] = Dum[0] THEN BEGIN        {Size Check :Speed Efficient}
      FOR k:=1 To ord(Dum[0]) DO BEGIN   {CHar by CHar comparison}
          IF not ( Name[k] = Dum[k] ) Then BEGIN
             Sfind:=False;               {When FIRST FALSE CASE}
             EXIT;                       {Speed Efficient}
          END;
      END;
  END ELSE BEGIN
    SFINd:=FALSE;                        {Failed Size Check}
    EXIT;
  END;
  SFind:=True;                           {The Two are the Same}
END;
FUNCTION SCANandUPdate(Dummy:String) : String;
{needs to be changed to boyerMoore type search string tech}
VAR J : integer;
    Dummy2 : string;
BEGIN
 Dummy2[0]:=Dummy[0]; {length}
 FOR J:=1 to ord(Dummy[0]) DO Dummy2[J]:=UpCase( Dummy[j] ); {Capitalize}
 
 FOR j:=1 to ResSize DO BEGIN
     IF Sfind(Capitals[j], Dummy2) then BEGIN    {check with Capitals array}
        SCANandUpdate:=Reserved[j];
        exit;
     END;{IF}
 END;
 SCANandUPdate:=Dummy;     {Return original if not found}
END;
BEGIN {MAIN SKELETION}
Announce;
 IF ParamStr(1)='' then NEEdhelp;
 IF ParamStr(2)='' then NEEDhelp;
 IF ParamStr(1)=ParamStr(2) then NEEDhelp;
 Fsplit(ParamStr(1), Path, name, ext);
 If path<>'' then path:=path+'\';    {writeln(path,' ',name,' ',ext);}
FINDFIRST(ParamStr(1), AnyFile, LOOK);
  IF dosError<>0 then NeedHelp;
  IF not OpenFile(F,path+Look.Name) THEN BEGIN
      WriteLN('Unable to open ',Look.Name,' : Halting.'); HALT;
  END;
INITcapitals;
   Assign(OUTf,ParamStr(2));                     {open and write output}
   ReWrite(OUTf,1);                              {NO preExistance check
done}
   WRITeLN('=< C-TP-Formating ',Look.name,' >=');
   InitBuffers(F,OUTf); {MUST Initialize the READ and WRITE buffers}
   b_READ(F,TB1,1,BytesREAD);       {initialize tb1}
   REPEAT
   REPEAT
     IF  (tb1=#39) THEN BEGIN               {ignore initial quote}
         Quote:=FALSE;
         WHILE (not Quote) and (not TrueFileEnd) do BEGIN           
            b_write(OUTf,tb1,1);            {NO need to check for reserved}
            b_read(f, tb1, 1,BytesREAD);
            IF tb1=#39 THEN Quote:=Not Quote;
         END;
         b_write(OUTf,tb1,1);                {write the closing quote}
         b_read(f, tb1, 1,BytesREAD);                  {re-init tb1}
     END else IF  ( tb1 ='{')  THEN BEGIN
         WHILE (tb1<> '}')  and (not TrueFileEnd) do BEGIN           {spit
out info until nex comment}
            b_write(OUTf,tb1,1);            {NO need to check for reserved}
            b_read(f, tb1, 1,BytesREAD);
         END;
         b_write(OUTf,tb1,1);                {write the closing comment}
         b_read(f, tb1, 1,BytesREAD);                  {re-init tb1}
     END;
   UNTIL (tb1 <> #39) and (TB1<> '{') or TrueFileEnd;      {tb1 might be
another Q or C}
        IF (tb1 in ['A'..'Z','a'..'z']) THEN BEGIN      {build String}
           Dummy:='';
           While (tb1 in ['A'..'Z','a'..'z'])  and (not TrueFileEnd) DO
BEGIN      
              Dummy:=Dummy+tb1;
              b_READ(f,tb1,1,BytesREAD);
           END;
           Dummy:=SCANandUPDATE(DUMMY);               {Scan for reserved}
          { gotoXY(1,25);
           CLReol;
           write(Dummy,' '); }
           b_WRITE(OUTf,DUMMY[1],ord(DUMMY[0]));      
        END ELSE BEGIN
             b_write(OUTf,tb1,1);
             b_read(F,tb1,1,BytesREAD);
        END; {IF}
    INC(tb2);
    CASE TB2 of
     1 : BEGIN
         write(#8#8); Write('.');END;
     400 : BEGIN
         write(#8#8);Write('*');END;
     700 : BEGIN
         write(#8#8);Write(#127);END;
     1000 : BEGIN
         write(#8#8);Write(#30);END;
     1300 : BEGIN
         write(#8#8);write(#254);END;
     1600 : tb2:=0;
     END;
   UNTIL TrueFileEnd;
   b_WRite(OUTf,TB1,1);  {hopefully spit out the last char}
   FLushWriteBuffer(OUTf);
   INPUTsize:= FileSize(F);
   OUTPUTsize:= FileSize(OUTf);
   Close(OUTf);
   Close(F);
IF  INPUTsize <> OUTPUTsize THEN BEGIN
    write(#8#8);
    WriteLN('ERROR (1): Finished file sizes do not match.');
END Else BEGIN
    write(#8#8);
    Writeln('Done.');
END;
END.

(*
    The previous sources are to format the Case of you TP code.
    It will skip all words within Quotes '' or Comments {}.

    The two units are FILES and FREEbuff.
    The FREEbuff unit is my attempt to uses disk cache logic in my programs.
    The logic is simple: don't read until read buffer empty
                         don't write until write buffer full.

    To use FREEbuff do the following

    INITbuffer( INfile, OUTfile) [must be opened]
    repeat
      b_read( INfile, buffer[1], sizeOF(buffer), bytesRead);
      b_write( OUTfile, buffer[1], BytesRead);
    until TrueFileEnd;
    FlushWriteBuffer(Outfile);

    set it all up
    Flush empties the write buffer before the file is closed.
    Syntax is very clock to BlockRead&write.

    BytesRead is the amount of bytes actually moved to the Buffer [or object]

    Instead of using blockRead for one byte reading, B_Read will fill the
    buffer with 8192 bytes and then only give the object one byte. This
    is extremely efficient when you only need small part of a file.
*)

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