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