SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00042 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.π 22 10-28-9311:39ALL WALKING-OWL ??? TEXT TO EXE IMPORT 8 F╔ {πFrom: WALKING-OWLπSubj: Re: TXT2COMπ}ππprogram MakeMessage;πconst loader: array [0..14] of byte =π ($BE,$0F,$01,π $B9,$00,$00,π $FC,$AC,$CD,$29,$49,$75,$FA,$CD,$20);πvar fin,fout: file;π nin,nout: string;π buffer: array [0..4095] of byte;π i: word;ππbeginπ writeln('"MakeMsg" v0.00');π if ParamCount<>2π then writeln('Usage: MAKEMSG textfile execfile')π else beginπ nin:=ParamStr(1);π nout:=ParamStr(2);π Assign(fin,nin); reset(fin,1);π Assign(fout,nout); rewrite(fout,1);π i:=filesize(fin);π loader[4]:=lo(i);π loader[5]:=hi(i);π BlockWrite(fout,loader[0],15);π repeatπ BlockRead(fin,Buffer[0],4096,i);π BlockWrite(fout,Buffer[0],i)π until i=0;π close(fin);π close(fout);π writeln('Done.')π endπend.π 23 11-02-9305:38ALL ROBERT ROTHENBURG Text to EXE Conversion IMPORT 11 F╔ {π> Do you have some code that will produce a Program that makesπ> self-viewing Text Files (like txt2com)?ππ This adds a small Text File to a loader which simply reads through theπ data and sends it to the ANSI driver, so it's good For ANSIs or Textπ Files that will fit in one screen.ππ However you could change the loader (if you know assembly) to do paUsesπ or output the File to STDOUT so you can use the more-pipe (|more).π}ππ(* MakeMsg v0.00 - Public Domain by Robert Rothenburg 1993 *)ππProgram MakeMessage;πConstπ loader : Array [0..14] of Byte =π ($BE,$0F,$01,$B9,$00,$00,$FC,$AC,$CD,$29,$49,$75,$FA,$CD,$20);πVarπ fin, fout : File;π nin, nout : String;π buffer : Array [0..4095] of Byte;π i : Word;ππbeginπ Writeln('"MakeMsg" v0.00');π if ParamCount <> 2 thenπ Writeln('Usage: MAKEMSG TextFile execFile')π elseπ beginπ nin := ParamStr(1);π nout := ParamStr(2);π Assign(fin, nin);π reset(fin, 1);π Assign(fout, nout);π reWrite(fout, 1);π i := Filesize(fin);π loader[4] := lo(i);π loader[5] := hi(i);π BlockWrite(fout, loader[0], 15);π Repeatπ BlockRead(fin, Buffer[0], 4096, i);π BlockWrite(fout, Buffer[0], i)π Until i = 0;π close(fin);π close(fout);π Writeln('Done.');π end;πend.π 24 11-02-9306:00ALL FRED JOHNSON Text to COM File IMPORT 33 F╔ {πFRED JOHNSONππ> Can anyone shed some light on creating a front-end loader for a Pascal .EXEπ> file?ππ{π *** Here is a piece of code that expresses the basic concept for whichπ *** you are looking. It takes a text file (.msg) you supply and performsπ *** an extremely simple encription on it and attaches a display methodπ *** and a password you supply. It then makes a .COM file that displaysπ *** the file contents once you enter the correct password.π *** The code is very inefficient, but written that way to show the methodπ *** used to write the ASM code to the file. A better way to do this wouldπ *** be to place your standard ASM code in an array and increment aπ *** pointer to each command as you write it to the disk. Let me know ifπ *** you want to see a rewrite.π}πUsesπ DOS,π CRT;ππVARπ FName,π RName : File Of Byte;π B, Q : Byte;π Password : String[10];π I_name : String[12];π J : Integer;ππPROCEDURE Z;πBeginπ Write(FName, Q);πEnd;ππBeginπ ClrScr;π Write('Input file name (extension must be .msg) : ');π Readln(I_name);π Assign(FName, I_name + '.com');π Assign(RName, I_name + '.msg');π ReWrite(FName);π Reset(RName);π Write('What is the Password you wish to use? 1 - 9 characters :');π Readln(Password);π B := Length(Password);π J := 1;π{***********************************************************************}π Q := $b4; Z; Q := $0a; Z; { MOV AH,0A }π Q := $ba; Z; Q := $4b; Z; Q := $01; Z; { MOV DX,014B }π Q := $cd; Z; Q := $21; Z; { INT 21 }π Q := $BE; Z; Q := $4D; Z; Q := $01; Z; { MOV SI,014D }π Q := $8A; Z; Q := $04; Z; { MOV AL,[SI] }π Q := $3C; Z; Q := $24; Z; { CMP AL,24 }π Q := $74; Z; Q := $07; Z; { JZ 0117 }π Q := $04; Z; Q := $08; Z; { ADD AL,08 }π Q := $88; Z; Q := $04; Z; { MOV [SI],AL }π Q := $46; Z; { INC SI }π Q := $EB; Z; Q := $F3; Z; { JMP 010A }π Q := $B8; Z; Q := $03; Z; Q := $00; Z; { MOV AX,0003 }π Q := $CD; Z; Q := $10; Z; { INT 10 }π Q := $B9; Z; Q := B; Z; Q := $00; Z; { MOV CX,length of Password }π Q := $BE; Z; Q := $4d; Z; Q := $01; Z; { MOV SI,014c }π Q := $BF; Z; Q := $57; Z; Q := $01; Z; { MOV DI,0148 }π Q := $F3; Z; { REPZ }π Q := $A6; Z; { CMPSB }π Q := $75; Z; Q := $1b; Z; { JNZ 014a }π Q := $BE; Z; Q := $61; Z; Q := $01; Z; { MOV SI,0161 }{message start}π Q := $8A; Z; Q := $04; Z; { MOV AL,[SI] }π Q := $3C; Z; Q := $24; Z; { CMP AL,24 }π Q := $74; Z; Q := $07; Z; { JZ 013a }π Q := $34; Z; Q := $02; Z; { XOR AL,02 }π Q := $88; Z; Q := $04; Z; { MOV [SI],AL }π Q := $46; Z; { INC SI }π Q := $EB; Z; Q := $F3; Z; { JMP 012d }π Q := $B4; Z; Q := $09; Z; { MOV AH,09 }π Q := $BA; Z; Q := $61; Z; Q := $01; Z; { MOV DX,0161 }{message start}π Q := $CD; Z; Q := $21; Z; { INT 21 }π Q := $31; Z; Q := $C0; Z; { XOR AX,AX }π Q := $CD; Z; Q := $16; Z; { INT 16 }π Q := $B8; Z; Q := $03; Z; Q := $00; Z; { MOV AX,0003 }π Q := $CD; Z; Q := $10; Z; { INT 10 }π Q := $CD; Z; Q := $20; Z; { INT 20 }π{************************************************************************}π Q := B + 1;π Z;π Q := $24;π For B := 1 to 11 doπ Z;π For B := 1 to Length(Password) Doπ Beginπ Q := Ord(Password[B]) + 8;π Z;π End;π While Length(Password) < 10 Doπ Beginπ Password := Password + '$';π Z;π End;π While Not EOF(RName) Doπ Beginπ Read(RName, B);π If B <> 26 Thenπ Beginπ Q := B XOr 2;π Z;π Inc(J);π End;π End;π Q := $24;π Z;π Close(RName);π Close(FName);πEnd.π 25 11-02-9306:17ALL GUY MCLOUGHLIN Seeking a TEXT line IMPORT 21 F╔ { GUY MCLOUGHLIN }ππ(* Public domain text-file "seek" line demo. *)π(* Guy McLoughlin - October 1993. *)πprogram SeekLineDemo;ππ(* Text buffer type definition. *)πtypeπ TextBuffer = array[1..(16 * 1024)] of byte;ππ (***** Check for IO file errors. *)π (* *)πprocedure CheckForErrors;πvarπ Error : byte;πbeginπ Error := ioresult;π if (Error <> 0) thenπ beginπ writeln('FILE ERROR = ', Error);π halt(1);π end;πend;ππ(***** Seek to specified line in a text file. LineCount returns the *)π(* line number that was "seeked" to. *)π(* *)πprocedure SeekLine({input } var TextFile : text;π var Tbuffer : TextBuffer;π LineNumber : word;π {output} var LineCount : word);πvarπ TempStr : string;πbeginπ (* Assign text buffer. *)π settextbuf(TextFile, Tbuffer);ππ (* Reset text file, and check for IO errors. *)π {$I-}π reset(TextFile);π {$I+}π CheckForErrors;ππ (* Read text file until just before specified line, or *)π (* end of text file reached. *)π LineCount := 0;π repeatπ readln(TextFile, TempStr);π inc(LineCount)π until (LineCount = pred(LineNumber)) or eof(TextFile);ππ (* If end of text file not reached, add 1 to LineCount. *)π if NOT eof(TextFile) thenπ inc(LineCount)πend;ππvarπ LineCount,π LineNumber : word;π TempStr : string;π TextFile : text;π Tbuffer : TextBuffer;ππBEGINπ (* Assign text filename. *)π assign(TextFile, 'TEST.TXT');ππ (* Obtain line numbe to display from user. *)π write('ENTER LINE NUMBER TO DISPLAY : ');π readln(LineNumber);π writeln('SEEKING TO LINE ', LineNumber);ππ (* Seek to line user wants to see. *)π SeekLine(TextFile, Tbuffer, LineNumber, LineCount);ππ (* If seek was successful, then read and display line. *)π if (LineCount = LineNumber) thenπ beginπ readln(TextFile, TempStr);π writeln;π writeln('LINE ', LineNumber, ' = ', TempStr);π endπ elseπ (* Else, display total number of lines in text file. *)π writeln('Sorry, total lines in TEST.TXT = ', LineCount);ππ (* Close the text file. *)π close(TextFile);πEND.π 26 11-02-9306:25ALL JAN DOGGEN BLOCKREAD/WRITE Text fileIMPORT 22 F╔ {πJAN DOGGENππ> I have already written the parts that open and read the File and find theπ> Record I need to update. Now I want to replace part of the String ofπ> Characters which comprise this Record, With the Record remaining in itsπ> location in the File.ππNo, if you use a Text File (Var T: Text) it's either read or Write.ππ 1. if you only replace 'n' Characters With another 'n' Characters, itπ is no big problem, although hardly an elegant solution:π you can Type it as a File of Byte, then read /Write each Stringπ using something like:π}ππProcedure BlockWriteStr(Var F : File; S : String);πVarπ L, Written : Word;πbeginπ L := Length(S) + 1;π BlockWrite(File(F), S[0], L, Written);π Assert(L = Written, 'Error writing to disk (disk full ?)');πend;πππProcedure BlockReadStr(Var F : File; Var S : String);πVarπ ReadIn : Word;πbeginπ BlockRead(File(F), S[0], SizeOf(Byte));π BlockRead(File(F), S[1], Ord(S[0]), ReadIn);π Assert(Ord(S[0]) = ReadIn, 'Error reading from disk');πend;ππ{ Of course, you'll have to remember your FilePos().ππ 2. if you replace With a different number of Chars, I cannot helpπ you, other than suggesting you use an input and output Text File,π and reWrite the whole thing. Not very elegant either.ππ BTW, as I am still in my editor, I might as well copy this too:π}ππFunction SubstituteStr(Original, Part1, Part2 : String): String;π(* Replaces all <Part1> subStrings in String <Original> With <Part2>.π *π * Example:π * SubstituteStr('Abracadabra','ra','rom') ==> 'Abromcadabrom'π * The Function does not work recursively, so:π * SubstituteStr('Daaaaaaaar','aa','a') returns 'Daaaar', not 'Dar'.*)πVarπ S : String;π P, L, T : Byte;πbeginπ if Original = '' thenπ beginπ SubstituteStr := '';π Exit;π end;ππ S := '';π L := Length(Part1);π T := 1;π P := Pos(Part1,Copy(Original,T,255));ππ While P <> 0 DOπ beginπ S := S + Copy(Original, T, P - 1) + Part2;π T := T + P + L - 1;π P := Pos(Part1, Copy(Original, T, 255));π end;π SubstituteStr := S + Copy(Original, T, 255);πend;ππFunction SubstituteStrX(Original, Part1, Part2 : String) : String;π(* Like SubstituteStr, but now the Function works recursively, soπ* SubstituteStrX('Daaaaaaaar','aa','a') returns 'Dar'. *)πVarπ S : String;π P, L, T : Byte;πbeginπ if Original = '' thenπ beginπ SubstituteStrX := '';π Exit;π end;ππ S := Original;π T := 1;π L := Length(Part1);π P := Pos(Part1,S);ππ While P <> 0 DOπ beginπ S := Copy(S, 1, P - 1) + Part2 + Copy(S, P + L, 255);π P := Pos(Part1, S);π end;π SubstituteStrX := S;πend;π 27 11-26-9317:46ALL LARS FOSDAL Reading File Backwards IMPORT 33 F╔ {π 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;π πPROCEDURE TRawStrCollection.FreeItem(Item:Pointer);πBEGINπ IF Item<>nilπ THEN StrDispose(pChar(Item));πEND; {PROC TRawStrCollection.FreeItem}ππFUNCTION ShowTail(FileName:String; n:Integer):Integer;π PROCEDURE DumpLine(p:pChar); FAR;π BEGINπ IF p^=#255π THEN Writelnπ ELSE Writeln(p);π END;π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;π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 {If no break was found within limit, it's no txt file}π THEN 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; {FUNC ShowTail}ππTYPEπ CharSet = Set of Char;ππ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; {FUNC StripAll} π πVARπ r : Integer;π l : Integer;π e : Integer;π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.π 28 11-26-9317:47ALL LEE LEFLER Shared TextFiles IMPORT 167 F╔ {πFrom: LEE LEFLERπSubj: Shared textfilesππ Want to do some reading of LARGE textfiles on a network.π How can I open a textfile for reading inπ (readonly+denywrite) mode ?ππ Some say that Text files can't be shared ?!?!?ππ Sure they can, but it takes a little special work to do it. I useπthe following unit to share the nodelist. I don't know who originally wrote itπso I hope it's OK to post. It's going to need a little cleaning up since theπmessage readers are going to wrap it, but I don't want to modify it so you guysπwill have to handle that when you export it.π}ππUnit TxtShare;ππ{$F+}ππ{ This UNIT implements a TEXT file device driver to access TEXT files with a }π{ user specified network access mode (see DOS Technical Reference for DOS }π{ function 3Dh). This can be accomplished for non-TEXT files by setting the }π{ standard global variable "FileMode" (part of the System unit) to the desiredπ}π{ value, and then calling the appropriate open function. This is not supportedπ}π{ for TEXT files in Turbo Pascal v4.0. }ππ{ To open a Text file with a user specified access mode, place a call to the }π{ procedure AssignText to associate a filename with the text file variable. }π{ Next, set the standard global variable FileMode with the desired DOS access }π{ mode value. RESET, REWRITE, and APPEND will now use the access mode }π{ assigned to the FileMode variable when opening the file. }ππ{ By default, no EOF marker is written to text files that have been "assigned"π}π{ using this unit's routines. If you require a ^Z at the end of any file }π{ opened for output, set the global variable WriteTextEofChar to TRUE before }π{ closing the file. }ππInterfaceππUses Dos;ππVarπ WriteTextEofChar : Boolean;ππProcedure AssignText(Var F : Text; FileName : String);ππImplementationππ{$R-,S-}ππVarπ ReadText_Addr : Pointer;π WriteText_Addr : Pointer;π SeekText_Addr : Pointer;π DoNothing_Addr : Pointer;π CloseText_Addr : Pointer;ππFunction ReadText(Var F : TextRec) : Word;πBeginπ Inline(π $1E/ { push ds ;Save data segmentπvalue}π $C5/$76/$06/ { lds si,[bp+6] ;Address the file varπstructure}π $AD/ { lodsw ;Pick up file handle}π $89/$C3/ { mov bx,ax ; ... and store in bx}π $46/ { inc si ;Skip past the Modeπfield}π $46/ { inc si ; ... and address theπBufSize field}π $AD/ { lodsw ;Pick up BufSize (# ofπbytes to read)}π $89/$C1/ { mov cx,ax ; ... and store in cx}π $81/$C6/$06/$00/ { add si,6 ;Address the BufPtrπfield}π $AD/ { lodsw ;Pick up Offset partπof the pointer}π $89/$C2/ { mov dx,ax ; ... and store in dx}π $AD/ { lodsw ;Pick up Segment partπof the pointer}π $8E/$D8/ { mov ds,ax ; ... and store in ds}π $B4/$3F/ { mov ah,$3F ;DOS Read aπFile/Device function}π $CD/$21/ { int $21 ;Call DOS}π $72/$0F/ { jc Error ;Error if Carry Flagπset}π $50/ { push ax ;Save # of bytesπactually read}π $31/$C0/ { xor ax,ax ;Clear ax to zero}π $C4/$7E/$06/ { les di,[bp+6] ;Address the file varπstructure}π $81/$C7/$08/$00/ { add di,8 ;Address the BufPosπfield}π $AB/ { stosw ;Store 0 in the BufPosπfield}π $58/ { pop ax ;Retrieve bytesπactually read}π $AB/ { stosw ; ... and store inπBufEnd field}π $31/$C0/ { xor ax,ax ;Return 0 ==> noπerrors}π $1F/ {Error: pop ds ;Restore ds value}π $89/$46/$FE); { mov [bp-2],ax ;Store returned value}πEnd {ReadText};ππFunction WriteText(Var F : TextRec) : Word;πBeginπ Inline(π $1E/ { push ds ;Save value of dataπseg register}π $C5/$76/$06/ { lds si,[bp+6] ;DS:SI points toπTextRec structure}π $AD/ { lodsw ;Pick up file handle}π $89/$C3/ { mov bx,ax ; ... and store in BX}π $81/$C6/$06/$00/ { add si,6 ;DS:SI points toπBufPos field}π $AD/ { lodsw ;Pick up # of bytes toπwrite}π $89/$C1/ { mov cx,ax ; ... and store in CX}π $46/ { inc si}π $46/ { inc si ;DS:SI points toπBufPtr field}π $AD/ { lodsw ;Pick up offset partπof buffer addr.}π $89/$C2/ { mov dx,ax ; ... and store in DX}π $AD/ { lodsw ;Pick up segment partπof buffer addr.}π $8E/$D8/ { mov ds,ax ; ... and store in DS}π $B4/$40/ { mov ah,$40 ;DOS write file/deviceπfunction}π $CD/$21/ { int $21 ;Call DOS}π $72/$0B/ { jc Error ;Error if Carry Flagπis set on return}π $31/$C0/ { xor ax,ax ;Clear AX to zero}π $C4/$7E/$06/ { les di,[bp+6] ;ES:DI points toπTextRec structure}π $81/$C7/$08/$00/ { add di,8 ;ES:DI points toπBufPos field}π $AB/ { stosw ;Reset BufPos to zero}π $AB/ { stosw ;Reset BufEnd to zero}π $1F/ {Error: pop ds ;Restore data segπregister}π $89/$46/$FE); { mov [bp-2],ax ;Store functionπresult}πEnd {WriteText};ππFunction DoNothing(Var F : TextRec) : Word;πBeginπ Inline(π $C7/$46/$FE/$00/$00); { mov word [bp-2],0}πEnd {DoNothing};ππFunction SeekEofText(Var F : TextRec) : Word;πBeginπ Inline(π $1E/ { push ds ;Save DataπSeg register}π $C4/$7E/$06/ { les di,[bp+6] ;ES:DIπpoints to the TextRec}π $26/$8B/$1D/ { es: mov word bx,[di] ;Fileπhandle into BX}π $31/$C9/ { xor cx,cx ;CX:DX =πOffset for Seek function}π $89/$CA/ { mov dx,cx ;With AL=2πand CX:DX=0, will seek eof}π $B8/$02/$42/ { mov ax,$4202}π $CD/$21/ { int $21 ;DX:AXπshould now contain filesize}π $72/$7B/ { jc Error}π $2D/$80/$00/ { sub ax,128π;Reposition to read the last 128 bytes of}π $81/$DA/$00/$00/ { sbb dx,0 ;the fileπ(or as much as we can)}π $79/$04/ { jns NonNeg ;If lessπthan 128 chars in file}π $31/$C0/ { xor ax,ax ; thenπjust read from beginning}π $89/$C2/ { mov dx,ax}π $89/$D1/ {NonNeg: mov cx,dx ;Set upπfor Seek function}π $89/$C2/ { mov dx,ax ;CX:DX =πAbsolute position to seek}π $26/$89/$55/$20/ { es: mov word [di+32],dx ;Save inπUserData field for later}π $26/$89/$4D/$22/ { es: mov word [di+34],cx}π $26/$8B/$1D/ { es: mov word bx,[di] ;Fileπhandle in BX}π $B8/$00/$42/ { mov ax,$4200 ;Dos seekπ(absolute) function}π $CD/$21/ { int $21}π $72/$58/ { jc Error}π $06/ { push es ;Set upπfor call to read by pushing}π $57/ { push di ;TextRecπaddress onto stack}π $FF/$1E/>READTEXT_ADDR/ { call far [>ReadText_Addr] ;Read theπfile}π $09/$C0/ { or ax,ax ;Anyπerrors?}π $75/$4E/ { jnz Error}π $C5/$76/$06/ { lds si,[bp+6] ;Use DS:SIπas TextRec ptr}π $8B/$4C/$0A/ { mov word cx,[si+10] ;CX = #πbytes read}π $E3/$44/ { jcxz Done ;If 0πbytes read, then we're done}π $8B/$44/$0C/ { mov word ax,[si+12] ;BufPtrπoffset}π $89/$C7/ { mov di,ax ;ES:DIπwill point at the buffer of data}π $4F/ { dec di ; thatπwas just read in}π $01/$CF/ { add di,cx}π $8B/$44/$0E/ { mov word ax,[si+14]}π $8E/$C0/ { mov es,ax}π $B0/$1A/ { mov al,$1A}π $FD/ { std}π $F2/$AE/ { repnz scasb ;Searchπbuffer for a ^Z}π $FC/ { cld}π $75/$2F/ { jnz Done ;If no ^Zπfound, then we're done}π $C4/$7E/$06/ { les di,[bp+6] ;Back toπusing ES:DI for TextRec}π $1F/ { pop ds ;Point DSπback at global variable segment}π $1E/ { push ds ;But pushπback for final pop}π $89/$C8/ { mov ax,cx ;ax=offsetπin buffer at which ^Z was found}π $26/$8B/$55/$20/ { es: mov word dx,[di+32] ;Retrieveπsaved file ptr pos.}π $26/$8B/$4D/$22/ { es: mov word cx,[di+34]}π $01/$C2/ { add dx,ax ;Add inπoffset of ^Z}π $81/$D1/$00/$00/ { adc cx,0}π $26/$8B/$1D/ { es: mov word bx,[di] ;fileπhandle back in BX}π $B8/$00/$42/ { mov ax,$4200 ;Againπwith the Seek function}π $CD/$21/ { int $21π;Reposition file pointer to ^Z char}π $72/$12/ { jc Error}π $26/$C7/$44/$08/$00/$00/ { es: mov word [si+8],0 ;BufPos=0π(write 0 bytes to truncate ...}π $06/ { push es ; ... theπfile at the ^Z)}π $57/ { push di ;Setup forπcall to write routine}π $FF/$1E/>WRITETEXT_ADDR/ { call far [>WriteText_Addr]}π $09/$C0/ { or ax,ax ;Anyπerrors}π $75/$02/ { jnz Error}π $31/$C0/ {Done: xor ax,ax ;Return 0πif no errors}π $1F/ {Error: pop ds}π $89/$46/$FE); { mov [bp-2],ax}πEnd {SeekEofText};ππFunction CloseText(Var F : TextRec) : Word;πBeginπ Inline(π $1E/ { push dsπ;Must preserve DS for return}π $C4/$7E/$06/ { les di,[bp+6]π;ES:DI is our ptr to the TextRec}π $26/$8B/$44/$02/ { es: mov ax,[si+2]π;Magic Number into AX}π $3D/>FMOUTPUT/ { cmp word ax,>fmOutputπ;File opened with Rewrite or Append?}π $75/$2D/ { jnz SkipEofπ;No, skip ^Z stuff}π $80/$3E/>WRITETEXTEOFCHAR/$01/ { cmp byte [>WriteTextEofChar],1π;Use ^Z to mark end of file?}π $75/$26/ { jnz SkipEofπ;No, skip ^Z stuff}π $26/$8B/$45/$0C/ { es: mov word ax,[di+12]π;Get address of output buffer}π $26/$8B/$5D/$0E/ { es: mov word bx,[di+14]}π $89/$C7/ { mov di,ax}π $8E/$C3/ { mov es,bxπ;ES:DI points to buffer now}π $B8/$1A/$00/ { mov ax,$1A}π $AB/ { stoswπ;Put a ^Z into the buffer}π $C4/$7E/$06/ { les di,[bp+6]π;Point ES:DI back at the TextRec}π $26/$C7/$45/$08/$01/$00/ { es: mov word [di+8],1π;Set BufPos to show 1 char to write}π $06/ { push esπ;Put TextRec Address onto stack}π $57/ { push di}π $FF/$1E/>WRITETEXT_ADDR/ { call far [>WriteText_Addr]π;Call Write routine to write the ^Z}π $09/$C0/ { or ax,axπ;Any problems with the write?}π $75/$1D/ { jnz Errorπ;Yes, exit with error code in AX}π $C4/$7E/$06/ { les di,[bp+6]π;ES:DI probably trashed in call}π {SkipEof:}π $26/$8B/$1D/ { es: mov bx,[di]π;File handle in BX}π $B8/$00/$3E/ { mov ax,$3E00π;Dos Close function}π $CD/$21/ { int $21π;Close the file}π $72/$10/ { jc Errorπ;If error, exit with code in AX}π $31/$C0/ { xor ax,ax}π $26/$89/$45/$08/ { es: mov word [di+8],axπ;Stuff zeros in BufPos and BufEnd}π $26/$89/$45/$0A/ { es: mov word [di+10],ax}π $26/$C7/$45/$02/>FMCLOSED/ { es: mov word [di+2],>fmClosedπ;Reset the magic number}π $1F/ {Error: pop ds}π $89/$46/$FE); { mov [bp-2],axπ;Store function result}πEnd {CloseText};ππFunction OpenText(Var F : TextRec) : Word;πBeginπ Inline(π $1E/ { push ds ;SaveπDS register}π $C4/$7E/$06/ { les di,[bp+6] ;ES:DIπis pointer to the TextRec structure}π $B4/$3D/ {Start: mov ah,$3D ;DOSπopen a file/device function}π $26/$81/$7D/$02/>FMOUTPUT/ { es: cmp word [di+2],>fmOutput ;Openπfor Rewrite?}π $75/$02/ { jnz OpenIt ;No,πskip next line}π $B4/$3C/ { mov ah,$3C ;DOSπcreate new/truncate old file}π $A0/>FILEMODE/ {OpenIt: mov al,[>FileMode] ;Putπuser specified access mode in AL}π $B9/$00/$00/ { mov cx,0 ;Fileπattribute (nothing special) in CX}π $8C/$C3/ { mov bx,es}π $8E/$DB/ { mov ds,bx}π $89/$FA/ { mov dx,di}π $81/$C2/$30/$00/ { add dx,48 ;DS:DXπpoints to asciiz filename}π $CD/$21/ { int $21 ;Openπthe file}π $1F/ { pop dsπ;Restore DS to segment with global vars}π $1E/ { push ds ; ...πand save back on stack for later}π $73/$15/ { jnc OpenOk ;If noπerrors, continue}π $3D/$02/$00/ { cmp ax,2 ;Fileπnot found?}π $75/$69/ { jnz Error ;No,πexit with error code in ax}π $26/$81/$7D/$02/>FMINOUT/ { es: cmp word [di+2],>fmInOut ;Openedπfor Append?}π $75/$61/ { jnz Error ;No,πexit with error code in ax}π $26/$C7/$45/$02/>FMOUTPUT/ { es: mov word [di+2],>fmOutput ;Noπexisting file to append ...}π $EB/$C9/ { jmp short Start ; ...πso try again with Rewrite}π $AB/ {OpenOk: stosw ;Storeπfile handle (in AX) into TextRec}π $BE/>CLOSETEXT_ADDR/ { mov si,>CloseText_Addr ;DS:SIπpoints at addr. of CloseText fn.}π $81/$C7/$1A/$00/ { add di,26 ;ES:DIπpoints to CloseFunc field}π $B9/$02/$00/ { mov cx,2 ;Doubleπword address to move}π $F2/$A5/ { rep movsw ;Storeπaddress into CloseFunc field}π $C4/$7E/$06/ { les di,[bp+6] ;ES:DIπback to pointing at TextRec}π $26/$81/$7D/$02/>FMINOUT/ { es: cmp word [di+2],>fmInOut ;Openedπwith Append?}π $75/$13/ { jnz NoSeek ;No,πskip the search for ^Z}π $06/ { push es ;Set upπstack for call to SeekEofText}π $57/ { push di ;Addrπof TextRec goes on the stack}π $FF/$1E/>SEEKTEXT_ADDR/ { call far [>SeekText_Addr] ;Getπrid of any ^Z at end of file}π $09/$C0/ { or ax,ax ;Anyπerrors?}π $75/$37/ { jnz Error ;Yes,πexit with error code in AX}π $C4/$7E/$06/ { les di,[bp+6]π;Restore ptr to TextRec trashed in call}π $26/$C7/$45/$02/>FMOUTPUT/ { es: mov word [di+2],>fmOutput ;ResetπTextRec mode to show output only}π {NoSeek:}π $26/$C7/$45/$08/$00/$00/ { es: mov word [di+8],0 ;SetπBufPos to 0}π $26/$C7/$45/$0A/$00/$00/ { es: mov word [di+10],0 ;SetπBufEnd to 0}π $26/$81/$7D/$02/>FMINPUT/ { es: cmp word [di+2],>fmInput ;Openedπwith reset?}π $74/$05/ { jz InFunc ;Yes,πset pointers accordingly}π $BE/>WRITETEXT_ADDR/ { mov si,>WriteText_Addr ;DS:SIπ--> Address of WriteText func.}π $EB/$03/ { jmp short SetFunc ;Go setπTextRec function pointers}π $BE/>READTEXT_ADDR/ {InFunc: mov si,>ReadText_Addr ;DS:SIπ--> Address of ReadText func.}π $81/$C7/$14/$00/ {SetFunc: add di,20 ;ES:DIπ--> InOutFunc field}π $B9/$02/$00/ { mov cx,2 ;Movingπa double word}π $51/ { push cx ;Saveπthis count for later}π $F2/$A5/ { rep movsw ;Storeπaddress of I/O routine}π $BE/>DONOTHING_ADDR/ { mov si,>DoNothing_Addr ;DS:SIπ--> Address of DoNothing func.}π $59/ { pop cx ;ES:DIπ--> FlushFunc field - move 2 words}π $F2/$A5/ { rep movsw ;Storeπaddress of flush routine}π $31/$C0/ { xor ax,ax ;Noπerrors, return a 0 to caller}π $1F/ {Error: pop dsπ;Restore DS register}π $89/$46/$FE); { mov [bp-2],ax ;Storeπfunction result}πEnd {OpenText};ππProcedure AssignText(Var F : Text; FileName : String);πVarπ I : Integer;πBeginπ With TextRec(F) do begin { Initialize textrec record }π Handle := $FFFF; { Set file handle to junk }π Mode := fmClosed; { Indicate the file is not yet open }π BufSize := SizeOf(Buffer); { Set size of default buffer (128) }π BufPtr := @Buffer; { Set up pointer to default buffer }π OpenFunc := @OpenText; { Set up pointer to OPEN function }π For I := 1 to Length(FileName) do { Set up asciiz filename }π Name[I-1] := FileName[I];π Name[Length(FileName)] := Chr(0);π End {with};πEnd {AssignText};ππBeginπ { Initialize global variable to suppress writing ^Z at the end of any }π { text file opened with Append or Rewrite. }π WriteTextEofChar := FALSE;ππ { Initialize internally used Address variables (pointers) }π ReadText_Addr := Addr(ReadText);π WriteText_Addr := Addr(WriteText);π SeekText_Addr := Addr(SeekEofText);π DoNothing_Addr := Addr(DoNothing);π CloseText_Addr := Addr(CloseText);πEnd {Unit TxtShare}.ππ{$F-}ππ{end}π 29 01-27-9412:11ALL SADHUNATHAN NADESAN Formatting IMPORT 38 F╔ {π| From: Scott Stone <pslvax!ucsd!u.cc.utah.edu!ss8913>π|π| This may sound like a simplistic request, but I need code to do theπfollowing:ππ not really trivial, although its not hardπ|π| Take a standard 80-column textfile and reformat it (w/ correctπ| wordwrapping) to be a new text file with lines of specified length (ie,π| 40, 50, 60, etc). Can anyone tell me how to do this (w/o truncatingπ| lines, and w/o splitting words)?ππ anyway, the following program may fill your needs as isπ its for dos, of course, ..π (just change the constant max_wid to 40, 50, 60 etc), or,π at least, it will give you a head start on writing a programπ for yourself.π}ππ{*************************************************************************πProgram reformatπby Sadunathan Nadesanπ6/9/89ππFormats a file into paragraphs suitable for sending via MCIππUsage: (on MS Dos) % reformat < filename > outfilenameππ*************************************************************************}ππprogram reformat(input,output);ππconstπ max_wid = 80; {all output lines are less than this}π {change this for different sized lines}πtypeπ i_line = string; {input line buffer type}π o_line = string; {input line buffer type}π ref = ^node;π node = recordπ word : string;π next : ref;π end;πvarπ root : ref; {beginning of sized line}π tail : ref; {pointer to last record in list}π line : i_line; {input buffer}π{------------------------------------------------------------------------}ππfunction end_of_paragraph (buffer : i_line): boolean;π{detect the end of a paragraph}πbeginπif (length(buffer) > 0) thenπ end_of_paragraph := FALSEπelseπ end_of_paragraph := TRUE;πend;ππ{------------------------------------------------------------------------}πprocedure store_words ( buffer : i_line );π{ **********************************************************π create a single linked list of all the words in a paragraph)π this is called anew for every line of the paragraph, butπ uses a global linked list that it keeps working with.ππ input paramters are buffer = the input lineπ uses global variables root and tailπ ********************************************************** }πvarπ insize : integer; {size of input line}π b_counter : integer; {position marker in input buffer}π p : ref; {word record}πbeginπinsize := length(buffer);πb_counter := 1;πif not (end_of_paragraph(buffer)) then {if not an empty line}π repeat {for each word in the input line}π beginπ new (p); {make a bucket for the word}π with p^ doπ beginπ next := nil;π word := '';π repeatπ beginπ if (buffer[b_counter] <> ' ') thenπ word := concat(word, buffer[b_counter]);π b_counter := b_counter + 1;π end;π until ((buffer[b_counter] = ' ') or (b_counter > insize));π end;π if (root = nil) then {this is the first word in the par.}π beginπ root := p;π tail := p;π endπ else {attach this word to the list of words}π beginπ tail^.next := p;π tail := p;π end;π end; {repeat 1}π until (b_counter > insize);πend; {store_words}ππ{------------------------------------------------------------------------}πprocedure format_output( p : ref );π{ **********************************************************π dump a single linked list of all the words in a paragraphπ out into lines of <= max_wid charactersππ input paramters is p = root, the starting record of the linked word listπ uses global variable lineππ ********************************************************** }πvarπ pretty : o_line; {output buffer}π one_more : boolean;πbeginπone_more := false;πpretty := '';πwhile (p^.next <> nil) doπ beginπ if (length(p^.word) + length(pretty) + 1 < max_wid) thenπ beginπ pretty := concat (pretty, p^.word);π pretty := concat (pretty, ' ');π p := p^.next;π endπ elseπ beginπ writeln(pretty);π pretty := '';π end;ππ if (p^.next = nil) then {for the last word!}π if (length(p^.word) + length(pretty) + 1 < max_wid) thenπ pretty := concat (pretty, p^.word)π elseπ one_more := true;π end;ππif (length(pretty) > 0) then {get the last line}π writeln(pretty);πif (one_more) thenπ writeln(p^.word);πend;π{------------------------------------------------------------------------}ππbeginπroot := nil;πrepeatπ repeatπ beginπ readln(input, line);π store_words ( line);π end;π until (end_of_paragraph(line));ππ if (root <> nil) thenπ beginπ format_output(root);π writeln;π root := nil;π end;ππuntil (eof(input));πend.π 30 01-27-9412:25ALL VINCE LAURENT Word Wrapping IMPORT 23 F╔ {π> ..Well.. I am back at writing a chat door for the third time.. and amπ> havin trouble with wrapping the text. It seems that when it wraps theπ> text to the next line it won't remove the text on the previous line,π> and sometimes it won't wrap at all.. I don't have very dependable codeπ> for this purpose so any help code is appreciated.. (I am using RMdoorπ> 4.2 right now..anybody seen anything better??).ππHope this helps...π}π{$R-,S-,I+,D+,F-,V+,B-,N-,L+ }π{$M 2048,0,0 }ππPROGRAM WordWrap(INPUT,OUTPUT);πUSES CRT;ππCONSTπ FKeyCode = #0;π Space = ' ';π Hyphen = '-';π BackSpace = ^H;π CarriageReturn = ^M;π MaxWordLineLength = 80;ππVARπ WordLine : STRING[MaxWordLineLength];π Index1 : BYTE;π Index2 : BYTE;π InputChar : CHAR;ππBEGINπ WordLine := '';π Index1 := 0;π Index2 := 0;π InputChar := Space;ππ AssignCRT(INPUT);π AssignCRT(OUTPUT);π Reset(INPUT);π ReWrite(OUTPUT);π Writeln('Enter text (ENTER to stop) : ');ππ InputChar := READKEY;ππ {Do the job.}π WHILE (InputChar <> CarriageReturn) DOπ BEGINπ CASE InputChar OFπ BackSpace: {write destructive backspace & remove char from WordLine}π BEGINπ Write(OUTPUT,BackSpace,Space,BackSpace);π Delete(WordLine,(LENGTH(WordLine) - 1),1)π END;π FKeyCode: {user pressed a function key, so dismiss it}π BEGINπ InputChar := READKEY; {function keys send two-char scan code!}π InputChar := Spaceπ ENDπ ELSE {InputChar contains a valid char, so deal with it}π BEGINπ Write(OUTPUT,InputChar);π WordLine := (WordLine + InputChar);π IF (Length(WordLine) >= (MaxWordLineLength - 1)) THENπ {we have to do a word-wrap}π BEGINπ Index1 := (MaxWordLineLength - 1);π WHILE ((WordLine[Index1] <> Space)π AND (WordLine[Index1] <> Hyphen) AND (Index1 <> 0))π DO Index1 := (Index1 - 1);π IF (Index1 = 0)π THEN {whoah, no space was found to split line!}π Index1 := (MaxWordLineLength - 1); {forces split}π Delete(WordLine,1,Index1);π FOR Index2 := 1 TO LENGTH(WordLine) DOπ Write(OUTPUT,BackSpace,Space,BackSpace);π Writeln(OUTPUT);π Write(OUTPUT,WordLine)π ENDπ ENDπ END; {CASE InputChar}π {Get next key from user.}π InputChar := READKEYπ END; {WHILE (InputChar <> CarriageReturn)}ππ {Wrap up the program.}π Writeln(OUTPUT);π Writeln(OUTPUT);π Close(INPUT);π Close(OUTPUT)πEND.π 31 02-03-9407:07ALL DON BURGESS Reading a Text File IMPORT 48 F╔ {πAfter much trial and error, and finding some helpful code from the SWAGπsupport team (thanks!) this is what I came up with. It can handle textπfiles up to 750,000 bytes and does basically what I'm looking for, butπthe scrolling isn't as smooth as it should be. Also, the lines ofπtext are limited to 79 characters... (The source code can probably beπstreamlined a lot too, like I said, I'm fairly new at this...)π}ππ Program Reader;ππ uses Crt, 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 }πππ Procedure HideCursor; assembler;π asmπ mov ah,$01 { Function number }π mov ch,$20π mov cl,$00π Int $10 { Call BIOS }π end; { HideCursor }πππ Procedure RestoreCursor; assembler;π asmπ mov ah,$01 { Function number }π mov ch,$06 { Starting scan line }π mov cl,$07 { Ending scan line }π int $10 { Call BIOS }π end; { RestoreCursor }πππ Varπ TxtFile : text;π s : string[79];π Cee : CHAR;ππ Label RWLoop, Final, FileSizeError, WrongKey, NoParamError;ππ Varπ Size : Longint;π YY, GG, Counter : LongInt;π LineNumArray : Array[0..15000] Of LongInt;π MyText : Array[0..23] Of String[79];π InstructStr : String[79];π OrigColor, ColorSwitch : Integer;π LineNo : String[5];π Beginπ OrigColor := TextAttr;π TextColor(11);π TextBackground(1);π InstructStr := 'Scroll (^) up - (v) down - (Page up/down) - (Home) - (End) - (ESC) Quit';π If ParamStr(1) = '' Then GoTo NoParamError;π Assign(TxtFile, ParamStr(1)); {'TEXTFILE.DOC';}π Reset(TxtFile);π Counter := -1;π ClrScr;π HideCursor;π If (TextFileSize(TxtFile)) >= 750000 Then GoTo FileSizeError;π While Not EOF(TxtFile) Doπ Beginπ Inc(Counter,1);π LineNumArray[Counter] := TextFilePos(TxtFile);π ReadLn(TxtFile);π End;π Inc(Counter,1);π YY:=0;πππ RWLoop:π For GG:=0+YY TO 23+YY DOπ Beginπ TextSeek(TxtFile,LineNumArray[GG]);π ReadLn(TxtFile,S);π MyText[GG-YY]:=S;π End;π GoToXY(1,1);π ColorSwitch := TextAttr;π Str(yy+23:5,LineNo);ππ Repeat Until Port[$3DA] And 8 = 8; { Wait For Vertical retrace }ππ For GG:=0 TO 23 DOπ Beginπ ClrEOL;π WriteLn(MyText[GG]);π End;π GoToXY(2,25);π TextColor(14);π Write(LineNo);π GoToXY(8,25);π TextColor(15);π Write(InstructStr);π TextAttr:=ColorSwitch;ππ Delay(1);π WrongKey:π Repeatπ Until KeyPressed;π Cee := ReadKey;ππ If Cee=Chr(27) Then GoTo Finalπ Else If Cee=Chr(72) Then {UP ARROW}π Beginπ If YY>0 Then Dec(YY,1);π GoTo RWLoop;π Endπ Else If Cee=Chr(80) Then {DOWN ARROW}π Beginπ Inc(YY,1);π If YY>=Counter-23 Then YY:= Counter-24;π GoTo RWLoop;π Endπ Else If Cee=Chr(73) Then {PAGE UP}π Beginπ YY:=YY-24;π If YY<1 Then YY:=0;π GoTo RWLoop;π Endπ Else If Cee=Chr(81) Then {PAGEDOWN}π Beginπ YY:= YY+24;π If YY>=Counter-23 Then YY:= Counter-24;π GoTo RWLoop;π Endπ Else If Cee=Chr(71) Then {HOME}π Beginπ YY:=0;π GoTo RWLoop;π Endπ Else If Cee=Chr(79) Then {End}π Beginπ YY:= Counter-24;π GoTo RWLoop;π End;ππ GoTo WrongKey;ππ FileSizeError:π WriteLn;π WriteLn('ERROR...');π WriteLn;π WriteLn('File Size Larger Than 750,000');π GoTo Final;ππ NoParamError:π WriteLn;π WriteLn('ERROR...');π WriteLn;π WriteLn('Command line syntax is Reader C:\TextFile.txt');π GoTo Final;ππ Final:π Close(TxtFile);π TextAttr := OrigColor;π RestoreCursor;π ClrScr;π End.π 32 02-03-9416:18ALL MIKE CHAMBERS Parse file by words IMPORT 19 F╔ πprogram ReadWord;πuses dos,crt;πConstπ delimiters = ' ,./?;:"[]{}!';π CrLf = #13#10;πtypeπ tfilename = string;π word_type = string;π wp_type = ^word_type;ππvarπ i : word;π filter : string;π sr : searchrec;π path : pathstr;π dir : dirstr;π fname : namestr;π ext : extstr;π Lines : word;πππprocedure ShowSyntax;πbeginπ writeln('USAGE OBJDIC <input fileset> ');π writeln(' ');π writeln(' <input fileset> is a DOS filename (wildcards allowed) ');π writeln(' ');π writeln(' ');π writeln('Example OBJDIC *.TXT ');π halt;πend;πππfunction GetNextWord (buf:string; apos:byte; var aword:word_type; var delim:string) : byte;πvar i,j,ch: byte;πbeginπ i := apos;π while (i <= length(buf)) and (pos(buf[i],delimiters) = 0) do inc (i);π aword := copy(buf,apos, i - apos);π j:= i;π while (i <= length(buf)) andπ ( ( (upcase(buf[i]) < 'A') or (upcase(buf[i]) > 'Z') ) andπ ( (buf[i] < '0' ) or (buf[i] > '9' ) ) )π do inc(i);π delim := copy(buf,j,i-j);π if i = length(buf) then i := 0;π GetNextWord :=i;πend;ππππprocedure scanfile(filename : string);πvarπ infile : text;π inbuf : string;π aword : word_type;π adelim : word_type;π len : byte;π inpos : byte;π index : word;ππbeginπ path := fexpand(filename);π fsplit(path,dir,fname,ext);π assign(infile,path);π reset(infile);π clrscr;π lines:=0;π writeln('Scanning ',filename);π while not eof(infile) do beginπ readln(infile,inbuf); inc(lines);π inpos := 1;π while (inpos < length(inbuf)) and (inpos <> 0) do beginπ inpos := GetNextWord(inbuf,inpos,aword,adelim);π if length(aword) > 0 then write(aword);π if length(adelim) > 0 then write(adelim);π end;π writeln;π end;π close(infile);π writeln;π end;ππ beginπ filter := Paramstr(1);π FindFirst(Filter,AnyFile,sr);π while DosError = 0 do with sr do beginπ scanfile(fexpand(name));π FindNext(sr);π end;π end.π 33 02-05-9407:57ALL STEVEN KERR Text File Parser IMPORT 36 F╔ π{╔═══════════════════════════════════════════════════════════════════╗}π{║ TEMPLATE - Text File Parser ║}π{║ Steven Kerr, 1994 ║}π{║ ║}π{║ Syntax : TEMPLATE Input Output ║}π{║ ║}π{║ Where Input = Input File ║}π{║ Output = Output File ║}π{╚═══════════════════════════════════════════════════════════════════╝}π{$M 8192, 0, 0}πProgram Template;πUses DOS;πConstπ Null : String = '';π LeftControl : Char = '<'; { Left hand control character }π RightControl : Char = '>'; { Right hand control character }πVarπ InputFile, OutputFile : Text;π Checked, Error : Boolean;ππFunction Upper (Parameter : String) : String;πVarπ I : Integer;πbeginπ for I := 1 to Length(Parameter) doπ Parameter[I] := UpCase(Parameter[I]);π Upper := Parameterπend {Function Upper};ππFunction File_Exists (Filename : String) : Boolean;πVarπ Attr : Word;π F : File;πbeginπ Assign(F, Filename);π GetFAttr(F, Attr);π File_Exists := (DOSError = 0)πend { Function FileExists };ππProcedure Display_Error (Message : String; Filename : String);πbeginπ Writeln;π Writeln('TEMPLATE - Text File Parser');π Writeln(' Steven Kerr, 1994');π Writeln;π Writeln('Syntax : TEMPLATE Input Output');π Writeln;π Writeln(' Where Input = Input File');π Writeln(' Output = Output File');π Writeln;π Writeln('Error : ', Message, Filename)πend { Procedure Display_Help };ππFunction Check_Variable (Variable : String; Position : Byte) : Byte;πVarπ Valid : Boolean;πbeginπ Valid := False;π { Add in addition variables as below. If Valid = False, the variable }π { is ignored and written "as is". }π if Upper(Variable) = LeftControl + 'DISKFREEC' + RightControl then beginπ Valid := True;π Write(OutputFile, DiskFree(3))π end { DiskFreeC };π {}π Checked := True;π if Valid thenπ Check_Variable := Position + Length(Variable) - 1π elseπ Check_Variable := Position - 1πend { Function Check_Variable };ππFunction Look_Ahead (Line : String; Position : Byte) : String;πVarπ Variable : String;πbeginπ Variable := Line[Position];π While (Length(Line) <> Position) andπ (Line[Position] <> RightControl) do beginπ Inc(Position);π Variable := Variable + Line[Position]π end { While };π Look_Ahead := Variableπend { Function Look_Ahead };ππProcedure Parse_File;πVarπ Line : String;π Position : Byte;πbeginπ Position := 0;π Checked := False;π While (not EOF(InputFile)) do beginπ Readln(InputFile, Line);π While Position < Length(Line) do beginπ Inc(Position);π if (Line[Position] = LeftControl) and (not Checked) then beginπ Position := Check_Variable(Look_Ahead(Line, Position), Position)π end else beginπ Write(OutputFile, Line[Position]);π Checked := Falseπ end { if }π end { While };π Position := 0;π Checked := False;π Writeln(OutputFile)π end { While }πend { Procedure Parse_File };ππFunction Files_Opened (InputF : String; OutputF : String) : Boolean;πVarπ Error : Boolean;πbeginπ Error := False;π Assign(InputFile, ParamStr(1));π Assign(OutputFile, ParamStr(2));π {$I-} ReWrite(OutputFile); {$I+}π if IOResult <> 0 then beginπ Display_Error('Unable to write to ', Upper(ParamStr(2)));π Error := Trueπ end { if IOResult };π if (not Error) then beginπ {$I-} Reset(InputFile); {$I+}π if IOResult <> 0 then beginπ Display_Error('Unable to read from ', Upper(ParamStr(1)));π Error := Trueπ end { if IOResult }π end { if };π Files_Opened := (not Error)πend { Function Files_Opened };ππbegin { Program Template }π if ParamCount = 2 then beginπ if File_Exists(ParamStr(1)) then beginπ if (not File_Exists(ParamStr(2))) then beginπ if Files_Opened(ParamStr(1), ParamStr(2)) then beginπ Parse_File;π Close(InputFile);π Close(OutputFile)π endπ end elseπ Display_Error('Output file already exists', '')π end elseπ Display_Error('Input file not found', '')π end elseπ Display_Error('Invalid number of parameters', '')πend { Program Template }.π 34 05-25-9408:23ALL ROWAN MCKENZIE Text file position SWAG9405 29 F╔ {π JK> I've started out in Pascal and need some information on howπ JK> to read from a certain point in a file, say line 3. Howπ JK> would I set the pointer to line 3 to read into a variable?ππ BvG> A seek does not work on textfiles.ππ Here, this will assist you. originally in a Pascal Newsletter, so it mustπ be PD.ππ---------------------------------------- CUT HERE --------------------------π}πUnit TextUtl2; (* Version 1.0 *)ππ{Lets you use typed-file operators on TEXT files. Note that I've cut out MOST}π{of the documentation so as to make it more practical for the PNL. I strongly}π{advise that you get in touch with the author at the address below (I haven't)}π{It's called TEXTUTL2 because it's a rewrite of an earlier unit called }π{TEXTUTIL which had some nasty limitations. }ππ{Both files can be FREQed from 3:634/384.0 as TEXTUT*.*, and I strongly }π{recommend that you do so. }ππ{I tried looking up the author's telephone number, but Telecom says the number}π{is silent. Oh well. }ππ{If you're having trouble, netmail me (Mitch Davis) at 3:634/384.6 }πππ(*πAuthor: Rowan McKenzie 28/12/88π 35 Moore Ave, Croydon, Vic, AustraliaππThese 3 routines are improvements to Tim Baldock's TEXTUTIL.PAS unit.πI can be contacted on: Eastwood, Amnet or Tardis BBS (Melbourne Australia)π*)ππInterfaceππUses Dos;ππProcedure TextSeek (Var F : Text; Offset : Longint);πFunction TextFileSize (Var F : Text): LongInt;πFunction TextFilePos (Var F : Text): LongInt;ππImplementationππProcedure TextSeek(Var F : Text; Offset : Longint);ππ{ seek char at position offset in text file f}ππvar BFile : File of byte absolute F; (* Set up File for Seek *)π BFileRec : FileRec absolute Bfile;π TFileRec : TextRec Absolute F;π OldRecSize : Word;π oldmode : word;ππBeginπ With BfileRec do Beginπ oldmode:=mode;π Mode := FmInOut; (* Change file mode so Turbo thinks it is *)π OldRecSize := RecSize; (* dealing with a untyped file. *)π RecSize := 1; (* Set the Record size to 1 byte. *)π Seek(Bfile,Offset); (* Perform Seek on untyped file. *)π Mode := oldmode; (* Change file mode back to text so that *)π RecSize := OldRecSize; (* normal text operation can resume. *)π end;π TfileRec.BufPos := TfileRec.BufEnd; (* Force next Readln. *)πend; {textseek}ππFunction TextFileSize(Var F : Text): LongInt;ππ{ determine size of text file f in bytes}ππvar BFile:File of byte absolute F;π BFileRec:FileRec absolute Bfile;π OldRecSize:Word;π oldmode:word;ππBeginπ With BfileRec do Beginπ oldmode:=mode;π Mode := FmInOut;π OldRecSize := RecSize;π RecSize := 1;π TextFileSize := FileSize(Bfile);π Mode := oldmode;π RecSize := OldRecSize;π end;πend; {textfilesize}πππFunction Textfilepos(Var F : Text): LongInt;ππ{ determine current position (in bytes) in text file f}ππvar BFile:File of byte absolute F;π BFileRec:FileRec absolute Bfile;π TFileRec:TextRec Absolute F;π OldRecSize:Word;π oldmode:word;ππBeginπ With BfileRec do Beginπ oldmode:=mode;π Mode := FmInOut;π OldRecSize := RecSize;π RecSize := 1;π textfilepos := Filepos(Bfile)-tfilerec.bufend+tfilerec.bufpos;π Mode := oldmode;π RecSize := OldRecSize;π end;πend; {textfilepos}ππend.π 35 05-25-9408:23ALL WILBERT VAN LEIJEN Positioning Text File SWAG9405 21 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 }ππ 36 05-25-9408:24ALL KIMMO FREDRIKSON Linking text file w/com..SWAG9405 19 F╔ {ππ This is not related to the original topic ".. w/exe!!", butπ if somebody is interested, at least I found this one a bitπ excited piece of code. It makes an executable com-file fromπ your text and you can easily extend it to the limits youπ need. Just remember that you can't call any pascal routines,π you have to write it in pure assembler. (would .80xxx have beenπ a better area..?) Anyway, here it is:ππ --!clip!-- { Code by Kimmo Fredrikson }ππ {$A+,D-,G-,I-,R-,S-}ππ program txt2com;ππ varπ src : file;π dst : file;π buff : array [0..2047] of byte;π bytesRead : word;π bytesWritten : word;π fSize : word;πππ function t2c: word; far; assembler;π asmπ jmp @tail { 2 bytes }ππ @head:mov ax, 0003h { -- here starts the code part of }π int 10h { the txt-show-proggie.. }ππ mov cx, word ptr [@tail+100h-2] { length of text }π lea si, [@tail+100h-2+2] { address of txt }ππ @nxtC:mov dl, [si] { read a character to dl }π mov ah, 2π int 21hπ inc siπ loop @nxtCππ mov ax, 4c00hπ int 21h { terminate, back to dos }ππ @tail:mov ax, offset [@tail] { length of t2c }π sub ax, offset [@head] { this returns the length of the }π end; { assembler code when called within this pascal }π { program }π beginπ if paramCount <> 2 then halt;π assign (src, paramStr (1));π assign (dst, paramStr (2));π reset (src, 1);π if ioResult <> 0 then halt;π if fileSize (src) > 64000 then halt;π fSize := fileSize (src) - 1; { get rid of the ctrl-z }π reWrite (dst, 1);π if ioResult <> 0 then halt;π blockWrite (dst, pointer (longint (@t2c) + 2)^, t2c); { the code }π blockWrite (dst, fSize, 2); { the length of text }π repeatπ blockRead (src, buff, 2048, bytesRead);π blockWrite (dst, buff, bytesRead, bytesWritten); { the text }π until (bytesRead = 0) or (bytesWritten <> bytesRead);π close (src);π close (dst);π end.π 37 05-26-9406:18ALL SCOTT F. EARNEST UNIX/Dos Text Converter IMPORT 73 F╔ {πI've gotten a couple requests for this source, which quasi-intelligentlyπconverts Unix-format text to DOS-format text and vice versa. Recently,πI justπadded a better command-line interpreter, and cleaned it up a little. I wasπhoping to get around to using untyped files instead of text files, but maybeπlater.ππThis is probably not the most graceful (and since it uses text files,πnot the fastest way to do this), but it's worked well for me.πSuggestions on how to improve are welcome.ππ-Scott E.πtiobe@cmu.eduπ------------------------------------------------------------------}πprogram SConvert;π π{Smart-converts UN*X/DOS format filesπ π Usage: sconvert infile [outfile] [/U | /D]π [/U forces unix, /D forces DOS, if forced type, do nothing.]ππ -- or --π π sconvert /? (-?, /h, -h, /H, and -H analogous)π for help messageπ π This program is capabable of having its output piped, providedπ it is the first in the pipeline. Since it opens input twice,π using it anywhere in a pipe besides the beginning probably won'tπ work well.π π Written by Scott F. Earnest, Aug 1993π Original version: 30 Aug 1993π Updated version: 9 May 1994 (Added force flags.)π}π πuses Crt;π πconstπ CR = chr(13); {Carriage Return}π LF = chr(10); {Line Feed}π πtypeπ sys = (dos,unix,bad); {system identifier}π πvarπ sysID : sys; {system identifier for case branch}π infile, outfile : string; {input/output files}π force : sys; {What mode to work in.}π πfunction exist (filename : string) : boolean;π π{Check if a file exists or notπ returns: true --> file existsπ false --> file non-existent}π πvarπ openfile : text;π errcode : integer;π πbeginπ {$I-} {Turn off error-checking}π assign (openfile, filename);π reset (openfile);π {$I+} {Turn it back on}π errcode := IOResult; {Get error code}π if errcode <> 0 then {There's an error if non-zero}π exist := false {So flag that it doesn't exist.}π elseπ beginπ close (openfile); {Otherwise, close file}π exist := true; {Flag that it does exist}π end;πend;ππfunction selectyn : boolean;π π{Get a yes/no single-keypress responseπ returns: true --> yes response, y or Yπ false --> no response, n or N}π πvarπ getchar : char; {Need something to read into}π πbeginπ while KeyPressed do {Clean keyboard buffer}π getchar := ReadKey;π repeat {Get a key until it's a (Y)es or (N)o.}π getchar := ReadKey;π getchar := upcase (getchar);π until (getchar in ['Y', 'N']);π writeln (getchar); {Print the response}π case getchar of {Tell it what it should return}π 'Y' : selectyn := true;π 'N' : selectyn := false;π end;πend;π πprocedure help (badflag : boolean);π π{brief message if command format was abused}π πbeginπ writeln ('SmartConvert, Written by Scott F. Earnest -- v1.3 -- 9 May 1994');π writeln;π if badflag thenπ beginπ writeln ('Invalid flag.');π writeln;π end;π writeln ('Usage');π writeln (' sconvert infile [outfile] [/d | /u]');π writeln;π writeln ('Use /d to force conversion to DOS, and /u to force UNIX.');π halt (1);πend;π πprocedure incheck (filename : string);π π{Make sure source exists, if specified}π πbeginπ if not (exist (filename)) thenπ beginπ writeln ('Source file does not exist!');π halt (3);π end;πend;π πprocedure outcheck (filename : string);π π{Make sure target does NOT exist, if specified, allow overwrite}π πvarπ select : boolean;π πbeginπ if exist (filename) and (filename <> '') thenπ beginπ write ('Target file exists! Overwrite? [y/n] ');π select := selectyn;π case select ofπ true : ;π false : halt (4);π end;π end;πend;π πfunction checktype (readfile : string) : sys;π πvarπ FileCheck : text;π checkvar : sys;π CROk, LFOk : boolean;π ReadBuf : char;π πbeginπ CROk := False;π LFOk := False; {Init flags.}π checkvar := bad; {Assume that type isn't known.}π assign (FileCheck, readfile);π reset (FileCheck);π while (not eof(FileCheck)) and (not CROk) and (not LFOk) doππ begin {Look for CR or LF}π read (FileCheck, ReadBuf);π if ReadBuf = CR then {CR found?}π beginπ CROk := True; {If yes, set the CR flag.}π Read (FileCheck, ReadBuf); {and get next char}π if ReadBuf = LF then {next one a LF?}π LFOk := True; {Flag it as found.}π if CROk and LFOk then {So is it CR/LF?}π beginπ checktype := dos; {If yes, specify DOS, and exit.}π close (FileCheck);π exit;π end;π end;π if ReadBuf = LF then {Found a LF?}π beginπ checktype := unix; {If yes, assume unix.}π close (FileCheck); {Close and exit.}π exit;π end;π end;π if checkvar = bad then {If there was a problem:}π beginπ writeln ('Ambiguous file type. Can''t determine type.');π close (FileCheck);π halt(2);π end;πend;π πprocedure dos2unix (infile, outfile : string);π πvarπ intext, outtext : text;π ReadBuf1, ReadBuf2 : char;π πbeginπ writeln ('Converting DOS -> UNIX. . . .');π assign (intext, infile);π reset (intext);π assign (outtext, outfile);π rewrite (outtext);π while not eof(intext) doπ beginπ read (intext, ReadBuf1); {Get character}π if ReadBuf1 = CR then {If it's CR then. . . }π beginπ read (intext, ReadBuf2); {. . . get next . . .}π if ReadBuf2 = LF then {. . . and see if it's LF.}π write (outtext, LF) {If yes, just put LF into new file.}π elseπ write (outtext, ReadBuf1, ReadBuf2); {Not CR/LF, dump to file.}π endπ elseπ write (outtext, ReadBuf1); {Dump the character to file.}π end;π close (intext);π close (outtext);πend;π πprocedure unix2dos (infile, outfile : string);π πvarπ intext, outtext : text;π ReadBuf : char;π πbeginπ writeln ('Converting UNIX -> DOS. . . .');π assign (intext, infile);π reset (intext);π assign (outtext, outfile);π rewrite (outtext);π while not eof(intext) doπ beginπ read (intext, ReadBuf); {Get a character.}π if ReadBuf = LF then {Is it LF?}π write (outtext, CR+LF) {If yes, put a CR/LF in its place.}π elseπ write (outtext, ReadBuf); {Otherwise, replace the character.}π end;π close (intext);π close (outtext);πend;π πprocedure getcommandline;π π{get commandline info. . . .}π πvarπ pnum : byte; {paramater counter}π pstr : string[2]; {string snippet}π fname : string; {temporary string}π πbeginπ if (paramcount < 1) or (paramcount > 3) thenπ help (false); {too few, too many--show help}π infile := ''; {Init names.}π outfile := '';π force := bad;π for pnum := 1 to paramcount do {Do this in two passes.}π begin {#1.) Flags}π pstr := paramstr(pnum); {Get parameter.}π pstr[2] := upcase(pstr[2]);π if pstr[1] in ['-', '/'] then {Flag?}π case pstr[2] of π 'H', '?' : help (false); {Is help.}π 'D' : force := dos; {Is force DOS.}π 'U' : force := unix; {Is force UNIX.}π elseπ help (true); {Bad switch.}π end;π end;π for pnum := 1 to paramcount do {#2.) Filenames}π begin π fname := paramstr(pnum); {Get parameter.}π if not (fname[1] in ['-', '/']) thenπ begin {If not flag then}π if infile = '' then {Get infile}π infile := fnameπ else if (infile <> '') and (outfile = '') thenπ outfile := fname {Get outfile}π elseπ help (false); {Oops, too many.}π end;π end;πend;π πbeginπ getcommandline; {Parse parameters}π sysID := checktype (infile); {Check the input file type}π if sysID = force then {If it's getting forced, then}π begin {compare types and skip if same.}π write ('Input file is already type ');π case sysID ofπ dos : write ('DOS');π unix : write ('UNIX');π end;π writeln (', skipped.');π halt(5);π end;π case sysID ofπ dos : dos2unix (infile, outfile); {DOS -> UNIX}π unix : unix2dos (infile, outfile); {UNIX -> DOS}π bad : begin {Not likely to happen but. . . .}π writeln ('Internal error! Check source code and recompile.');π halt (6);π end;π end;πend.π 38 08-24-9413:54ALL JOSE CAMPIONE Faster READLN SWAG9408 AKR+ 20 F╔ {π I have been exploring a faster way to read lines from textπ files. This one seems to be 30% faster than readln even withπ a full settextbuffer of $FFFF. However, it only works forπ files smaller than 64K ($FFF1) and all lines, including theπ last one, must end in the CR/LF word (readln recognizes theπ EOF (01Ah) char also as an end of line). Please repost anyπ improvements. }ππ program readtext;ππ Uses CRT;ππ const π maxsize = $FFF0;π π typeπ barr = array[0..maxsize] of byte;π ptrbarr = ^barr;ππ varπ f : file;π s : string;π p : longint;π fsiz : longint;π fbuf : ptrbarr;π π function pos13(pnt:pointer): word; assembler;π asmπ les di,[pnt] {load pointer in es:di}π mov cx,$00FF {load maximum size to scan in cx}π mov bx,cx {save maximum size to scan in bx}π mov al,$0D {load in al byte to match = 0Dh}π cld {increment di}π repne scasb {search loop}π je @found {jump if found}π mov ax,0 {if not found report result = 0}π jmp @fin {goto end}π @found: {if found...}π sub bx,cx {get position matched}π mov ax,bx {report result = position matched}π @fin:π end;π π procedure readx(fbuf:ptrbarr;var s:string;var p:longint);π varπ q : word;π b : ptrbarr;π beginπ b:= addr(fbuf^[p]); {point to first byte in remaining block}π q:= pos13(b); {get position of first $0D occurence}π move(b^,s[1],pred(q)); {transfer preceeding bytes to string}π s[0]:= char(pred(q)); {assign size byte to Pascal string}π inc(p,succ(q)); {adjust pointer skipping 1 byte ($0A)}π end;ππ beginπ ClrScr;π if paramcount = 0 thenπ BEGINπ writeLn( 'Enter FILENAME on commandline');π halt;π END;π assign(f,paramstr(1));π reset(f,1);π fsiz:= filesize(f);π if fsiz > maxsize then halt;π getmem(fbuf,fsiz);π blockread(f,fbuf^,fsiz);π close(f);π p := 0; {initialize pointer to position in fbuf^}π while p < fsiz do beginπ readx(fbuf,s,p);π writeln(s);π end;π dispose(fbuf);π end.ππ 39 08-24-9417:50ALL WIM VAN DER VEGT Text File Objects SWAG9408 Bjúm 57 F╔ {πHere's a piece of code I wrote last year which does what wasn'tπuploaded. It allows text files converted to obj format to be linked inπand being accessed as 'normal' turbo pascal text files. The 'object'πtext files support reset, read, readln eof, eoln and close fileπcommands.ππWhat you need to write in your program is a obj_find function whichπtranslates filenames into pointers or returns NIL to indicate anπexternal file. Use Assign_text procedure instead. A sample of how toπuse it is supplied in the second program/unit. Only the two linked inπfiles will be fetched from memory, any other name supplied will beπfetched from disk as usual.ππThe first unit can be the same for all projects, the second one isπproject depended, because one will be using different files.ππQuestion about this, ask them!ππ}π{---------------------------------------------------------}π{ Project : Object linked textfiles }π{ By : Ir.G.W. van der Vegt }π{---------------------------------------------------------}π{ Datum .tijd Revisie }π{ 930914.2200 Creatie. }π{ 930915.2200 Support for Settextbuffer. Bufptr used }π{ again for addressing & pointer advancing }π{ adjusted. }π{---------------------------------------------------------}π{ Usage : Convert textfile to obj with turbo's BINOBJ }π{ Add them to a unit as show in this sample }π{ Create a custom filename to func address }π{ converter as show in My_getp. This function }π{ should return NIL if the requested file isn't }π{ linked in. Use Obj_assign to get assign the }π{ filevar. Reset, Read, Readln & Close are }π{ allowed. If a file isn't found it's searched on}π{ disk. Pathnames are stripped when searching for}π{ linked-in files. }π{---------------------------------------------------------}ππUnit Obj_01;ππINTERFACEππTypeπ Obj_find = Function(fn : String) : Pointer;ππVarπ Obj_getp : Obj_find;ππProcedure Obj_Assign(VAR tpl : Text;fn : String;decoder : Obj_find);ππIMPLEMENTATIONππUsesπ Dos;ππ{---------------------------------------------------------}π{----To simplyfy addressing inside the buffer, the segment}π{ of the pointer to the text in memmory is incremented }π{ instead of using the old Longint typecast trick }π{---------------------------------------------------------}ππConstπ para = 16;ππTypeπ obj_user = Recordπ base,π curr : Pointer;π dummy : ARRAY[1..8] OF Byte;π End;ππ{---------------------------------------------------------}π{----Ignore handler }π{---------------------------------------------------------}π{$F+}πFunction Obj_ignore(VAR f : textrec) : Integer;ππBeginπ Obj_ignore:=0;πEnd; {of Obj_ignore}π{$F-}ππ{---------------------------------------------------------}π{----Inoutfunc handler }π{---------------------------------------------------------}π{$F+}πFUNCTION Obj_input(VAR f : textrec) : INTEGER;ππVARπ p : Pointer;ππBEGINπ WITH Textrec(f) DOπ BEGINπ {----Advance Pointer obj_size paragraphs}π p:=Ptr(Seg(obj_user(userdata).curr^)+(bufsize DIV para),π Ofs(obj_user(userdata).curr^));π obj_user(userdata).curr:=p;π Move(obj_user(userdata).curr^,bufptr^,(bufsize DIV para)*para);π bufpos :=0;π bufend :=(bufsize DIV para)*para;π END;π obj_input:=0;πEND; {of obj_input}π{$F-}π{---------------------------------------------------------}π{----Open func handler }π{---------------------------------------------------------}π{$F+}πFUNCTION obj_open(VAR f : textrec) : INTEGER;ππBEGINπ WITH Textrec(f) DOπ BEGINπ obj_user(userdata).curr:=obj_user(userdata).base;π Move(obj_user(userdata).base^,bufptr^,(bufsize DIV para)*para);π bufpos :=0;π bufend :=(bufsize DIV para)*para;π END;π obj_open:=0;πEND; {of obj_open}π{$F-}π{---------------------------------------------------------}π{----Assign a link-in file or disk file }π{---------------------------------------------------------}ππProcedure Obj_Assign(VAR tpl : Text;fn : String;decoder : Obj_find);ππVARπ tplp : POINTER;π i : Byte;ππBEGINππ If (Addr(decoder)=NIL)π THEN tplp:=NILπ ELSE tplp:=Decoder(fn);ππ IF (tplp<>NIL)π THENπ WITH Textrec(tpl) DOπ BEGINπ handle :=$ffff;π mode :=fmclosed; {fminput}π bufsize :=SIZEOF(textbuf);π bufpos :=0;π bufptr :=@buffer;ππ obj_user(userdata).base:=tplp;π obj_user(userdata).curr:=tplp;ππ openfunc :=@obj_open;π inoutfunc:=@obj_input;π flushfunc:=@obj_ignore;π closefunc:=@obj_ignore;ππ i:=0;π While (i<Length(fn)) AND (i<Sizeof(name)) DOπ Beginπ name[i]:=Upcase(fn[i+1]);π Inc(i);π End;π name[i] :=#00;π ENDπ ELSE Assign(tpl,Fexpand(fn));πEND; {of obj_open}ππEND.πππ---------------<source part II, to link in your text files.ππ{---------------------------------------------------------}π{ Project : Object linked textfiles }π{ Unit : Sample program }π{ By : Ir.G.W. van der Vegt }π{---------------------------------------------------------}π{ Datum .tijd Revisie }π{ 930914.2200 Creatie. }π{---------------------------------------------------------}ππUnit Objtext;ππInterfaceππProcedure Assign_text(VAR tpl : Text;fn : String);ππImplementationππ{---------------------------------------------------------}ππUsesπ Dos,π Obj_01;ππ{---------------------------------------------------------}π{----SAMPLE Get_obj Function}π{$L SAMPLE_d.obj}π{$L SAMPLE_m.obj}ππ{---------------------------------------------------------}ππFUNCTION SAMPLE_D : Byte ; External;πFUNCTION SAMPLE_M : Byte ; External;ππ{---------------------------------------------------------}π{$F+}πFUNCTION My_getp(fn : String) : Pointer;ππVARπ name : String[12];π d : dirstr;π n : namestr;π e : extstr;ππBeginπ Fsplit(Fexpand(fn),d,n,e);ππ My_getp:=NIL;ππ name:=Strip(Upcasestr(n+e),true,true);ππ {12345678.123}π IF name= 'SAMPLE.D' THEN My_getp:= @Sample_d;π IF name= 'SAMPLE.M' THEN My_getp:= @Sample_m;πEnd; {of My_getp}ππ{---------------------------------------------------------}ππProcedure Assign_text(VAR tpl : Text;fn : String);ππBeginπ Obj_assign(tpl,fn,Obj_find(Assign_decoder));πEnd;ππ{---------------------------------------------------------}πππ{---------------------------------------------------------}ππBeginπ Assign_decoder:=@My_getp;πEnd.π 40 08-24-9417:54ALL NORBERT IGL Good file Viewer SWAG9408 F aσ 26 F╔ {π IP> Does anyone have a source to a viewer out there? Im lookingπ IP> for one kinda like List.com or whatever.. where you can use yourπ IP> arrow keys to list the file.. Thanx alot!!!!!!!!!!!!!!!!!!!!π}ππ Program Viewer;π (*$M $800,0,$A0000 *)ππ Usesπ crt;ππ Type TextBlock = Array[1..16000] 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:2453/50.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.π 41 08-25-9409:05ALL SCOTT F. EARNEST SConvert Upgrade SWAG9408 ÄSwé 87 F╔ {πFrom: "Scott F. Earnest" <tiobe+@CMU.EDU>ππAbout a month ago, I posted a program called "SmartConvert" which does auto-πmatic conversions between DOS and UNIX format text files.ππUnfortunately, there were a couple problems with the code I posted I wasn'tπaware of:ππ1.) While debugging, I accidentally removed the code which called theπ procedures to check that the files existed. Hopefully nobody'sπ gotten in trouble by overwriting files they didn't mean to. . . .π2.) S . . . L . . . O . . . W . . . ! I clocked a large file (~650K)π both ways, and got a time over 7 minutes. In this version, Iπ reassigned the text file buffers to 8K, and got much better times.ππI've also added an overwrite switch to ignore the output file.ππAnd could the kind soul(s) who donated the previous version to SWAG pleaseπmake sure this replaces the old version in the next upgrade? Thanks!ππ ■ Done! - Kerry ■π}πprogram SConvert;ππ{Smart-converts UN*X/DOS format filesππ Usage: sconvert infile [outfile] [/u | /d] [/o]ππ /u -- force output to UNIX (LF only)π /d -- force output to DOS (CR/LF)π /o -- Overwrite output file if it exists (for batch support)ππ -- or --ππ sconvert /? (-?, /h, -h, /H, and -H analogous)π for help messageππ This program is capabable of having its output piped, providedπ it is the first in the pipeline. Doesn't do well as an inter-π mediary pipe section.ππ Written by Scott F. Earnest, Aug 1993π Original version: 30 Aug 1993π Updated versions: 9 May 1994 (Added force flags.)π 9 Jun 1994 (Bug fix, added /o flag.)ππ This version uses 8K input/output buffers instead of the default 128-byteπ text buffers. The result is a performance of over 250% (only noticeableπ with large files). Untyped files turned out to be worthless here--theyπ performed worse than text files, believe it or not.ππ Unless I come up with a phenomenal improvement, this is the last versionπ I plan to post.π}ππuses Crt;ππconstπ CR = chr(13); {Carriage Return}π LF = chr(10); {Line Feed}ππtypeπ sys = (dos,unix,bad); {system identifier}π {Note to people who make upgrades--if youπ need the DOS unit, you'll have to modifyπ this variable so that "DOS" isn't a label.}π fbuf = array [0 .. 8191] of char;ππvarπ sysID : sys; {system identifier for case branch}π infile, outfile : string; {input/output files}π force : sys; {what mode to work in}π overwrite : boolean; {(don't) check if outfile exists}π ibuf, obuf : fbuf; {increase text buffers}ππfunction exist (filename : string) : boolean;ππ{Check if a file exists or notπ returns: true --> file existsπ false --> file non-existent}ππvarπ openfile : text;π errcode : integer;ππbeginπ {$I-} {Turn off error-checking}π assign (openfile, filename);π reset (openfile);π {$I+} {Turn it back on}π errcode := IOResult; {Get error code}π if errcode <> 0 then {There's an error if non-zero}π exist := false {So flag that it doesn't exist.}π elseπ beginπ close (openfile); {Otherwise, close file}π exist := true; {Flag that it does exist}π end;πend;ππfunction selectyn : boolean;ππ{Get a yes/no single-keypress responseπ returns: true --> yes response, y or Yπ false --> no response, n or N}ππvarπ getchar : char; {Need something to read into}ππbeginπ while KeyPressed do {Clean keyboard buffer}π getchar := ReadKey;π repeat {Get a key until it's a (Y)es or (N)o.}π getchar := ReadKey;π getchar := upcase (getchar);π until (getchar in ['Y', 'N']);π writeln (getchar); {Print the response}π case getchar of {Tell it what it should return}π 'Y' : selectyn := true;π 'N' : selectyn := false;π end;πend;ππprocedure help (badflag : boolean);ππ{brief message if command format was abused}ππbeginπ writeln ('SmartConvert, Written by Scott F. Earnest -- v1.4 -- 9 Jun 1994');π writeln;π if badflag thenπ beginπ writeln ('Invalid flag.');π writeln;π end;π writeln ('Usage');π writeln (' sconvert infile [outfile] [/d | /u] [/o]');π writeln;π writeln (' /d -- convert input to DOS format');π writeln (' /u -- convert input to UNIX format');π writeln (' /o -- unconditionally overwrite output');π writeln (' (for batch files or writing to devices)');π halt (1);πend;ππprocedure incheck (filename : string);ππ{Make sure source exists, if specified}ππbeginπ if not (exist (filename)) thenπ beginπ writeln ('Source file does not exist!');π halt (3);π end;πend;ππprocedure outcheck (filename : string);ππ{Make sure target does NOT exist, if specified, allow overwrite}ππvarπ select : boolean;ππbeginπ if exist (filename) and (filename <> '') thenπ beginπ write ('Target file exists! Overwrite? [y/n] ');π select := selectyn;π case select ofπ true : ;π false : halt (4);π end;π end;πend;ππfunction checktype (readfile : string) : sys;ππvarπ FileCheck : text;π checkvar : sys;π CROk, LFOk : boolean;π ReadBuf : char;ππbeginπ CROk := False;π LFOk := False; {Init flags.}π checkvar := bad; {Assume that type isn't known.}π assign (FileCheck, readfile);π reset (FileCheck);π while (not eof(FileCheck)) and (not CROk) and (not LFOk) doπ begin {Look for CR or LF}π read (FileCheck, ReadBuf);π if ReadBuf = CR then {CR found?}π beginπ CROk := True; {If yes, set the CR flag.}π Read (FileCheck, ReadBuf); {and get next char}π if ReadBuf = LF then {next one a LF?}π LFOk := True; {Flag it as found.}π if CROk and LFOk then {So is it CR/LF?}π beginπ checktype := dos; {If yes, specify DOS, and exit.}π close (FileCheck);π exit;π end;π end;π if ReadBuf = LF then {Found a LF?}π beginπ checktype := unix; {If yes, assume unix.}π close (FileCheck); {Close and exit.}π exit;π end;π end;π if checkvar = bad then {If there was a problem:}π beginπ writeln ('Ambiguous file type. Can''t determine type.');π close (FileCheck);π halt(2);π end;πend;ππprocedure dos2unix (infile, outfile : string);ππvarπ intext, outtext : text;π ReadBuf1, ReadBuf2 : char;ππbeginπ writeln ('Converting DOS -> UNIX. . . .');π assign (intext, infile);π settextbuf (intext, ibuf, sizeof(ibuf));π reset (intext);π assign (outtext, outfile);π settextbuf (outtext, obuf, sizeof(obuf));π rewrite (outtext);π while not eof(intext) doπ beginπ read (intext, ReadBuf1); {Get character}π if ReadBuf1 = CR then {If it's CR then. . . }π beginπ read (intext, ReadBuf2); {. . . get next . . .}π if ReadBuf2 = LF then {. . . and see if it's LF.}π write (outtext, LF) {If yes, just put LF into new file.}π elseπ write (outtext, ReadBuf1, ReadBuf2); {Not CR/LF, dump to file.}π endπ elseπ write (outtext, ReadBuf1); {Dump the character to file.}π end;π close (intext);π close (outtext);πend;ππprocedure unix2dos (infile, outfile : string);ππvarπ intext, outtext : text;π ReadBuf : char;ππbeginπ writeln ('Converting UNIX -> DOS. . . .');π assign (intext, infile);π settextbuf (intext, ibuf, sizeof(ibuf));π reset (intext);π assign (outtext, outfile);π settextbuf (outtext, obuf, sizeof(obuf));π rewrite (outtext);π while not eof(intext) doπ beginπ read (intext, ReadBuf); {Get a character.}π if ReadBuf = LF then {Is it LF?}π write (outtext, CR+LF) {If yes, put a CR/LF in its place.}π elseπ write (outtext, ReadBuf); {Otherwise, replace the character.}π end;π close (intext);π close (outtext);πend;ππprocedure getcommandline;ππ{get commandline info. . . .}ππvarπ pnum : byte; {paramater counter}π pstr : string[2]; {string snippet}π fname : string; {temporary string}ππbeginπ if (paramcount < 1) or (paramcount > 4) thenπ help (false); {too few, too many--show help}π infile := ''; {Init names.}π outfile := '';π force := bad;π for pnum := 1 to paramcount do {Do this in two passes.}π begin {#1.) Flags}π pstr := paramstr(pnum); {Get parameter.}π pstr[2] := upcase(pstr[2]);π if pstr[1] in ['-', '/'] then {Flag?}π case pstr[2] of π 'H', '?' : help (false); {Is help.}π 'D' : force := dos; {Is force DOS.}π 'U' : force := unix; {Is force UNIX.}π 'O' : overwrite := true; {is overwrite.}π elseπ help (true); {Bad switch.}π end;π end;π for pnum := 1 to paramcount do {#2.) Filenames}π begin π fname := paramstr(pnum); {Get parameter.}π if not (fname[1] in ['-', '/']) thenπ begin {If not flag then}π if infile = '' then {Get infile}π infile := fnameπ else if (infile <> '') and (outfile = '') thenπ outfile := fname {Get outfile}π elseπ help (false); {Oops, too many.}π end;π end;πend;ππbeginπ overwrite := false; {Initialize flag}π getcommandline; {Parse parameters}π sysID := checktype (infile); {Check the input file type}π incheck (infile); {verify that infile exists}π if not overwrite then {/o specified?}π outcheck (outfile); {verify that outfile doesn't exist}π if sysID = force then {If it's getting forced, then}π begin {compare types and skip if same.}π write ('Input file is already type ');π case sysID ofπ dos : write ('DOS');π unix : write ('UNIX');π end;π writeln (', skipped.');π halt(5);π end;π case sysID ofπ dos : dos2unix (infile, outfile); {DOS -> UNIX}π unix : unix2dos (infile, outfile); {UNIX -> DOS}π bad : begin {Not likely to happen but. . . .}π writeln ('Internal error! Check source code and recompile.');π halt (6);π end;π end;πend.π 42 08-25-9409:09ALL AFAD@ACAD2.ALASKA.EDU Speeding up text files SWAG9408 ZI~ë 15 F╔ {πThe most important thing when processing text files is to allocateπa large buffer for reading & writing the files. By default, TPπallocates 2k for reads & writes. Increasing this buffer to as littleπ(111 min left), (H)elp, More? as 10k significantly speeds up programs.πUsing larger text buffers is painless: you simply set a text buffer.πBefore closing the files, you really should do a flush() on any outputπtext file you're buffering.ππThe following code segment is what I use in my programs to establishπthe largest possible text buffer (64k-8, if memory available):πThe lines below create a maximum size file buffer for a text file fromπmemory available on the heap. Once the buffer has been created and assignedπto the file, i/o can proceed with normal READLN commands.πThe buffer is automatically created to the maximum possible size permittedπby TP (64k - 8 bytes), or the largest size permitted by available memory.ππ"Tbuffsize" can be any variable of type LongInt. It is only used duringπthe creation of the buffer and can be reused for any purpose.π}ππ{Declarations..}ππVarπ Target : Text; { Text file handle }π TBuff : Pointer; { Buffer }π TBuffsize : LongInt; { Size of buffer }ππ{Code}π tbuffsize:=Maxavail; {Find available memory block}π if tbuffsize > $fff0 {Limit to max. data object size}π then tbuffsize := $fff0;π getmem(tbuff,tbuffsize); {Grab memory, hook to pointer}π settextbuf(target,tbuff^,tbuffsize); {Attach new buffer to text file}π reset(target); {Open file with buffer}ππ{πWhen processing text on floppy disks, I find this frequently reduces theπprogram to executing only a single read - which speeds up execution byπa factor of 10.π}π
