[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]