IMD 1.18: 22/01/1996 8:09:10 micro cornucopia kaypro user group disk 45     45-DISK DOCCYFER COM` CYFER PASZNFILELSTCOMo !"#$%&'()*+NFILELSTDOCx,-./0123456789:NFILELSTPAS{;<=>?@ABCDEFGHIJSORTLINECOMmKLMNOPQRSTUVWXSORTLINEPAS*YZ[\]^SRT DOC3_`abcdeSRT PASnfghijklmnopqrsTD COMmtuvwxyz{|}~TD DOCTD DOC2TD PAS0TDR INC'TDS INCA KAYPRO DISK K-45 PASCAL RUNOFF - UTILITIES We received a number of general utilities as entries in our Turbo Pascal Runoff. This disk contains four of the best. Two of them (TD and SRT) were designed to be used either as routines within a larger program or as stand alone programs. Some of the files on this disk have been squeezed. So before you do anything else, any file with a 'Q' as the second letter of the extension should beTDSS INCiTDTRAP INC TDU INC unsqueezed as in the following example: USQ CYFER.PQS d: The unsqueezed file will be redirected to drive d:. If d: is not specified, USQ will write to the current drive. Since the unsqueezed files take up so much room you'll want to unsqueeze them to another disk, especially if all you have are single sided drives. ______________________________________________________________________________ CYFER - Protect those sensitive files from prying eyes with t  his encoding and decoding program. NFILELST - More than just a file lister (with pagination and line numbering if requested), NFILELST also does string searches through files using either ambiguous or unambiguous file names. SRT - Up to 320K worth of data can be sorted with any field within a 255 byte record as the sort key. SRT provides a great example of the use of the Quicksort algorithm. TD - Include these directory routines in any of your Turbo programs which need access to directoH\<z5+)+<z {0Gɯgo||H}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'ͬͬdͬ ͬ} wͦWͧ _}8(8J`9{T]=o`9y 28!?"9!!>2 :D]SXN]D [ (!e}̈́A8Q0G: x@!\w# (   yV. V!h6# (*(.(!8}(*(̈́w#>?> w#a{ |͒}͛Ɛ'@'7||}>"C"6# ""͐ͩ*B"[R5*"^#V#a}.; OJ , ; !U >,k- o&0%,` }g; }؉}颋.:}8c~I$I~L*kٷx˸; }0G,͙<},-(-J ! >0 a` o8 Oþ >um.`1pF,t6|!wS<.z}[|%FXc~ur1}Oٯx(<˸ͨ 8; !~Jͨ 0O!><ͨ 8 =  7 <` O ; 7 0 W-J OT0 j oD,:j !I}袋.}8c~I$I~L!>ry information. Three different versions are provided: unsorted (a la DIR), sorted, and sorted with file size and disk space infor- mation. xW^8/w >uJ u` }>(; xQ }} ˸T}ٕ(0D=C ,= ( [ 0%D , 7 ͏ ?(8u x O - ; 8˸x X ,-xG}; }م 9; .>#n0[ D = - nx P ,-(-˸G,-; }ٕ? 9.>͏ 8u ?= u+-(>O 0u O 8^#V#N#FO/o&9O/o&9!9(> (G!9 w#E͊w}8uRB0 >R@RR!+ͨ z R!+ͨ z <!+ͨ z <!+ͨ z <!#ͨ z <!+ͨ z T]KB!z> S>))0 = |JJDMgo>jB0 7?= u` ` 77 ` = O nf^VNF!DLT\I!!53!r1!\!> x #-= o˸xO(- }(x>8(C ,C `iM!>u|; |J>| )=|(DMbo˸ͦ88ͦx(0 8> Mx(>-Ͳ{(ay(Ͱͦ \z(>.Ͳ (Ͱ ~ͦ{>EͲ>+|(|Dg>-Ͳ|/ 0:p# ~# +>0w#,-  60#J˸}րogM| .ͫCopyright (C) 1984 BORLAND IncAKayproDelete2/920/92P= ERT###&&&~7#~=% o&ͦoͦܐԩͣ}!!"8~#(}:$= +*!Z!*B!!:(=2!Z: <2!!!:O::O:!*B͏ ?x P , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx(ͼ ?}ٽÏ }ց; <(; 7D = |٤g{٣_z٢Wy١Ox٠GD u J }x>uu}ƀ/ƀo; -J }0W-J W,}l˸ͨ 8 ; ` x( -ͨ 8J -ͨ 8,J }l8;*!` ! >u` ` u--- J ,,,-xGg?+2n*8t z~,->uxu  (C = ~> x0w#xG%P %P ZJDM%P = _~65i+~hìx-Sx9?+{Η@}|C C gZJDM0D ,7}o˸  #yO!@9i&   # w# /w#*###w* N#FB ͟r+s> !T]>)j)0 0= UR!#U*^#V#N#F#^#V>">!2DM"~x(L* :O(o:" C}=( ?*-N#Fp+qq#p! * F+N+++V+^Bq#p>>> SRѷR* s#r$ s#r"S"! N#FB(^x * 6#[<(H*! Kq#p##K[! *! 4 #4! x *$ *>w""{_!"*nf}(HR0nf" ^VMDnfutqp J= B== ͯ}8= ͵}/ͭ !*###~-_~(4Q6*>2>*##w:>*##~*#~(E[ ( ( ( !][ ( ( ((w#(6!]~-#8~>7  [>OkͼMs #rkͼpX á[ [ (( #w(q*#~[ (  *##~6͜O$*#~(08ʦ=ʦ==ʩ=ʬò+###~-_q46͡> *:4^q}Ò*|(s*# !*5zo!"! **+! *!*R+n& &s*#!!*!!5z!""! *+! *!R+n&! *!R+n&! *!R+n&*!  &s*#È!!!*5z""! *+! !*R+n& &s*#4"&}2&}2!!͡!*&)))))))b*&!NEj#!*&))))))) w#!9! E9!!9~(+F͊!"9!(#>2*Ͳ"|>" :( ͆ *6#w*6#6 !\$![ (̈́( #:~CONTRMKBDLSTAUXUSR>2$*#~ Ͷ$*:> >w###6  #6++p>2S-$Ͷ:*6###ww#w$w#w: ##N#F*B> w#w#[s#r>2S$Ͷ$*6 #-Nw#Fwq#p#6#w#w#w* :( ͒*s#r*s#r"* 5KB!>u~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6# * *!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#VS>O"w2x2!"" @*>2"!"""!\Ͳ*: !~6go(\R*s#r_2x( s xM|( M6-#͐ͦ[R8 (G> ͒C~͒#*ͦC!h !lTRUEFALSEͦ!9^#(~#(G~͒#> ͒> Ò "F![(#RR0*4#4> RR *4 #4(>>2$*V(/˖:(#~+ x y2!͵( =( X:(R*:(###~-_-͌X> :("͟"*^˞*V˖0 SRѷR8A* N#F#s#r$ 0})jS\b!!͸Ej#!*&)))))))[́b!!ͳ !͡#!*&)))))))b!*&)))))))\b!"!&}2! !!!)))))))͝}oEʼ&*!"*!͛E$!"!!)))))))8!b!!)))))))͚*&!;N}oE$Ï&*&!>RB$*&! *+n&R&}2*&!!ͯE$*&!>&}2Q% _ RBQ%*&: *^ F* < >26"~͟*-w#ww#͟"~ <@*Ͳ!\  <ʮ!\$> >2*|>! * \$\<(!: [1Á\!(f"> 2:!<"F( #~#6e>!["N>!~8>O6*"w (=(&("( :(N 8y(~#x+% (6*#~[*#~ *~(h#"b=  8(T]DMR0 -a%}̈́o*!~6o&͠|ͣ}%^C User break1:% I/O% Run-time% error ͒%, PC=[R"͍% Program aborted*1!͍!0Ͳ/Document Encrypted""Ŕ ́Enter your key:͐b*+._b* m"*Rp !ae.*Ͳ* m"ù R¹ R!́,Key 255 chars. Long, may have been truncated͐b!*5z !"! *+**n&!  &  ! *+n&R&}2*&!_ͯEQ%*&! &}2*& Rr%!{&}2X&{R%! &}2X&,R¬%!}&}2X&}R%!,&}2X&|R%!&}2!.&}2X&.R&!|&}2X&aRBX&*&EH&*&! R&}2!&}2*&! N*&!.N}oE&Ï&!&}2!!)))))))[*&b#!"!!͡!&}2! !!!)))))))))!R*&)))) .ENC!*&)))))))!R*&)))) <b!*&)))))))b/!R*&)))) R!q́ not found.͐b!&*s)ŔEncypher, Decypher, or Quit: b!8! b* &R͐b* &(&}2 * &ER„0!!m+*&Eʁ0ͽ&!!̀"ñ0DR±0!!m+*&Eʱ0ͳ#!!̀"* &!QNE/&}2 * &ERE!!m+*&Estͽ&!!̀ the ENC suffix, text files maý ́may have other suffixes.́ ́REMEMBER THE KEY!́ ͐b"&}2!*&))) R!q́ file: b!R*&))))+._b!*&)))))))!R*&)))) <b!*&)))))))5!NEʣ/*&!NEv,!&}2Æ,!&}2!R*&))))!"!&*s*!"!R*&)))) *!5` ce letters' ASCII values to produce a new ASCII value. Values are kept in specific ranges by subtracting known values if the new value exceeds given limits. In this way, lower case letters are usually encrypted as lower case letters. To minimize pattern recognition in the encrypted file, the key phrase is expanded into a large (here 1000 elements) scrambling array. The precise method is described by comments in the AKEY procedure. In any case, the resulting scrambling array will turn the origin)͝}oE)*!"!!ͳ !͡*!͛ER'!"!!)))))))8!b*&! N*&!.N}oEʡ'ñ'!&}2!!)))))))͚*&!;N}oE')*&ARB3(*&E (*&! &}2!&}2(  RQ(!{&}2({Rn(! &}2(,R‹(!}&}2(}R¨(!,&}2(.R(!&}2!|&}2(|R(!.&}2*&!>RB{$R+} {----------------------------------------------------------------------------- FILE ENCRYPTION PROGRAM By Walter E. Frick, 1843 NW Woodland Drive, Corvallis, OR 97330. Computer users must often share their machines with others, making privacy difficult. With this program you can encrypt files using a favorite letter, word, or phrase as a key. The same key is also used to decypher the file when it is to be reused. Whenever encryption occurs a file by the same&}2!R*&))))!R*&)))) *&e.*&!.N*!R*&)))) mN}oE,!*&))) R!q́ file is being opened.͐b*&!NEʑ.*&!.NED.!R*&))))!R*&)))) DOCÎ.!R*&))))!R*&)))) .DOC9/*&!.NE.!R*&))))!R*&)))) ENC9/!R*&)al key into a larger key effectively using all letters without repetition if the key word or phrase is of any length greater than a few letters. The length of the key is also used as part of the scrambling procedure. How long you make your keys depends on your patience and degree of paranoia. In encryption, certain characters are treated as exceptions. E.G., the common character ' ' (or space) is exchanged with '{' (ASCII number 123, right after small z) before encryption so that it will usually[)*&! *+n&&}2*&!^͛EX)*&!>R&}2) _ RB)*&! *+n&&}2*&!~͛E)*&! R&}2!!)))))))[*&b&cŔ ! e.!q́FILE ENCRYPTION PROGRAḾ ́7To encrypt a file choose option E and give file name. ́#To decypher a file choose option D.́ ́AThe key may be a letter, word, or phrase of up to 255 characters.́ ́=Encrypted files always receive name as the source file with the suffix ".ENC" is formed. The original file is null filled before being automatically deleted. Similarly, when the ENC file is decyphered, a file with the same name and the suffix ".DOC" is formed. The basic principles used in the program are not difficult to understand. Each letter in the key is used in sequence to help scramble the source file. A key of up to 255 letters may be used. Basically, the ASCII value of each key letter, modulo 32, is added to the sour   appear as one of the lower case letters in encrypted form. This makes it difficult to separate words in order to help break the code. The period and comma are buried in the same way, as are each first capital after the occurence of periods and spaces. To help protect Pascal files, semi-colons at the end of lines are NOT altered. When encrypting Pascal files, it is desirable to place several statements on each line so that reserved words are not easily discerned. ASCII characters greater than 1+ 1 to maxlen do scram[i] := (scram[i-1] + scram[i-2] + scram[i-1] mod keylen) mod 32; { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- To complete the scramble, replace the original set at the beginning of -- the scram array with corresponding elements from the end of the array --} for i := 1 to 2*keylen do scram[i] := scram[maxlen-i]; { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } end; procedure closefiles(source,other : filet----------------------------} var achr : char; i : integer; begin writeln(^J^M,'Enter your key:'); readln(key); keylen:=length(key); case keylen of 0 : begin key := 'a'; keylen := length(key); end; 255 : writeln(^G,'Key 255 chars. Long, may have been truncated'); end; { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- Enter the key elements into the scram(ble) array, --} for i := 1 to keylen do scram[i] := ord(key[i]) mod 32; { - - - nd (achr=';') then { do nothing } else begin { encryption } case ord(achr) of 33..94 : begin achr := chr(ord(achr) - scram[count]); if achr < #33 then achr := chr(ord(achr) + 62); end; 95..126: begin achr := chr(ord(achr) - scram[count]); if achr < #95 then achr := chr(ord(achr) + 32); end; end; {}case ord(achr) of 32 : achr := #123; 123: achr := #32; 44 : achr := #125; 125: achr := #44; 124: begin period 28 are unaffected, so that, for example, WordStar files may not be as well protected as ordinary text files. However, the concept of the expanded key will make decypherment of these files also very difficult. -----------------------------------------------------------------------------} type filetype = (D,E); { Set identifying Document and Encrypted files } longstr = string[255]; mixers = 0..31; const descriptor: array [filetype] of string[9] = ('Document','Encrypted'); maype); {----------------------------------------------------------------------------- Overwrite original file on the disk drive and close the files. -----------------------------------------------------------------------------} var count : real; begin count:=0; close(feil[other]); if source = D then begin rewrite(feil[source]); while count < size do begin write(feil[source],''); count := count + 1; end; end; close(feil[source]); erase(feil[source]); end; procedu- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- ...And again in reverse order. --} for i := 1 to keylen do scram[i+keylen] := scram[keylen+1-i]; { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- Fill the remaining elements with values depending on the ordinal sum of the -- two preceding chars. And the length of the key, modulo 32. Including the -- length of the key will further complicate attempts to decypher the key. --} for i := 2*keylen := true; achr := #46; end; 46 : achr := #124; 97..122: begin if period then achr := chr(ord(achr) - 32); period := false; end; end; if (achr = ' ') or (achr = '.') then { do nothing } else period := false; end; write(feil[D],achr); end; end; procedure encypher; {----------------------------------------------------------------------------- Scrambles the source document file using the scram array. ------------------------------------------------xlen = 1000; var filename : array [filetype] of string[20]; feil : array [filetype] of text; scram : array [1..Maxlen] of mixers; choice : char; key : longstr; keylen : integer; size : real; ok : boolean; procedure akey(var key: longstr; var len : integer); {----------------------------------------------------------------------------- Produce the expanded scrambling array. -------------------------------------------------re decypher; {----------------------------------------------------------------------------- Decyphers ENC files. Inverts the steps in procedure encypher. -----------------------------------------------------------------------------} var count : integer; period : boolean; achr : char; begin count := 0; period := false; akey(key,keylen); while not eof(feil[E]) do begin count := count + 1; if count>maxlen then count := 1; read(feil[E],achr); if (eoln(feil[E])) a  -----------------------------} var count : integer; period : boolean; achr : char; begin count := 0; size := 0; period := false; akey(key,keylen); while not eof(feil[D]) do begin { set counters } count := count + 1; size := size + 1; if count>maxlen then count := 1; read(feil[D],achr); {- -- The Period boolean helps encrypt sentence leading capital letters -- in lower case. Set to false if chars. After a period are not blanks. } if (achr = ' ') or (ac---------------------------------------------------------} var other : filetype; count : integer; addon : char; begin write(descriptor[source],' file: '); readln(filename[source]); assign(feil[source],filename[source]); {$i-} reset(feil[source]); {$i+} if ioresult = 0 then begin if source = E then other := D else other := E; filename[other] := ''; count := 0; ok := true; repeat count := count + 1; addon := copy(filename[source],count,1); filename[other]  if ord(achr) > 126 then achr := chr(ord(achr) - 32); end; end; end; write(feil[E],achr); end; end; procedure introduction; {----------------------------------------------------------------------------- Help. -----------------------------------------------------------------------------} begin clrscr; writeln(^J^M,' ':20,'FILE ENCRYPTION PROGRAM',^J^M^J^M, 'To encrypt a file choose option E and give file name.'^J^M, 'To decyphern encypher; closefiles(D,E); end; end; 'D': begin open(E,ok); if ok then begin decypher; closefiles(E,D); end; end; end; until choice='Q'; end. hr = '.') then { do nothing } else period := false; if (eoln(feil[D])) and (achr=';') then { do nothing, i.E. Line ending semi-colons are not encrypted } else begin { decypherment } case ord(achr) of 65..90: begin if period then { if capital encypher as lower case } achr := chr(ord(achr) + 32); period := false; end; { Trade spaces, '.', and ',' with chars near lower case ASCII } 32 : achr := #123; 123: achr := #32:= filename[other] + addon; until (addon = '.') or (count = length(filename[source])); writeln(descriptor[other],' file is being opened.'); if other = D then if addon = '.' then filename[other] := filename[other] + 'DOC' else filename[other] := filename[other] + '.DOC' else if addon = '.' then filename[other] := filename[other] + 'ENC' else filename[other] := filename[other] + '.ENC'; assign(feil[other],filename[other]); rewrite(feil[other]);  a file choose option D.',^J^M, 'The key may be a letter, word, or phrase of up to 255 characters.',^J^M, 'Encrypted files always receive the ENC suffix, text files may',^J^M, 'may have other suffixes.',^J^M^J^M, 'REMEMBER THE KEY!',^J^M^J^M); end; procedure open(source: filetype; var ok: boolean); {----------------------------------------------------------------------------- Opens the target file. If successful, opens opposite 'other' file. --------------------; 44 : achr := #125; 125: achr := #44; 46 : begin { ASCII 46 = '.'; set period true } period := true; achr := #124; end; 124: achr := #46; end; {}case achr of {- -- Scramble the letters and leave them in their respective ranges. -} #33..#94: begin achr := chr(ord(achr) + scram[count]); if ord(achr) > 94 then achr := chr(ord(achr) - 62); end; #95..#126: begin achr := chr(ord(achr) + scram[count]);  end else begin writeln(filename[source],' not found.'); ok := false; end; end; {----------------------------------------------------------------------------- Main -----------------------------------------------------------------------------} BEGIN introduction; repeat write('Encypher, Decypher, or Quit: '); read(kbd,choice); writeln(choice); choice := upcase(choice); case choice of 'E': begin open(D,ok); if ok then begi   ͫCopyright (C) 1985 BORLAND IncBKaypro with hiliteedP=  E RC1B1~7#~=  oͦlԅ!!"~#(}:$= +*!6!*!!:(2!6:(>2!!!:O::O:!*! !45(! +/ 0y09.> 8ͭ ?= u+-(>͇ 0ͭ ͇ 8 ?x ͈ , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx( ?}ٽ }ցs <(s 7| = |٤g{٣_z٢Wy١Ox٠G| ͭ ͂ }x>( ͭ}ƀ/ƀo  -͂ }0͏-͂ ͏,}l˸ 8 5 ͘ x( - 8͂ - 8,͂ }l8;*!͘ ! >5ͭ͘ ͘ ͭ---  S>))0 = | |́́DMgo>jB0 7?= H͓<z5b)b<z {0Gɯgo||}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'd } * W _}8(8J`9{T]=o`9y .({ = ~> x0w#xG%͈ %͈ ZJDM%͈ = _~65+~hìx-Sx9?+{Η@}|{ { gZJDM0| ,7}o˸@ #yO!@9i&( d!k6!{6``o&  :(͠|(  *"x2y( >28!"9!! og2"">~22!:05+:!Co&ͦͣ} [ (!e|ͧA8Q0G: x@!\w# (̓ ?(*( .( x_. _!h6# (?( *( ̓( w#>?> w#ͧ 8 !ɿ .,;:=?*[]<>{}a{ |͵};Ɛ'@'7||}>2Ͱ*Bک  "og"2>2! ,,,-xGg?+2n*8t z~,->( x( ͙}. ͇͂ , ! >5,ͣ- o&0% ,͘  }gs }؉}颋.:}8c~I$I~L*ͣٷx˸ }0G,<} ,-(-͂ !>J0 ͙͘ o8 ͇ >( m.`1pF,t6|!wS<.z}[|%FXc~ur1}͇ٯx(<˸ 8 !~J 0/O!>t 8 =  o t͘ ͇ /o 0 ͏-͂ OT0 j oD,:~8 (8~wPT] *  >( ͂ ͭ͘ }>( x‰ }} ˸T}ٕ(0D={ ,= ( ͓ 0%| , 7 ?(8ͭ x ͇ - s 8˸x ͐  ,-xG}s }مN 9s .>#n0͓ | = - nx ͈ ,-(-˸G,-s }ٕ?N @  #@w#@/w#@w#!9! E9!!9~(+Fͻ!"9!(#>2*"| >"2:( ͷ *w*6 !\$![ (ͧ( #:~CONTRMKBDLSTCAUXUSR>2j:*ˮ~1:*:(@q##p[* :(  ~* < >26"!"""~>2""v>2>"!"ˮ(!~8>~O6~*" ""*B"[Rv*"^#V#^#V#N#FO/o&9O/o&9!9(> (G!9 w#Eͻw}8( RB0 >( RrRR!+ ͱ R!+ ͱ s!+ ͱ s!+ ͱ s!# ͱ s!+ ͱ T]KB!z>j !I}袋.}8c~I$I~L! >ͭ͘ JØ oo ͘ = ͇ nf^VNF!DLT\I!!53!r1!͓!> x #-= o˸x͇(- }(x>8({ ,{ `iÄ!>( |s |́>)=|(DMbo˸88x(0 8> ́x(>-{(ay( z(>. ( {>E>+|(|Dg>-|/ 0:p# ~# +>0w#,-  60#~  w(6(2(-()(6 (8 0 :(* y(~#+ (( 66 #6 #"*: y~o p .##~ͻ(.6w4._~ =*##55= *[R8*~#"= ͣ}== ͯ}͵}*#w+#~+>*~('l!0(ˮ]l!8ˮ!]~-#8~>27lˮw>O%7̄s #r%ͤ7̐ l ( (ˮ ql(ˮ ( l ˮ*O:~ ##~._q4((=ʦ==ʩ=ʬò*!G"""!\*: Os!~6go(\R*s#r_2x( s x(T]DMx(R0 U(͞O/o&9q# (!>F0#( ~ ( #]( ~ ( (#}(  i&T-a%ã}ͧo*!~6o&|:2!2}:__{ѯ2*|KB " z ^C User break+=  I/O Run-time error {͵, PC=*ͰNot enough memory Program aborted :m'1!e!L8>4"~ʱ*w#wx(9* :O *-4 #4!*4 #4 *-N#Fq#pV+^Bq#pS[ѷR'* s#r$ s#rM <?*M!\  <( !\$>2>2M:>!(* \$\<(!4: [1ð\!(7"~> 2"S"Ns#FrB(Z#\: \<(?*"}K\! !*}#"}! x \* *>* 2""{_!"*#A!m ͜ͻ$How many lines to print per page =>  !!O ͜ͻ$How many lines for a top margin =>  !!O ͜ͻ8Does your printer recognize a form-feed character [Y/N]  !E *&!ỲEi&͜ͻes ͜ͻ8Enter formfeed character; (control as "^" character) =>  !m(͏ !m;Ͳ#͗ }2!!}2!&͜ͻNo ͜ͻ&How many lines for a bottom margin =>  !!O !}2!͜ͻ only if none des:4^q*##~6ͻ>2}*|(̈́|( ̈́6-#[RM8( G> A~#*(C! !TRUEFALSE!9N#Z~#( G~#> >    "~(lѻ(( !0 (ˮ!!>2S{:1:*6##ww#w$w#w:  ##N#F*B>2w#w#[s#r> "~ͯ*-w#ww##> ͯÂ""~>2:[R0 *4#4>2:[R> *4 #4(> 7 @! ͜ͻLines per page = *!!' ͜ͻTop margin = *!!' ͜ͻBottom margin = *!!' *!&E!͜ͻForm feed character chr(*!&!'ͻ ) is used "͜ͻForm feed character not used ͜ͻSetup string =  !!!;ͤgzʅ"}2^͜ͻchr(!!*^&n&!'ͻ),  *^&#E"͜ ͜ͻreset string =  !!!;ͤgz"}2^͜ͻchr(!!*^&n&!'ͻ),  *^&#û"͜nf}(HR0nf" ^VMDnfutqp*s#r*s#r"* vKB!1>( ~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6#L*L*!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#V""6#>O"w2x2*"!G"" 'z*"*>2"*"ired.  !m(͏ !m;Ͳ# !!͜ͻ;Enter printer reset string {RETURN} only if none desired.  !m(͏ !m;Ͳ# !!͜ͻFilename for new version ==>  !͏ !;#Am#! ""!}2!}2N**ͪ!E *&!|g}o}2*&! ̀*&}oE\(!}2Â(*&! ̀Ez(!}2Â(!}2*&}o*&͂!!͜!~͒!͒P}o}oE(*;*&e.>**&*}oE(# ! >22*f(/˦:G(##~++ :O x yD!ͻ Q*:G(##~._.͛g<]=<͛*##w ͯ +4 #4x>>2:G("ͯ"*nˮ*0 S[ѷR8@* N#F#s#r- 0})jS\*##w+ N#FB ͯr+s>2!T]>)j)0 0= ^R!#^*^#V#N#F#^#V>2ͱ:1:*6 #-Nw#Fwq#p#6#w#w#w"~Â>">!DM!":*B:!>(>2>">!"2 #%G!& !^!&!^;q͜ͻ Writing file !^;!ͫͻ  !&p !&!!pͻ !&ͱ ͜ͻ --- WRITTEN! !G&#! (!N(!!"*!"!*n&}2*&͂!\͒!^͒P}oE:$!;*&e.>(!$*&}2*!"!*n&}2*&!\̀Eʔ$!;*&e.>(!$*&}2!;*&!@Re.>(!*!;ͤͦE#!;(!!;  ͜ ͜ͻList File ==>  !͏ !;N͎EN)!!!;ͤgzʖ)}2!*&!*&n&s*&#`)!:e.!;ͳ}2*&!̀E)!\!+!s*!\!+!*&!Rn&!AR!s!}2*&!!;ͤgz+}2!*&n&}2*&! E(+*&!*̀Eʭ**&! Eʪ*!\*&+!?s*&!}2p*%+*&!.̀E**&! E*!\*&+! s*&!}2*%+ !}oE3*&E/3!!'D3!ͪ!͏ͬ *!"*!"**!Eʀ31ͪ1!"*&Eʥ3!ͻ*!'! # !ͻ!;!ͫ 3*!"1# !Q "Y*Y!͓E4*Y^#V.N !!!!\!+n&!@s!!!:s*Y;!!! !!!!.e.!! ! !.*&Eʹ4!;!;8/4!;ͧ1*Y^#V. Q#!}2*&EH8!}2!}2/*O*E!.*O*En&!.̀E. E#!| !6!6͜ ͜ͻSearching file !6;!ͫ ͜ͻ for !6;!ͫ ͜ *&E 0!ͻ !ͻͻSearching file !6;!ͫ !ͻͻ for !6;!ͫ !ͻ !"|!~!6;p !~ !~}oEʝ1*&Em0!~!~'Â0!~ͪ!~͏ͬ *|!"|*&E0!!~;ͤgz0}2\!~*\&!~*\&n&s*\&#í0!~!!~;ͤs 1! NFILELST A text file utility. by Frank C. Jones written in TURBO PASCAL VERSION 3.0 As the name would suggest, NFILELST is a text file listing and searching utility. It works with standard ASCII files and by setting a software switch it will operate on non-ASCII files such as WordStar files that have em!\*&+*&s*&!}2ø+*&!*̀Ez+*&! Ew+!\*&+!?s*&!}2=+ø+*&!.̀Eʑ+ø+!\*&+*&s*&!}2*&#***&! gz+}2!\*&+! s*&#+ #!r !N !r*^&!}2]!*]&n&! ͓*]&!;ͤ͹}oEʧ,!r;!*]&n&e.> !r*]&!}2]8,͜ͻ SWITCH = !r;!ͫ !Le.!r;ͳ!͓E,!}2!We.!r;ͳ!}2!}2!}2!}2!}2!"!!͜!̀EU5(n5!}2!~!!\e.!;ͳ}2^*^&!͓Eʠ5!;,*&Eʯ5!*&Eʾ5#*&Eʚ6͜ͻSearch String ==>  !͏ !\e.!;ͳ}2^*^&!͓EF6!;,!!*^&!Rs*&Eʙ6!!;ͤgzʙ6}2^!*^&!*^&n&s*^&#c6!!\o&}2\*\&!͓E6!*\&))))) 9 !!!;-7͜ͻFile n~;!~!6;!~;ͳ!͓Eʙ1*|͜!' ͜ͻ !~;!ͫ *&Eʘ1!ͻ*|!' !ͻͻ !~;!ͫ C0|#L2 ! !*!gz1"!ͻ *#ÿ1 # ! *!&E2!ͻ*!&# B2**!*!gzB2"!ͻ *##2 #! !mͪ1͜ͻPrinting file !m;!ͫ ͜ !ͻͻ ********** !m;!ͫͻ ********** !ͻ !"!"!!m;p !bedded control characters and characters with the high order bit set. NFILELST will list files to the LST: device with or without line numbers and paginate the output according to your choosing. It will also search files for a specified search string and echo its output to the LST: device if you so choose. The files to be listed or searched may be specified ambiguously (ie. with wildcards) and all files that match the specification will be listed or searched in a!͓E-!}2!Ce.!r;ͳ!͓E<-!}2!Se.!r;ͳ!͓Eb-!}2!Pe.!r;ͳ!͓Eʈ-!}2!De.!r;ͳ!͓Eʮ-!}2!Me.!r;ͳ!͓E-!}2r#![  !c"p*p^#V!̀EW.*p!*p^#V"[!*[s#r*[!s#r*[!c; ÷.*p^#V"[!c;*[;Eʌ.*[!c;-÷.!c;*[;Eʷ.*[!c;-[#3 !E "O!"E*E!"E*O*En&! ̀Eot found !*\&!͓Eʄ7!!\o&}2\*\&!͓Eʀ7!*\&))))) 9 !!!;-7!\!+n&!̀E7!\!+*&!|g}o!s*&E77!ͻ!!;!ͫ *.*&E88!ͻ!!;!ͫ  !8\!ͬ4 v7!ͻ!!;!ͫ *.*&Ev7  lphabetical order. Thus you can search for a particular word or phrase in every file on a given disk and have the output printed and labeled by filename. BACKGROUND NFILELST originated about a year and a half ago when I first obtained my copy of version 1 Turbo Pascal. I had been interested in the Pascal programming language for some time and was eager to try my hand at recursion and dynamic data structures. A very natural use of recursion is in storing and retrieving  a little study to use this method correctly and it is not necessary if you only want to compile a COM file for use on your own computer. Anyone wanting to use this technique should read Shiflett's article carefully before uncommenting this block of code..cp5 INVOKING NFILELST The program may be invoked in two different modes: by including or not including parameters on the command line. If command line parameters are used NFILELST will search or list the files that match theity that would list all of my CMD files clearly labeled with their filenames. Thus NFILELST was born. Other features were added as the need arose with the exception of the 'clone' feature. This came into being when I finally realized that Turbo's typed constants differed from typed variables primarily in that they are stored with the code rather than in the data area. Therefore if the program code is saved to disk after these constants values have been changed with the file extension .PAS and then returns to the "ListFile==>" prompt once more to process more files. NFILELST *.PAS \S The program loads and prompts you for a "SearchString==>" (the 'S' after the '\' character is the switch character that turns on the search mode-- more about that later.) At this prompt you items in a binary tree data structure. Therefore the routines for searching a disk directory for files that match an ambiguous file specification and processing them in alphabetical order were the first to be written. The techniques were, of course, not original with me; they can be found in any modern book on structured programming. The ones I used came from How to Solve it by Computer by R. G. Dromey, 1982, Prentice-Hall, Englewood Cliffs, N.J. The idea of usi file specification and then terminate with a "warm boot" back to CP/M. If, on the other hand, no parameters are included on the command line you are prompted for them after NFILELST loads into RAM and after the indicated files are processed you are again prompted to enter another file specification. The program continues to perform an endless loop in this manner until either no match can be found for the file specification or you enter only a carriage return at t the 'new' program will have the new values of these constants. Turbo's Untyped Files and the Mem array provided a natural way for the program to save itself to disk. This feature is there simply because it was so much fun to make it work. The COM file that is included on the disk uses the technique of dynamic memory allocation described by James R. Shiflett, Micro C #25. The source file contains the necessary code for this but it is commented out. It takes enter: Tim The program searches all files on the default drive with the extension .PAS for the string "Tim" and list all lines with line numbers that contain the string on the monitor; after finishing this the program returns to CP/M, The two methods of invoking NFILELST serve different purposng this technique to list a group of files came when I realized that in the course of my work I had amassed about thirty dBASE II *.CMD files on a hard disk, many of them five or so lines long and most of them quite vague in my mind. Of course, I had not put the names of the files in the files themselves so although I could list them to the printer to look them over when I had finished I couldn't remember which lists went with which filenames. What I needed was a utilhe prompt. Experienced CP/M users will notice a resemblance to PIP in this behavior. To illustrate: you type Action ________________________________________________________________ NFILELST The program loads and prompts the user for a filespec with the prompt "ListFile==>" at which point you type B:*.PAS The program lists all files on disk B:   es; if one or more files that may be grouped by means of wildcards are to be listed or searched the first method, using command line parameters, is quicker and the program terminates when it is finished, on the other hand if a series of files that can not be grouped with wildcards is to be processed the second method allows the program to remain in memory until you are finished with it. LISTING FILES TO THE PRINTER To send a text file or group of files to the syechoed to the printer if the printer switch 'P' is used. SWITCH CHARACTERS Various switch characters may be entered along with filespecs or pattern strings either on the command line or at prompts. These switch characters modify the way that NFILELST works. We have already mentioned a number of these switches and indicated what effect they have. The '\' symbol indicates that the characters that follow it are switch characters and separates them from the rest of the entry linearch mode and the user will be prompted to enter the string to be searched for. At this time additional switch characters may be entered immediately after the pattern string that will affect the way the search is carried out. It should be noted that any spaces that precede the '\' character that begins all switch character strings will be considered to be part of the pattern string and will be included in the search. As the search proceeds the name of the file being ses NFILELST into the search mode rather than the default list mode. This character must be entered with the filespec, otherwise the listing to the printer will begin and no prompt for a search string will be given. L - Line numbers -- Causes the listing to include line numbers, inappropriate for searches - line numbers are always listed during a search. C - Case -- Causes searchestem printer the file or files need only to be named on the command line or at the prompt without adding the 'S' switch (more about switches in a moment.) This will cause the files that match the given filespec to be listed to the printer with the file name listed on the first line in the form '********** D:FILENAME.EXT **********'. This name will be the actual name of the file including the drivespec, wildcard characters (*,?) will not appear. The printe. When the switch string follows a filespec the '\' symbol must be proceeded by a space character or it will be taken to be a part of the filespec. However, when it is entered after a search string it should follow immediately after the last character to be searched for. As many characters as desired may be entered at a time and invalid characters will simply be ignored as will those characters that are valid switch characters but are inappropriate in aarched is written to the screen as well as any lines in the file, with line numbers, that contain the pattern string. It is important to realize that the search proceeds a line at a time throughout the file being searched and therefore a string that is not contained completely within a single line will not be found. The search is normally case sensitive but case will be ignored if the case switch 'C' is entered in the switch string. Also all output from the search will be s to ignore case, otherwise upper and lower case characters are considered to be different, inappropriate if not in search mode. P - Print -- Causes output from the search mode to be echoed to the printer, inappropriate if not in search mode. W - Wordstar -- Tells NFILELST that the text files to be listed or searched are Wordstar document files. This is necessary because such files are nr listing will be paginated according to certain preset options such as top margin, lines per page, and page length. Line numbers may be printed by using the 'L' switch character. SEARCHING FILES FOR A PATTERN STRING To search a file or file group for a particular text string the 'S' switch character must be added, after a space, to the filespec when it is entered on either the command line or at the prompt. Entering this character will place NFILELST in the se given situation. An inappropriate switch character is one that can have no effect in a given context; for example calling for the output of a search to be echoed to the printer ('P') when the search mode ('S') is not switched on would be inappropriate. The following is a list of the switch characters that are recognized by NFILELST with a description of their actions, when they should be entered, and under what circumstances they are appropriate. S - Search -- Switche  ot strictly ASCII files; high order bits are set in all words and soft carriage returns and the file may contain control codes that will do strange things to your printer. This switch tells NFILELST to strip all high order bits from the characters before listing or comparing them with the search string and to skip control codes. This switch may be used with non-Woe formfeed character the bottom margin will be generated by the given number of linefeeds. The prompts in this mode are self explanatory and only required information is requested (if you answer 'yes' when asked if your printer understands formfeeds you will be requested to enter the formfeed character that it wants and will not be asked for a value for a bottom margin, it is not needed if formfeeds are used, but if you answer 'no' the reverse will hold.) To enter until now and deserves a more detailed discussion. When a file is listed to the printer the page is formatted using a preset top margin, bottom margin and number of lines per page. As distributed NFILELST formats the page with a top margin of three lines, a bottom margin of 8 lines and prints 55 lines of text to a page. This adds up to the standard 66 lines per page used by most printers. Furthermore the bottom margin is generated by sending a formfeed characprogram FILELST(INPUT,OUTPUT); {Frank C. Jones October, 1985} {Lists one or more text files to the LST: device. Ambiguous filenames may be used in the specification} {$U+ Allow ^C to stop program} {$a- Allow recursion} TYPE link = ^node; Fcb = array[1..32] of char; {File control block} Dma = array[0..3] of Fcb; {Return found filenames here} datatype = string[12]; filetype = string[14]; linetype = string[255]; ch_array = array[1..25] of char; rdstar files but processing will be slowed slightly due to the additional, unnecessary processing. D - Display -- This switch produces a display of the printer parameters such as top margin, etc. It may be entered at any point and will not interfere with any other operation. M - Modify -- This puts NFILELST in the modification mode. In this mode you will be prompted to  a control character use the text representation of the character ie. a '^' character followed by a 'O' character will be interpreted as a control-O character. If you wish to enter the '^' character itself precede it with the backslash character '\' as an escape. To enter '\' enter it twice - '\\'. When all of the required parameters have been entered you will be prompted for a filename to save the new version under. If you enter the original name the old file will be ovter (^L) to the printer, an initialization string of '^O' is sent to put Epson printers in the compressed mode and when the listing is finished a reset string, '^[@'is sent to the printer. All of these parameters may be changed by entering the Modify mode and the modified program may be saved to disk under any name you wish (there is no checking for existing files so be careful not to overwrite a file unless that is what you want to do. If your printer does not understand th node = RECORD left, right :link; {Found filenames are stored in} data : datatype {in these nodes in a binary tree} END; VAR Fcb_1 : ch_array absolute $5c; xfer : ch_array; i,j,n : byte; Block : Dma ; file_Name: filetype; pointer : link; word : datatype; InString : linetype; curdsk : byte absolute $4; ws_flag, chng_flag, case_flag, lno_flag, srch_flag, cmnd_flagenter new printer parameters including a setup and reset string. When the modification is completed you will be prompted for a filename to save the modified version under. This mode makes all other switches, with the exception of Display inappropriate. The next section describes this mode in more detail. MODIFY MODE The Modify mode has not been mentioned erwritten, a new name will produce a new file and keep the old one. This will allow you to generate several versions of NFILELST under different names for different purposes. The idea behind this method was to produce a utility that could be invoked quickly to do a simple job setting up parameters each time the program was used would slow things down considerably; it is better to have different versions for different purposes.  was used would slow things down co  , stat_flag, prn_flag : boolean; MemTop : integer absolute $6; {Where CP/M keeps its Mem. Size info} CONST {Change these constants for} Lines_per_Page : integer = 55; {different page formats } Top_Margin : integer = 3; Bottom_Margin : integer = 8; form_feed : boolean = true; ff : char = ^L; set_up_string : string[10] = ^O; reset_string : string[10] = ^['@'; {The number of lines in Lines_perACTER IN ['\','^']) THEN BLDSTR := BLDSTR + CHARACTER ELSE BEGIN FLAG := CHARACTER; J := J + 1; CHARACTER := INSTRING[J]; IF FLAG = '\' THEN BLDSTR := BLDSTR + CHARACTER ELSE BEGIN CHARACTER := UPCASE(CHARACTER); BLDSTR := BLDSTR + CHAR(ORD(CHARACTER) - $40); END; END; UNTIL J >= LENGTH(INSTRING); SETPRN := BLDSTR; END; {-----------------------------------} BEGIN WRITE('How many line FILETYPE = STRING[14]; ANSWER = STRING[40]; var ans : char; newfile : filetype; ansstr : ANSWER; {-----------------------------} PROCEDURE CLONE(FILENAME :FILETYPE); VAR CLONEFIL : FILE; BEGIN ASSIGN(CLONEFIL,FILENAME); WRITE('Writing file ',filename,' '); REWRITE(CLONEFIL); BLOCKWRITE(CLONEFIL,MEM[$100],$70);{<-- This number must be set equal to } CLOSE(CLONEFIL); {the numberof 128 byte records in the } writere wsreadln(var infile :text; var outstring : linetype); var ch : char; almost, done : boolean; begin almost := false; done := false; outstring := ''; repeat read(infile,ch); ch := chr(ord(ch) and $7f); if (ch = ^J) and almost then done := true else if (ch = ^M) then almost := true else almost := false; if (not almost) and not (ord(ch) in [0..31,126,127]) then outstring := outstring + ch; until done or eof(_Page + Top_Margin + Bottom_Margin must equal the total number lines on a sheet of paper for your printer. If your printer understands the formfeed character '^l' only Lines_per_Page and Top_Margin need be considered in this total as Bottom_Margin will be whatever is left on the page.} {-----------------------------------------------------------------------} PROCEDURE DISPLAY; BEGIN WRITELN('Lines per page = ',Lines_per_page); WRITELN('Top margin = ',Top_Margin); WRITELN('Bottom ms to print per page => '); readln(lines_per_page); WRITE('How many lines for a top margin => '); readln(top_margin); write('Does your printer recognize a form-feed character [Y/N] '); read(ans); if upcase(ans) = 'Y' then begin writeln('es'); write('Enter formfeed character; (control as "^" character) => '); readln(ansstr); ff := setprn(ansstr); Form_Feed := true; end else begin writeln(^H'No'); write('How many lines for a bottom ln('--- WRITTEN!'); {code portion the compiled program, } bdos(0); {from $100 to the end of the code } {segment.} END; {-----------------------------} FUNCTION SETPRN(INSTRING :ANSWER) : ANSWER; VAR J : INTEGER; FLAG, CHARACTER : CHAR; BLDSTR : STRING[40]; BEGIN BLDSTR := ''; J := 0; REPEAT J := J + 1; CHARACTER := INSTRING[J]; IF NOT (CHARinfile); end; {-----------------------------------------------------------------------} PROCEDURE GetFile; {If the filename is not given on the command line this procedure is called to ask for and get the possibly ambiguous filename to list.} VAR j,n : byte; ch :char; BEGIN writeln; write('List File ==> '); readln(InString); IF InString = '' THEN Bdos(0); {Parse filename (possibly ambiguous) to proper form for BDOS and put it in the the file control block FCB_1} argin = ',Bottom_Margin); IF form_feed THEN WRITELN('Form feed character chr(',ord(ff),') is used') ELSE WRITELN('Form feed character not used'); WRITE('Setup string = '); FOR I := 1 TO LENGTH(set_up_string) DO WRITE('chr(',ord(set_up_string[i]),'), '); WRITELN; WRITE('reset string = '); FOR I := 1 TO LENGTH(reset_string) DO WRITE('chr(',ord(reset_string[i]),'), '); WRITELN; END; {-----------------------------------------------------------------------} PROCEDURE RE_DO; TYPE margin => '); readln(Bottom_Margin); Form_Feed := false; end; write('Enter printer set up string'^m^J' only if none desired. '); readln(ansstr); set_up_string := setprn(ansstr); write('Enter printer reset string'^M^J'{RETURN} only if none desired. '); readln(ansstr); reset_string := setprn(ansstr); write('Filename for new version ==> '); readln(newfile); clone(newfile); END; {-----------------------------------------------------------------} procedu  FOR n := 1 to length(InString) do InString[n] := UpCase(InString[n]); n := pos(':',InString); IF n = 0 THEN Fcb_1[1] := chr(0) ELSE Fcb_1[1] := chr(ord(InString[n-1]) - ord('A') + 1); j := 2; FOR n:= n + 1 to length(InString) do BEGIN ch := InString[n]; IF j < 10 THEN {If '*' is found in filenane then change to '?' for the remaining characters} BEGIN IF ch = '*' Then WHILE j < 10 do {expand the '*' wildcard}  THEN TreeInsert(left,newdata) ELSE IF newdata > data THEN TreeInsert (right,newdata) END; {------------------------------------------------------------------} PROCEDURE List_File(tree : link); {This procedure uses recursion to search the previously constructed binary tree in alphabetacal order and send to the list device any file that it finds there. } PROCEDURE Remove_Blanks(VAR strvar : filetype); VAR i : integer; BEGIN i := TRUE; IF POS('W',SWITCH) <> 0 THEN WS_FLAG := TRUE; IF POS('C',SWITCH) <> 0 THEN CASE_FLAG := TRUE; IF POS('S',SWITCH) <> 0 THEN SRCH_FLAG := TRUE; IF POS('P',SWITCH) <> 0 THEN PRN_FLAG := TRUE; IF POS('D',SWITCH) <> 0 THEN STAT_FLAG := TRUE; IF POS('M',SWITCH) <> 0 THEN CHNG_FLAG := TRUE; END; {---------------------------------------------------------------------} PROCEDURE TreeInsert (VAR tree :link; newdata : datatype); {This procedure inserts a foun Uline[0] := chr(length(line)); END ELSE Uline := line; IF pos(Search_String,Uline) <> 0 THEN BEGIN write(count:5); writeln(' ',line); IF PRN_FLAG THEN BEGIN WRITE(LST,COUNT:5); WRITELN(LST,' ',LINE); END; END; END; END; {--------------------------------------------------------------} PROCEDURE Print_File(file_n BEGIN Fcb_1[j] := '?';j := j + 1 END ELSE IF ch = '.' then WHILE j < 10 do BEGIN FCB_1[J] := ' '; J := J + 1 END ELSE BEGIN Fcb_1[j] := ch; j := j + 1 END END ELSE {If '*' is found in ext then change to '?' for the remaining characters} BEGIN IF ch = '*' THEN WHILE J < 13 do BEGIN Fcb_1[j] := '?'; j := j + 1 END ELSE IF ch = '.' THEN ELSE := 0; repeat i := i + 1; WHILE strvar[i] = ' ' do delete(strvar,i,1) UNTIL strvar[i] = '.'; END; {---------------------------------------------------------------------} PROCEDURE Search_File (file_name : filetype;Search_String :linetype); VAR FileVar : Text; Uline,line : string[255]; count : integer; BEGIN writeln; write('Searching file ',file_name);writeln(' for ',Search_String); writeln; IF PRN_FLAd filename into a binary tree data structure so that it can be retrieved in alphabetacal order for processing} BEGIN IF tree = NIL THEN BEGIN new(tree); WITH tree^ DO BEGIN left := NIL; right := NIL; data := newdata END { with } END ELSE WITH tree^ DO IF newdata < data ame : filetype); VAR FileVar : Text; line : string[255]; lcount, count : integer; {-----------------------} procedure top; var i : integer; begin for i := 1 to top_margin do writeln(lst); end; {------------------------} procedure bottom; var i : integer; begin if form_feed then write(lst,ff) else for i := lcount to lines_per_page + bottom_margin do writeln(lst);  BEGIN Fcb_1[j] := ch; j := j + 1 END END; END; FOR N := j to 12 do Fcb_1[n] := ' '; END; {--------------------------------------------------------------------} PROCEDURE PROCESS_SWITCH(INSTR : LINETYPE); VAR SWITCH : STRING[10]; BEGIN SWITCH := ''; J := I +1; WHILE (INSTR[J] <> ' ') AND (J<= LENGTH(INSTR)) DO BEGIN SWITCH := SWITCH + UPCASE(INSTR[J]); J := J + 1; END; writeln('SWITCH = ',switch); IF POS('L',SWITCH) <> 0 THEN LNO_FLAG G THEN BEGIN writeln(LST); write(LST,'Searching file ',file_name);writeln(LST,' for ',Search_String); writeln(LST); END; count :=0; assign(FileVar,file_name); reset(FileVar); WHILE not EOF(FileVar) do BEGIN if ws_flag then wsreadln(FileVar,line) else readln(FileVar,line); count := count + 1; IF case_flag THEN BEGIN FOR n := 1 TO length(line) do Uline[n] := UpCase(line[n]);    end; {------------------------} BEGIN top; writeln('Printing file ',file_name); writeln; writeln(lst,'********** ',file_name,' **********'); writeln(lst); count :=0; lcount := 2; assign(FileVar,file_name); reset(FileVar); WHILE not EOF(FileVar) do BEGIN if ws_flag then wsreadln(FileVar,line) else readln(FileVar,line); count := count + 1; lcount := lcount + 1; IF lcount >ambiguous) filename on the command line; the requested files are listed and the program terminates with a Warm Boot. If there is no filename on the command line cmnd_flag remains TRUE, the procedure GetFile is called and the program loops until a null string is entered when a filename is requested. This is reminescent of the behaviour of PIP.} I := POS('\',instring); if i <> 0 then process_switch(instring); if stat_flag then DISPLAY;  END END; {====================================================================} BEGIN (* StackPtr := MemTop - $826; {place stack pointer below CCP} RecurPtr := StackPtr - $400; {place recursive stack 1k lower} HeapPtr := $450f; {SET COMPILER END ADDR. BELOW THIS VALUE ($4500)} {The above code is taken from an article by James R. Shiflett, Micro C #25. If you wish to compile this code to a .COM file that will run on any CP/M machine uncomment the code and READ THE ARF ord(Fcb_1[1]) = 0 THEN Fcb_1[1] := chr((curdsk and $F) +1); {Default drive?} if srch_flag then else write(lst,set_up_string); List_File(pointer); if srch_flag then else write(lst,reset_string); Fcb_1 := ' '; {Clear out FCB } release(pointer); END; END.  Lines_per_Page THEN BEGIN bottom;top; lcount := 1; END; if lno_flag then write(lst,count:5,' '); WRITELN(LST,LINE); END; lcount := lcount + 1; bottom; END; BEGIN IF tree <> NIL THEN BEGIN List_File(tree^.left); file_name := ' '; file_name[1] :=chr(ord(Fcb_1[1]) +64); file_name if chng_flag then RE_DO; IF SRCH_FLAG THEN BEGIN WRITE('Search String ==> '); READLN(INSTRING); I := POS('\',INSTRING); IF I <> 0 THEN BEGIN PROCESS_SWITCH(INSTRING); INSTRING[0] := CHR(I -1); END; IF CASE_FLAG THEN FOR I := 1 TO LENGTH(INSTRING) DO INSTRING[I] := UPCASE(INSTRING[I]); END; n := Bdos(17,Addr(Fcb_1)); {Seek first service request} IF n <> 255 THEN TICLE BY SHIFLETT.} *) cmnd_flag := TRUE; WHILE cmnd_flag DO BEGIN chng_flag := FALSE; case_flag := FALSE; ws_flag := FALSE; srch_flag := FALSE; prn_flag := FALSE; stat_flag := FALSE; lno_flag := FALSE; pointer := NIL; Bdos(26,addr(block)); IF paramcount = 0 THEN GetFile ELSE begin cmnd_flag := FALSE; instring := paramstr(2); end; {Cmdflag is set FALSE if there is a (possibly [2] :=':'; insert(tree^.data,file_name,3);delete(file_name,3,1); insert('.',file_name,11); Remove_Blanks(file_name); {The above 5 lines convert the filename from FCB format to the format required by the Pascal file handling procedures.} if srch_flag then search_file(file_name,Instring) else Print_File(file_name); List_File(tree^.right);  {Seek successful} BEGIN word := block[n]; TreeInsert(pointer,word) END ELSE {Seek failed} BEGIN writeln('File not found'); BDOS(0); END; while n<>255 do BEGIN n := Bdos(18,addr(Fcb_1)); {Seek next} IF n<> 255 THEN BEGIN word := block[n]; TreeInsert(pointer,word) END; END; I  ͫCopyright (C) 1984 BORLAND IncA Kaypro 4-84 hiliteedPB44B44= EERRTC1B1~7#~=% o&ͦoͦܐԩͣ}!!"8~#(}:$= +*!Z!*B!!:(=2!Z: <2!!!:O::O:!*B͏ ?x P , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx(ͼ ?}ٽÏ }ց; <(; 7D = |٤g{٣_z٢Wy١Ox٠GD u J }x>uu}ƀ/ƀo; -J }0W-J W,}l˸ͨ 8 ; ` x( -ͨ 8J -ͨ 8,J }l8;*!` ! >u` ` u--- J ,,,-xGg?+2n*8t z~,->uxuH\<z5+)+<z {0Gɯgo||H}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'ͬͬdͬ ͬ} wͦWͧ _}8(8J`9{T]=o`9y  x0w#xG%P %P ZJDM%P = _~65i+~hìx-Sx9?+{Η@}|C C gZJDM0D ,7}o˸  #yO!@9i&   # w# /w#! !45(!.+/ 0y0( d!kZ!{Z͈͈o&  :(y ͠|( *"x2y( >28!?"9!!>2 :D]SXN]D [ (!e}̈́A8Q0G: x@!\w# (   yV. V!h6# (*(.(!8}(*(̈́w#>?> w#a{ |͒}͛Ɛ'@'7||}>"C"6# ""͐ͩ*B"[R5*"^#V#a}.; OJ , ; !U >,k- o&0%,` }g; }؉}颋.:}8c~I$I~L*kٷx˸; }0G,͙<},-(-J ! >0 a` o8 Oþ >um.`1pF,t6|!wS<.z}[|%FXc~ur1}Oٯx(<˸ͨ 8; !~Jͨ 0O!><ͨ 8 =  7 <` O ; 7 0 W-J OT0 j oD,:j !I}袋.}8c~I$I~L!>xW^8/w >uJ u` }>(; xQ }} ˸T}ٕ(0D=C ,= ( [ 0%D , 7 ͏ ?(8u x O - ; 8˸x X ,-xG}; }م 9; .>#n0[ D = - nx P ,-(-˸G,-; }ٕ? 9.>͏ 8u ?= u+-(>O 0u O 8 w#!9! E9!!9~(+F͊!"9!(#>2*Ͳ"|>" :( ͆ *6#w*6#6 !\$![ (̈́( #:~CONTRMKBDLSTAUXUSR>2$*#~ Ͷ$*:> >w###6  #6++p>2S-$Ͷ:*6###ww#w$w#w: ##N#F*B> w#w#[s#r>2S$Ͷ$*6 #-Nw#Fwq#p#6#w#w#w* :( ͒^#V#N#FO/o&9O/o&9!9(> (G!9 w#E͊w}8uRB0 >R@RR!+ͨ z R!+ͨ z <!+ͨ z <!+ͨ z <!#ͨ z <!+ͨ z T]KB!z> S>))0 = |JJDMgo>jB0 7?= u` ` 77 ` = O nf^VNF!DLT\I!!53!r1!\!> x #-= o˸xO(- }(x>8(C ,C `iM!>u|; |J>| )=|(DMbo˸ͦ88ͦx(0 8> Mx(>-Ͳ{(ay(Ͱͦ \z(>.Ͳ (Ͱ ~ͦ{>EͲ>+|(|Dg>-Ͳ|/ 0:p# ~# +>0w#,-  60#J˸}րogM| .  : *^ F* < >26"~͟*-w#ww#͟"~ <@*Ͳ!\  <ʮ!\$> >2*|>! * \$\<(!: [1Á\!(f"> 2:!<"F( #~#6e>!["N>!~8>O6*"w (=(&("( :(N 8y(~#x+% (6*#~[*#~ *~(h#"b=  8(T]DMR0 -a%}̈́o*!~6o&͠|ͣ}%^C User break1:% I/O% Run-time% error ͒%, PC=[R"͍% Program aborted*1!͍!7@ͲË0"!* m"*""!}2*&!}2*&*&͛EE !}2Ó !*&+)"* *n&*n&5* *n&*n&5\}2*&}oE !}2*&*&͇EW!!*&+)"*n&E!* *n&*n&5* **###w* N#FB ͟r+s> !T]>)j)0 0= UR!#U*^#V#N#F#^#V>">!2DM"~x(L* :O(o:" C}=( ?*-N#Fp+qq#p! * F+N+++V+^Bq#p>>> SRѷR* s#r$ s#r"S"! N#FB(^x * 6#[<(H*! Kq#p##K[! *! 4 #4! x *$ *>w""{_!"*nf}(HR0nf" ^VMDnfutqpͯEV$**+)**+)^#Vs#r**+)*s#r**R**R͛E%*&#}2!*&+)*s#r!*&+)*+s#r*&#}2!*&+)*s#r!*&+)*s#r=&*&#}2!*&+)*s#r!*&+)*s#r*&#}2!*&+)*s#r!*&+)*+s#r6"*+!Ez '"**#+)^#V**+)^#V E'**+)^#V"*#"**++)**+)^#Vs#r*#"**͛E&!}2&**+)^#V* }o}2*&E J= B== ͯ}8= ͵}/ͭ !*###~-_~(4Q6*>2>*##w:>*##~*#~(E[ ( ( ( !][ ( ( ((w#(6!]~-#8~>7  [>OkͼMs #rkͼpX á[ [ (( #w(q*#~[ (  *##~6͜O$*#~(08ʦ=ʦ==ʩ=ʬò+###~-_q46͡> *:4^q}Ò*|(n&*n&5ͽ}2W!* *n&*n&5* *n&*n&5ͪ}2*&!! <b!b""!͝}o*s*n&Eʱ!!8*._b!b!! <b!b"![* !q͐b!bi0ä)!}2!!+)!s#r!!+)*s#r*&!͛E@&!*&+)^#V"!*&+)^#V"*&+}2**R! tE=&*#"**! "**+)^#V"**+)**+)^#Vs#r**+)*s#r**+)^*s#r*s#r"* 5KB!>u~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6# * *!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#VS>O"w2x2!"" @*>2"!"""!\Ͳ*: !~6go(\R*s#r_2x( s x&**++)*s#r*+L&""!"~*~*ͯE'*&!tEʁ'!*&+)))))*!gb!}2**~R"|*|!*&R͛Eʼ'!*&R"|**~**&*| *~*|"~*&*|}23'*&!tE/(ŔMerge order too great!͐b*&#}2*&!!st*&! aEʁ(*&!:e.l !s !sͲ!*&+)))))!s .$$$=!*&+)))))yb!}2"!*5z))"q**q+)^#V"o!oM|( M6-#͐ͦ[R8 (G> ͒C~͒#*ͦC!h !lTRUEFALSEͦ!9^#(~#(G~͒#> ͒> Ò "F![(#RR0*4#4> RR *4 #4(>>2$*V(/˖:(#~+ x y2!͵( =( X:(R*:(###~-_-͌X> :("͟"*^˞*V˖0 SRѷR8A* N#F#s#r$ 0})jS\#V**+)^#V Eb#**+)^#V"**+)**+)^#Vs#r**+)*s#r**+)^#V**+)^#V E#**+)^#V"**+)**+)^#Vs#r**+)*s#r**+)^#V**+)^#V E>$**+)^#V"**+)**+)^#Vs#r**+)*s#r*"**+)^#V"*#"**+)^#V* }oEV$*+"***+)^#V }oE}$**ͯE$**+)^#V"**+)**+)^#Vs#r**+)*s#r**  !!'**q+)^#V*o!'*q#(!"o!o!!'!*&+)))))*!gb!*&+)))))Sb*"**"**R"!"]!!!ͥ"!*ͥ!}2*"**"**R"!"*!t*!!ͯ}oE*'*!w!*&Ev**!R"*!+)*s#r**"**R"*#"*&}oE)Ͳ!*&!͛Eʯ**!͛Eʬ*'*"ͼ!!*5z*"**+)^#V!*#*!!*:!!:o,fter any field's position and length to͐bŔ?indicate that lines should be sorted in ascending or descending͐bŔ>order on that field. If neither is specified, `A' is assumed.͐bR͐bŔUnsorted input file: b!+._bŔSorted output file: b!+._bR͐b!}2*&! ͯ}2E*E&E6ŔKey #*&!!́ (pos len [A/D]) or : b!"C!"A!C+!A!@_b*@&!NE4!A}2@*C!N*A!N}o*@&!ANd\b*d0*d2^#V:*d6!:!T*&+)^#V"d*&+}2!}2h!}2g*g&*&͇EL0*g&*&ͯE/!T*g&+)^#V6^#V!T*g&#+)^#V6^#V }oE/*g&#}2g!T*g&+)^#V6^#V*d6^#V E:0!T*h&+)!T*g&+)^#Vs#r*g&}2h*h&!}2gI0*&!}2gX/!T*h&+)*ds#rÊ.!}2"*&!͛Eʊ0*cŔ6SORTLINE sorts the lines of a text file on as many as ! !͐bŔ=key fields, and writes the sorprogram sortline; {-- A simple utility demonstrating the use of the `srt' routine. Sorts the lines of an input file on as many as ten key fields, and writes the sorted lines to an output file or device. --} {-- The following definitions are specific to this particular sorting program. Most sorting programs will contain some such "private" material; details vary depending on what is being sorted, where it's coming from, and so on. --} const MaxKey = 10; "N"P"R!"H*R"J*H*NͯEn,*J4^#V*J2^#VtE+*JU*JMR"F*F*J2^#V! ͛Eʗ+*J2^#V! "F*J*J0^#V*Fkb*J4!s#r*N*HR"F*F*J2^#V*J4^#VR͛E,*J2^#V*J4^#VR"F*J0^#V*J4^#V*P*H*F *J4*J4^#V*Fs#r*H*F"H+!*&5zʳ,}2f!*f&+)))))6!ͥ*f&#|,!*&5zʇ.}2f!*f&+)))))"d*d"k*k2! *}oE5!}2E6*@&(}2@*C!t*A!͛}o*C*A!͇}o*@&Q!Aa!Da}oE5*&!}2!*&+)*Cs!*&+)*As!*&+)*@&!ANs6Ŕ'Invalid key specification -- try again͐b*E&}oE=4*&!NE6R͐bŔ0No keys specified; ascending sort on entire line͐b!}2!!+)!s!!+)!s!!+)!sR͐bŔ Sorting ...͐b! "Ŕ ... Sorted!͐ted result to a file or device.͐bR͐bŔ keys then checking := False else with key[i] do checking := Copy(a,bgn,siz) = Copy(b,bgn,siz); until not checking; srt_precedes := False; if i <= keys then with key[i] do if asc then srt_precedes := Copy(a,bgn,siz) < Copy(b,bgn,siz) else srt_precedes := Copy(a,bgn,siz) > Copy(b,b Write ('Sorted output file: '); ReadLn (out_name); WriteLn; keys := 0; repeat ask_again := keys < MaxKey; if ask_again then begin Write ('Key #', keys+1, ' (pos len [A/D]) or : '); bgn := 0; siz := 0; ReadLn (bgn, siz, dir); if dir = #26 then dir := 'A'; if (bgn = 0) and (siz = 0) and (dir = 'A') then ask_again := False else begin dir := UpCase(dir); r; dir : char; begin {main program} ClrScr; WriteLn ('SORTLINE sorts the lines of a text file on as many as ', MaxKey); WriteLn ('key fields, and writes the sorted result to a file or device.'); WriteLn; WriteLn ('The lines may be no longer than 255 characters (plus CR/LF).'); WriteLn ('Longer lines are truncated without warning.'); WriteLn; WriteLn ('Key fields are specified by their starting position and length;'); WriteLn ('a field consisting of the first ten gn,siz); end; procedure srt_open_raw; begin Assign (fcb, raw_name); Reset (fcb); end; procedure srt_read_raw (var itm : srtrec ; var got : Boolean); begin got := not EOF(fcb); if got then ReadLn (fcb, itm); end; procedure srt_close_raw; begin Close (fcb); end; procedure srt_open_out; begin Assign (fcb, out_name); Rewrite (fcb); end; procedure srt_write_out (var itm : srtrec); begin WriteLn (fcb, itm); end; procedur if (bgn >= 0) and (siz > 0) and (bgn + siz <= 256) and (dir in ['A','D']) then begin keys := keys + 1; key[keys].bgn := bgn; key[keys].siz := siz; key[keys].asc := (dir = 'A'); end else WriteLn (#7'Invalid key specification -- try again'); end; end; until not ask_again; if keys = 0 then begin WriteLn; WriteLn ('No keys sp   S O R T / M E R G E F O R L A R G E F I L E S -- USAGE -- SRT.PAS contains `srt', a Turbo Pascal procedure which sorts large amounts of data, that is, more than can fit in memory at one time. It is intended to be included (either by {$I} or by ^K^R) in a supporting program which provides the following: A definition of the type `srtrec' as the Pascal data type (often a record) defining the data items to be sorted. An Integer ly intended as an example of how to use srt in a program. Refer to it to see how to go about writing all the procedures and functions you must add to srt to make it go. (There are eight of them -- a daunting number, but most of them are trivial.) Note that all the functions and procedures in sortline declare their srtrec parameters as `var', even though srt_read_raw is the only one which actually alters its parameters. This is for speed: Turbo Pascal refers to a var  and `srt_close_out' have no para- meters. `srt_write_out' has one: a srtrec to be written. (N.B.: these procedures need not actually write a file; any means of absorbing output srtrecs will do.) `srt' itself has one parameter: a Char identifying a disk drive on which srt can store temporary files. This parameter should be a letter in the range 'A'..'P' or 'a'..'p', or a blank space to use the logged drive. The input and output files can reside on the same disk w on the same diskette; it will certainly not be possible to fit them on the same diskette as the merge files. (The total size of the merge files will be greater than the input or output, because of the two-byte Integer preceding each srtrec and because of disk frag- mentation.) Sorting a 320K file on a two-drive system would probably require a scenario something like this: Load the sort program from `A:', and at a convenient moment (say, in srt_open_raw) replace thfunction named `srt_sizeof' taking one srtrec para- meter. The function returns the number of Bytes occupied by the srtrec. (This value may be less than `SizeOf(srtrec)' if variable-length items are being sorted.) A Boolean function named `srt_precedes' taking two srtrec parameters. The function returns True if the first srtrec precedes the second, or False if the first follows the second or if their order doesn't matter. Three procedures to open, rparameter by passing its address on the stack, but makes a local copy of each non-var parameter. Unless your srtrecs are very small -- six or eight bytes, say -- you're probably better off incurring the overhead of the indirect reference than spending the time to copy them. -- CAPACITY -- `srt' is advertised as dealing with "large" amounts of data, but it is in fact unsuitable for "really large" amounts. A sorting program which is compiled to disk will haith each other and/or with the temporary files, if space permits. -- HINTS -- Pay careful attention to the function srt_precedes. If it com- pares two srtrecs and finds them equal in everything that matters, it must return False. Returning True in such a case could put srt into an infinite loop; you should write srtrec := a < b; rather than srtrec := a <= b; The program `sortline', while it can be useful in its own right, is primarie program disk with the input data disk. Use a formatted blank disk in `B:' for the merge files. When the distribution pass ends (that is, when srt_close_raw is called), remove the input disk from `A:' and replace it with the (empty) output disk. Before opening the output file, srt_open_out should use the Bdos procedure to reset the `A:' disk (otherwise `A:' will be considered read-only). If the program is compiled to disk (rather than directly toead from, and close the unsorted input file. `srt_open_raw' and `srt_close_raw' have no para- meters. `srt_read_raw' has two `var' parameters: a srtrec to receive the next input item, and a Boolean which it sets True if it stores an item or False if there are no more. (N.B.: these procedures need not actually read a file; any means of generating input srtrecs will do.) Three procedures to open, write onto, and close the sorted output file. `srt_open_out've something like 40K free space for the heap; this allows srt to handle up to about 320K of raw data. The constant `MAXMRG' could be changed to increase this amount, but not without limit: as the merge order grows, the merge buffers shrink and the number of seeks goes up rapidly. For "really large" files, it is not practical to do all the merging in a single pass. Even for files in the 180K-320K range some care must be taken. It may not be possible to put the input and output   memory), Turbo's overlay feature can be used to gain memory space. srt can be made an an overlay procedure by inserting the reserved word `overlay' just before the {$I} which includes it. The sub-procedures within srt can themselves be overlaid: in- corporate srt bodily into the program by means of ^K^R, then change all occurrences of `{overlay}' to `overlay'. -- MEMORY MANAGEMENT -- `srt' gobbles up all the heap space it can, leaving none for the  {file control block} buf : memptr; {address of I/O buffer} len : Integer; {length of I/O buffer} pos : Integer; {current position in buffer} itm : srtptr; {pointer to extracted item} end; mrgptr = ^mrgfil; {pointer to merge file info} var merge_order : 0..MAXMRG; {number of merge files used} mrg : array[1..MAXMRG] of mrgfhe array `indx' (which contains pointers to the in-core items). --} const srt_limit = 10; {smallest subfile for partitioning} var u, v : srtptr; {items being sorted} sr, sl : array[1..10] of Integer; {stack of subfile boundaries} d : 0..10; {current stack depth} l, r : Integer; {boundaries of current subfile} i, j : Integer; {miscellaneous indic procedures and functions described above. This means that New and GetMem cannot be used while srt runs. Recursion is also prohibited, since the recursion stack and the heap share the same area of memory. As distributed, srt uses Dispose and FreeMem rather than Mark and Release. The two methods of getting rid of unwanted heap must never be used in the same program, so you have two choices for using srt in a program which calls Mark and Release: Change the program to usil; {facts about each merge file} {overlay} procedure distribute; {-- First pass of `srt': read and sort a core-load at a time, writing the sorted data to temporary files for subsequent merge. --} type index_array = array[1..1] of srtptr; var core_base : srtptr; {base of working heap} core_size : Integer; {size (bytes) of working heap} free_core : Integer; {unused bytes in working heap} nexprocedure srt (merge_disk : char); {-- Sort/merge for large amounts of data. See `SRT.DOC' for instructions. --} const MAXMRG = 8; {maximum number of merge files} type srtptr = ^srtrec; {pointer to item being sorted} memory = array[0..0] of Byte; {miscellaneous storage} memptr = ^memory; {miscellaneous storage pointer} mrgfil = record {facts about a merge file} fcb : file; es} clumsy_flag : Boolean; {loop control for insertion sort} begin {procedure quicksort} d := 1; sl[1] := 1; sr[1] := new_items; {put entire file on stack} while d > 0 do {until all subfiles are sorted} begin l := sl[d]; r := sr[d]; d := Pred(d); if (r - l) >= srt_limit then begin {Use the median of the first, last, and middle items as the partitioning ee Dispose (or FreeMem). Change srt to use Mark and Release. This shouldn't be diffi- cult: `distribute' discards all its heap space at the end anyhow, and `merge' could easily be made to throw it all away at once instead of as each merge file is drained. t_item : srtptr; {where next item will be stored} indx : ^index_array; {where pointer to next item will go} new_items : Integer; {items currently in memory} mrgbuf : memptr; {address of merge file output buffer} mrg_bytes : 0..128; {bytes in current merge buffer} got_item : Boolean; {signal from `srt_read_raw'} i : Integer; procedure quicksort; {-- Sort t  lement.} i := Succ(l); j := (l + r) shr 1; u := indx^[j]; indx^[j] := indx^[i]; indx^[i] := u; if srt_precedes (indx^[r]^, indx^[i]^) then begin u := indx^[i]; indx^[i] := indx^[r]; indx^[r] := u; end; if srt_precedes (indx^[r]^, indx^[l]^) then begin u := indx^[l]; indx^[l] := indx^[r]; indx^[r] := u; end; ' onto the current merge file. --} var i, n : Integer; bdata : array[0..0] of Byte absolute data; begin {procedure write_merge} i := 0; while i < size do begin if mrg_bytes >= 128 then begin BlockWrite (mrg[merge_order].fcb, mrgbuf^, 1); mrg_bytes := 0; end; n := size - i; if n > 128 - mrg_bytes then n := 128 - mrg_bytes; Mo] := r; end else begin d := Succ(d); sl[d] := i; sr[d] := r; d := Succ(d); sl[d] := l; sr[d] := Pred(j); end; end; end; {All subfiles partitioned. Use insertion sort to clean up the small subfiles which remain.} for i := Pred(new_items) downto 1 do if srt_precedes (indx^[Succ(i)]^, indx^[i]^) then begin v := indx^[i]new_items do begin l := srt_sizeof(indx^[i]^); write_merge (l, SizeOf(l)); write_merge (indx^[i]^, l); end; l := -1; write_merge (l, SizeOf(l)); BlockWrite (mrg[merge_order].fcb, mrgbuf^, 1); Close (mrg[merge_order].fcb); next_item := core_base; indx := Ptr(Ord(core_base) + core_size); free_core := Ord(indx) - Ord(next_item); new_items := 0; end; {procedure if srt_precedes (indx^[l]^, indx^[i]^) then begin u := indx^[i]; indx^[i] := indx^[l]; indx^[l] := u; end; {Partition current subfile into two smaller ones.} j := r; v := indx^[l]; repeat repeat i := Succ(i); until not srt_precedes (indx^[i]^, v^); repeat j := Pred(j); until not srtve (bdata[i], mrgbuf^[mrg_bytes], n); i := i + n; mrg_bytes := mrg_bytes + n; end; end; {procedure write_merge} procedure sort_and_drain; {-- Sort the items currently in memory and write them onto a merge file. Each item is preceded by an `Integer' giving the item's size; the last item in the file is followed by a `-1'. --} var filename : string[4]; i, l : Integer; b; j := Succ(i); repeat indx^[Pred(j)] := indx^[j]; j := Succ(j); if j > new_items then clumsy_flag := True else clumsy_flag := not srt_precedes (indx^[j]^, v^); until clumsy_flag; indx^[Pred(j)] := v; end; end; {procedure quicksort} procedure write_merge (var data; size : Integer); {-- Write `size' bytes of `data sort_and_drain} begin {procedure distribute} srt_open_raw; GetMem (mrgbuf, 128); core_size := MaxAvail; GetMem (core_base, core_size); merge_order := 0; {The items to be sorted will be stored starting from the base of free memory and working upwards, while pointers to them will be stored at the top and working down. Memory is "full" when there's not enough room left in the middle to store a maximum-size `srtrec' and a pointer to it_precedes (v^, indx^[j]^); if i < j then begin u := indx^[i]; indx^[i] := indx^[j]; indx^[j] := u; end; until j < i; indx^[l] := indx^[j]; indx^[j] := v; {Put new subfiles on stack, larger deeper.} if (j - l) > (r - i) then begin d := Succ(d); sl[d] := l; sr[d] := Pred(j); d := Succ(d); sl[d] := i; sr[degin {procedure sort_and_drain} if merge_order >= MAXMRG then begin WriteLn ('Merge order too great!'); Halt; end; merge_order := Succ(merge_order); Str (merge_order, filename); if merge_disk <> ' ' then filename := merge_disk + ':' + filename; Assign (mrg[merge_order].fcb, filename + '.$$$'); Rewrite (mrg[merge_order].fcb); mrg_bytes := 0; quicksort; for i := 1 to   ; we will then sort what we've got, write it to a merge file, and start over. We assume that `SizeOf(srtrec) + SizeOf(srtptr) <= MaxInt', which seems fairly safe.} next_item := core_base; indx := Ptr(Ord(core_base) + core_size); free_core := Ord(indx) - Ord(next_item); new_items := 0; repeat if (free_core >= 0) and (free_core < SizeOf(srtrec) + SizeOf(srtptr)) then sort_and_drain; srt_read_raw (next_item^, got_ie - i; if n > len - pos then n := len - pos; Move (buf^[pos], bdata[i], n); pos := pos + n; i := i + n; end; end; {procedure read_merge} begin {procedure merge} {Get space for each merge file's current `srtrec'.} for f := 1 to merge_order do New (mrg[f].itm); {Open the merge files, allocate their buffers, read the first `srtrec' from each, and initialize the selection tree. There are e sorted output stream. --} var itmsiz : Integer; {length of an item} i, j : Byte; {0..2*MAXMRG} {selection heap indices} f : 1..MAXMRG; {merge file index} mptr : mrgptr; {pointer to merge file data} heap : array[1..MAXMRG] of mrgptr; {selection heap} procedure read_merge (f : mrgptr ; var data ; size : Integer); {-- Read `size' bytes from the merge file indicated by `f' an heap[j] := mptr; end; srt_open_out; {Select the "earliest" item (the one on the top of the heap) and write it to the output file, then replace it with the next item from the same merge file and adjust the heap as necessary. If the merge file is empty, close it and remove its entry from the heap. When the heap is empty, all merge files must be empty and sorting is complete.} while merge_order > 0 do begin mptr := heap[1]tem); if got_item then begin indx := Ptr(Ord(indx) - SizeOf(srtptr)); indx^[1] := next_item; next_item := Ptr(Ord(next_item) + srt_sizeof(next_item^)); free_core := Ord(indx) - Ord(next_item); new_items := Succ(new_items); end; until not got_item; srt_close_raw; if merge_order > 0 then begin if new_items > 0 then sort_and_drain; {flush out partial corsnazzier ways to allocate buffers, but the following algorithm seems reasonable, especially since we don't actually know where the final output is going.} for f := 1 to merge_order do begin mptr := Ptr(Addr(mrg[f])); with mptr^ do begin len := ((MaxAvail shr 7) div Succ(merge_order-f)) shl 7; if len = 0 then begin WriteLn ('Insufficient heap for merge!'); Halt; end stash them in `data'. --} var i, n : Integer; bdata : array[0..0] of Byte absolute data; begin {procedure read_merge} i := 0; with f^ do while i < size do begin if pos >= len then begin n := FileSize(fcb) - FilePos(fcb); if n > len shr 7 then n := len shr 7; BlockRead (fcb, buf^, n); pos := 0; end; n := siz; srt_write_out (mptr^.itm^); read_merge (mptr, itmsiz, SizeOf(itmsiz)); if itmsiz > 0 then read_merge (mptr, mptr^.itm^, itmsiz) else begin Close (mptr^.fcb); Erase (mptr^.fcb); FreeMem (mptr^.buf, mptr^.len); Dispose (mptr^.itm); mptr := heap[merge_order]; merge_order := Pred(merge_order); end; i := 1; j := 2; while j e-load} end else begin {the cannon kills the canary} quicksort; srt_open_out; for i := 1 to new_items do srt_write_out (indx^[i]^); srt_close_out; end; FreeMem (core_base, core_size); Freemem (mrgbuf, 128); end; {procedure distribute} {overlay} procedure merge; {-- Second pass of `srt': merge items from the temporary files created by `distribute' to produce thd; GetMem (buf, len); Reset (fcb); pos := len; read_merge (mptr, itmsiz, SizeOf(itmsiz)); read_merge (mptr, itm^, itmsiz); end; j := f; i := j shr 1; while i > 0 do begin if srt_precedes (mptr^.itm^, heap[i]^.itm^) then begin heap[j] := heap[i]; j := i; i := j shr 1; end else i := 0; end;   <= merge_order do begin if j < merge_order then if not srt_precedes (heap[j]^.itm^, heap[Succ(j)]^.itm^) then j := Succ(j); if srt_precedes (heap[j]^.itm^, mptr^.itm^) then begin heap[i] := heap[j]; i := j; j := i shl 1; end else j := merge_order + 1; end; heap[i] := mptr; end; srt_close_out; end; {procedure m S>))0 = | |́́DMgo>jB0 7?= H͓<z5b)b<z {0Gɯgo||}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'd } * W _}8(8J`9{T]=o`9y 28!"9!! og2"">~22!:05+:!Co&ͦͣ} [ (!e|ͧA8Q0G: x@!\w# (̓ ?(*( .( x_. _!h6# (?( *( ̓( w#>?> w#ͧ 8 !ɿ .,;:=?*[]<>{}a{ |͵};Ɛ'@'7||}>2Ͱ*Bک  "og"2>2! ,,,-xGg?+2n*8t z~,->( x( ͙}. ͇͂ , ! >5,ͣ- o&0% ,͘  }gs }؉}颋.:}8c~I$I~L*ͣٷx˸ }0G,<} ,-(-͂ !>J0 ͙͘ o8 ͇ >( m.`1pF,t6|!wS<.z}[|%FXc~ur1}͇ٯx(<˸ 8 !~J 0/O!>t 8 =  o t͘ ͇ /o 0 ͏-͂ OT0 j oD,:erge} begin {procedure srt} distribute; if merge_order > 0 {if entire file didn't fit in core} then merge; end; {procedure srt} ~8 (8~wPT] *  >( ͂ ͭ͘ }>( x‰ }} ˸T}ٕ(0D={ ,= ( ͓ 0%| , 7 ?(8ͭ x ͇ - s 8˸x ͐  ,-xG}s }مN 9s .>#n0͓ | = - nx ͈ ,-(-˸G,-s }ٕ?N  ""*B"[Rv*"^#V#^#V#N#FO/o&9O/o&9!9(> (G!9 w#Eͻw}8( RB0 >( RrRR!+ ͱ R!+ ͱ s!+ ͱ s!+ ͱ s!# ͱ s!+ ͱ T]KB!z>j !I}袋.}8c~I$I~L! >ͭ͘ JØ oo ͘ = ͇ nf^VNF!DLT\I!!53!r1!͓!> x #-= o˸x͇(- }(x>8({ ,{ `iÄ!>( |s |́>)=|(DMbo˸88x(0 8> ́x(>-{(ay( z(>. ( {>E>+|(|Dg>-|/ 0:p# ~# +>0w#,-  60#~ ͫCopyright (C) 1985 BORLAND IncBKaypro with hiliteedP=  E RC1B1~7#~=  oͦlԅ!!"~#(}:$= +*!6!*!!:(2!6:(>2!!!:O::O:!*! !45(! +/ 0y09.> 8ͭ ?= u+-(>͇ 0ͭ ͇ 8 ?x ͈ , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx( ?}ٽ }ցs <(s 7| = |٤g{٣_z٢Wy١Ox٠G| ͭ ͂ }x>( ͭ}ƀ/ƀo  -͂ }0͏-͂ ͏,}l˸ 8 5 ͘ x( - 8͂ - 8,͂ }l8;*!͘ ! >5ͭ͘ ͘ ͭ---   ˸}րogM| .({ = ~> x0w#xG%͈ %͈ ZJDM%͈ = _~65+~hìx-Sx9?+{Η@}|{ { gZJDM0| ,7}o˸@ #yO!@9i&"~ʱ*w#wx(9* :O *-4 #4!*4 #4 *-N#Fq#pV+^Bq#pS[ѷR'* s#r$ s#rM <?*M!\  <( !\$>2>2M:>!(* \$\<(!4: [1ð\!(7"~> 2"S"Ns#FrB(Z#\: \<(?*"}K\! !*}#"}! x \* *>* 2""{_!"*:4^q*##~6ͻ>2}*|(̈́|( ̈́6-#[RM8( G> A~#*(C! !TRUEFALSE!9N#Z~#( G~#> >    "~(lѻ(( !0 (ˮ!!>2S{:1:*6##ww#w$w#w:  ##N#F*B>2w#w#[s#r> "~ͯ*-w#ww##> ͯÂ""~>2:[R0 *4#4>2:[R> *4 #4(> +v# !"s*\Rj!!!gzg!"u!*un&!͓E^!*s*Z"s*u#0!!R!!!gz!"u!*u*un&!͓!*u*u!n&!͓}oE!*s*Z"s*u#!*s"* !i "q*q^#V!͓Eʤ"! 9*q^#V 9E>"*q^#V!á"! 9*q^#V 9El"*q^#V!á"*q^#V *q^#V ^#V!*)))))!s#rm#*q!*X!"X*q^#V"i![i *i !*)))))! +n&!s*@  #@w#@/w#@w#!9! E9!!9~(+Fͻ!"9!(#>2*"| >"2:( ͷ *w*6 !\$![ (ͧ( #:~CONTRMKBDLSTCAUXUSR>2j:*ˮ~1:*:(@q##p[* :(  ~* < >26"!"""~>2""v>2>"!"ˮ(!~8>~O6~*"nf}(HR0nf" ^VMDnfutqp*s#r*s#r"* vKB!1>( ~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6#L*L*!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#V""6#>O"w2x2*"!G"" 'z*"*>2"*">22*f(/˦:G(##~++ :O x yD!ͻ Q*:G(##~._.͛g<]=<͛*##w ͯ +4 #4x>>2:G("ͯ"*nˮ*0 S[ѷR8@* N#F#s#r- 0})jS\*##w+ N#FB ͯr+s>2!T]>)j)0 0= ^R!#^*^#V#N#F#^#V>2ͱ:1:*6 #-Nw#Fwq#p#6#w#w#w"~Â>">!DM!":*B:!>(>2>">!"2i!*)))))! +n&!s*i !*)))))!s#r*i!s#r*i!s#r i#!!!."N*v!*Ns*N!k *N !s!!.o&"!?}2:!"^!"X!!.o&"*!͓E$!*)))))! +n&!*j&}oE$!*))))) !! +!! +n&!|g}os!! +!! +n&!|g}os!! +!! +n&!|g}os!^!!o&"#>%}2R!"F!!gz4%"H!*Hw(6(2(-()(6 (8 0 :(* y(~#+ (( 66 #6 #"*: y~o p .##~ͻ(.6w4._~ =*##55= *[R8*~#"= ͣ}== ͯ}͵}*#w+#~+>*~('l!0(ˮ]l!8ˮ!]~-#8~>27lˮw>O%7̄s #r%ͤ7̐ l ( (ˮ ql(ˮ ( l ˮ*O:~ ##~._q4((=ʦ==ʩ=ʬò*!G"""!\*: Os!~6go(\R*s#r_2x( s x(T]DMx(R0 U(͞O/o&9q# (!>F0#( ~ ( #]( ~ ( (#}(  i&T-a%ã}ͧo*!~6o&|:2!2}:__{ѯ2*|KB " z ^C User break+=  I/O Run-time error {͵, PC=*ͰNot enough memory Program aborted :m'1!e!c7>3  O*R&|g}o!͓E+%*F!"F*H#$*F"S*S"e"g*V !+n&$*V !+n&$"Y*V^#V!*YR*Z*gs#r!"[!"W!*V^#V!!!gz&"U*W*[*U+n&$"W*U#%*V^#V!*WR*Z*es#rH' * $ ! "*!͓E?'*^#V8&*0!"0*2* ^#V"2*0!̀Eʯ&!!+)*s#rÿ&**s#r!*8gz*'":*0!&*:!R)^#V!̀E!'!̀}oEH/͜ͻblank filename not allowed NTD.DIR!!}2!!;ͤgzʦ/"!*n&e.N <>,;=?*[]ͳ!Eʝ/!}2*#`/*&E/͜ͻillegal character in filename NTD.DIR!!:e.!;ͳ!̀}2*&Eb0!.e.!;ͳ!̀EH0!;N.DIR>!!;!;>! 1!;NCON:͎!;NLST:͎}o}2!:e.!;ͳ!͓*&}o}oE0͜ͻ&CON: and LST: are only allowed devices NCON:! 1!ing of *6!'!k# "h}2jk "v!ͤ!o&"!*v!"V*V^#V!Eʄ+!"\Ê+!"\!*Vn&!RO"Z!*!1&!**R{!!U!;q!Uq!̀}2*&!^!;!!.e.!;ͳlN$$$>p !^ !;+}2*&El-E"I*I!Eo,!"I!K*I͜ͻ Copying ... !!;p ! !}oE=-!"E*E*I!}o}oE,*E!"E!ͪ*K*EE ü,*!;ͳ!}2!#e.!;ͳ!}2! !;ͣ >! e.>!͂!!!gz5"*!!Ϳ! !;ͣ >! e.>!!;!;ͳ!E5!^͂*͒!*#k5! !o&"!^͂E!6͂*͒!*&EA6͂!!͜!!"*!^PE#7! **&!*&!^!*!!^͂*!!͜4͂}o!^n&!|g}o!̀}oE#7͜ͻpress any key to continue  !ͪ*:+)*s#r*!s#r*:#&*"*^#V8& #!6!4$*hn&!|g}o!͓E}'*hͻ *X!!R!"8*8!Eʰ'!"8*8!̀E'!&!)!s#r!&!)!s#r!*8gz[(":!&*:)!&*:!R)^#V*X*8*:R*8s#r!*:+)!s#r*:#'!"2!"0*^8&*hͻ !!&!)^#VgzH*"<*!!;*!!;ͤlN >!!*e.!;ͳ"*!E"G!*Ggz:-"E!^ͻ*K*En&# *E#-ç,!K*I{!j ͜! #N!ͫ! # "CN!!>e.*C;ͳ"*!̀Eʮ-!}2 -!}2 *C;ͤ*R"*C;*!*l!*C**!! e.!;ͳ!E7.!! e.!;ͳ!-!;ͤ!̀E].NCON:!!;ͤ!ͦ!!n&!:̀}oEʵ.!;!!l!!!!.!A!o&!:e.ͣ >!!.e.!;ͳ!̀!;ͤ!!E ͜! #N!Oͫ *!"*!*&!̀}oEG6! *i1 any key to continue  !ͪ(͜! #N!Oͫ! # !*8gz3*":!*:+)^#V!͓E***:!͓Em)*hͻ!|# !*:+)^#V">*hͻ!4&*> n&n&#*> 9!!l!ͫ!.#*> 9! !l!ͫ*> ^#V!'!k#!6&*>n&n&# !*:+)!*:+)^#V^#Vs#r*:#))*hͻ *<#Ð(*hͻͻ *v!A#! !o&!'!:#!k 9!!l!ͫ!.#!k 9! !l!ͫN!ͫ*0!'ͻ files: *2!'ͻk *4!'ͻk Bytes remainE13*!gz13"!*!?s*#3!*e.!;ͳ"*!Eʁ3*!gzʁ3"!*!?s*#_3!;!;> !!! gz3"**+!*n&s*#ã3!;ͤ!E3!!!s! e.!;ͳ!̀E$4!!!3!^NCON:p !m-!;ͤ!ͦ!!n&!:̀}oEʖ4!!n&!AR}2!!!å4!o&}2!,e.!;ͳ!E4!!,e.!;ͳ! så4!!͝1!;!2!$e.   --------------------------------------------- Micro-Cornucopia / Turbo Pascal contest entry Steve Oxborrow 927 NW Carlon #4 Bend, OR 97701 --------------------------------------------- Turbo Directory --------------- File Directory Procedures for CP/M-80 written in Turbo Pascal 3.0 The files TD* performs essentially the same service as DIR. However, it is small and uses no heap space, as do the other two versions. TD.PAS program source file which can be compiled into TD.COM utility. Include TDSS.INC to implement sorted directories, file sizes, and drive statistics. Valid destinations for the output redirection feature are the console device (CON:), the LST: device, or  redirection. The DIRECTORY procedure reads the directory tracks of the specified drive and lists those files which match the directory mask. It has four parameters: drive: integer; - the drive to search ListMask: array[1..11] of char; - a character mask, indicating which filenames to match (e.g., '???????????' will match ALL filenames on a disk) ListingSystemFiles: boolean; - indicating whether or not to list SYSTEM files Dest: text; - the destination  list and anywhere else they may appear in the code. An alternative would be to just pass a boolean constant and one of Turbo's Standard Files. Also, if you prefer, you could move the filename-parsing code from TD.PAS into the DIRECTORY procedure. That way you could call DIRECTORY with a single string parameter that would contain an ambiguous filename with optional drive designator. You could even include the parsing for the destination and system-file indication ('$'). .* contain several different versions of a disk-directory listing procedure (DIRECTORY) that could be included in a program in order to provide a disk-directory feature -- perhaps as part of a menu routine. Their capabilities range from a simple unsorted listing much like that provided by CP/M's DIR command, to an alphabetically-sorted listing that includes the size of each file, the space remaining on the disk, and an indication of files having SYSTEM or READ-ONLY attribute -- much like D.COM. T a disk-file. Directories can be listed for any or all user areas. TDR.INC the bulk of the code implementing the output-redirection feature in TD. This can be eliminated by commenting-out the indicated sections of code in TD.PAS. TDTRAP.INC a section of code which can be included in TD.PAS to trap illegal drive references and prevent the program from "hanging" on a BDOS error (e.g., asking for the listing (a filevar assigned to a file or device) Files ----- TDSS.INC procedure DIRECTORY - implements sorted directory with listing of file sizes, total drive capacity, and unused drive capacity. TDS.INC procedure DIRECTORY - sorted directory only -- no file sizes or other statistics. TDU.INC procedure DIRECTORY - unsorted directory only --  features of TD.COM ------------------ Command Line Syntax TD.PAS can be compiled to a .COM file. When executed, it takes it's parameters from the command line. ambiguous file names: TD will interpret standard ambiguous filenames, e.g., a: list all files on the A: drive b:*.pas list all Pascal source files on the B: drive ?.com list all executable files with single-letter names on the here is also a stand-alone utility program that can be compiled to a .COM file and used to obtain directories for any or all user areas, or to send listings to the printer (without having to fuss with ) or a disk file. Hopefully, these routines will also serve to illustrate several useful algorithms and programming techniques. There are examples of using BDOS function calls and CP/M data structures; a sorting algorithm that uses a binary tree; and even crude command-line parsing and output for a directory of drive N: instead of drive B:). TD.DOC this file. Further Customization Not all combinations of features are covered -- however, you should be able to start with one of the versions and add or delete features to obtain the exact combination you need. If you have no need for either of the last two parameters (to specify listing of system files or the destination of the output) it should be fairly straight-forward to eliminate them from the parameter   default drive specifying NO filename (hitting ) will list all files on the default drive system files: To specify that all system files are to be listed, enter the character '$' (dollar sign) somewhere in the parameter string after the filename. The filename must be delimited with a blank space or a comma. Note that since leading blanks are ignored, there must either be some string specifying a filename (even if it is only the drive character) console if no destination is specified. The output destination is designated by a "right-carat" or "greater-than" sign, and MUST be the last item on the command line. CON: and LST: are the only devices allowed. If a diskfile is specified as the listing destination, the file will be created if it does not already exist; if it DOES exist, the current directory listing will be appended to the end of the file. The destination file will always be in the current user-area in effect when the command A: drive *.pas 0,9,10 list all Pascal source files of non-system attribute in user areas 0, 9, and 10 on the default drive b: $# list ALL files on the B: drive. They will be displayed in order of, and grouped by, their user number. ,6,7,8 list the non-system files in user areas 6, 7, and 8 on the default drive syntax limitations: The following commands will be interpretted differently than what might have been intext files on the A: drive in user areas 0, 1, and 2, and send the output to the file "ATEXT.DIR" on the B: drive in the current user-area. b:,$ > b:dir.b list all files on the B: drive in the current user-area and send the output to the file "DIR.B", also on the B: drive and in the current user-area. The temporary file "DIR.$$$" will be shown in the directory, and drive capacity statis, or a leading comma to delimit a null filename specification from the remainder of the parameter string. a:*.com, $ list all executable files on the A: drive with either system OR non-system attribute b: $ list ALL files on the B: drive ,$ list ALL files on the default drive user areas: To list files in various user areas, merely list the user numbers after the filename. User numbers must be delimited by either blanks or commas FRONT AN was issued. If no file-type is specified, the file will be given the type ".DIR". A period as the last character of a filename specifies a blank file-type. A temporary file ( .$$$ ) is created when output to a file is specified, and will show up in the directory listing if the output disk is the same as the one for which the directory is requested (and the temporary-file name is matched by the directory mask, of course). a: > con: list all non-system files on the A: drive in tended. $ 0 6,7,8 '$' is assumed to be the filename, so TD.COM will search for the file '$ . ' , but it will search in user areas 0, 6, 7, and 8 a: $0,2,4 files in user area 0 will not be listed because there is no space between the '$' and the '0' output redirection: A directory listing can be sent to either the screen (the console device, CON:), a printer (the list device, LST:), or a disk file. Output defaults to thetics will also be slightly affected. limitations: - only 31 characters can be used for a command line About the programs ------------------ Use of the Heap In order to list the filenames in alphabetical order, we must have ALL the files before we can begin listing. It is not practical to set aside dedicated variable space for the file information, since the number of files can't be known ahead of time, and in the case of a hard diD BACK. If no user numbers are specified, then files in the current user area will be listed. To list files in ALL user areas, include the character '#' in the parameter string. Again, there must be either a space or a comma between the filename and the rest of the parameter string. Also, when the "continue" prompt is displayed between user area listings, further output can be terminated with . a: 4 5 10 12 list all non-system files in the specified user areas on thehe current user-area, and send the output to the console. *.com $ list all executable program files on the default drive in the current user-area. Send the output to the console (this is the default destination). b:*.pas > lst: list all non-system Pascal source files on the B: drive in the current user-area, and send the output to the printer. a:*.txt 0,1,2>b:atext list all non-system t  sk, may be very large. To provide for the worst case would require a large amount of dedicated variable space, which would not be worth it just to provide a sorted directory feature -- presumably a small part of the entire program. To alleviate this problem, all the necessary information about each file is placed on the heap. Thus, no dedicated memory space is needed for the file information -- memory is dynamically allocated on the heap and then returned when the procedure is finished. Bin |left |right| ---+ | ------------- | | ------------ | | | | | V V V V ------------- ------------- ------------- ------------- |ALPHA PAS| |CHARLIE PAS| |ECHO PAS| |GOLF PAS| ------------- ------------- ------------- ------------- |left |right| |left |right| ee if the filename already exists at the current node. If so, instead of creating a new node as for the first occurance, we merely update the file-size information at the node by adding in the size of the current extent. after building tree (7 elements): (root) | V ------------- |DELTA PAS| se implies a pointer to it), you would encounter each of the filenames in alphabetical order. As a refinement of this, there is an array of pointers (one for each column to be printed) that each point to the node containing the filename that will be printed at the head of that column (the first row). That node points to the entry for the second row of that column (through it's right pointer), and so on, until the entry for the last row of the column is reached, where the linked-list is terminated bary-tree sort The DIRECTORY procedures in TDS.INC and TDSS.INC use a binary tree to sort the filenames. Nodes are created on the heap as each new filename is found, and filenames are automatically sorted as they are placed in the tree due to the ordered nature of the tree. For any given "leaf" (node), "keys" (filenames) in the left subtree are always less than that of the leaf, and keys in the right subtree are always greater. Building an ordered binary tree merely involves searching on the c |left |right| |left |right| ------------- ------------- ------------- ------------- | | | | | | | | V V V V V V V V nil nil nil nil nil nil nil nil A tree can be "traversed" recursively, visiting each node in turn and processing them in order. This will not work, however, for printing the files in a columnar  ------------- +------------- |left |right| -------------+ | ------------- | | | V V ------------- ------------- |BRAVO PAS| |FOXTROT PAS| ------------- ------------- +-- |left |right| ---+ +--y a nil pointer. The original tree is thus divided up into a number of disjoint linked-lists -- one for each column. Printing the filenames in a columnar format now involves just using the column-pointers to print a row at a time, and resetting each to the value of it's right-link. No action is taken when a column-pointer reaches the end of it's list (the terminating nil pointer) to accomodate short columns. after creating linked-lists from tree: - left pointers not shown - assume that 7urrent key, finding where it SHOULD be (eventually the search will terminate at a subtree with a nil pointer), and inserting the new key by allocating a new node and linking pointers. If file-sizes are being calculated (as in TDSS.INC), ALL file-extents must be found in order to calculate the correct file-size, and thus for a large file, the same filename will come up once for each extent. In this case, besides checking whether to continue searching in the left or right subtree, we must check to sformat. As each row of filenames is printed, we must have access to as many different points in the tree as the number of columns we are printing. A "trick" is employed for this. After the tree is built (all filenames have been inserted), the tree is recursively traversed (by the LINK procedure) and the right-subtree pointers are changed so as to convert the binary tree into a linked-list! Thus, if you were to follow the chain of right-pointers starting with the left-most leaf (this of cour   filenames implies 2 columns: column #1 lists 4 filenames, and column #2 lists 3 (column 1) (column 2) | | | ------------- | | |DELTA PAS| | | ------------- | | |left |right| | | ------------- | | ^ | | | -------th a hard disk (in the ultimate worst case a drive could have 8192 directory ENTRIES!), or with a large program with little left-over memory for the heap. However, you still can't predict ahead of time how much heap space will be used, since you still don't know how many filenames will be matched. You could watch the value of MemAvail diligently for the possibility of not having enough heap space left for the allocation of one more filename. Then, if you ran out of space, you could exit back thro nil resulting listing (as would be produced by TDS): ALPHA .PAS | ECHO .PAS BRAVO .PAS | FOXTROT .PAS CHARLIE .PAS | GOLF .PAS DELTA .PAS So what about Heap Overflow? The advantage of using the heap is that we only use the minimum amount of memory necessary to store information about just the files being listed. The disadvantage is that the amount of heap space IS finite, and since you can't know ahead of time howirectory procedures. The alternative is to use the unsorted directory procedure in TDU.INC. This only requires reading through the directory and listing each filename as it is encountered. This method does not allow the calculation of file-sizes for files consisting of more than 1 extent (without using extra memory -- which is what we are trying to avoid). Further Comments ---------------- Notes on the Command Tail Turbo seems to maint------ | v | ------------- | |BRAVO PAS| | nil | |FOXTROT PAS| | ------------- | | ------------- | |left |right| ---+ | | |left |right| --+ | ------------- | | | ------------ | | ^ | | | ^ | v | v | v | v ------------- | ------------- | ---ugh the several layers of subprogram calls and terminate the routine, presumably with some sort of an error message. This could work, except for one other thing. The binary-tree search routines involve recursion, which ALSO makes use of the dynamic memory area to store the state-information from each previous level of recursion. Therefore, the recursion stack can collide with the heap area even though there had seemed to be sufficient space on the heap before you called a recursive routine. Ther many filenames you'll need to sort, there is no way of telling if there will still be some "shortfall" in the amount of heap space required. You COULD read through the directory twice, once to count matching filenames, and then if that number would not overflow the heap space, again to store the filenames for sorting. This may be somewhat inefficient, but it would save you from a heap-overflow error at run-time. A lack of sufficient heap space would probably only be a problem when working wiain a jump table beginning at address $A0, and thus this part of the command tail is overwritten after your program begins executing, but before you have access to the command tail. Therefore, only the first 32 bytes of the command tail area are valid (the length byte, and 31 characters). CP/M sets the length byte at address $80 when it handles the command line, but Turbo does not reset it. In other words, if the command tail is longer than 31 characters, the length byte of a Turbo string overlay---------- | ------------- |ALPHA PAS| | |CHARLIE PAS| | |ECHO PAS| | |GOLF PAS| ------------- | ------------- | ------------- | ------------- |left |right| --+ |left |right| --+ |left |right| ---+ |left |right| ------------- ------------- ------------- ------------- | v e is also no way to predict the usage of the recursion stack, since the maximum level of recursion will depend not only on the number of files, but the order in which they are retrieved. The worst case would be if the files happened to be already perfectly sorted as they existed on the directory tracks! Alas, there seems to be no good way to avoid heap overflow. Therefore, if you have very little memory to spare (large program and/or much data), it may not be safe to use either of the sorted-d  ed at $80 will also be greater than 31 (even if the explicit maximum string length is <= 31!), and any characters past the 31st position will be GARBAGE! Whenever you use the CP/M command tail from Turbo, you should artificially truncate the overlayed string to length 31. VAR CommandTail: string[31] absolute $80; begin if length(CommandTail) > 31 then CommandTail[0] := chr(31); end. Turbo Pascal version 3.0 provides the ParamCount and ParamStr functthen again, it may not). I could find no mention of such a problem in any of several CP/M books. If it were actually a problem with the BDOS, it would seem that it would have been discovered long ago and therefore documented. If you feel brave, you could try it without the code initiating searching on extent 0. On my system, NO matches are found unless this is done first. I merely issue this warning in case it IS a fluke with the BDOS (or at least some versions). Credits I suppose somew"word"} if BlankPos > 0 then begin Word := copy(Str,1,BlankPos-1); delete(Str,1,BlankPos); end else begin word := Str; Str := ''; end; end; {Get_FirstWord} procedure Format_DirectoryMask(Str: str12; var DirMask:FileNameAndType); VAR NameMask: string[8]; TypeMask: string[3]; dot,ast,i: integer; begin if length(Str)=0 then Str := '*.*'; {blank string means ALL fions which simplify access to the command tail by automatically truncating it to 31 characters for you. If it seems that these functions only allow access to the first 30 characters of the command tail, remember that the first character of the command tail is always a blank, and blanks are the delimiters for the ParamStr function. Redirection and Turbo 2.0 Turbo Pascal version 2.0 doesn't seem to like the redirection scheme I've used (at least the part where a filevar is assigned to a deviProgram TurboDirectory; {stand-alone directory utility} type str31 = string[31]; str12 = string[12]; {FileNameAndType = array[1..11] of char;} {only global identifier required by procedure DIRECTORY} {choose one of the following versions of the procedure DIRECTORY} { $I tdu.inc} {unsorted file listing} { $I tds.inc} {sorted file listing} {$I tdss.inc} {sorted file listing with file sizes and drive statistics} var Destination: text; {for output redirectiohere in here I ought to say that Turbo Pascal is a registered trademark of Borland International, Inc. -- everyone else does it. iles} dot := pos('.', Str); {find name/typ division} if dot=0 then dot := length(Str) + 1; {no dot means it's all name} NameMask := copy(Str,1,dot-1) + ' '; {split & app. blanks if short} TypeMask:= copy(Str,dot+1,length(Str)) + ' '; ast := pos('*',NameMask); {expand '*' for ambiguity} if ast > 0 then for i:= ast to 8 Do NameMask[i] := '?'; ast := pos('*',TypeMask); if ast > 0 then for i:= ast to ce and passed as a procedure parameter). If you're still using Turbo 2.0, you may have to either eliminate the redirection feature, or just use one of the Standard File identifiers in calls to the DIRECTORY procedure -- e.g.: DIRECTORY(Drive, DirectoryMask, SystemFiles, con); BDOS bug? The problem with using the match-any-extent feature of the BDOS search-first / search-next functions (extent = '?') noted in the Get_Files procedure in TDSS.INC may only be a problem with my BIOS (and n} {--------------------------------------------------------------------------} {TDR.INC contains routines for parsing output destination from command line} {----- include if output-redirection is in effect -------------------------} {$I tdr.inc} {--------------------------------------------------------------------------} procedure Get_FirstWord(var Str:str31; var Word: Str12); VAR BlankPos: integer; begin BlankPos := pos(' ',Str); {find blank delimiter after first   3 Do TypeMask[i] := '?'; Str := NameMask + TypeMask; {make string of length 11} for i:= 1 to 11 Do DirMask[i] := Str[i]; {copy to character array} end; {Format_DirectoryMask} {BDOS function codes} const GetActiveDisks = 24; GetDefaultDrive = 25; GetUserNumber = 32; SetUserNumber = 32; VAR ParameterStr: str31 absolute $80; {CP/M command tail} DirectoryMask: File if user numbers have been explicitly specified} begin Str(user:1, UserStr); UserStr := ' '+UserStr+' '; if pos(UserStr, ParameterStr) > 0 then Users := Users + [user]; end; {for} CurrentUser := Bdos(GetUserNumber, $FF); if Users = [] then Users := [CurrentUser]; {if no user number(s) specified} if AllUsers then Users := [0..15]; (* {$I tdtrap.inc} {optional code traps illegal drive references} *) user := 0; repeat if user in Users then  {-------------------------------------------------------------------------} {----- comment out following line to suppress output-redirection ---------} Get_Destination(ParameterStr); {----- comment out previous line to suppress output-redirection ----------} {-------------------------------------------------------------------------} if (length(ParameterStr) >= 2) AND (ParameterStr[2] = ':') then begin drive := ord(ParameterStr[1]) - ord('A'); delete(Param{TDR.INC -- code needed to support output redirection for TD} type str80 = string[80]; str14 = string[14]; str8 = string[8]; str3 = string[3]; str2 = string[2]; var ExistingFile: text; {existing directory file} DestinationName: str14; AppendingToExistingFile, DestinationIsDiskFile: boolean; function FileExists(filename:str14):boolean; VAR F:file; beeNameAndType; DirectoryMaskStr: Str12; drive: 0..15; {CP/M drives A-P} Users: set of 0..15; User, CurrentUser,i: integer; UserStr: string[4]; AllUsers, SystemFiles: boolean; ch: char; begin (* {comment out following lines to run as .COM file} {--- use only for testing during development ---} writeln; write('enter directory begin Bdos(SetUserNumber, user); DIRECTORY(Drive, DirectoryMask, SystemFiles, Destination); if (user<15) AND (Users*[user+1..15] <> []) AND ((mem[addr(Destination)] AND $0F) = 1) {console output} then begin write('press any key to continue '); read(Kbd, ch); writeln(^M,'':79); end; end; user := user + 1; until (user>15eterStr,1,2); end else drive := Bdos(GetDefaultDrive); while pos(',',ParameterStr)>0 {replace commas with blanks in parameter str} Do ParameterStr[pos(',',ParameterStr)]:=' '; Get_FirstWord (ParameterStr, DirectoryMaskStr); Format_DirectoryMask (DirectoryMaskStr, DirectoryMask); SystemFiles := pos('$',ParameterStr) > 0; AllUsers := pos('#',ParameterStr) > 0; ParameterStr := ' ' + ParameterStr + ' '; Users := []; for user := 0 to 15 Do {segin assign(f,filename); {$I-} reset(f); {$I+} FileExists := (IOResult=0); end; {FileExists} procedure Assign_DestinationFile; type CharacterBuffer = array[0..MaxInt] of char; var buffer: ^CharacterBuffer; BufferSize, CharCount,i: integer; begin assign(Destination, copy(DestinationName,1,pos('.',DestinationName)) + '$$$'); {make file-type '$$$'} rewrite(Destination); AppendingToExistingFile := FileExists(Destinatmask: '); readln(ParameterStr); for i:=1 to length(ParameterStr) Do ParameterStr[i] := UpCase(ParameterStr[i]); {comment out previous lines to run as .COM file} *) {truncate garbage characters beyond position 31. Turbo overwrites this space, but length byte remains as it was set by CP/M} if length(ParameterStr) > 31 then ParameterStr[0] := chr(31); while pos(' ',ParameterStr) = 1 {delete leading spaces} Do delete(ParameterStr,1,1); assign(Destination,'CON:'); ) OR (ch=^C); Bdos(SetUserNumber, CurrentUser); {-------------------------------------------------------------------------} {----- comment out following line to suppress output-redirection ---------} Close_Destination; {----- comment out previous line to suppress output-redirection ----------} {-------------------------------------------------------------------------} end. !  ionName); if AppendingToExistingFile then begin {copy existing directory file to temporary to append to} BufferSize := MaxAvail; {heap space for character buffer} if BufferSize<0 then BufferSize := MaxInt; { <0 means >MaxInt } GetMem(buffer,BufferSize); write('Copying ...'); assign(ExistingFile,DestinationName); reset(ExistingFile); while NOT EOF(ExistingFile) Do begin  then begin writeln('illegal character in filename'); DestStr := 'TD.DIR'; end; DestinationIsDiskFile := pos(':',DestStr)=0; if DestinationIsDiskFile then begin {separate file name and type} if pos('.',DestStr)=0 then DestStr := DestStr + '.DIR'; DestinationName := DestDrive + DestStr; end else begin {check for legal devices} LegalDevice := (DestStr='CON:') OR (DestStr='LST:'); stPos; DestStr := copy(Str,DestPos+1,DestStrLength); delete(Str,DestPos,DestStrLength+1); end; {--- delete blanks} while pos(' ',DestStr)>0 Do delete(DestStr,pos(' ',DestStr),1); {--- check for blank string} if length(DestStr)=0 then DestStr := 'CON:'; {--- check for drive character} if (length(DestStr)>=2) AND (DestStr[2]=':') then begin DestDrive := copy(DestStr,1,2); delete(DestStr,1,2); {TDS.INC -- produces alphabetically sorted directory} type FileNameAndType = array [1..11] of char; {only global identifier required by procedure Directory} procedure DIRECTORY(drive: integer; {A=0, B=1,...} ListMask: FileNameAndType; ListingSystemFiles: boolean; var Dest: text); {destination filevar} type NodePtr = ^Node; Node = record {individual "leaves" of i:=-1; while (i4) OR NOT LegalDevice then begin writeln('CON: and LST: are only allowed devices'); DestinationName := 'CON:'; end else DestinationName := DestStr; end; if NOT DefaultDestination then writeln('output being sent to ',DestinationName); if DestinationIsDiskFile then Assign_DestinationFile else assign(Destination,DestinationName); end; {G end else DestDrive := chr(ord('A') + Bdos(GetDefaultDrive)) + ':'; {--- check for leading period} if (pos('.',DestStr) = 1) OR (length(DestStr)=0) then begin writeln('blank filename not allowed'); DestStr := 'TD.DIR'; end; {--- check for illegal characters} IllegalCharacter := false; for i:=1 to length(DestStr) Do if pos(DestStr[i],'<>,;=?*[]')>0 then IllegalCharacter := true; if IllegalCharacter  binary tree} FileName: FileNameAndType; ReadOnly, {use to flag read-only files} System: Boolean; {use to flag and list system files} left, {left subtree pointer} right: NodePtr; {right subtree pointer -- also used to thread linked-list through tree alphabetically}  Var DestStr: str31; DestDrive: str2; DestPos,DestStrLength, dot,i: integer; LegalDevice, IllegalCharacter, DefaultDestination: boolean; begin {--- separate Parameter and Redirection strings} DestStr := ''; DestPos := pos('>',Str); if DestPos = 0 then DefaultDestination := true else begin DefaultDestination := false; DestStrLength := length(Str) - Deet_Destination} procedure Close_Destination; begin if DestinationIsDiskFile then begin close(Destination); if AppendingToExistingFile then erase(ExistingFile); rename(Destination,DestinationName); end; end; {CloseDestination} "   end; VAR Root: NodePtr; {root of tree containing directory entries} DirectoryEntries: integer; {number of filenames matched} procedure Get_Files; {finds all files to be listed and inserts them into binary tree in heap area} {BDOS function codes} const SearchFirst = 17; SearchNext = 18; SetDMAaddr = 26; type FCBrecord = record {CP/M File Control Block} Disk: byte; F addr(SearchFile)); while FCBindex <> $FF Do begin if (FCBarea[FCBindex].FileName[10] < chr(128)) {not a system file} OR ListingSystemFiles then begin CurrentFileName := FCBarea[FCBindex].FileName; {trim bit 7 from those characters carrying file attributes} CurrentFileName[9] := chr( ord(CurrentFileName[9]) AND $7F); CurrentFileName[10] := chr( ord(CurrentFileName[10]) AND $7F); ) else begin {create new node and insert here} new(P); DirectoryEntries := DirectoryEntries + 1; with P^ Do begin FileName := CurrentFileName; ReadOnly := FCBarea[FCBindex].FileName[9] > chr(127); System := FCBarea[FCBindex].FileName[10] > chr(127); left := nil; right := nil; end; {with} end; {else} end; {Insert} {$A+} {disablxCols] of integer;{index of last file in column} ColumnHead: array[1..MaxCols] of NodePtr; {pointers to element listed at top of each column} Last: NodePtr; {temporary pointer needed by Link procedure} {$A-} {enable recursion} procedure Link(P:NodePtr); {traverse tree and build linked-list reflecting alphabetical order using right subtree-pointers -- no longer has binary tree structure, can only be used as linked-list} begin ileName: FileNameAndType; Extent: byte; ResWord: integer; {reserved} RecNo: byte; AllocBlocks: array[0..15] of byte; end; VAR SearchFile: FCBrecord; FCBarea: array[0..3] of FCBrecord; FCBindex: integer; {pointer returned by BDOS search first/next} CurrentFileName: FileNameAndType; {$A-} {enable  CurrentFileName[11] := chr( ord(CurrentFileName[11]) AND $7F); Insert(Root); {insert this filename into tree} end; FCBindex := Bdos(SearchNext); end; {while} end; {Get_Files} procedure List_Directory; {This algorithm lists files in from 1 to MaxCols columns in a "pleasing" format. If DirectoryEntries <= (MaxCols-1)*MinRows, then files are listed in (MaxCols-1) or fewer columns with up to MinRows files in a column. The array "LastRow[n]" hoe recursion} begin {Get_Files} Bdos(SetDMAaddr, addr(FCBarea)); {specify where to put FCB records} With SearchFile Do begin {initialize FCB to search for specified files on given drive} disk := drive + 1; {convert to FCB format} FileName := ListMask; {procedure parameter} extent := 0; {0 extent will find all unique filenames} end; {with} Root := nil; {initialize tree} DirectoryEntries := 0; FCBindex := Bdos(SearchFirst, if P<>nil then begin Link(P^.left); N := N + 1; {count this node as we pass through} if N=1 then ColumnHead[1] := P {point to first element} else Last^.right := P; {link from previous element} for col:=2 to Ncols Do if N = (LastRow[col-1]+1) {if file is head of a column} then begin {then} recursion} procedure Insert(var P:NodePtr); {inserts current filename into binary tree by creating a new node the first time it finds a nil pointer -- note that since all filenames are unique, the current filename will never be equal to any already in the tree, and this condition doesn't have to be checked} begin if P <> nil then {search subtrees} if CurrentFileName < P^.FileName then Insert(P^.left) else Insert(P^.rightlds the index of the last file to be listed in column "n". The index of the FIRST file in column "n" (at the top of the column) is just "LastRow[n-1]+1". It is thus necessary that LastRow[0]=0 } const MinRows = 5; {Minimum number of rows to attempt to display} MaxCols = 5; {Maximum number of columns to display} ROcharacter: array[boolean] of char = ' *'; SYScharacter: array[boolean] of char = ' $'; VAR row, col, Ncols, N: integer; LastRow: array[0..Ma#   ColumnHead[col] := P; {set column pointer to it} Last^.right := nil; {terminate previous links} end; Last := P; {now this node will be next to be linked} Link(P^.right); end; end; {Link} {$A+} {disable recursion} begin {List_Directory} {find "height" of each column} Ncols := ( DirectoryEntries + MinRows-1) div MinRows; if Ncols > MaxCols then Ncols : copy(filename,1,8), '.', copy(filename,9,3), SYScharacter[System]); ColumnHead[col] := ColumnHead[col]^.right; end; {if / for col:= } writeln(Dest); end; {for row:=} end; {List_Directory} VAR HeapTop: ^integer; {to mark heap for return of memory} begin {Directory} Mark(HeapTop); {save current top of heap} Get_Files; List_Directory; FreeMem(HeapTop, HeapPtr-ord(Hea to thread linked-list through tree alphabetically} end; DPBrecord = record {CP/M Disk Parameter Block} SecPerTrack: integer; BlockShift, BlockMask, ExtentMask: byte; MaxAllocBlock, DirEntriesM1: integer; {number of dir. entrys minus 1} = MaxCols; if Ncols = 0 then LastRow[1] := 0; {no files} LastRow[0] := 0; {first file is head of first column} for col:=1 to Ncols Do begin LastRow[col] := LastRow[col-1] + (DirectoryEntries+Ncols-col) div Ncols; ColumnHead[col] := nil; end; N := 0; Link(Root); {construct linked-list from binary tree} writeln(Dest); if DirectoryEntries = 0 then writeln(Dest,' NO FILES'); for row :=1 to LastRow[1] Do begin if ({TDSS.INC -- produces sorted directory with file sizes and drive statistics} { -- features similar to D.COM, with optional output redirection} {only global identifier required by procedure Directory} type FileNameAndType = array [1..11] of char; procedure DIRECTORY(drive: integer; {A=0, B=1, ...} ListMask: FileNameAndType; ListingSystemFiles: boolean; var Dest: text); {destinpTop) ); {de-allocate heap space} end; {Directory}  DirAllocBlockMap: array[1..2] of byte; {bit-map of alloc. blocks for directory} other: array[1..4] of byte; end; VAR Root: NodePtr; {root of tree containing directory entries} BytesPerAllocBlock, {bytes used for each allocation block number} BlockSize, {Allocation Block size in KiloBytes} DirectoryEntries: integer; {number of filenames matched} DP(row mod 18) = 0) AND ((mem[addr(Dest)] AND $0F) = 1) {console output} then begin write('more - press any key to continue '); repeat until Keypressed; write(^M,'':79,^M); end; for col := 1 to Ncols Do if ColumnHead[col]<>nil then begin if col<>1 then write(Dest,'|'); with ColumnHead[col]^ Do write(Dest,ROcharacter[ReadOnly], ation filevar} type NodePtr = ^Node; Node = record {individual "leaves" of binary tree} FileName: FileNameAndType; Ksize: integer; {size in KiloBytes} ReadOnly, {use to flag read-only files} System: Boolean; {use to flag and list system files} left, {left subtree pointer} right: NodePtr; {right subtree pointer -- also used$  B: ^DPBrecord; procedure Get_Files; {finds all files to be listed and inserts them into binary tree in heap area} {BDOS function codes} const SearchFirst = 17; SearchNext = 18; SetDMAaddr = 26; type FCBrecord = record {CP/M File Control Block} Disk: byte; FileName: FileNameAndType; Extent: byte; ResWord: integer;  System := FCBarea[FCBindex].FileName[10] > chr(127); Ksize := FileSize(FCBarea[FCBindex]); left := nil; right := nil; end; {with} end; {else} end; {Insert} {$A+} {disable recursion} begin {Get_Files} Bdos(SetDMAaddr, addr(FCBarea)); {specify where to put FCB records} With SearchFile Do begin {initialize FCB to search for specified files on given drive} disk := drive + 1; {convert to FCB format} t finds a nil pointer -- if a node already exists for a file, it just means that the file consists of more than 1 extent, and the size of the current extent is added to the filesize already recorded at the node } begin if P <> nil then begin {node exists -- search subtrees or check for match} if CurrentFileName < P^.FileName then {search left subtree} Insert(P^.left) else if CurrentFileName > P^.FileName then {search right subtreName := FCBarea[FCBindex].FileName; {trim bit 7 from those characters carrying file attributes} CurrentFileName[9] := chr( ord(CurrentFileName[9]) AND $7F); CurrentFileName[10] := chr( ord(CurrentFileName[10]) AND $7F); CurrentFileName[11] := chr( ord(CurrentFileName[11]) AND $7F); Insert(Root); {insert this filename into tree} end; FCBindex := Bdos(SearchNext); end; {while} end; {reserved} RecNo: byte; AllocBlocks: array[0..15] of byte; end; VAR SearchFile: FCBrecord; FCBarea: array[0..3] of FCBrecord; FCBindex: integer; {pointer returned by BDOS search first/next} CurrentFileName: FileNameAndType; function FileSize(FCB:FCBrecord):integer; {returns size of file-extent pointed to by FCB} VAR i,size: integer; begin size FileName := ListMask; {procedure parameter} extent := 0; {0 extent will find all unique filenames} end; {with} FCBindex := Bdos(SearchFirst, addr(SearchFile)); SearchFile.Extent := ord('?'); {scan ALL extents (for size calculation)} {it is only necessary to scan ALL extents if correct file-size statistics are desired -- otherwise just searching on extent 0 would return all matching filenames. However, the search must (apparently) bee} Insert(P^.right) else { CurrentFileName = P^.FileName} {name matches node} P^.Ksize := P^.Ksize + FileSize(FCBarea[FCBindex]) end else begin {create new node and insert here} new(P); DirectoryEntries := DirectoryEntries + 1; with P^ Do begin FileName := CurrentFileName; ReadOnly := FCBarea[FCBindex].FileName[9] > chr(127); {Get_Files} procedure Calculate_DriveStatistics(var Capacity, Available: integer); {calculates total drive capacity and remaining space available in KiloBytes} const GetAllocVector = 27; type AllocationVectorArray = array[1..MaxInt] of byte; VAR AllocationVector: ^AllocationVectorArray; AllocBlocksForDir, {number of allocation blocks used by directory} BlocksUsed, i: integer; function BitCount(b:byte):integer; {counts the number of "1" bits := 0; case BytesPerAllocBlock of 1: for i:=0 to 15 Do if FCB.AllocBlocks[i]<>0 then size := size + BlockSize; 2: for i:=0 to 7 Do if (FCB.AllocBlocks[i+i]<>0) OR (FCB.AllocBlocks[i+i+1]<>0) then size := size + BlockSize; end; {case} FileSize := size; end; {FileSize} {$A-} {enable recursion} procedure Insert(var P:NodePtr); {inserts current filename into binary tree by creating a new node the first time i intitiated on extent 0 before the MATCH ANY EXTENT feature ( extent = '?' ) can be used. I don't know why this would be necessary, but it doesn't seem to work otherwise} Root := nil; {initialize tree} DirectoryEntries := 0; FCBindex := Bdos(SearchFirst, addr(SearchFile)); while FCBindex <> $FF Do begin if (FCBarea[FCBindex].FileName[10] < chr(128)) {not a system file} OR ListingSystemFiles then begin CurrentFile%   in a byte} VAR i,count: integer; begin count := 0; for i:=0 to 7 Do if ((1 shl i) AND b) <> 0 then count := count + 1; BitCount := count; end; {BitCount} begin AllocBlocksForDir := BitCount(DPB^.DirAllocBlockMap[1]) + BitCount(DPB^.DirAllocBlockMap[2]); Capacity := (DPB^.MaxAllocBlock+1 - AllocBlocksForDir) * BlockSize; AllocationVector := ptr(BdosHL(GetAllocVector)); BlocksUsed := 0; for i:= 1 to ((DPB^.MaxAllocBlo Do if FilesListed = (LastRow[col-1]+1) then begin {file is head of a column} ColumnHead[col] := P; {set column pointer to it} Last^.right := nil; {terminate previous links} end; Last := P; {now this node will be next to be linked} Link(P^.right); end; end; {Link} {$A+} {disable recursion} ed: integer; LastRow: array[0..MaxCols] of integer;{index of last file in column} ColumnHead: array[1..MaxCols] of NodePtr; {pointers to element listed at top of each column} Last: NodePtr; {temporary pointer needed by Link procedure} {$A-} {enable recursion} procedure Link(P:NodePtr); {traverse tree and build linked-list reflecting alphabetical order using right subtree-pointers -- no longer has binary tree structure, can only {construct linked-list from binary tree} writeln(Dest); for row :=1 to LastRow[1] Do begin if ((row mod 18) = 0) AND ((mem[addr(Dest)] AND $0F) = 1) {console output} then begin write('more - press any key to continue '); repeat until Keypressed; write(^M,'':79,^M); end; for col := 1 to Ncols Do if ColumnHead[col]<>nil then begin if col<>1 thenck+1) div 8) + 1 Do BlocksUsed := BlocksUsed + BitCount(AllocationVector^[i]); Available := (DPB^.MaxAllocBlock+1 - BlocksUsed) * BlockSize; end; {Calculate_DriveStatistics} procedure List_Directory; {This algorithm lists files in from 1 to MaxCols columns in a "pleasing" format. If DirectoryEntries <= (MaxCols-1)*MinRows, then files are listed in (MaxCols-1) or fewer columns with up to MinRows files in a column. The array "LastRow[n]" holds the index of the last file to be listed in  begin {List_Directory} Calculate_DriveStatistics(KbytesCapacity, KbytesAvailable); if (mem[addr(Dest)] AND $0F) <> 1 then writeln(Dest); {NOT console output} (* {if you prefer, statistics can be listed before files} writeln(Dest,^M^J, chr(drive+ord('A')), Bdos(GetUserNumber,$FF),':', copy(ListMask,1,8),'.',copy(ListMask,9,3), '':4, FilesListed,' files: ',KbytesListed,'k ', KbytesAvailable,'k Bytes remaining of ', KbytesCapaci be used as linked-list} begin if P<>nil then begin Link(P^.left); FilesListed := FilesListed + 1; {count node/file as we pass} KbytesListed := KbytesListed + P^.Ksize; {add size to total} if FilesListed=1 then ColumnHead[1] := P {point to first element} else Last^.right := P; {link from previous element} for col:=2 to Ncols  write(Dest,'|'); with ColumnHead[col]^ Do write(Dest,ROcharacter[ReadOnly], copy(filename,1,8), '.', copy(filename,9,3), Ksize:4,'k', SYScharacter[System] ); ColumnHead[col] := ColumnHead[col]^.right; end; {for col:= / if} writeln(Dest); end; {for row:=} writeln(Dest,^M^J, chr(drive+ord('A')), Bdos(GetUserNumber,$FF),':', c column "n". The index of the FIRST file in column "n" (at the top of the column) is just "LastRow[n-1]+1". It is thus necessary that LastRow[0]=0 } const GetUserNumber = 32; MinRows = 5; {Minimum number of rows to attempt to display} MaxCols = 4; {Maximum number of columns to display} ROcharacter: array[boolean] of char = ' *'; SYScharacter: array[boolean] of char = ' $'; VAR row, col, Ncols, KbytesCapacity, KbytesAvailable, KbytesListed, FilesListty,'k'); *) {find "height" of each column} Ncols := ( DirectoryEntries + MinRows-1) div MinRows; if Ncols > MaxCols then Ncols := MaxCols; if Ncols = 0 then lastRow[1] := 0; {no files} LastRow[0] := 0; {first file is head of first column} for col:=1 to Ncols Do begin LastRow[col] := LastRow[col-1] + (DirectoryEntries+Ncols-col) div Ncols; ColumnHead[col] := nil; end; KbytesListed := 0; FilesListed := 0; Link(Root); &  opy(ListMask,1,8),'.',copy(ListMask,9,3), '':4, FilesListed,' files: ',KbytesListed,'k ', KbytesAvailable,'k Bytes remaining of ', KbytesCapacity,'k'); end; {List_Directory} {BDOS function codes} const SelectDrive = 14; GetDefaultDrive = 25; GetDPB = 31; VAR HeapTop: ^integer; {to mark heap for return of memory} DefaultDrive: integer; begin {Directory} Mark(HeapTop); {save current tyet un-logged drive is provided. In an application program, a better scheme may be to establish the legal drives at the outset by asking the user to enter the needed drives, and immediately attempt to log them in via the BDOS Select Drive function (better to "hang" now, than later). Having done that, you could then use the log-in vector to deny access to un-logged drives. global identifiers assumed by this code: const GetActiveDisks = 24; var drive: integer; {A=0{TDU.INC -- produces un-sorted directory - like CP/M DIR command} {only global identifier required by Directory} type FileNameAndType = array [1..11] of char; procedure DIRECTORY(drive: integer; {A=0, B=1, ...} ListMask: FileNameAndType; ListingSystemFiles: boolean; var Dest: text); {destination filevar} {BDOS function codes} const SearchFirst = 17; SearchNext op of heap} DefaultDrive := Bdos(GetDefaultDrive); Bdos(SelectDrive, drive); {DPB can only be gotten for default disk} DPB := ptr(BdosHL(GetDPB)); if DPB^.MaxAllocBlock < 256 then BytesPerAllocBlock := 1 else BytesPerAllocBlock := 2; BlockSize := 1 shl (DPB^.BlockShift-3); {allocation block size in KiloBytes} Bdos(SelectDrive, DefaultDrive); {return to default drive} Get_Files; List_Directory; FreeMem(HeapTop, HeapPtr-ord(HeapTop) ); {de-allocate , B=1, etc.} ch: char; Users: set of 0..15; *) if ((1 shl drive) AND BdosHL(GetActiveDisks)) = 0 then begin write( chr(drive+ord('A')), ': NOT AN ACTIVE DRIVE -- continue (Y/N)? '); repeat read(Kbd,ch); ch:=UpCase(ch) until ch in ['Y','N']; writeln(ch); if ch='N' then Users := []; {disables further processing} end; {TDTRAP.INC -- optional code to trap illegal drive references} (* Here is one way to prevent the system from hanging on an illegal drive reference -- checking the drive against the "log-in" vector. However, this doesn't always produce the desired result, since after a warm-boot (which occurs after each time a program is run) only the A: drive will be logged-in, and therefore isn't a very good feature for a stand-alone directory utility. For this reason, the option to access an as- = 18; SetDMAaddr = 26; GetUserNumber = 32; ROcharacter : array[boolean] of char = ' *'; SYScharacter : array[boolean] of char = ' $'; type FCBrecord = record {CP/M File Control Block} Disk: byte; FileName: FileNameAndType; Extent: byte; ResWord: integer; {reserved} RecNo: byte; AllocBlocks:heap space} end; {Directory} '   array[0..15] of byte; end; VAR SearchFile: FCBrecord; FCBarea: array[0..3] of FCBrecord; FCBindex, NameCount: integer; FileName: FileNameAndType; ReadOnly,System: boolean; begin Bdos(SetDMAaddr, addr(FCBarea)); {specify where to put directory records} With SearchFile Do begin {initialize FCB to search for specified files on given drive} disk := drive + 1; {convert te(Dest,ROcharacter[ReadOnly], copy(FileName,1,8),'.',copy(FileName,9,3), SYScharacter[System]); if (NameCount mod 5) = 4 then writeln(Dest); NameCount := NameCount + 1; end; {if} FCBindex := Bdos(SearchNext); end; {while} if NameCount = 0 then write(Dest,' NO FILES'); writeln(Dest); end; {Directory} o FCB format} FileName := ListMask; {procedure parameter} extent := 0; {0 extent will find all unique filenames} end; {with} writeln(Dest); NameCount := 0; FCBindex := Bdos(SearchFirst, addr(SearchFile)); while FCBindex <> $FF Do begin if (FCBarea[FCBindex].FileName[10] < chr(128)) {not a system file} OR ListingSystemFiles then begin ReadOnly := FCBarea[FCBindex].FileName[9] > chr(127);  System := FCBarea[FCBindex].FileName[10] > chr(127); FileName := FCBarea[FCBindex].FileName; {trim bit 7 from those characters carrying file attributes} FileName[9] := chr( ord(FileName[9]) AND $7F); FileName[10] := chr( ord(FileName[10]) AND $7F); FileName[11] := chr( ord(FileName[11]) AND $7F); if (NameCount mod 5) <> 0 then write(Dest,'|'); writ