SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00021 TEXT FILE MANAGEMENT ROUTINES 1 05-28-9313:58ALL SWAG SUPPORT TEAM FASTIO.PAS IMPORT 10 F╔╔ GB>Could you Write a MCSEL ;-) wich gives us some hints For making Text i/oπ GB>_much_ faster ? I read that about the SetTextBuf although I never triedπ GB>it. What are other examples? Some little example-sources ?ππType BBTYP = ^BIGBUF;π BIGBUF = Array[0..32767] of Char;ππVar BUFFin : BBTYP; { general-use large Text I/O buffer }πVar BUFFOUT : BBTYP;π F : Text;π S : String;ππProcedure BBOPEN (Var F : Text; FN : String; OMODE : Char;π Var BP : BBTYP);πVar S : String;πbeginπ{$I-}π Assign (F,FN); New (BP); SetTextBuf (F,BP^);π Case UpCase(OMODE) ofπ 'R' : beginπ Reset (F); S := 'Input'π end;π 'W' : beginπ ReWrite (F); S := 'Output'π end;π 'A' : beginπ Append (F); S := 'Extend'π endπ elseπ end;π{$I+}π if Ioresult <> 0 thenπ beginπ Dispose (BP); FATAL ('Cannot open '+FN+' For '+S+' - Terminating')π endπend; { BBOPEN }ππto use:ππ BBOPEN (F,'myFile.txt',r,BUFFin);π While not Eof (F) doπ beginπ readln (F,S);π etc.π end;π Close (F); Dispose (BUFFin)π 2 05-28-9313:58ALL SWAG SUPPORT TEAM HEXDUMP.PAS IMPORT 90 F╔═D { In the following message is a Complete Program I just wroteπ(including 3 routines from TeeCee's hints) which solves a particularπproblem I was having, but also demonstrates some things I see queriedπhere. So, there are a number of useful routines in it, as well as aπwhole Program which may help.π This Program dumps a Dos File to Hex and (modified) BCD. It isπpatterned after Vernon Buerg's LIST display (using Alt-H), which I findπuseful to look at binary Files. The problem is (was) I couldn't PrtScπthe screens, due to numerous special Characters which often hung myπPrinter. So, I wrote this Program to "dump" such Files to either theπPrinter or a Printer File. It substitutes an underscore For mostπspecial Characters (you can change this, of course).π note, too, that it demonstates the use of a C-like Character streamπi/o, which is a Variation of the "stream i/o" which is discussed here.πThis allows fast i/o of any Type of File, and could be modified toπprovide perFormant i/o For Text Files.π A number of the internal routines are a bit clumsy, since I had toπ(107 min left), (H)elp, More? make them "generic" For this post, rather than make use of after-marketπlibraries that I use (TTT, in my Case).π Enjoy!...π}ππProgram Hex_Dump; { Dump a File in Hex and BCD 930107 }πUses Crt, Dos, Printer;π{$M 8192,0,8192}π { Public Domain, by Mike Copeland and Trevor Carlsen 1993 }πConst VERSION = '1.1';π BSize = 32768; { Buffer Size }π ifLinE = 4; { InFormation Line }π PRLinE = 24; { Prompt Line }π ERLinE = 25; { Error Line }π DSLinE = 22; { Display Line }π PL = 1; { partial line o/p }π WL = 2; { whole line o/p }π B40 = ' ';πVar CP : Word; { Character Pointer }π BLKNO : Word; { Block # }π L,N : Word;π RES : Word;π LONG : LongInt;π NCP : LongInt; { # Characters Processed }π FSize : LongInt; { Computed File Size }π BV : Byte; { generic Byte Variable }π PRtoK : Boolean;π PFP : Boolean;π REGS : Registers;π PRTFile : String;π F1 : String;π MSTR,S1 : String;π PFV1 : Text;π F : File;π B : Array[0..BSize-1] of Byte;π CH : Char;ππProcedure WPROM (S : String); { generalized Prompt }πbeginπ GotoXY (1,PRLinE); Write (S); ClrEol; GotoXY (Length(S)+1,PRLinE);πend; { WPROM }ππProcedure CLEARBOT; { clear bottom of screen }πbeginπ GotoXY (1,PRLinE); ClrEol; GotoXY (1,ERLinE); ClrEolπend; { CLEARBOT }ππFunction GETYN : Char; { get Single-key response }πVar CH : Char;πbeginπ CH := UpCase(ReadKey); if CH = #0 then CH := ReadKey;π CLEARBOT; GETYN := CH;πend; { GETYN }ππProcedure PAUSE; { Generalized Pause processing }πVar CH : Char;πbeginπ WPROM ('Press any key to continue...'); CH := GETYNπend; { PAUSE }ππProcedure ERRor1 (S : String); { General Error process }πVar CH : Char;πbeginπ GotoXY (1,ERLinE); Write (^G,S); ClrEol; PAUSEπend; { ERRor1 }ππProcedure FATAL (S : String); { Fatal error - Terminate }πbeginπ ERRor1 (S); Haltπend; { FATAL }ππFunction TEStoNLinE : Byte; { Tests For Printer On Line }πVar REGS : Registers;πbeginπ With REGS doπ beginπ AH := 2; DX := 0;π Intr($17, Dos.Registers(REGS));π TEStoNLinE := AH;π endπend; { TEStoNLinE }ππFunction SYS_DATE : String; { Format System Date as YY/MM/DD }πVar S1, S2, S3 : String[2];πbeginπ REGS.AX := $2A00; { Function }π MsDos (Dos.Registers(REGS)); { fetch System Date }π With REGS doπ beginπ Str((CX mod 100):2,S1); Str(Hi(DX):2,S2); Str(Lo(DX):2,S3);π end;π if S2[1] = ' ' then S2[1] := '0'; { fill in blanks }π if S3[1] = ' ' then S3[1] := '0';π SYS_DATE := S1+'/'+S2+'/'+S3πend; { SYS_DATE }ππFunction SYS_TIME : String; { Format System Time }πVar S1, S2, S3 : String[2];πbeginπ REGS.AX := $2C00; { Function }π MsDos (Dos.Registers(REGS)); { fetch System Time }π With REGS doπ beginπ Str(Hi(CX):2,S1); Str(Lo(CX):2,S2); Str(Hi(DX):2,S3);π end;π if S2[1] = ' ' then S2[1] := '0'; { fill in blanks }π if S3[1] = ' ' then S3[1] := '0';π if S1[1] = ' ' then S1[1] := '0';π SYS_TIME := S1+':'+S2+':'+S3πend; { SYS_TIME }ππFunction EXISTS ( FN : String): Boolean; { test File existance }πVar F : SearchRec;πbeginπ FindFirst (FN,AnyFile,F); EXISTS := DosError = 0πend; { EXISTS }ππFunction UPPER (S : String) : String;πVar I : Integer;πbeginπ For I := 1 to Length(S) doπ S[I] := UpCase(S[I]);π UPPER := S;πend; { UPPER }ππProcedure SET_File (FN : String); { File Output For PRinT }πbeginπ PRTFile := FN; PFP := False; PRtoK := False;πend; { SET_File }ππProcedure PRinT_inIT (S : String); { Initialize Printer/File Output }πVar X,Y : Word;πbeginπ PRtoK := TestOnLine = 144; PFP := False; X := WhereX; Y := WhereY;π if PRtoK thenπ beginπ WPROM ('Printer is Online - do you wish Printer or File? (P/f) ');ππ if GETYN = 'F' then SET_File (S)π elseπ beginπ WPROM ('Please align Printer'); PAUSEπ endπ endπ else SET_File (S);π GotoXY (X,Y) { restore cursor }πend; { PRinT_inIT }ππFunction OPENF (Var FV : Text; FN : String; MODE : Char) : Boolean;πVar FLAG : Boolean;πbeginπ FLAG := True; { set default }π Assign (FV, FN); { allocate File }π Case UpCase(MODE) of { open mode }π 'W' : begin { output }π {$I-} ReWrite (FV); {$I+}π end;π 'R' : begin { input }π {$I-} Reset (FV); {$I+}π end;π 'A' : begin { input/extend }π {$I-} Append (FV); {$I+}π end;π elseπ end; { of Case }π if Ioresult <> 0 then { test For error on OPEN }π beginπ FLAG := False; { set Function result flag }π ERRor1 ('*** Unable to OPEN '+FN);π end;π OPENF := FLAG { set return value }πend; { OPENF }ππProcedure PRinT (inD : Integer; X : String); { Print Report Line }πVar AF : Char; { Append Flag }π XX,Y : Word;πbeginπ if PRtoK then { Printer online? }π beginπ Case inD of { what Type of print line? }π PL : Write (LST, X); { partial line }π WL : Writeln (LST, X); { whole line }π endπ end { Printer o/p }π else { use o/p File }π beginπ XX := WhereX; Y := WhereY;π if not PFP then { File not opened }π beginπ AF := 'W'; { default }π if EXISTS (PRTFile) thenπ beginπ WPROM ('** Print File '+PRTFile+' exists - Append to it? (Y/n) ');π if GETYN <> 'N' then AF := 'A';π end;π if OPENF (PFV1, PRTFile, AF) then PFP := True { set flag }π else FATAL ('*** Cannot Open Printer O/P File - Terminating');ππ end; { of if }π GotoXY (XX,Y); { restore cursor }π Case inD ofπ PL : Write (PFV1, X); { partial }π WL : Writeln (PFV1, X); { whole }π end;π end; { else }πend; { PRinT }ππFunction FSI (N : LongInt; W : Byte) : String; { LongInt->String }πVar S : String;πbeginπ if W > 0 then Str (N:W,S)π else Str (N,S);π FSI := S;πend; { FSI }ππProcedure CLOSEF (Var FYL : Text); { Close a File - open or not }πbeginπ{$I-} Close (FYL); {$I+} if Ioresult <> 0 then;πend; { CLOSEF }ππFunction CENTER (S : String; N : Byte): String; { center N Char line }πbeginπ CENTER := Copy(B40+B40,1,(N-Length(S)) Shr 1)+Sπend; { CENTER }ππProcedure SSL; { System Status Line }π{ This routine is just For "flash"; it can be omitted... }πConst DLM = #32#179#32;πbeginπ GotoXY (1,1); Write (F1+DLM+'Fsz: '+FSI(FSize,1)+DLM+π 'Blk: '+FSI(BLKNO,1)+DLM+π 'C# '+FSI(CP,1));πend; { SSL }ππ { The following 3 routines are by Trevor Carlsen }πFunction Byte2Hex(numb : Byte): String; { Byte to hex String }πConst HexChars : Array[0..15] of Char = '0123456789ABCDEF';πbeginπ Byte2Hex[0] := #2; Byte2Hex[1] := HexChars[numb shr 4];π Byte2Hex[2] := HexChars[numb and 15];πend; { Byte2Hex }ππFunction Numb2Hex(numb: Word): String; { Word to hex String.}πbeginπ Numb2Hex := Byte2Hex(hi(numb))+Byte2Hex(lo(numb));πend; { Numb2Hex }ππFunction Long2Hex(L: LongInt): String; { LongInt to hex String }πbeginπ Long2Hex := Numb2Hex(L shr 16) + Numb2Hex(L);πend; { Long2Hex }ππFunction GET_Byte: Byte; { fetch Byte from buffer data }πbeginπ GET_Byte := Byte(B[CP]); Inc (CP); Inc (NCP)πend; { GET_Byte }ππFunction EOS (Var FV : File): Boolean; { Eof on String File Function }πbeginπ if CP >= RES then { data still in buffer? }π if NCP < FSize thenπ begin { no - get new block }π BLKNO := (NCP div BSize);π FillChar(B,BSize,#0); { block to read }π Seek (F,BLKNO*BSize); BlockRead (F,B,BSize,RES); CP := 0;π endπ else RES := 0;π EOS := RES = 0;πend; { EOS }ππbeginπ ClrScr; GotoXY (1,2);π Write (CENTER('--- Hex Dump - Version '+VERSION+' ---',80));π if ParamCount > 0 then F1 := ParamStr(1)π elseπ beginπ WPROM ('Filename to be dumped: '); readln (F1); CLEARBOTπ end;π if not EXISTS (F1) then FATAL ('*** '+F1+' File not present - Terminating! ***');π PRinT_inIT ('HEXDUMP.TXT'); F1 := UPPER(F1);π PRinT (WL,CENTER('Hex Dump of '+F1+' '+SYS_DATE+' '+SYS_TIME,80));π Assign (F,F1); GotoXY (1,ifLinE); Write ('Processing ',F1);π Reset (F,1); FSize := FileSize(F); CP := BSize; NCP := 0; RES :=πBSize;π PRinT (WL,'offset Addr 1 2 3 4 5 6 7 8 9 10 A B C D E F 1234567890abcdef');π While not EOS (F) doπ beginπ if (NCP mod 16) = 0 thenπ beginπ if NCP > 0 thenπ beginπ PRinT (WL,MSTR+S1); SSLπ end;π MSTR := FSI(NCP,6)+' '+Numb2Hex(NCP); { offset & Address }π S1 := ' ';π end;π BV := GET_Byte; { fetch next Byte from buffer }π MSTR := MSTR+' '+Byte2Hex(BV); { Hex info }π if BV in [32..126] then S1 := S1+Chr(BV) { BCD info }π else S1 := S1+'_';π end;π Close (F);π While (NCP mod 16) > 0 doπ beginπ MSTR := MSTR+' '; Inc (NCP); { fill out last line }π end;π PRinT (WL,MSTR+S1); SSL; MSTR := 'Printer';π if PFP thenπ beginπ CLOSEF (PFV1); MSTR := PRTFileπ end;π GotoXY (1,ifLinE+1); Write ('Formatted output is on ',MSTR);π GotoXY (1,ERLinE); Write (CENTER('Finis...',80))πend.π 3 05-28-9313:58ALL SWAG SUPPORT TEAM LINE-CNT.PAS IMPORT 20 F╔ {π>I'm wondering if anyone can post me a source For another way toπ>find out the max lines in a Text File.π}ππ {.$DEFinE DebugMode}ππ {$ifDEF DebugMode}ππ {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P-,Q+,R+,S+,T+,V+,X-}ππ {$else}ππ {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}ππ {$endif}ππ {$M 1024,0,0}ππProgram LineCounter;ππConstπ co_LineFeed = 10;ππTypeπ byar_60K = Array[1..61440] of Byte;ππVarπ wo_Index,π wo_BytesRead : Word;ππ lo_FileSize,π lo_BytesProc,π lo_LineCount : LongInt;ππ fi_Temp : File;ππ byar_Buffer : byar_60K;ππbeginπ (* Attempt to open TEST.doC File. *)π assign(fi_Temp, 'linecnt.pas');π {$I-}π reset(fi_Temp, 1);π {$I+}ππ (* Check if attempt was sucessful. *)π if (ioresult <> 0) thenπ beginπ Writeln('ERRor opening TEST.doC File');π haltπ end;ππ (* Record the size in Bytes of TEST.doC . *)π lo_FileSize := Filesize(fi_Temp);ππ (* Initialize Variables. *)π lo_LineCount := 0;π lo_BytesProc := 0;ππ (* Repeat Until entire File has been processed. *)π Repeatπ (* Read in all or a 60K chunk of TEST.doC into the *)π (* "buffer" For processing. *)π blockread(fi_Temp, byar_Buffer, sizeof(byar_60K), wo_BytesRead);ππ (* Count the number of line-feed Characters in the *)π (* "buffer". *)π For wo_Index := 1 to wo_BytesRead doπ if (byar_Buffer[wo_Index] = co_LineFeed) thenπ inc(lo_LineCount);ππ (* Record the number of line-feeds found in the buffer. *)π inc(lo_BytesProc, wo_BytesRead)ππ Until (lo_BytesProc = lo_FileSize);ππ (* Close the TEST.doC File. *)π close(fi_Temp);ππ (* Display the results. *)π Writeln(' total number of lines in LinECNT.PAS = ', lo_LineCount)ππend.π{π ...to find a specific line, you'll have to process the Text File upπ to the line you are after, then use a "seek" so that you can readπ in just this line into a String Variable. (You'll have to determineπ the length of the String, and then set the String's length-Byte.)π} 4 05-28-9313:58ALL SWAG SUPPORT TEAM LISTER.PAS IMPORT 63 F╔π╖ { Right now I'm writing an interpreter For a language that Iπdeveloped, called "Isaac". (It's Physics oriented). I'd be veryπinterested in you publishing this inFormation regarding PascalπCompilers, though I would likely not have time to do the excercisesπright away.ππ Ok, Gavin. I'll post the lister (not Really anything exceptional,π but it'll get this thing going in Case anyone joins in late.)ππ Here's the lister Program:π}π{$I-}πProgram Lister;ππUses Dos;ππ{$I PTypeS.inC}π{Loacted in the SOURCE\MISC Directory.}ππFunction LeadingZero(w:Word): String;{convert Word to String With 0's}π Var s :String;π beginπ Str(w:0,s);π if Length(s) < 2 then s := '0'+s;π LeadingZero := s;π if Length(s) > 2 then Delete(s,1,Length(s)-2);π end;πππFunction FormatDate :String; { get system date and pretty it up }π Constπ months : Array[1..12] of String[9] =π ('January', 'February', 'March', 'April', 'May', 'June', 'July',π 'August', 'September', 'October', 'November', 'December');π Var s1,fn : String; y,m,d,dow : Word;π beginπ GetDate(y,m,d,dow);π s1 := leadingZero(y);π fn := LeadingZero(d);π s1 := fn+' '+s1;π fn := months[m];π s1 := fn+' '+s1;π FormatDate := s1;π end;ππFunction FormatTime :String; { get system time and pretty it up }π Var s1, fn : String; h,m,s,s100 : Word;π beginπ GetTime(h,m,s,s100);π fn := LeadingZero(h);π s1 := fn+':';π fn := LeadingZero(m);π FormatTime := s1+fn;π end;ππProcedure Init(name:String);π Var t,d :String;π beginπ line_num := 0; page_num := 0; level := 0;π line_count := MAX_LinES_PER_PAGE;π source_name := name;π Assign(F1, name); { open sourceFile - terminate if error }π Reset(F1);π if Ioresult>0 thenπ beginπ Writeln('File error!');π Halt(1);π end;π { set date/time String }π d := FormatDate;π t := FormatTime;π date := d+' '+t;π end;ππProcedure Print_Header;π Var s, s1 :String;π beginπ Writeln(F_FEED);π Inc(page_num);π Str(page_num, s1);π s := 'Page '+s1+' '+source_name+' '+date;π Writeln(s);π end;ππProcedure PrintLine(line :String);π beginπ Inc(line_count);π if line_count>MAX_LinES_PER_PAGE thenπ beginπ print_header;π line_count := 1;π end;π if ord(line[0])>MAX_PRinTLinE_LEN thenπ line[0] := Chr(MAX_PRinTLinE_LEN);π Writeln(line);π end;πππFunction GetSourceLine :Boolean;π Var print_buffer :String[MAX_SOURCELinE_LEN+9];π s :String;π beginπ if not(Eof(F1)) then beginπ Readln(F1, source_buffer);π Inc(line_num);π Str(line_num:4, s);π print_buffer := s+' ';π Str(level, s);π print_buffer := print_buffer+s+': '+source_buffer;π PrintLine(print_buffer);π GetSourceLine := True;π end else GetSourceLine := False;π end;πππbegin { main }π if ParamCount=0 then beginπ Writeln('Syntax: LISTER <Filename>');π Halt(2);π end;π init(ParamStr(1));π While GetSourceLine do;πend.ππ{π Now that the task of producing a source listing is taken care of,π we can tackle the scanners main business: scanning. Our next jobπ is to produce a scanner that, With minor changes, will serve usπ For the rest of this "course".ππ The SCANNER will do the following tasks:ππ ° scan Words, numbers, Strings and special Characters.π ° determine the value of a number.π ° recognize RESERVED WordS.ππ LOOKinG For toKENSππ SCANNinG is reading the sourceFile and breaking up the Text of aπ Program into it's language Components; such as Words, numbers,π and special symbols. These Components are called toKENS.ππ You want to extract each each token, in turn, from the sourceπ buffer and place it's Characters into an empty Array, eg.π token_String.ππ At the start of a Word token, you fetch it's first Character andπ each subsequent Character from the source buffer, appending eachπ Character to the contents of token_String. As soon as you fetch aπ Character that is not a LETTER, you stop. All the letters inπ token_String make up the Word token.ππ Similarly, at the start of a NUMBER token, you fetch the firstπ digit and each subsequent digit from the source buffer. Youπ append each digit to the contents of token_String. As soon as youπ fetch a Character that is not a DIGIT, you stop. All digitsπ within token_String make up the number token.ππ Once you are done extracting a token, you have the firstπ Character after a token. This Character tells you that you haveπ finished extracting the token. if the Character is blank, youπ skip it and any subsequent blanks Until you are again looking atπ a nonblank Character. This Character is the start of the nextπ token.ππ You extract the next token in the same way you extracted theπ previous one. This process continues Until all the tokens haveπ been extracted from the source buffer. Between extracting tokens,π you must reset token_String to null String to prepare it For theπ next token.ππ PASCAL toKENSππ A scanner For a pascal Compiler must, of course, recognize Pascalπ tokens. The Pascal language contains several Types of tokens:π identifiers, reserved Words, numbers, Strings, and specialπ symbols.ππ This next exercise is a toKENIZER that recognizes a limitedπ subset of Pascal tokens. The Program will read a source File andπ list all the tokens it finds. This first version will recognizeπ only Words, numbers, and the Pascal "end-of-File" period - but itπ provides the foundation upon which we will build a full Pascalπ scanner in the second version.ππ Word: A Pascal Word is made up of a LETTER followed by any numberπ of LETTERS and DIGITS (including 0).ππ NUMBER: For now, we'll restrict a number token to a Pascalπ unsigned Integer, which is one or more consecutive digits. (We'llπ handle signs, decimals, fractions, and exponents later) and,π we'll use the rule that an input File *must* have a period asπ it's last token.ππ The tokenizer will print it's output in the source listing.ππ EXERCISE #2ππ Use the following TypeS and ConstANTS to create a SCANNER asπ described above:ππ-------------------------------------------------------------------ππTypeπ Char_code = (LETTER, DIGIT, SPECIAL, Eof_CODE);π token_code = (NO_toKEN, Word, NUMBER, PERIOD,π end_of_File, ERRor);π symb_Strings :Array[token_code] of String[13] =π ('<no token>','<Word>','<NUMBER>','<PERIOD>',π '<end of File>','<ERRor>');ππ literal_Type = (Integer_LIT, String_LIT);ππ litrec = Recordπ l :LITERAL_Type;π Case l ofππ Integer_LIT: value :Integer;π String_LIT: value :String;π end;π end;ππConstπ Eof_Char = #$7F;ππVarπ ch :Char; {current input Char}π token :token_code; {code of current token}π literal :litrec; {value of current literal}π digit_count :Integer; {number of digits in number}π count_error :Boolean; {too many digits in number?}π Char_table :Array[0..255] of Char_code;{ascii Character map}πππThe following code initializes the Character map table:ππFor c := 0 to 255 doπ Char_table[c] := SPECIAL;πFor c := ord('0') to ord('9') doπ Char_table[c] := DIGIT;πFor c := ord('A') to ord('Z') doπ Char_table[c] := LETTER;πFor c:= ord('a') ro ord('z') doπ Char_table[c] := LETTER;πChar_table[ord(Eof_Char)] := Eof_CODE;ππ-------------------------------------------------------------------ππ You can (and should) use the code from your source listingπ Program to start your scanner. if you have just arrived, use myπ own code posted just previously.ππ 5 05-28-9313:58ALL SWAG SUPPORT TEAM LONGLINE.PAS IMPORT 16 F╔ûE Program longline;ππVarπ LinePart: String;π InFile, OutFile: Text;π Index1, Index2: Word;π Result: Byte;ππbegin { First create a test File With lines longer than }π { 255 caracters, this routine will generate lines in }π { exess of 600 caracters. The last "EOLN" at the end }π { is a visual aid to check that the Complete line has }π { been copied to the output File. }ππ Assign (OutFile, 'InFile.txt');π ReWrite (OutFile);π Randomize;π For Index1 := 1 to 100 do beginπ For Index2 := 1 to (Random (5) + 1) doπ Write (OutFile, 'These are some very long Text Strings that'π + ' are written to the File InFile.txt in order to test' +π ' the capability of reading verylong Text lines. Lines' +π ' that even exceed Turbo Pascal''s limit of 255' +π ' caracters per String');π Writeln (OutFile, 'EOLN');π end;π Close (OutFile);ππ { Now re-open it and copy InFile.txt to OutFile.txt }π Assign (InFile, 'InFile.txt');π Assign (OutFile, 'OutFile.txt');π Reset (InFile);π ReWrite (OutFile);ππ While not Eof (InFile) do beginπ While not Eoln (InFile) do beginππ { While we are not at enf-of-line, read 255 }π { caracters notice we use READ instead of READLN }π { because the latter would skip to the next line even }π { if data was still left on this line.}ππ Read (InFile, LinePart);π Result := Ioresult;π Writeln ('Result was ', Result);π Write (OutFile, LinePart);π end;ππ { We have reached end-of-Line so do a readln to skip }π { to the start of the next line.}ππ Readln (InFile);ππ { Also Writeln to output File so it to, skips to the }π { next line. }ππ Writeln (OutFile);ππ end;ππ { Close both Files }ππ Close (OutFile);π Close (InFile);πend.ππ 6 05-28-9313:58ALL SWAG SUPPORT TEAM PTYPES.INC IMPORT 5 F╔in {--PTYPES.INC-----------------------------------------------------------π}π{ Type and Constant decalarations }ππCONSTπ MAX_FILENAME_LEN = 32;π MAX_SOURCELINE_LEN = 246;π MAX_PRINTLINE_LEN = 80;π MAX_LINES_PER_PAGE = 50;π DATE_STRING_LENGTH = 26;π F_FEED = #12;ππVARπ line_num, page_num,π level, line_count :word;ππ source_buffer :string[MAX_SOURCELINE_LEN];π source_name :string[MAX_FILENAME_LEN];π date :string[DATE_STRING_LENGTH];π F1 :text;ππ 7 05-28-9313:58ALL SWAG SUPPORT TEAM READFILE.PAS IMPORT 47 F╔¿ {π Could somebody post some source code on how to read in a config File? andπ also have it ignore lines that start With the semicolon. Sorta like thisπ one:ππSure do, here is mine. I have to include quite a couple of other Functions asπthey are used in the readcfg. I included one 'block' as an example in whichπyou read in a particular keyWord (named: 'keyWord') and find the parammeterπwhich follows. You can duplicate this block as many times as you like.πAlthough it scans the whole File again, it's pretty fast as it does it inπmemory.π}πFunction Trim(S : String) : String;π {Return a String With leading and trailing white space removed}πVarπ I : Word;π SLen : Byte Absolute S;πbeginπ While (SLen > 0) and (S[SLen] <= ' ') doπ Dec(SLen);π I := 1;π While (I <= SLen) and (S[I] <= ' ') doπ Inc(I);π Dec(I);π if I > 0 thenπ Delete(S, 1, I);π Trim := S;πend;πππ{******************************************************}πFunction StrUpper(Str: String): String; Assembler;π Asmπ jmp @Start { Jump over Table declared in the Code Segment }ππ @Table:π { Characters from ASCII 0 --> ASCII 96 stay the same }π DB 00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21π DB 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43π DB 44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65π DB 66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87π DB 88,89,90,91,92,93,94,95,96π { Characters from ASCII 97 "a" --> ASCII 122 "z" get translated }π { to Characters ASCII 65 "A" --> ASCII 90 "Z" }π DB 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86π DB 87,88,89,90π { Characters from ASCII 123 --> ASCII 127 stay the same }π DB 123,124,125,126,127π { Characters from ASCII 128 --> ASCII 165 some changesπ #129 --> #154, #130 --> #144, #132 --> #142, #134 --> #143π #135 --> #128, #145 --> #146, #148 --> #153, #164 --> #165}ππ DB 128,154,144,131,142,133,143,128,136,137,138,139,140,141,142,143π DB 144,146,146,147,153,149,150,151,152,153,154,155,156,157,158,159π DB 160,161,162,163,165,165π { Characters from ASCII 166 --> ASCII 255 stay the same }π DB 166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181π DB 182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197π DB 198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213π DB 214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229π DB 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245π DB 246,247,248,249,250,251,252,253,254,255ππ @Start:π push DS { Save Turbo's Data Segment address }π lds SI,Str { DS:SI points to Str[0] }π les DI,@Result { ES:DI points to StrUpper[0] }π cld { Set direction to Forward }π xor CX,CX { CX = 0 }π mov BX,ofFSET @Table { BX = offset address of LookUpTable }π lodsb { AL = Length(Str); SI -> Str[1] }π mov CL,AL { CL = Length(Str) }π stosb { Move Length(Str) to Length(StrUpper) }π jcxz @Exit { Get out if Length(Str) is zero }ππ @GetNext:π lodsb { Load next Character into AL }π segcs XLAT { Translate Char using the LookupTable }π { located in Code Segment at offset BX }π stosb { Save next translated Char in StrUpper}π loop @GetNext { Get next Character }ππ @Exit:π pop DS { Restore Turbo's Data Segment address }πend {StrUpper};π{-----------------------------------------------------------------}πFunction MCS(element,line:String):Integer;ππ{Returns the position of an element in a line.π Returns zero if no match found.π Example: line:='abcdefg'π i:=MCS('bc',line) would make i=2π MCS is not Case sensitive}ππbeginπ MCS:=pos(StrUpper(element),StrUpper(line));πend;ππFunction getparameter(element,line:String;pos:Integer):String;π{This Function is called With 'pos' already indexed after the command Word inπa line. It searches For the Word(s) after the command Word in the rest ofπthe line, up to the end of the line or Until a ; is encountered}ππVarπ n,b,e,l:Byte;ππbeginπ n:=pos+length(element);π {places n-index just after keyWord}ππ While (line[n]=' ') doπ inc(n); {increment line[n] over spaces}π b:=n; l:=length(line);π While (n<=l) doπ beginπ if line[n]<>';' thenπ beginπ inc(n);π e:=n;π endπ elseπ beginπ e:=n;π n:=l+1;π end;π end;π getparameter:=trim(copy(line,b,e-b));ππend;ππProcedure ReadCfg(name:String); {'name' is Filename to read in}πTypeπ Line = String[80];π Lines = Array[0..799] of Line;π LinesP = ^Lines;πVarπ TextBuf : LinesP;π TextFile : Text;π Index,Number:Integer;π buffer:Array[1..2048] of Char;π s:line;π s1:line;π n:Byte;π i:Integer;πbeginπ assign( TextFile, name );π reset( TextFile );π SetTextBuf(TextFile,Buffer);π Index := 0;π new(TextBuf);ππ While not eof( TextFile) doπ {Read the Text File into heap memory}π beginπ readln( TextFile,s);π if s[1]<>';' then if s<>'' thenπ beginπ TextBuf^[Index]:=s;π inc( Index )π end;π end;π close( TextFile );ππ{********begin of "find a keyWord" block***********}π Number := Index -1;π For Index := 0 to Number doπ beginπ s:=( TextBuf^[ Index ]);π n:=MCS('BoardNo',s);π if n > 0 thenπ beginπ s1:=getparameter('KeyWord',s,n);π {do other things With found 'keyWord'}π end;π end;π{end of "find a keyWord" block}ππ dispose( TextBuf); {release heap memory}πend;π 8 05-28-9313:58ALL SWAG SUPPORT TEAM READTEXT.PAS IMPORT 57 F╔Γ {$A+,B-,D-,E+,F-,I+,L-,N-,O-,R+,S-,V-}π{$M 4048,65536,655360}ππProgram ReadText;ππ{ Author Trevor J Carlsen - released into the public domain 1991 }π{ PO Box 568 }π{ Port Hedland }π{ Western Australia 6721 }π{ Voice +61 91 73 2026 Data +61 91 73 2569 }π{ FidoNet 3:690/644 }ππ{ This example Programs displays a Text File using simple Word wrap. The }π{ cursor keys are used to page Forward or backwards by page or by line. }π{ The Program makes some important assumptions. The main one is that no }π{ line in the File will ever exceed 255 Characters in length. to get }π{ around this restriction the ReadTxtLine Function would need to be }π{ rewritten. }ππ{ The other major restriction is that Files exceeding a size able to be }π{ totally placed in RAM cannot be viewed. }ππ{$DEFinE TurboPower (Remove the period if you have Turbo Power's TPro) }ππUsesπ {$ifDEF TurboPower }π tpCrt,π colordef;π {$else}π Crt;π {$endif}ππConstπ {$ifNDEF TurboPower }π BlackOnLtGray = $70; LtGrayOnBlue = $17;π {$endif}π LineLength = 79; MaxLines = 6000;π ScreenLines = 22; escape = $011b;π Home = $4700; _end = $4f00;π upArrow = $4800; downArrow = $5000;π PageUp = $4900; PageDown = $5100;ππTypeπ LineStr = String[Linelength];π StrPtr = ^LineStr;ππVarπ TxtFile : Text;π Lines : Array[1..MaxLines] of StrPtr;π NumberLines: 1..MaxLines+1;π CurrentLine: 1..MaxLines+1-ScreenLines;π st : String;π finished : Boolean;π OldExitProc: Pointer;π TxtBuffer : Array[0..16383] of Byte;π OldAttr : Byte;ππFunction LastPos(ch : Char; S : String): Byte;π { Returns the last position of ch in S or zero if ch not in S }π Varπ x : Word;π len : Byte Absolute S;π beginπ x := succ(len);π Repeatπ dec(x);π Until (x = 0) or (S[x] = ch);π LastPos := x;π end; { LastPos }ππFunction Wrap(Var S,CarryOver: String): String;π { Returns a String of maximum length Linelength from S. Any additional }π { Characters remaining are placed into CarryOver. }π Constπ space = #32;π Varπ temp : String;π LastSpace : Byte;π len : Byte Absolute S;π beginπ FillChar(temp,sizeof(temp),32);π temp := S; CarryOver := ''; wrap := temp;π if length(temp) > LineLength then beginπ LastSpace := LastPos(space,copy(temp,1,LineLength+1));π if LastSpace <> 0 then beginπ Wrap[0] := chr(LastSpace - 1);π CarryOver := copy(temp,LastSpace + 1, 255)π end { if LastSpace... }π else beginπ Wrap[0] := chr(len);π CarryOver := copy(temp,len,255);π end; { else }π end; { if (length(S))...}π end; { Wrap }ππFunction ReadTxtLine(Var f: Text; L: Byte): String;π Varπ temp : String;π len : Byte Absolute temp;π done : Boolean;π beginπ len := 0; done := False;π {$I-}π While not eoln(f) do beginπ read(f,temp);π if Ioresult <> 0 then beginπ Writeln('Error reading File - aborted');π halt;π end;π end; { While }π if eoln(f) then readln(f);π ReadTxtLine := st + Wrap(temp,st);π finished := eof(f);π end; { ReadTxtLine }ππProcedure ReadTxtFile(Var f: Text);π Varπ x : Word;π beginπ st := '';π NumberLines := 1;π Repeatπ if NumberLines > MaxLines then beginπ Writeln('File too big');π halt;π end;π if (MaxAvail >= Sizeof(LineStr)) thenπ new(Lines[NumberLines])π else beginπ Writeln('Insufficient memory');π halt;π end;π FillChar(Lines[NumberLines]^,LineLength+1,32);π if length(st) > LineLength thenπ Lines[NumberLines]^ := wrap(st,st)π else if length(st) <> 0 then beginπ Lines[NumberLines]^ := st;π st := '';π end elseπ Lines[NumberLines]^ := ReadTxtLine(f,LineLength+1);π Lines[NumberLines]^[0] := chr(LineLength);π if not finished thenπ inc(NumberLines);π Until finished;π end; { ReadTxtFile }ππProcedure DisplayScreen(line: Word);π Varπ x : Byte;π beginπ GotoXY(1,1);π For x := 1 to ScreenLines - 1 doπ Writeln(Lines[x-1+line]^);π Write(Lines[x+line]^)π end;ππProcedure PreviousPage;π beginπ if CurrentLine > ScreenLines thenπ dec(CurrentLine,ScreenLines-1)π elseπ CurrentLine := 1;π end; { PreviousPage }ππProcedure NextPage;π beginπ if CurrentLine < (succ(NumberLines) - ScreenLines * 2) thenπ inc(CurrentLine,ScreenLines-1)π elseπ CurrentLine := succ(NumberLines) - ScreenLines;π end; { NextPage }ππProcedure PreviousLine;π beginπ if CurrentLine > 1 thenπ dec(CurrentLine)π elseπ CurrentLine := 1;π end; { PreviousLine }ππProcedure NextLine;π beginπ if CurrentLine < (succ(NumberLines) - ScreenLines) thenπ inc(CurrentLine)π elseπ CurrentLine := succ(NumberLines) - ScreenLines;π end; { NextLine }ππProcedure StartofFile;π beginπ CurrentLine := 1;π end; { StartofFile }ππProcedure endofFile;π beginπ CurrentLine := succ(NumberLines) - ScreenLines;π end; { endofFile }ππProcedure DisplayFile;ππ Function KeyWord : Word; Assembler;π Asmπ mov ah,0π int 16hπ end;ππ beginπ DisplayScreen(CurrentLine);π Repeatπ Case KeyWord ofπ PageUp : PreviousPage;π PageDown : NextPage;π UpArrow : PreviousLine;π DownArrow : NextLine;π Home : StartofFile;π _end : endofFile;π Escape : halt;π end; { Case }π DisplayScreen(CurrentLine);π Until False;π end; { DisplayFile }ππProcedure NewExitProc;Far;π beginπ ExitProc := OldExitProc;π {$ifDEF TurboPower}π NormalCursor;π {$endif}π Window(1,1,80,25);π TextAttr := OldAttr;π ClrScr;π end;ππProcedure Initialise;π beginπ CurrentLine := 1;π if ParamCount <> 1 then beginπ Writeln('No File name parameter');π halt;π end;π OldAttr := TextAttr;π assign(TxtFile,Paramstr(1));π {$I-} reset(TxtFile);π if Ioresult <> 0 then beginπ Writeln('Unable to open ',Paramstr(1));π halt;π end;π SetTextBuf(TxtFile,TxtBuffer);π Window(1,23,80,25);π TextAttr := BlackOnCyan;π ClrScr;π Writeln(' Next Page = [PageDown] Previous Page = [PageUp]');π Writeln(' Next Line = [DownArrow] Previous Line = [UpArrow]');π Write(' Start of File = [Home] end of File = [end] Quit = [Escape]');π Window(1,1,80,22);π TextAttr := LtGrayOnBlue;π ClrScr;π {$ifDEF TurboPower}π HiddenCursor;π {$endif}π OldExitProc := ExitProc;π ExitProc := @NewExitProc;π end;ππbeginπ Initialise;π ReadTxtFile(TxtFile);π DisplayFile;πend.ππππ 9 05-28-9313:58ALL ERIC MILLER SCROLLER.PAS IMPORT 18 F╔:¢ {πERIC MILLERπread a Text File and scrollπ}ππUsesπ Crt;ππConstπ MaxLine = 200;π MaxLength = 80;ππVarπ Lines : Array [1..MaxLine] of String[MaxLength];π OldLine,π L,π CurrentLine,π NumLines : Word;π TextFile : Text;π Key : Char;π Redraw,π Done : Boolean;ππbeginπ ClrScr;π Assign(TextFile, 'MCGALIB.PAS');π Reset(TextFile);π NumLines := 0;π While not EOF(TextFile) and (NumLines < MaxLine) DOπ beginπ Inc(NumLines);π Readln(TextFile, Lines[NumLines]);π end;π Close(TextFile);ππ{π Well...that handles getting the File into memory...butπ to scroll through using Up/Down & PgUp PgDn is a lot harder,π but not incredibly difficult.π}π Done := False;π Redraw := True;π CurrentLine := 1;ππ While not Done DOπ beginπ if Redraw thenπ beginπ GotoXY(1,1);π For L := CurrentLine to CurrentLine + 22 DOπ Write(Lines[L], ' ':(80-Length(Lines[L])));π Redraw := False;π end;π Key := ReadKey;π Case Key ofπ #0:π begin { cursor/page keys }π OldLine := CurrentLine;π Key := ReadKey;ππ Case Key ofπ #72: { up }π if CurrentLine > 1 thenπ Dec(CurrentLine);π #80: { down }π if CurrentLine < (NumLines-22) thenπ Inc(CurrentLine);π #73: { page up }π if CurrentLine > 23 thenπ Dec(CurrentLine, 23)π elseπ CurrentLine := 1;π #81: { page down }π if CurrentLine < (NumLines-44) thenπ Inc(CurrentLine, 23)π elseπ CurrentLine := NumLines-22;π end;ππ if CurrentLine <> OldLine thenπ Redraw := True;π end;ππ #27: Done := True;ππ end; {Case}π end; {begin}πend. {Program}ππ{πThat should work For scrolling through the lines. Sorryπ'bout not commenting the code alot; it is almost self-explanatoryπthough. But it works! You could optimize it For larger Filesπby using an Array of Pointers to Strings. But enough For now.π} 10 05-28-9313:58ALL WILBERT VAN LEIJEN TEXTUNIT.PAS IMPORT 38 F╔⌠ Unit TextUtil;π{ Written by Wilbert Van.Leijen and posted in the Pascal Echo }ππInterfaceππFunction TextFilePos(Var f : Text) : LongInt;πFunction TextFileSize(Var f : Text) : LongInt;πProcedure TextSeek(Var f : Text; n : LongInt);ππImplementationπUses Dos;ππ{$R-,S- }ππProcedure GetFileMode; Assembler;ππAsmπ CLCπ CMP ES:[DI].TextRec.Mode, fmInputπ JE @1π MOV [InOutRes], 104 { 'File not opened For reading' }π xor AX, AX { Zero out Function result }π xor DX, DXπ STCπ@1:πend; { GetFileMode }ππFunction TextFilePos(Var f : Text) : LongInt; Assembler;ππAsmπ LES DI, fπ CALL GetFileModeπ JC @1ππ xor CX, CX { Get position of File Pointer }π xor DX, DXπ MOV BX, ES:[DI].TextRec.handleπ MOV AX, 4201hπ inT 21h { offset := offset-Bufend+BufPos }π xor BX, BXπ SUB AX, ES:[DI].TextRec.Bufendπ SBB DX, BXπ ADD AX, ES:[DI].TextRec.BufPosπ ADC DX, BXπ@1:πend; { TextFilePos }πππFunction TextFileSize(Var f : Text) : LongInt; Assembler;ππAsmπ LES DI, fπ CALL GetFileModeπ JC @1ππ xor CX, CX { Get position of File Pointer }π xor DX, DXπ MOV BX, ES:[DI].TextRec.handleπ MOV AX, 4201hπ inT 21hπ PUSH DX { Save current offset on the stack }π PUSH AXπ xor DX, DX { Move File Pointer to Eof }π MOV AX, 4202hπ inT 21hπ POP SIπ POP CXπ PUSH DX { Save Eof position }π PUSH AXπ MOV DX, SI { Restore old offset }π MOV AX, 4200hπ inT 21hπ POP AX { Return result}π POP DXπ@1:πend; { TextFileSize }ππProcedure TextSeek(Var f : Text; n : LongInt); Assembler;ππAsmπ LES DI, fπ CALL GetFileModeπ JC @2ππ MOV CX, Word Ptr n+2 { Move File Pointer }π MOV DX, Word Ptr nπ MOV BX, ES:[DI].TextRec.Handleπ MOV AX, 4200hπ inT 21hπ JNC @1 { Carry flag = reading past Eof }π MOV [InOutRes], AXπ JMP @2π { Force read next time }π@1: MOV AX, ES:[DI].TextRec.Bufendπ MOV ES:[DI].TextRec.BufPos, AXπ@2:πend; { TextSeek }πend. { TextUtil }ππ{ With the aid of that Unit you could save the position of each lineπin the Text File to an Array of LongInt as you read them. You can alsoπopen a temporary File, a File of LongInt, where each Record would simplyπrepresent the offset of that line in the Text File. if you need to goπback in the Text, simply read the offset of the line where you which toπrestart reading. Suppose you are on line 391 and you decide to go backπsay, 100 lines, simply do a Seek(MyIndex, CurrentLine-100). then use theπTextSeek Procedure to seek to that position in the Text File and startπreading again, taking into acount that you allready read those lines soπyou either re-Write the offsets to your index File, which won't hurtπsince you will just be overwriting the Records With the same valuesπagain or simply skip writing the offsets Until you reach a point whereπNEW lines that haven't yet been read are reached. Save any new offset asπyou read Forward.ππ With this method you can go back-wards as well as Forwards. In factπif you first read the File, saving all offsets Until the end, you canπoffer the user to seek to any line number.ππ When you read new lines or seek backwards, simply flush any linesπfrom memory. or maybe you could decide to keep a predetermined number ofπlines in memory say 300. When ever the user asks to read Forward orπbackwards, simply flush the 100 first or Last line, depending on theπdirection the user wants to go, and read 100 new lines from the TextπFile.ππ Maybe the best approach to be sure of sufficient memory is toπdetermine how many lines will fit. Suppose you limit line lengths to 255πcaracters. Determine how many will fit in a worse Case scenario. Createπas many 255 caracter Strings as will fit. divide that number of lines byπ4. Say you managed to create 1000 Strings of 255 caracters. divided by 4πis 250. So set a limit to 750 Strings to be safe and make any diskπaccesses in bundles of 250 Lines.ππ You can also keep the line offsets in memory in Arrays but you willπbe limited to 65520 / 8 = 16380 lines. Make that two Arrays stored onπthe heap and you've got yourself enough space to store 32760 lineπoffsets which at 255 caracters by line would be an 8.3 Meg File.π } 11 05-28-9313:58ALL SWAG SUPPORT TEAM VIEWER.PAS IMPORT 25 F╔ëe {π│I would like to be able to read a standard ASCII Text File from disk intoπ│a section of memory so I would be able to call up the screen later. Howπ│would I accomplish this? I'm assuming that once I have it in memory I couldπ│copy the information into $B800 and so have it display on the screen. Thisπ│would actually be useful For an instruction screen so I could scroll oneπ│screenful at a time With PgDn.ππSample code For viewing Text File. Feel free to experiment With it. If youπhave any questions, just ask.π}ππUsesπ Crt, Dos;πππProcedure ViewTextFile(fname: String);π{ fname - name of Text File to display }ππConstπ Bad = #255;π Null = #0;π ESC = #27;π Home = #71;π PgUp = #73;π PgDn = #81;π Done : Boolean = False;π PageIndex: Word = 1; { index to our screen/page }ππVarπ InFile : File; { unTyped File }π PFile : Pointer; { Pointer to our heap area }π Size, { size of File }π Result, { return code For BlockRead }π FileSeg, { Segment address of File in heap }π off: Word; { use as offset to our heap }π Pages: Array[1..2000] of Word; { define screen as Array of Words }π ch: Char; { For reading commands }ππbeginπ Assign(InFile, fname);π {$I-} Reset(InFile, 1); {$I+}π if IOResult <> 0 thenπ beginπ Writeln('File not found: ',fname);π Halt(1) { stop Program & return to Dos }π end;π Size := FileSize(InFile); { get size of File }π GetMem(PFile, Size); { allocate space in heap }π FileSeg := Seg(PFile^); { get Segment address of File in heap }ππ BlockRead(InFile, PFile^, Size, Result); { use BlockRead For fast File I/O }π FillChar(Pages, SizeOf(Pages), 0); { fill page With zeroes--ie:blank }π Repeatπ ClrScr;π off := Pages[PageIndex];π Repeat { display screenfull at a time }π Write(Chr(Mem[FileSeg:off]));π inc(off);π Until (off = Size) or (WhereY = 25);π Repeat { inner event loop }π ch := ReadKey;π if ch = ESC thenπ Done := True { user escaped }π elseπ if ch = Null thenπ Case ReadKey ofπ Home: PageIndex := 1; { go to first page }π PgUp: if PageIndex > 1 thenπ Dec(PageIndex);π PgDn: if off < Size thenπ beginπ Inc(PageIndex);π Pages[PageIndex] := off;π endπ elseπ ch := Badπ end;π Until (ch = Null) or Done;π Until Done;π Close(InFile) { don't forget to close the File }πend; { DisplayTextFile }πππbeginπ if ParamCount > 0 thenπ ViewTextFile(ParamStr(1))π elseπ Writeln('Error: Missing File parameter.')πend. { program }ππ 12 05-17-9315:05ALL SEAN PALMER DUPLICATE LINES (TEXT) (1221)F-PASCAL 28 F╔« Hi! Someone was needing help speeding up a duplicate line finder.πHere is what I came up with (it's tested, TP 6.0)πIt needs the txtSeek unit I'm also posting here. I converted txtSeekπfrom some code I found here (written in German), hope that personπdoesn't mind...ππ{D-,I-,L-,R-,X+}πunit TxtSeek;πinterfaceππ function TextFilePos(var f:text):LongInt; {FilePos}π function TextFileSize(var f:text):LongInt; {FileSize}π procedure TextSeek(var f:text;Pos:LongInt); {Seek}π procedure TextSeekRel(var f:text; Count:Longint); {Relative Seek}ππimplementationπuses dos;ππconstπ sAbs=0; { for use with DosSeek }π sRel=1;π sEnd=2;ππfunction DosSeek(handle:word; posn:LongInt; func:byte):longint;assembler;asmπ mov ah,$42; mov al,func; mov bx,handle;π mov dx,word ptr posn; mov cx,word ptr posn+2; int $21;π jnc @S; mov inOutRes,ax; xor ax,ax; xor dx,dx; @S:π end;ππfunction TextFilePos(var f:text):LongInt;beginπ textFilePos:=DosSeek(Textrec(f).handle,0,sRel)π -TextRec(f).BufEnd+TextRec(f).BufPos;π end;ππfunction TextFileSize(var f:text):LongInt;var Temp:LongInt;beginπ case TextRec(f).Mode ofπ fmInput:with Textrec(f) do beginπ Temp:=DosSeek(handle, 0, sRel);π textFileSize:=DosSeek(handle, 0, sEnd);π DosSeek(handle, Temp, sAbs);π end;π fmOutput:textFileSize:=TextFilePos(f);π else beginπ textFileSize:=0;π InOutRes:=1;π end;π end;π end;ππprocedure TextSeek(var f:text; Pos:LongInt);beginπ dosSeek(textRec(f).handle, pos, sAbs);π textRec(f).bufPos:=textRec(f).bufEnd; {force read}π end;ππprocedure TextSeekRel(var f:text; Count:LongInt);beginπ dosSeek(textRec(f).handle, count, sRel);π textRec(f).bufPos:=textRec(f).bufEnd; {force read}π end;ππend.ππ<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>ππ{$A-,B-,D-,E-,F-,G+,I-,L-,N-,O-,R-,S-,V-,X+}π{$M $800,$8000,$8000} {require heap memory}πUses Crt,txtSeek;ππtype bufType=array[0..32767] of char; {try this, it's a nice round binary #}πVarπ buff:^bufType;π f, f2:Text;π looking,s,parm:String[80];π n,siz:Longint;π dupes:word;ππProcedure CheckError(Err:integer); Beginπ TextColor(12);π Case Err Ofπ -1: WriteLn('You must specify a file on the command line.');π 2: WriteLn('Can''t find "', parm,'"');π 4: WriteLn('Too many open files to open ', parm);π 3,5..162: WriteLn('Error in reading ', parm);π End;π if err<>0 then begin WriteLn; Halt(1);end;π End;ππBeginπ If Paramcount<1 Then CheckError(-1);π parm:=paramstr(1);π Assign(f,parm);π New(buff);π SetTextBuf(f,buff^);π Reset(f);π checkError(IoResult);π Assign(f2,'FINDDUPE.$$$');π ReWrite(f2);π checkError(IoResult);π siz:=textFileSize(f);π Writeln('Deleting duplicate lines');π write(' 0% complete');π n := 0;π dupes:=0;π Reset(f);π While not eof(f) Do Beginπ Readln(f,Looking);π n:=textFilePos(f);π repeatπ Readln(f, s);π until (s=looking) or eof(f);π if eof(f)then writeln(f2, looking) else inc(dupes);π Write(^M,(n*100)div siz:3);π textSeek(f, n);π End;π Close(f);π erase(f); {erase original file}π Close(f2);π rename(f2,parm); {rename temp file on top of it}π dispose(buff);π writeln(^M'Found ',dupes,' duplicates');π End.πππ * OLX 2.2 * This tagline was created with 100% recycled electrons...ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π 13 08-17-9308:43ALL SWAG SUPPORT TEAM An OOP FILELIST Unit IMPORT 15 F╔ PROGRAM FileListDemo; {FILELIST.PAS}ππUSES Crt, Printer;ππTYPEπ Action = (Input, Output);π TextObj = OBJECTπ fp : text;π LineCount : integer;π EndOfFile : boolean;π CONSTRUCTOR OpenFile(FileName: string;π FileAction: Action);π PROCEDURE ReadLine(VAR TextLine: string);π PROCEDURE WriteLine(TextLine: string);π PROCEDURE PrintLine(TextLine: string);π PROCEDURE FillBlanks;π FUNCTION Done: boolean;π DESTRUCTOR CloseFile;π END;ππCONSTRUCTOR TextObj.OpenFile;πBEGINπ Assign(fp, FileName);π CASE FileAction ofπ Input:π BEGINπ LineCount := 1;π Reset(fp);π IF IOResult <> 0 THENπ BEGINπ writeln(FileName, ' not found!');π halt(1);π END;π writeln(FileName, ' opened for read...');π END;π Output:π BEGINπ Rewrite(fp);π WriteLn(FileName, ' opened for write...');π END;π END; {CASE}πEND;ππDESTRUCTOR TextObj.CloseFile;πBEGINπ Close(fp);π WriteLn('File closed...');πEND;ππPROCEDURE TextObj.ReadLine;πBEGINπ ReadLn(fp, TextLine);π EndOfFile := Eof(fp);πEND;ππPROCEDURE TextObj.WriteLine;πBEGINπ WriteLn(fp, TextLine);πEND;ππPROCEDURE TextObj.PrintLine;πBEGINπ IF not EndOfFile THENπ BEGINπ IF TextLine[1] <> '}' THENπ BEGINπ WriteLn(lst, TextLine);π Inc(LineCount);π END ELSE FillBlanks;π END;πEND;ππPROCEDURE TextObj.FillBlanks;πVARπ i : integer;πBEGINπ FOR i := LineCount TO 6 DO WriteLn(lst);π LineCount := 1;πEND;ππFUNCTION TextObj.Done;πBEGINπ Done := EndOfFile;πEND;ππVARπ InFile: TextObj;π TextLine: string;ππBEGINπ ClrScr;π WITH InFile DOπ BEGINπ OpenFile('DUMMY.DAT', Input);π REPEATπ ReadLine(TextLine);π PrintLine(TextLine);π UNTIL Done;π CloseFile;π END;π Write('Press Enter to quit...'); ReadLn;πEND.π 14 08-17-9308:43ALL SWAG SUPPORT TEAM A good FILEVIEW unit IMPORT 30 F╔ ===========================================================================π BBS: Canada Remote SystemsπDate: 08-09-93 (11:14) Number: 33641πFrom: NORBERT IGL Refer#: NONEπ To: MARK GRYN Recvd: NO πSubj: FILE VIEWER Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πHello Mark!πOne of these days, Mark Gryn wrote to all:ππ MG> I'm wondering if anyone has some code laying around for a 'file'π MG> viewer.ππ TAKE THIS! (:-)ππ Program Viewer;π (*$M $800,0,$A0000 *)ππ Usesπ crt;ππ Type TextBlock = Array[1..16209] of ^String; { lines enough? 8-) }ππ Var VText : TextBlock;π Lines : integer;π Last : integer;ππ Procedure Init(N:string);π Var F: text;π S: String;π beginπ FillChar( VText, Sizeof(Vtext), 0 );π Lines := 0;π Assign( f, N );π(*$I-*)π Reset( f );π(*$I+*)π If IoResult <> 0 then exit;π While ( not EOF( F ) )π AND ( Maxavail > 80 ) do { assume a 80-Char-String }π beginπ Inc( Lines );π ReadLn( F, S );π If Length(S) > 80π Then S[0] := #80;π GetMem( Vtext[Lines], 1+Length(S) );π VText[Lines]^ := S;π end;π Last := Lines;π if not eof( F )π then Write(' Sorry, only ')π else Write(' All ');π Writeln( Lines,' Lines of ', N , ' read. ');π Close( F );π end;ππ Procedure Display(N:String);π Var ch : Char;π akt: integer;π Procedure Update;π Var y,i: integer;π beginπ if akt > ( Last - 22 )π then akt := last - 22;π if akt < 1π then akt := 1;π y := 2;π for i := akt to akt + 22 doπ beginπ gotoxy( 1, y );π ClrEol;π inc( y );π if i <= Last then write( VText[i]^ );π end;π TextAttr := $70; (* Black on Gray *)π Gotoxy(70,25);π if akt+23 > Lastπ then Write(akt,'..',Last)π else Write(akt,'..',akt+22);π ClrEolπ end;π beginπ TextAttr := $70; (* Black on Gray *)π ClrScr;π Gotoxy( 2, 1);π Write('The All Dancing and Singing Textfile Viewer');π Write(' Norbert Igl, 2:243/8301.3@Fido');π Gotoxy( 2,25);π while Pos('\',N) > 0 do delete(n,1,1);π for akt := 1 to length(N) do N[akt] := upcase(n[akt]);π Write('File: ',N,', ',Last,' Lines, ');π Write( MemAvail,' Bytes free.');π Gotoxy(63,25); Write('Lines: ');π akt := 1;π repeatπ TextAttr := $1F; { white on blue }π Update;π repeatπ ch := ReadKey;π if ch = #0 thenπ beginπ ch := readkey;π case ch ofπ 'H' : ch := #1; { up }π 'P' : ch := #2; { down }π 'Q' : ch := #3; { pg-up }π 'I' : ch := #4; { pg-down }π 'G' : ch := #5; { home }π 'O' : ch := #6; { end }π else ch := #0; { discard }π endπ endπ until Ch in [#27, #1..#6 ] ;π case Ch ofπ #1 : dec( akt );π #2 : inc( akt );π #3 : inc( akt, 22 );π #4 : dec( akt, 22 );π #5 : akt := 1;π #6 : akt := last-22;π end;π until ch=#27;π end;ππ procedure CleanUp;π Var I : Integer;π beginπ for I := last downto 1 doπ FreeMem( Vtext[i], 1+Length(VText[i]^) );π TextAttr := 7;π ClrScr;π end;ππ beginπ if Paramcount <> 1 thenπ beginπ writeln(' Usage : VIEWER [Drive:[\Path\]] FileName.Ext');π haltπ end;π Init(paramstr(1));π if Lines > 0 thenπ beginπ Display(paramstr(1));π CleanUpπ end;π end.ππ hth, Norbertππ--- GoldEd 2.40p/FD2.02/FastEchoπ * Origin: GHOSTBUSTERS: We're afraid of no code... (2:243/8301.3)π 15 08-17-9308:48ALL SWAG SUPPORT TEAM Text Search in Files IMPORT 65 F╔ { Turbo Pascal File Viewer Object }ππuses Dos, Crt;ππconstπ PrintSet: set of $20..$7E = [ $20..$7E ];π ExtenSet: set of $80..$FE = [ $80..$FE ];π NoPrnSet: set of $09..$0D = [ $09, $0A, $0D ];ππtypeπ CharType = ( Unknown, Ascii, Hex );π DataBlock = array[1..256] of byte;π Viewer = objectπ XOrg, YOrg,π LineLen, LineCnt, BlockCount : integer;π FileName : string;π FileType : CharType;π procedure FileOpen( Fn : string;π X1, Y1, X2, Y2 : integer );π function TestBlock( FileBlock : DataBlock;π Count : integer ): CharType;π procedure ListHex( FileBlock : DataBlock;π Count, Ofs : integer );π procedure ListAscii( FileBlock : DataBlock;π Count : integer );π end;ππ Finder = object( Viewer )π procedure Search( Fn, SearchStr : string;π X1, Y1, X2, Y2 : integer );π end;ππprocedure Finder.Search;π varπ VF : file; Result1, Result2 : word;π BlkOfs, i, j, SearchLen : integer;π SearchArray : array[1..128] of byte;π EndFlag, BlkDone, SearchResult : boolean;π FileBlock1, FileBlock2, ResultArray : DataBlock;π beginπ BlockCount := 0;π XOrg := X1;π YOrg := Y1;π LineLen := X2;π LineCnt := Y2;π FileType := Unknown;π SearchLen := ord( SearchStr[0] );π for i := 1 to Searchlen doπ SearchArray[i] := ord( SearchStr[i] );π for i := 1 to sizeof( ResultArray ) doπ ResultArray[i] := $00;ππ assign( VF, Fn );π {$I-} reset( VF, 1 ); {$I+}π if IOresult = 0 thenπ beginπ EndFlag := false;π BlkDone := false;π SearchResult := false;π BlockRead( VF, FileBlock2, sizeof( FileBlock2 ), Result2 );π EndFlag := Result2 <> sizeof( FileBlock2 );π repeatπ FileBlock1 := FileBlock2;π Result1 := Result2;π FileBlock2 := ResultArray;π if not EndFlag thenπ beginπ BlockRead( VF, FileBlock2, sizeof( FileBlock2 ), Result2 );π inc( BlockCount );π EndFlag := Result2 <> sizeof( FileBlock2 );π end else BlkDone := True;π for i := 1 to Result1 doπ beginπ if SearchArray[1] = FileBlock1[i] thenπ beginπ BlkOfs := i-1;π SearchResult := true;π for j := 1 to SearchLen doπ beginπ if i+j-1 <= Result1 thenπ beginπ if SearchArray[j] = FileBlock1[i+j-1] thenπ ResultArray[j] := FileBlock1[i+j-1] elseπ beginπ SearchResult := false;π j := SearchLen;π end;π end elseπ if SearchArray[j] = FileBlock2[i+j-257] thenπ ResultArray[j] := FileBlock2[i+j-257] elseπ beginπ SearchResult := false;π j := SearchLen;π end;π end;π if SearchResult thenπ beginπ for j := SearchLen+1 to sizeof( ResultArray ) doπ if i+j-1 <= Result1π then ResultArray[j] := FileBlock1[i+j-1]π else ResultArray[j] := FileBlock2[i+j-257];π i := Result1;π end;π end;π end;π until BlkDone or SearchResult;π if SearchResult thenπ beginπ writeln( 'Search string found in file block ', BlockCount,π ' beginning at byte offset ', BlkOfs, ' ...' );π writeln;π if FileType = Unknown thenπ FileType := TestBlock( ResultArray,π sizeof( ResultArray ) );π case FileType ofπ Hex : ListHex( ResultArray, sizeof( ResultArray ), BlkOfs );π Ascii : ListAscii( ResultArray, sizeof( ResultArray ) );π end;π end else writeln( '"', SearchStr, '" not found in ', FN );π close( VF );π window( 1, 1, 80, 25 );π end else writeln( Fn, ' invalid file name!' );π end;ππprocedure Viewer.FileOpen;π varπ VF : file; Ch : char;π Result, CrtX, CrtY : word;π EndFlag : boolean;π FileBlock : DataBlock;π beginπ BlockCount := 0;π XOrg := X1;π YOrg := Y1;π LineLen := X2;π LineCnt := Y2;π FileType := Unknown;π assign( VF, Fn );π {$I-} reset( VF, 1 ); {$I+}π if IOresult = 0 thenπ beginπ window( X1, Y1, X1+X2-1, Y1+Y2-1 );π writeln;π EndFlag := false;π repeatπ BlockRead( VF, FileBlock, sizeof( FileBlock ), Result );π inc( BlockCount );π EndFlag := Result <> sizeof( FileBlock );π if FileType = Unknown thenπ FileType := TestBlock( FileBlock, Result );π case FileType ofπ Hex : ListHex( FileBlock, Result, 0 );π Ascii : ListAscii( FileBlock, Result );π end;π if not EndFlag thenπ beginπ CrtX := WhereX; CrtY := WhereY;π if WhereY = LineCnt thenπ begin writeln;π dec( CrtY ); end;π gotoxy( 1, 1 ); clreol;π write(' Viewing: ', FN );π gotoxy( 1, LineCnt ); clreol;π write(' Press (+) to continue, (Enter) to exit: ');π Ch := ReadKey; EndFlag := Ch <> '+';π gotoxy( 1, LineCnt ); clreol;π gotoxy( CrtX, CrtY );π end;π until EndFlag;π close( VF );π sound( 440 ); delay( 100 );π sound( 220 ); delay( 100 ); nosound;π window( 1, 1, 80, 25 );π end else writeln( Fn, ' invalid file name!' );π end;ππfunction Viewer.TestBlock;π varπ i : integer;π beginπ FileType := Ascii;π for i := 1 to Count doπ if not FileBlock[i] in NoPrnSet+PrintSet thenπ FileType := Hex;π TestBlock := FileType;π end;ππprocedure Viewer.ListHex;π constπ HexStr: string[16] = '0123456789ABCDEF';π varπ i, j, k : integer;π beginπ k := 1;π repeatπ write(' ');π j := (BlockCount-1) * sizeof( FileBlock ) + ( k - 1 ) + Ofs;π for i := 3 downto 0 doπ write( HexStr[ j shr (i*4) AND $0F + 1 ] );π write(': ');π for i := 1 to 16 doπ beginπ if k <= Count thenπ write( HexStr[ FileBlock[k] shr 4 + 1 ],π HexStr[ FileBlock[k] AND $0F + 1 ], ' ' )π else write( ' ' );π inc( k );π if( i div 4 = i / 4 ) then write(' ');π end;π for i := k-16 to k-1 doπ if i <= Count thenπ if FileBlock[i] in PrintSet+ExtenSetπ then write( chr( FileBlock[i] ) )π else write('.');π writeln;π until k >= Count;π end;ππprocedure Viewer.ListAscii;π varπ i : integer;π beginπ for i := 1 to Count doπ beginπ write( chr( FileBlock[i] ) );π if WhereX > LineLen then writeln;π if WhereY >= LineCnt thenπ beginπ writeln;π gotoxy( 1, LineCnt-1 );π end;π end;π end;ππ{=============== end Viewer object ==============}ππvarπ FileFind : Finder;πbeginπ clrscr;π FileFind.Search( 'D:\TP\EXE\search.EXE', { file to search }π 'Press any key', { search string }π 1, 1, 80, 25 ); { display window }π gotoxy( 1, 25 ); clreol;π write( 'Press any key to continue: ');π while not KeyPressed do;πend. 16 08-27-9320:12ALL LARS FOSDAL Reading Text Backwards IMPORT 39 F╔ {πLARS FOSDALππ> I'm working on a project where Text Records are appended to a disk Fileπ> at regular intervals. I'd like to position the Pointer at the end of theπ> File and read the line ending at the end of File into a null-terminatedπ> String (BP7).π> I can think of a couple of ways to implement this quickly: 1) prependπ> the Record to the File instead of appending, and 2) Write a fast driverπ> to do the backwards reading For me.ππ1) Prepending instead of appending...π I think you might run into some problems With this...π To prepend a line, you must first read the entire File,π then move to the start of the File again, Write the new Record,π and finally Write back all the Records you first read.π The overhead would become enormous if the File was large.ππ2) Fast driver For backwards reading... Aha!π This is the way to do it.ππ Below you will find the source of a "tail" Program.π I wrote it because I needed to check the status of some log Files,π and I didn't want to go through the entire File every time, as theπ Files could grow quite large.ππ It is currently limited to 255 Chars per line, but thatπ can easily be fixed (see the Limit Const).ππ Although it's not an exact solution to your problem, it will show youπ how to do "backwards" reading.π}ππProgram Tail;π{π Shows the tailing lines of a Text File.ππ Syntax: TAIL [d:\path]Filespec.ext [-<lines>]π Default number of lines is 10.ππ "TAIL Filename -20" will show the 20 last linesππ Written by Lars Fosdal, 1993π Released to the Public Domain by Lars Fosdal, 1993π}ππUsesπ Dos, Objects, Strings;ππConstπ MaxBufSize = 32000;ππTypeπ pBuffer = ^TBuffer;π TBuffer = Array[0..MaxBufSize-1] of Char;ππ pRawStrCollection = ^TRawStrCollection;π TRawStrCollection = Object(TCollection)π Procedure FreeItem(Item : Pointer); VIRTUAL;π end;ππ CharSet = Set of Char;ππVarπ r, l, e : Integer;πππProcedure TRawStrCollection.FreeItem(Item : Pointer);πbeginπ if Item <> nil thenπ StrDispose(pChar(Item));πend;ππFunction ShowTail(FileName : String; n : Integer) : Integer;πConstπ Limit = 255;πVarπ lines : pRawStrCollection;π fm : Byte;π f : File;π fs, fp : LongInt;π MaxRead : Word;π Buf : pBuffer;π lc, ix,π ex : Integer;π sp : Array [0..Limit] of Char;ππ Procedure DumpLine(p : pChar); Far;π beginπ if p^ = #255 thenπ Writelnπ elseπ Writeln(p);π end;ππbeginπ lines := nil;π fm := FileMode;π FileMode := $40; {Read-only, deny none}π Assign(f, FileName);π Reset(f, 1);π lc := IOResult;ππ if lc = 0 thenπ beginπ New(Buf);ππ fs := FileSize(f); {First, let's find out how much to read}π fp := fs - MaxBufSize;π if fp < 0 thenπ fp := 0;ππ Seek(f, fp); {Then, read it}π BlockRead(f, Buf^, MaxBufSize, MaxRead);π Close(f);ππ if MaxRead > 0 thenπ beginπ New(Lines, Init(n, 10));π ix := MaxRead - 1;ππ if Buf^[ix] = ^J thenπ Dec(ix);π if (ix > 0) and (Buf^[ix] = ^M) thenπ Dec(ix); {Skip trailing line break}ππ While (lc < n) and (ix > 0) DOπ beginπ ex := ix;π FillChar(sp, SizeOf(sp), 0);ππ While (ix > 0) and not (Buf^[ix] = ^J) DOπ Dec(ix);ππ if ex - ix <= Limit thenπ {if no break was found Within limit, it's no txt File}π beginπ if ix = ex thenπ sp[0] := #255 {Pad empty lines to avoid zero-length pChar}π elseπ StrLCopy(sp, @Buf^[ix + 1], ex - ix);π Inc(lc);ππ Lines^.AtInsert(0, StrNew(sp));ππ Dec(ix);π While (ix > 0) and (Buf^[ix] = ^M) DOπ Dec(ix);π endπ elseπ beginπ Writeln('"', FileName, '" doesn''t seem to be a Text File');π ix := -1;π end;ππ end; {lc<n and ix>0}π end {Maxread>0}π elseπ Lines := nil;π Dispose(Buf);π endπ elseπ lc := -lc;ππ if Lines <> nil thenπ beginπ Lines^.ForEach(@DumpLine);π Dispose(Lines, Done);π end;ππ ShowTail := lc;π FileMode := fm;πend;ππFunction StripAll(Const Exclude : CharSet; S : String) : String;πVarπ ix : Integer;πbeginπ ix := Length(S);π While ix > 0 DOπ beginπ if S[ix] in Exclude thenπ Delete(S, ix, 1);π Dec(ix);π end;π StripAll := S;πend;ππbeginπ if (ParamCount < 1) or (ParamCount > 2) thenπ beginπ Writeln('TAIL v.1.0 - PD 1993 Lars Fosdal');π Writeln(' TAIL [d:\path]Filename.ext [-n]');π Writeln(' Default is 10 lines');π endπ elseπ beginπ if ParamCount = 2 thenπ beginπ Val(StripAll(['/','-'], ParamStr(2)), l, e);π if e <> 0 thenπ l := 10π endπ elseπ l := 10;ππ r := ShowTail(ParamStr(1), l);π if r < 0 thenπ beginπ Writeln('Couldn''t open "', ParamStr(1), '"! (Error ', -r, ')');π Halt(Word(-r));π end;π end;πend.π 17 08-27-9320:22ALL MATT GIWER Cleaning a Text file IMPORT 26 F╔ {πMATT GIWERππIt is designed to clean up Files you might wish to capture from Real timeπchat. It gets rid of all those back spaces and recreates a readable Fileπthat appears as though no typos were made by anyone.ππ{$M 65520,0,655360 }πProgram capture_strip;ππUsesπ Dos, Crt;ππConstπ copyright : String[80] =π 'copyright 1988 and 1991 by Matt Giwer, all rights reserved';π name : String[20] = 'CAPture CLeaN ';π ver : String[5] = '1.2';ππVarπ in_File,π out_File : Text;π in_name,π out_name : String[30];π in_String,π out_String : String[250];π i, k, l : Integer;π ch : Char;π count : Integer;π Files : Array[1..50] of String[20];π in_Array,π out_Array : Array[1..100] of String[250];π Array_count : Byte;ππProcedure clear_Strings;πVarπ i : Byte;πbeginπ for i := 1 to 100 doπ beginπ in_Array[i] := '';π out_Array[i] := '';π end;πend;ππProcedure strip_File;πbeginπ For l := 1 to Array_count doπ beginπ out_String := '';π in_String := in_Array[l];π For i := 1 to length(in_String) doπ {if it is any except a backspace then add it to the output String}π beginπ if ord(in_String[i]) <> 8 thenπ out_String := out_String + in_String[i];π {if it is a backspace than the intention was to remove the last Characterπ in the String that was added above. Thus the BS is a signal to remove theπ last Character added above.}π if ord(in_String[i]) = 8 thenπ delete(out_String, length(out_String), 1);π end;π While (out_String[length(out_String)] = ' ') doπ delete(out_String, length(out_String), 1);π out_Array[l] := out_String;π end;πend;ππProcedure fill_Array;πbeginπ While not eof(in_File) doπ beginπ clear_Strings;π Array_count := 1;π While (not eof(in_File) and (Array_count < 100) ) doπ beginπ readln(in_File, in_Array[Array_count]);π Array_count := Array_count + 1;π end;π strip_File;π For l := 1 to Array_count doπ Writeln(out_File, out_Array[l]);π end;πend;ππbeginπ Writeln(name,ver);π Writeln(copyright);π For count := 1 to 50 doπ Files[count] := ' ';π clear_Strings;π Writeln;π if paramcount < 1 then {if command line empty}π beginπ Writeln('Only Filenames are accepted, no extenders');π Writeln('Output File will be .CLN');π Write('Enter File name. '); readln(in_name);π endπ else {else get an Array of the parameters}π beginπ For i := 1 to paramcount doπ Files[i] := paramstr(i) {! count vice i}π end;π if paramcount < 1 thenπ beginπ assign(in_File, in_name);π reset(in_File);π assign(out_File, in_name + '.CLN');π reWrite(out_File);π Write('Working on ', in_name:20);π fill_Array;π Writeln;π endπ elseπ beginπ For count := 1 to paramcount doπ beginπ in_name := paramstr(count);π assign(in_File, in_name);π reset(in_File);π assign(out_File, in_name + '.CLN');π reWrite(out_File);π Write('Working on ', paramstr(count):20);π fill_Array;π Writeln;π close(in_File);π close(out_File);π end;π end;πend. 18 08-27-9322:01ALL SWAG SUPPORT TEAM Text File Positions IMPORT 41 F╔ Unit TextUnit;ππInterfaceππ{$B-,D-,E-,I-,L-,N-,X+}ππUses Dos;ππ Function TextFilePos(Var andle:Text):LongInt; { FilePos }π Function TextFileSize(Var andle:Text):LongInt; { FileSize }π Procedure TextSeek(Var andle:Text;Pos:LongInt); { Seek }π Procedure TextBlockread(Var andle:Text; Var buf; { Blockread }π count:Word; Var result:Word);π Procedure TextBlockWrite(Var andle:Text; Var buf; { BlockWrite }π count:Word; Var result:Word);π Function BinEof(Var andle:Text):Boolean; { eof ohne $1a }π Function TextSeekRel(Var andle:Text; Count:LongInt):LongInt;π { Relativer Seek }ππImplementationππConstπ ab_anfang=0; { DosSeek }π ab_jetzig=1;π ab_ende=2;ππFunction DosSeek(Handle:Word; Pos:LongInt; wie:Byte):LongInt;πType dWord=Array[0..1] of Word;πVar Regs:Registers;π erg:LongInt;πbeginπ With Regs do beginπ ah:=$42;π al:=wie;π bx:=Handle; { Dos-Handle }π cx:=dWord(Pos)[1]; { Hi-Word Position }π dx:=dWord(Pos)[0]; { Lo-Word Position }π MSDos(Regs);π if Flags and fCarry<>0 then beginπ InOutRes:=ax;π erg:=0π endπ else erg:=regs.ax+regs.dx*65536;π end;π DosSeek:=erg;πend;ππFunction TextFilePos(Var andle:Text):LongInt;πVar erg:LongInt;πbeginπ erg:=DosSeek(Textrec(andle).Handle, 0, ab_jetzig)π -TextRec(andle).Bufendπ +TextRec(andle).BufPos;π TextFilepos:=erg;πend;ππFunction TextFileSize(Var andle:Text):LongInt;πVar TempPtr, erg:LongInt;πbeginπ Case TextRec(andle).Mode ofπ fmInput:with Textrec(andle) do beginπ TempPtr:=DosSeek(Handle, 0, ab_jetzig);π erg:=DosSeek(Handle, 0, ab_ende);π DosSeek(Handle, TempPtr, ab_anfang);π end;π fmOutput:erg:=TextFilePos(andle);π else beginπ erg:=0;π InOutRes:=1;π end;π end;π TextFileSize:=erg;πend;ππProcedure TextSeek(Var andle:Text; Pos:LongInt);πVar aktpos:LongInt;πbeginπ aktpos:=TextFilePos(andle);π if aktpos<>pos then With Textrec(andle) do beginπ if Mode=fmOutput then flush(andle);π With Textrec(andle) do beginπ if (aktpos+(bufend-bufpos)<Pos) or (aktpos>Pos) thenπ beginπ bufpos:=0;π bufend:=0;π DosSeek(Textrec(andle).Handle, pos, ab_anfang);π endπ else beginπ inc(bufpos, pos-aktpos);π end;π end;π end;πend;ππProcedure TextBlockread(Var andle:Text; Var buf; count:Word; Var result:Word);πVar R:Registers;π noch, ausbuf:Word;π posinTextbuf:Pointer;πbeginπ if Textrec(andle).Mode<>fmInput then InOutRes:=1π else beginπ With Textrec(andle) doπ beginπ noch:=bufend-bufpos;π if noch<>0 thenπ beginπ if noch<count then ausbuf:=noch else ausbuf:=count;ππ posinTextbuf:=Pointer(LongInt(bufptr)+bufpos);π move(posinTextbuf^, buf, ausbuf);π inc(bufpos, ausbuf);π end;π end;π if noch<count then With r doπ beginπ ds:=Seg(buf);π dx:=Ofs(Buf)+noch;π ah:=$3f;π bx:=Textrec(andle).Handle;π cx:=count-noch;π MsDos(R);π if Flags and fCarry<>0π then InOutRes:=axπ else result:=ax+noch;π endπ else result:=count;π end;πend;ππProcedure TextBlockWrite(Var andle:Text; Var buf; count:Word;Var result:Word);πVar r:Registers;π posinTextbuf:Pointer;πbeginπ if Textrec(andle).Mode<>fmOutput then InOutRes:=1π else beginπ With Textrec(andle) do beginπ if (bufsize-bufpos)>count thenπ beginπ posinTextbuf:=Pointer(LongInt(bufptr)+bufpos);π move(buf, posinTextbuf^, count);π inc(bufpos, count);π endπ else beginπ flush(andle);π With r do beginπ ah:=$40;π cx:=count;π ds:=seg(buf);π dx:=ofs(buf);π bx:=Handle;π MsDos(r);π if Flags and fCarry<>0 then InOutRes:=axπ else Result:=ax;π end;π end;π end;π end;πend;ππFunction TextSeekRel(Var andle:Text; count:LongInt):LongInt;πVar ziel, erg:LongInt;πbeginπ With Textrec(andle) do beginπ if Mode=fmOutput then begin InOutRes:=1; Exit; end;π if (count<0) thenπ beginπ ziel:=TextFilePos(andle)+count;π if ziel<0 then ziel:=0;π TextSeek(andle, ziel);π erg:=ziel;π endπ else if ((bufend-bufpos)<Count) thenπ beginπ ziel:=count-(bufend-bufpos);π if ziel<0 then ziel:=0;π erg:=DosSeek(Textrec(andle).Handle, ziel, ab_jetzig);π bufpos:=0; bufend:=0;π endπ else beginπ inc(bufpos, count);π erg:=maxLongInt;π end;π TextSeekRel:=erg;π end;πend;πππFunction BinEof(Var andle:Text):Boolean;πVar e:Boolean;πbeginπ e:=eof(andle);π{$R-}π With Textrec(andle) doπ BinEof:=e and (bufptr^[bufpos]<>#$1a);π{$R+}πend;πππend.ππ 19 08-27-9322:01ALL KIM KOKKONEN Reading Backwards IMPORT 58 F╔ {π> Can anyone help me figure out how I can move a Text File positionπ> Pointer backwards instead of forwards?π}ππ{$R-,S-,I-}ππ{π Turbo Pascal 4.0 Unit to read Text Files backwards.ππ See TESTRB.PAS For a test and demonstration Program. Routines hereπ are used in a manner very similar to normal Text File read routinesπ except that the "reset" positions to the end of the File, and eachπ subsequent "readln" returns the prior line in the File Until theπ beginning of the File is reached.ππ Each String returned by ReadLnBack is in normal forward order.ππ One quirk will occur if an attempt is made to read from Files Withπ lines longer than 255 Characters. In this Case ReadLnBack will returnπ the _last_ 255 Characters of each such line rather than the first. Thisπ is in keeping With the backwards nature of the Unit, however.ππ Hope someone finds a use For this!ππ Written 6/7/88, Kim Kokkonen, TurboPower Software.π Released to the public domain.π}ππUnit RB;π {-Read Text Files backwards}ππInterfaceππTypeπ BackText = File; {We use the UserData area in the unTyped FileππProcedure AssignBack(Var F : BackText; Fname : String);π {-Assign a backwards File to a File Variable}ππProcedure ResetBack(Var F : BackText; BufSize : Word);π {-Reset a backwards File, allocating buffer space (128 Bytes or greater)}ππProcedure ReadLnBack(Var F : BackText; Var S : String);π {-Read next line from end of backwards File}ππProcedure CloseBack(Var F : BackText);π {-Close backwards File, releasing buffer}ππFunction BoF(Var F : BackText) : Boolean;π {-Return True when F is positioned at beginning of File}ππFunction BackResult : Word;π {-Return I/O status code from operation}ππ {======================================================================}ππImplementationππConstπ LF = #10;ππTypeπ BufferArray = Array[1..65521] of Char;π BackRec = {Same as Dos.FileRec, With UserData filled inπ Recordπ Handle : Word;π Mode : Word;π RecSize : Word;π Private : Array[1..26] of Byte;π Fpos : LongInt; {Current File position}π BufP : ^BufferArray; {Pointer to Text buffer}π Bpos : Word; {Current position Within buffer}π Bcnt : Word; {Count of Characters in buffer}π Bsize : Word; {Size of Text buffer, 0 if none}π UserData : Array[15..16] of Byte; {Remaining UserData}π Name : Array[0..79] of Char;π end;ππVarπ BResult : Word; {Internal IoResult}ππ Procedure AssignBack(Var F : BackText; Fname : String);π {-Assign a backwards File to a File Variable}π beginπ if BResult = 0 then beginπ Assign(File(F), Fname);π BResult := IoResult;π end;π end;ππ Procedure ResetBack(Var F : BackText; BufSize : Word);π {-Reset a backwards File, allocating buffer}π Varπ BR : BackRec Absolute F;π beginπ if BResult = 0 thenπ With BR do beginπ {Open File}π Reset(File(F), 1);π BResult := IoResult;π if BResult <> 0 thenπ Exit;ππ {Seek to end}π Fpos := FileSize(File(F));π Seek(File(F), Fpos);π BResult := IoResult;π if BResult <> 0 thenπ Exit;ππ {Allocate buffer}π if BufSize < 128 thenπ BufSize := 128;π if MaxAvail < BufSize then beginπ BResult := 203;π Exit;π end;π GetMem(BufP, BufSize);π Bsize := BufSize;π Bcnt := 0;π Bpos := 0;π end;π end;ππ Function BoF(Var F : BackText) : Boolean;π {-Return True when F is at beginning of File}π Varπ BR : BackRec Absolute F;π beginπ With BR doπ BoF := (Fpos = 0) and (Bpos = 0);π end;ππ Function GetCh(Var F : BackText) : Char;π {-Return next Character from end of File}π Varπ BR : BackRec Absolute F;π Bread : Word;π beginπ With BR do beginπ if Bpos = 0 thenπ {Buffer used up}π if Fpos > 0 then beginπ {Unread File remains, first reposition File Pointer}π Bread := Bsize;π Dec(Fpos, Bread);π if Fpos < 0 then beginπ {Reduce the number of Characters to read}π Inc(Bread, Fpos);π Fpos := 0;π end;π Seek(File(F), Fpos);π BResult := IoResult;π if BResult <> 0 thenπ Exit;ππ {Refill buffer}π BlockRead(File(F), BufP^, Bread, Bcnt);π BResult := IoResult;π if BResult <> 0 thenπ Exit;ππ {Remove ^Z's from end of buffer}π While (Bcnt > 0) and (BufP^[Bcnt] = ^Z) doπ Dec(Bcnt);π Bpos := Bcnt;π if Bpos = 0 then beginπ {At beginning of File}π GetCh := LF;π Exit;π end;ππ end else beginπ {At beginning of File}π GetCh := LF;π Exit;π end;ππ {Return next Character}π GetCh := BufP^[Bpos];π Dec(Bpos);π end;π end;ππ Procedure ReadLnBack(Var F : BackText; Var S : String);π {-Read next line from end of backwards File}π Varπ Slen : Byte Absolute S;π Tpos : Word;π Tch : Char;π T : String;π beginπ Slen := 0;π if (BResult = 0) and not BoF(F) then beginπ {Build String from end backwards}π Tpos := 256;π Repeatπ Tch := GetCh(F);π if BResult <> 0 thenπ Exit;π if Tpos > 1 then beginπ Dec(Tpos);π T[Tpos] := Tch;π end;π {Note that GetCh arranges to return LF at beginning of File}π Until Tch = LF;π {Transfer to result String}π Slen := 255-Tpos;π if Slen > 0 thenπ Move(T[Tpos+1], S[1], Slen);π {Skip over (presumed) CR}π Tch := GetCh(F);π end;π end;ππ Procedure CloseBack(Var F : BackText);π {-Close backwards File, releasing buffer}π Varπ BR : BackRec Absolute F;π beginπ if BResult = 0 thenπ With BR do beginπ Close(File(F));π BResult := IoResult;π if BResult <> 0 thenπ Exit;π FreeMem(BufP, Bsize);π end;π end;ππ Function BackResult : Word;π {-Return I/O status code from operation}π beginπ BackResult := BResult;π BResult := 0;π end;ππbeginπ BResult := 0;πend.πππAnd now, the little test Program TESTRB.PAS that demonstrates how to use theπ Unit:ππ{π Demonstration Program For RB.PAS.π Takes one command line parameter, the name of a Text File to read backwards.π Reads File one line at a time backwards and Writes the result to StdOut.ππ See RB.PAS For further details.ππ Written 6/7/88, Kim Kokkonen, TurboPower Software.π Released to the public domain.π}ππProgram Test;π {-Demonstrate RB Unit}ππUsesπ RB;ππVarπ F : BackText;π S : String;ππ Procedure CheckError(Result : Word);π beginπ if Result <> 0 then beginπ WriteLn('RB error ', Result);π Halt;π end;π end;ππbeginπ if ParamCount = 0 thenπ AssignBack(F, 'RB.PAS')π elseπ AssignBack(F, ParamStr(1));π CheckError(BackResult);π ResetBack(F, 1024);π CheckError(BackResult);π While not BoF(F) do beginπ ReadLnBack(F, S);π CheckError(BackResult);π WriteLn(S);π end;π CloseBack(F);π CheckError(BackResult);πend.π 20 08-27-9322:03ALL MARCO MILTENBURG Seeking a text file IMPORT 13 F╔ {πMARCO MILTENBURGππ> One cannot seek in a Text File...ππSure you can... For Dos, TextFiles are Really the same things as TypedπFiles, so why don't ask Dos ;-) ? Try this one. F is a TextFile and n is theπFile-offset.π}ππProcedure tSeek(Var f : Text; n : LongInt); Assembler;πAsmπ push DSπ push BPππ lds SI, fπ lodsw { handle }π mov BX, AXππ mov CX, Word ptr [BP+8]π mov DX, Word ptr [BP+6]ππ mov AX, 4200h {AL = 2, AH = 42}π int 21hππ les DI, fπ mov AX, DIπ add AX, 8π mov DI, AXππ lodsw { mode }π lodsw { bufsize }π mov CX, AX { CX = number of Bytes to read }π lodsw { private }π lodsw { bufpos }π lodsw { bufend }π lodsw { offset of Pointer to Textbuf }π mov DX, AX { DX = offset of Textbuf }π lodswπ mov DS, AX { DS = segment of Textbuf }π mov AH, 3Fhπ int 21hπ push AX { Save AX on stack }ππ les DI, f { ES:DI points to f }π mov AX, DI { Move Pointer to position 8 }π add AX, 8π mov DI, AXππ mov AX, 0 { Bufpos = 0 }π stoswπ pop AX { Bufend = number of Bytes read }π stoswππ pop BPπ pop DSπend; { tSeek }ππ 21 08-27-9322:03ALL MARK OUELLET Sorting a Text file IMPORT 33 F╔ {πMARK OUELLETππ> I know, Mark, that is what Mike said in his last post on it,π> however, when I tried to make that correction the error simply changedπ> from an unrecognized Variable to a Type mismatch. I kept the Programπ> and may be able to rework it. I think Mike indicated originally that itπ> was untested. I kept a copy and may get back to it later. I thoughtπ> (grin) that you might come along and supply the missing touch!! I'veπ> profited greatly by the instruction of your skilled hand as well as thatπ> of Mike's.ππ The Type mismatch comes from the fact Mike elected to use a generalπpurpose Pointer Type For his Array rather than defining a new StringπPointer Type.ππ Ok, you have two possible solutions to the problem. You can (A)πTypeCast every Pointer use With String() as inππ if PA[MIDDLE]^ < SππBECOMESππ if String(PA[MIDDLE]^) < SππThis one is long and requires adding the Typecast to every singleπcomparison. Or you can (B) define a new StrPointer Type and redefine theπArray to an Array of StrPointer.ππHere is a version that should work correctly. I decided to go With theπString Pointer Type since Mike Uses GetMem anyways. if he had been usingπNEW() then each allocation would have been For a 255 caracter String butπsince he allready Uses GetMem to request just enough to hold the Stringπthen the new Type will pose no problems.ππ Note that some additions and Modifications have also been done toπmake it work. I guess Mike was pretty tired when he wrote this ;-). Theπsorting routine does work as is, just as Mike stated. I also took itπupon myself to reformat it to my standards.π}πππ{$A+,B-,D+,E-,F+,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T+,V-,X+,Y+}π{$M 65520,100000,655360}π{π Written by Mike Copeland and Posted to the Pascal Lessons echoπ on April 10th 1993.ππ Modified by Mark Ouellet on May 3rd 1993 and reposted to Pascalπ Lessons echo.ππ Modifications are not indicated in any way to avoid loading the echoπ too much. A File compare of both versions will point out the obviousπ modifications and additions.π}πProgram Text_File_SORT;ππUsesπ Dos, Crt, Printer;ππConstπ MAXL = 10000; { maximum # of Records to be processed }ππTypeπ BBUF = Array[1..16384] of Char;π StrPointer = ^String;ππVarπ I : Word;π IDX : Word;π P : StrPointer;π S : String;π BP : ^BBUF; { large buffer For Text File i/o }π PA : Array [1..MAXL] of StrPointer;{ Pointer Array }π F : Text;ππProcedure Pause;πbeginπ { Flush Keyboard buffer }π Asmπ Mov AX, 0C00h;π Int 21hπ end;π Writeln('Press a key to continue...');π { Wait For Keypress }π While not KeyPressed do;π { Flush Keyboard Buffer again, we don't need the key }π Asmπ Mov AX, 0C00h;π Int 21hπ end;πend;ππProcedure L_HSORT (LEFT, RIGHT : Word);{ Lo-Hi QuickSort }πVarπ LOWER,π UPPER,π MIDDLE : Word;π PIVOT,π T : String;π Temp : StrPointer;πbeginπ LOWER := LEFT;π UPPER := RIGHT;π MIDDLE := (LEFT + RIGHT) Shr 1;π PIVOT := PA[MIDDLE]^;π Repeatπ While PA[LOWER]^ < PIVOT doπ Inc(LOWER);π While PIVOT < PA[UPPER]^ doπ Dec(UPPER);π if LOWER <= UPPER thenπ beginπ Temp := PA[LOWER];π PA[LOWER] := PA[UPPER];π PA[UPPER] := Temp;π Inc (LOWER);π Dec (UPPER);π end;π Until LOWER > UPPER;π if LEFT < UPPER thenπ L_HSORT (LEFT, UPPER);π if LOWER < RIGHT thenπ L_HSORT (LOWER, RIGHT);πend; { L_HSORT }ππbeginπ ClrScr;π Assign (F,'input.dat');π New (BP);π SetTextBuf (F,BP^);π Reset (F);π IDX := 0;π While not EOF (F) doπ begin { read File; load into Heap }π readln (F,S);π Inc (IDX);π GetMem (P,Length(S)+1);π P^ := S;π PA[IDX] := P;π gotoXY (1,22);π Write (IDX:5)π end;π Close (F);π Dispose (BP);π if IDX > 1 thenπ L_HSORT (1,IDX); { sort the data }π For I := 1 to IDX do begin { display the data }π Writeln (PA[I]^);π if not Boolean(I MOD 23) thenπ pause;π end;π Writeln ('Finis...')πend.π