IMD 1.16: 29/05/2007 12:34:56 FOGCPM.038 --FOGCPM038PHONE-16COM PHONE-16COM-04-00 86 PHONE-16DOCPHONE-16PAS !"#$%&'(PHONE-16PAS)-CPM038 DOC$MEMBER COM*+,-./0123456789MEMBER COM?:;<=>?@AMEMBER DOC BCMEMBER PAS\DEFGHIJKLMNOALLCAPS PASPCHNGNAMEPASBQRSTUVWXYCURSOR PASZDATE PAS [\DIAL PAS]^_ENTRNAMEPAS`abcEQUATES PAS deERASE PASfEXIST PASgGETINSTRPAS hiGETYESNOPASjIOCHECK PAS klMENU PASmnopMODEM LIBqrsPRINT PAStuvSIGN-OFFPASwSTATUS PAS xyVIDEO PAS z{XECSCRN6COM|}XECSCRN6DOC~INSTALL COMBD001 ASMBD002 ASMBD006D ASMBD009 ASMDECODE ASMHLDCUR ASMINSTALL ASMKEYCPM ASMSCRN1 ASMSNDESC ASMXECSCRN6ASM Z80 LIBMLINKIT SUBPRTSCRN COMPRTSCRN DOC1PRTSCRN ASM This is the disk name.  ͫCopyright (C) 1985 BORLAND IncB Osborne 1al selectedP)(= ERT()~7#~=  oͦlԅ!!"~#(}:$= +*!6!*!!:(2!6:(>2!!!:O::O:!*! !45(! +/ 0y0( 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! ""*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> 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 *  >( ͂ ͭ͘ }>( x‰ }} ˸T}ٕ(0D={ ,= ( ͓ 0%| , 7 ?(8ͭ x ͇ - s 8˸x ͐  ,-xG}s }مN 9s .>#n0͓ | = - nx ͈ ,-(-˸G,-s }ٕ?N 9.> 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ͭ͘ ͘ ͭ---  ,,,-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,: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#~˸}րogM| .({ = ~> x0w#xG%͈ %͈ ZJDM%͈ = _~65+~hìx-Sx9?+{Η@}|{ { gZJDM0| ,7}o˸@ #yO!@9i&@  #@w#@/w#@w#!9! E9!!9~(+Fͻ!"9!(#>2*"| >"2:( ͷ *w*6 !\$![ (ͧ( #:~CONTRMKBDLSTCAUXUSR>2j:*ˮ~1:*:(@q##p[* :(  ~* < >26"!"""~>2""v>2>"!"ˮ(!~8>~O6~*"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((=ʦ==ʩ=ʬò*: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(> >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"~ʱ*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""{_!"*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"*"!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!O(>ÜMP!!!;ͤgzL!"y!*y!*yn&s*y#!!;P!Կ!Կ;!c!+!c;q!+q!̀}2x*x&͜!!.e.ͣ >!0e.>!ͫ ͜!!.e.ͣ >!2e.>!ͫ }2*&R"͜!#!j# 7"R4"͜!#!k# 7"7"}2*&Rd"͜!#!)# Æ"Rƒ"͜!#!(# Æ"Æ"}2*&R³"͜!#!^# "R"͜!#!q# ""}2*&R#͜!#!l# $#R!#͜!#!m# $#$#l!!͜ͻO ============================================================================== !!͜ͻO ============================================================================== ͅd!͙!l!P!;ͤR!"!{e.!;ͳ!͓E$!{e.!;ͳ"~!*~!!!(e.ͣ >!*~d! !$!}e.!;ͳ!͓E$!}e.!;ͳ"~!*~!! e.!!d! !!)e.ͣ >!*~!d! $!!͚*!͜!#!;!ͫ ͅP!)"z"|*|*zͅ!!!);͜!ͫ P!̽""**!!l!̽;͜!ͫ ""!}2!}2!*gz$&}2**&)))));ͤ*&E&**&)))));ͤ}2*&#%!P*&R!!}2!*gz'}2**&)))))**&)))));NN !*&**&)))));ͤRl>(*&#O&!*R!"?%#NM{Space} = Down, {Left-Arrow} = Up, {First Letter} to Find, {Return} to Select#!P*!)))));ͤR!**!)))));͜!ͫ l!*gzD(}2*&*&*!**&)))));͜!ͫ *&#'*&*!ͅ!!!}2*!)))));͜!ͫ !ͪ!E *&R=)*&*!*&**&)))));d%*&!R}2*&!̀E)*}2*&*!*&**&)))));)%* R)*&*!*&**&)))));d%*&!}2*&*Eʣ)!}2*&*!*&**&)))));)%* R)*&"½**&*!*&**&)))));d%*&}2*&}2*&#}2*&*E[*!}2*&*&̀*&**&)))));!!l͗ ̀}oE8**&}2*&*!*&**&)))));)%*&! ̀Eʊ(!!!*½"*!͓}2!*!&Ex.*RT+N+++ File Does NOT Exist +++#i.R‡+N+++ File NOT Open For INPUT +++#i.R»+N +++ File NOT Open For OUTPUT +++#i.R+N+++ File NOT Open +++#i.R,N+++ ERROR In Numeric Format +++#i. RZ,N/+++ Operation NOT Allowed On LOGICAL Device +++#i.!R,N"+++ NOT Allowed In DIRECT Mode +++#i."R,N,+++ Assign To STANDARD Files NOT Allowed +++#i.R-N+++ RECORD Length Mismatch +++#i.R5-N+++ Seek BEYOND End-Of-File +++#i.Rg-N+++ UNEXPECTED End-Of-File +++#i.R“-N+++ Disk WRITE Error +++#i.R-N+++ Directory Is FULL +++#i.R-N+++ File SIZE Overflow +++#i.R.N+++ Too MANY Open FILES +++#i.RI.N+++ File DISAPPEARED +++#i.N+++ Unknown I/O ERROR +++#!ͪ!E .$"KP!M""*!M;ͤ"@*K!P!M;ͤRE:/!P!M;ͤR"KNP!'!">**l!M;͜!ͫ ͜NN______________________________________________________________________________!*Kl!ͫ !ͅ*@*!ͪ!BE *B&!̀Eʊ0!e.P!'͜NN !*K*>Rl!ͫ <3è2*B&!. ^P*>*K}oE0!';*B&e.>P!'*B&͜# è2*B&! ̀EI1!';! e.>P!'͜! # !!';ͤ!F̀!';ͤ*Kͦ}oE0è2*B&!̀*B&!̀}o*>!}oE2!'*>!l͜!#NN______________________________________________________________________________!!l!ͫ!# ͅè2*B&!̀Eʨ2NP!'*@*l͜NN______________________________________________________________________________!*Kl!ͫ ͅ*@*!';ͤ">*B&!. ^PE/͜NN !*K*>Rl!ͫ P!":"̓6!@6;! e.>̓6s6}2s6}2! !i! !hi!! !i! !iNAT H! e.>̓67ATDTATD!"N5{H}ome Phone ** TURN MODEM ON ** {B}usiness Phone#!ͪ!E *&͂!H͒!h͒!B͒!b͒PE*8*&HRz8hR˜8!7;*b;>!Ǻ8BRʬ8bR8!7;*t;>!Ǻ*S4&}oE8NInitializing Modem ...#7!}2S4N Dialing ...#!Ǻ;! e.>̓6N({H}ang-Up {C}ontinuous Re-dial#!ͪ!E *&͂!H͒!h͒!C͒!c͒PEP9*&HRʠ9hR¾9NDisconnecting ...#͘7ê:CR9cRª:NDEnter Number of Seconds to Delay Before Re-Dial {} = 15 sec. #!º͏ !º;N͎EK:N15!º!º;!!͘7N{ANY KEY} to Stop Dialing#!Ǻ;! e.>̓6*!͘7͠E~:!"!o&}2*&!̀E:N** Printer {NOT} Ready **#!Examples: 15551212 1-555-1212 1(615)555-1212 1/615/555-1212 !!NEnter Home Phone Number : !y.*b!';!!NEnter Business Phone Number : !y.*t!';!!4!! NEnter Occupation : !y.*!';NEnter '{Y}' or '{N}'#!! NAre ALL Entries Correct (Y/N) :=3*&&͂!Y͒!y͒PE@!#ͥ! !#ͦ !#{ @@!"N=Enter {NEW} Last Name - {} = No Change {} = Blank#! !N CHANGE TO : !y.! !͚!';N͡EʵA!';!e.͎EʛA*NîA*!';!}2Q4N>Enter {NEW} First Name - {} = No Change {} = Blank#! !N CHANGE TO : !y.! !͚!';N͡EqB!';!e.͎E\BN*jB!';*!}2Q4NBEnter {NEW} Street Address - {} = No Change {} = Blank#! !N CHANGE TO : !y.! !͚!';N͡E;C!';!e.͎E!C**N4C**!';!}2Q4N8Enter {NEW} City - {} = No Change {} = Blank#! !N CHANGE TO : !y.! !͚!';N͡EC!';!e.͎EC*DNC*D!';!}2Q4N>Enter {NEW} State Code - {} = No Change {} = Blank#! !N CHANGE TO : !y.! !͚!';N͡ED!';!e.͎EʧD*TNúD*T!';!}2Q4N} = No Change {} = Blank#! !N CHANGE TO : ! y.! !͚!';N͡EʅE!';!e.͎EkE*WN ~E*W!'; !}2Q4N>Enter {NEW} Home Phone - {} = No Change {} = Blank#! !N CHANGE TO : !y.! !͚!';N͡EKF!';!e.͎E1F*bNDF*b!';!}2Q4NBEnter {NEW} Business Phone - {} = No Change {} = Blank#! !N CHANGE TO : !y.! !͚!';N͡EG!';!e.͎EF*tNG*t!';!}2Q4N>Enter {NEW} Occupation - {} = No Change {} = Blank#! !N CHANGE TO : !y.! !͚!';N͡EG!';!e.͎EG*NG*!';!}2Q4"QP!S?!! NEnter !S;>N : >*Qy.!';!*! !#N PHONE.DTAqN PHONE.DTAe!}oEʕH%#N!{** CANNOT FIND DATA FILE **}#!#{ !# !"I!"G?l! !͜ͻ FULL NAME : !!͜ͻSTREET ADDRESS : !! ͜ͻCITY, STATE & ZIP : !! ͜ͻAREA/HOME PHONE : !! ͜ͻAREA/BUSINESS PHONE : ! !͜ͻ OCCUPATION : ͅ%#N Searching ...#!#J}oEʒM!#*G !#ͥ!ͷ *ӼRI*I;!dJR J*I;!dJR+J*I*;!dJRJJ*ID;!dJRiJ*IT;!dJRˆJ*IW;!dJR§J*Ib;!dJRJ*It;!dJ RJ*I;!d!d;!!*;ͤl!!*;!͎EʃM!!͚!!͚*I;N, >*I;>͜!ͫ !!͚*I*;͜!ͫ !! ͚*ID;N, >*IT;>N >*IW;>͜!ͫ !! ͚*Ib;͜!ͫ !! ͚*It;͜!ͫ !!͚*I;͜!ͫ N8{C}hange {D}ial {P}rint {Q}uit {ANY KEY} to CONTINUE#!ͪ!DE *D&DRʏLdR˜L7 KÃMPRʬLpRµLͫ: KÃMCRLcRlM@*Q4&EfM*G"(N Updating ...#!#*G !#! !#ͦ !#{ !#N PHONE.DTAq!# !#*( !#ͥ!ͷ *("G!}2Q4 KÃMQRʀMqRƒMÛM*G!"GåI!#{ ! !T4͟%"Ӽ*ӼRMN First Name!GÌORMN Last Name!GÌORNNStreet Address!GÌOR1NNCity!GÌOR^NNTwo Letter State Code!GÌOR~NNZip Code! GÌOR§NNHome Phone Number!GÌORNNBusiness Phone Number!GÌO RNN Occupation!GÌO RO<ÌO RŒO?!͜ͅͻPHONE ver. 1.5 ͜ͻ Program by: ͜ͻJoseph L. Fall ͜ͻ CIS 76555,37 ͜ ÜM !͜ͅͻPHONE ver. 1.5 ͜ͻ Program by: ͜ͻJoseph L. Fall ͜ͻ CIS 76555,37 ͫ !!͚*I;͜!ͫ N8{C}hange {D}ial {P}rint {Q}uit {ANY KEY} to CONTINUE#!ͪ!DE *D&DRʏLdR˜L7 KÃMPRʬLpRµLͫ: KÃMCRLcRlM@*Q4&EfM*G"(N Updating ...#!#*G !# PHONE-16.DOC 02/07/86 PHONE-1 i writte i Turb Pascal T re-compil th sourc cod t thi progra i i necessar t hav Turb Pasca 3. o greater PHONE.CO͠ wa th beginnin o thi program I wa computerize phon an addres filin syste whic als feature th abilit t us smartmode t dia phon numbe containe i th file Thi progra use ver simpl procedure th WRITELINE(AUX,'###########') statemen t accomplis蠠 thi autodialing Thi progra wa originall writte b Josep Fal o Nashville T fo Kaypr 2-8 an wa ver fin piec o work. Th proble wit PHONE.CO aros whe i wa use i conjunctio wit othe program o th Osborn Executiv whic als accesse mode connecte t th EXEC' mode port I seeme tha afte runnin progra suc a MDM74 th progra wa n longe abl t outpu t th mode por usin th abov statement Jo ha bee workin o thi sam proble wit th Kaypr an ha writte cod t allo PHONE-1 t directl initializ th mode port too thi effort an wit cod "lifted fro M7OX-1.AS modifie i t wor wit th Osborn Executive Thi progra i no finishe and therefore th mor curiou amon yo ma fin som equate i MODEM.LI tha ar no use b PHONE-16.......fea not i i no mistak an the wil b use i futur version o thi program. Program i thi library: EQUATES.PA IOCHECK.PAS ALLCAPS.PA GETINSTR.PAS EXIST.PA GETYESNO.PAS CURSOR.PA ERASE.PAS VIDEO.PA MODEM.LIB STATUS.PA DIAL.PAS MENU.PA Question o comment regardin thi progra ma b directe t eithe mysel o Jo Fal o F.O.G RBBS-RCP/ #2 i Nashville. Ernes Dryde -Sysop F.O.G RBBS-RCP/ #23 (615 292-0710 {$I EQUATES.PAS} {$I ALLCAPS.PAS} {$I EXIST.PAS} {$I CURSOR.PAS} {$I VIDEO.PAS} {$I STATUS.PAS} {$I MENU.PAS} {$I IOCHECK.PAS} {$I GETINSTR.PAS} {$I GETYESNO.PAS} {$I ERASE.PAS} {$C-} label Start; const Changed : Boolean = False; DiskFull : Boolean = False; Init : Boolean = FALSE; MaxLines = 11; Lines : Array[0..MaxLines] of String[40] = ('* What Do You Want To Search By *', ' First Name', ' Last Name', ' Address', ' City', ' State', ' Zip Code', ' Phone Number', ' Business Phone', ' Occupation', ' Enter New Member', ' Quit: Go to CP/M '); type Entry = record First_name : String[20]; Last_Name : String[20]; Street_Address : String[25]; City : String[15]; State : String[2]; Zip_Code : String[10]; Home_Phone : String[17]; Business_Phone : String[17]; Occupation : String[25]; end; var Reply : Char; Choice : Integer; DataFile : File of Entry; Individual : Entry; Search_For : String[30]; {$I MODEM.LIB} {$I DIAL.PAS} procedure Print_Name; var Result : Byte; begin With Individual Do begin Result := BIOS(14); If Result = 0 then begin Write_Status('** Printer {NOT} Ready **'); Delay(1000); Exit end; writeln(Lst); writeln(Lst); writeln(Lst,First_Name,' ',Last_Name); writeln(Lst,Street_Address); writeln(Lst,City,', ',State,' ',Zip_Code); writeln(Lst); writeln(Lst,'Business Phone : ',Business_Phone); writeln(Lst,' Home Phone : ',Home_Phone); write end end; procedure Enter_Names; var Answer : Char; begin Draw_Status_Border; BDOS(13); assign(DataFile,'PHONE.DTA'); if not Exist('PHONE.DTA') then Rewrite(DataFile); Reset(DataFile); {$I-} seek(DataFile,FileSize(DataFile)) {$I+}; DiskFull := (IOresult = $F0); if DiskFull then  begin Write_Status('{+++ DISK FULL. Exit and ERASE Unnecessary Files +++}'); Close(Datafile); Exit end; ClrScr; Draw_Status_Border; with Individual do begin Write_Status('Enter a {Carriage Return} to Leave Blank'); Get_InStr(1,1,'Enter First Name : ',20); First_Name := InStr; Get_InStr(1,2,'Enter Last Name : ',20); Last_Name := InStr; Get_InStr(1,3,'Enter Street Address : ',25); Street_Address := InStr; Get_InStr(1,4,'Enter City : ',15); City := InStr; Get_InStr(1,5,'Enter Two Letter State Code : ',2); State := AllCaps(InStr); Get_InStr(1,6,'Enter Zip Code  : ',10); Zip_Code := InStr; GotoXY(1,18); writeln(BEL,'Enter Phone Numbers EXACTLY As You Would Dial Them.'); writeln('Use Punctuation To Make Them More Readable If Desired.'); write('Examples: 15551212 1-555-1212 1(615)555-1212 1/615/555-1212'); Get_InStr(1,7,'Enter Home Phone Number : ',17); Home_Phone := InStr; Get_InStr(1,8,'Enter Business Phone Number : ',17); Business_phone := InStr; EraseXY(18,20); Get_InStr(1,9,'Enter Occupation : ',25); Occupation := InStr; Write_Status('Enter ''{Y}'' or ''{N}'''); Get_YesNo(1,13,'Are ALL Entries Correct (Y/N) :'); If YesNo in ['Y','y'] then begin write(DataFile,Individual);   Flush(DataFile); Close(DataFile); end else Exit end end; procedure Change_Names; begin with Individual do begin Write_Status('Enter {NEW} Last Name - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',20); GotoXY(12,18); ClrEol; if InStr <> '' then begin if InStr = ESC then Last_Name := '' else Last_Name := InStr; Changed := True end; Write_Status('Enter {NEW} First Name - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',20); GotoXY(12,18); ClrEol;  if InStr <> '' then begin if InStr = ESC then First_Name := '' else First_Name := InStr; Changed := True end; Write_Status('Enter {NEW} Street Address - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',25); GotoXY(12,18); ClrEol; if InStr <> '' then begin if InStr = ESC then Street_Address := '' else Street_Address := InStr; Changed := True end; Write_Status('Enter {NEW} City - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',15); GotoXY(12,18); ClrEol; if InStr <> '' then begin if InStr = ESC then City := '' else City := InStr; Changed := True end; Write_Status('Enter {NEW} State Code - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',2); GotoXY(12,18); ClrEol; if InStr <> '' then begin if InStr = ESC then State := '' else State := InStr; Changed := True end; Write_Status('Enter {NEW} Zip Code - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',10); GotoXY(12,18); ClrEol;  if InStr <> '' then begin if InStr = ESC then Zip_Code := '' else Zip_Code := InStr; Changed := True end; Write_Status('Enter {NEW} Home Phone - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',17); GotoXY(12,18); ClrEol; if InStr <> '' then begin if InStr = ESC then Home_Phone := '' else Home_Phone := InStr; Changed := True end; Write_Status('Enter {NEW} Business Phone - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',17); GotoXY(12,18); ClrEol;  if InStr <> '' then begin if InStr = ESC then Business_Phone := '' else Business_Phone := InStr; Changed := True end; Write_Status('Enter {NEW} Occupation - {} = No Change {} = Blank'); Get_InStr(12,18,'CHANGE TO : ',25); GotoXY(12,18); ClrEol; if InStr <> '' then begin if InStr = ESC then Occupation := '' else Occupation := InStr; Changed := True end end end; procedure Search_Names (Search_Type : Str80; Len : Integer); label Rewrite; var I,J : Integer;   Ch : Char; Search_Key : String[25]; Temp : Integer; begin ClrScr; Get_InStr(4,12,'Enter '+Search_Type+' : ',Len); Search_Key := InStr; BDOS(13); assign(DataFile,'PHONE.DTA'); if not Exist('PHONE.DTA') then begin Draw_Status_Border; Write_Status('{** CANNOT FIND DATA FILE **}'); Close(Datafile); halt; end; reset(DataFile); with Individual do begin I := 0; ClrScr; LowVideo; GotoXY(12,7); write('FULL NAME :'); GotoXY(7,8); write('STREET ADDRESS :'); GotoXY(4,9); write('CITY, STATE & ZIP :'); GotoXY(6,11);  write('AREA/HOME PHONE :'); GotoXY(2,12); write('AREA/BUSINESS PHONE :'); GotoXY(11,14); write('OCCUPATION :'); NormVideo; Draw_Status_Border; Write_Status('Searching ...'); while not EOF(DataFile) do begin seek(DataFile,I); read(DataFile,Individual); case Choice of 1 : Search_For := First_Name; 2 : Search_For := Last_Name; 3 : Search_For := Street_Address; 4 : Search_For := City; 5 : Search_For := State; 6 : Search_For := Zip_Code; 7 : Search_For := Home_Phone; 8 : Search_For := Business_Phone;  9 : Search_For := Occupation; end; if AllCaps(Copy(Search_For,1,Length(Search_Key))) = AllCaps(Search_Key) then begin Rewrite: GotoXY(1,18); ClrEol; GotoXY(25,7); ClrEol; write(Last_Name + ', ' + First_Name); GotoXY(25,8); ClrEol; write(Street_Address); GotoXY(25,9); ClrEol; write(City + ', ' + State + ' ' + Zip_Code); GotoXY(25,11); ClrEol; write(Home_Phone); GotoXY(25,12); ClrEol; write(Business_Phone); GotoXY(25,14); ClrEol; write(Occupation); Write_Status('{C}hange {D}ial {P}rint {Q}uit {ANY KEY} to CONTINUE'); read(Kbd,Ch); case Ch of 'D','d' : begin Dial_Number; Goto Rewrite end; 'P','p' : begin Print_Name; Goto Rewrite end; 'C','c' : begin Change_Names; if Changed then begin Temp := I; Write_Status('Updating ...');  Seek(DataFile,I); Write(DataFile,Individual); Flush(Datafile); Close(Datafile); Assign(Datafile,'PHONE.DTA'); Reset(Datafile); Seek(Datafile,Temp); Read(Datafile,Individual); I := Temp; Changed := False; end; Goto Rewrite; end; 'Q','q' : Exit end end;   I := I + 1 end; Close(DataFile); end; end; { ************************************************************************ * * * MAIN PROGRAM * * * ************************************************************************ } begin Start: Choice := Menu(MaxLines,Lines); Case Choice of 1 : Search_Names ('First Name',20); 2 : Search_Names ('Last Name',20); 3 : Search_Names ('Street Address',25); 4 : Search_Names ('City',15); 5 : Search_Names ('Two Letter State Code',2); 6 : Search_Names ('Zip Code',10); 7 : Search_Names ('Home Phone Number',17); 8 : Search_Names ('Business Phone Number',17); 9 : Search_Names ('Occupation',25); 10 : Enter_Names; 11 : begin ClrScr; Cursor_On; NormVideo; writeln('PHONE ver. 1.5'); writeln('Program by:'); writeln('Joseph L. Fall'); writeln('CIS 76555,37'); writeln; Halt end end; goto Start; end. ͫCopyright (C) 1985 BORLAND IncB Osborne 1al selectedP)(= ERT()~7#~=  oͦlԅ!!"~#(}:$= +*!6!*!!:(2!6:(>2!!!:O::O:!*! !45(! +/ 0y0( 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! ""*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> 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 *  >( ͂ ͭ͘ }>( x‰ }} ˸T}ٕ(0D={ ,= ( ͓ 0%| , 7 ?(8ͭ x ͇ - s 8˸x ͐  ,-xG}s }مN 9s .>#n0͓ | = - nx ͈ ,-(-˸G,-s }ٕ?N 9.> 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ͭ͘ ͘ ͭ---   ,,,-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,: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#~˸}րogM| .({ = ~> x0w#xG%͈ %͈ ZJDM%͈ = _~65+~hìx-Sx9?+{Η@}|{ { gZJDM0| ,7}o˸@ #yO!@9i&@  #@w#@/w#@w#!9! E9!!9~(+Fͻ!"9!(#>2*"| >"2:( ͷ *w*6 !\$![ (ͧ( #:~CONTRMKBDLSTCAUXUSR>2j:*ˮ~1:*:(@q##p[* :(  ~* < >26"!"""~>2""v>2>"!"ˮ(!~8>~O6~*"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((=ʦ==ʩ=ʬò*: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(> >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"~ʱ*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""{_!"*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"*"!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!H`>s^ P!!!;ͤgzL!"y!*y!*yn&s*y#!!;P!Կ!Կ;!c!+!c;q!+q!̀}2x*x&͜!!.e.ͣ >!0e.>!ͫ ͜!!.e.ͣ >!2e.>!ͫ }2*&R"͜!#!j# 7"R4"͜!#!k# 7"7"}2*&Rd"͜!#!)# Æ"Rƒ"͜!#!(# Æ"Æ"}2*&R³"͜!#!^# "R"͜!#!q# ""}2*&R#͜!#!l# $#R!#͜!#!m# $#$#l!!͜ͻO ============================================================================== !!͜ͻO ============================================================================== ͅd!͙!l!P!;ͤR!"!{e.!;ͳ!͓E$!{e.!;ͳ"~!*~!!!(e.ͣ >!*~d! !$!}e.!;ͳ!͓E$!}e.!;ͳ"~!*~!! e.!!d! !!)e.ͣ >!*~!d! $!!͚*!͜!#!;!ͫ ͅP!)"z"|*|*zͅ!!!);͜!ͫ P!̽""**!!l!̽;͜!ͫ ""!}2!}2!*gz$&}2**&)))));ͤ*&E&**&)))));ͤ}2*&#%!P*&R!!}2!*gz'}2**&)))))**&)))));NN !*&**&)))));ͤRl>(*&#O&!*R!"?%#NM{Space} = Down, {Left-Arrow} = Up, {First Letter} to Find, {Return} to Select#!P*!)))));ͤR!**!)))));͜!ͫ l!*gzD(}2*&*&*!**&)))));͜!ͫ *&#'*&*!ͅ!!!}2*!)))));͜!ͫ !ͪ!E *&R=)*&*!*&**&)))));d%*&!R}2*&!̀E)*}2*&*!*&**&)))));)%* R)*&*!*&**&)))));d%*&!}2*&*Eʣ)!}2*&*!*&**&)))));)%* R)*&"½**&*!*&**&)))));d%*&}2*&}2*&#}2*&*E[*!}2*&*&̀*&**&)))));!!l͗ ̀}oE8**&}2*&*!*&**&)))));)%*&! ̀Eʊ(!!!*½g+$"VP!X""*!X;ͤ"K*V!P!X;ͤRE+!P!X;ͤR"VNP!'!"I**l!X;͜!ͫ ͜NN______________________________________________________________________________!*Vl!ͫ !ͅ*K*!ͪ!ME *M&!̀E-!e.P!'͜NN !*V*IRl!ͫ /3/*M&!G+ ^P*I*V}oEg-!';*M&e.>P!'*M&͜# 3/*M&! ̀E-!';! e.>P!'͜! # !!';ͤ!F̀!';ͤ*Vͦ}oEy-3/*M&!̀*M&!̀}o*I!}oEʓ.!'*I!l͜!#NN______________________________________________________________________________!!l!ͫ!# ͅ3/*M&!̀E3/NP!'*K*l͜NN______________________________________________________________________________!*Vl!ͫ ͅ*K*!';ͤ"I*M&!'+ ^PEn,͜NN !*V*IRl!ͫ P!"E"G!*G*El!;͜!ͫ ͜!?#!# ͅ!ͪ!&E *&&͂!Y͒!y͒!N͒!n͒PE/*&&YRc0yRv0͜ͻYes Ù0NRʊ0nR™0͜ͻNo }2}2*&*&gz0}2!*&͚*&#÷0P!"Լ"ּ*ּ!;ͤ"yN__/__/__!ؼl*ּ*Լ!;͜!ͫ *y*Լ!ؼ;͜!ͫ ͅ!*y*Լ!"wNDUMMYP!'!ͪ!vE *v&! ̀*w!̀}oE1NP!'N!ؼE3*v&!̀*w!̀}oE1!e.P!'E3*v&!̀*v&!̀}o*w!}oE{2*w͂!͒!͒PEY2*w!R"wh2*w!R"w!ؼ*w!_s2*v&͂!0!9͜P*w! }oE2!ؼ*w*v&s*w͂!͒!͒PE2*w!"w2*w!"w*y*Լ!ؼ;͜!ͫ *y*w!R*Լ*v&! ̀*w! ̀}oEx1!k!k!n&e.!a!Y!k!n&e.!_!Y!k!n&e.!]!Y!k!n&e.![!Y*]!*[!d*a! *_!"t*t* What Do You Want To Do * First Name (Search)  Last Name (Search) City (Search) State (Search) Topic (Search) Generate Labels Enter New Member Quit: Go to CP/M* Print Labels For * Test Label All Members Paid Members Expired Members  Non - Members Go To Main MenuATQ0V0M1X1 S0=0 S2=3 S11=50! Mh}2 * &P!ǹ!!ǹ;ͤgzV7}2!ǹ*&n&!,̀E7!K7!! Mh|g}o!͓E7! !ǹ*&n&i*&#6!! !i! !i! !i! !Di! !i! !i! !i! !iNAT! e.>6!6;! e.>6ͽ6}2ͽ6}2! !i! !hi!! !i! !iNAT H! e.>628ATDTATD!X"N5{H}ome Phone ** TURN MODEM ON ** {B}usiness Phone#!ͪ!E *&͂!H͒!h͒!B͒!b͒PEt8*&HR8hR8!)8;*;>!9BR8bR9!)8;*;>!*3&}oEF9NInitializing Modem ...#]7!}23N Dialing ...#!;! e.>6N({H}ang-Up {C}ontinuous Re-dial#!ͪ!E *&͂!H͒!h͒!C͒!c͒PEʚ9*&HR9hR:NDisconnecting ...#7:CR:cR:NDEnter Number of Seconds to Delay Before Re-Dial {} = 15 sec. #!͏ !;N͎Eʕ:N15!!;!}!{7N{ANY KEY} to Stop Dialing#!;! e.>6*}!7͠E:!X"sN"** Printer ON Then Press RETURN **#!ͪ!rE !ͻ*s;!ͫ! #*s;!ͫ !ͻ*s*;!ͫ *sI;N͡Eʯ;!ͻ*sI;!ͫ !ͻ*sh;!ͫͻ, *sx;!ͫͻ *s{;!ͫ !ͻ !ͻN Home Phone : *s;>N Bus. Phone : >*s;>!ͫ !ͻN Occupation : *s;>!ͫ !ͻN Computer 1 : *s;>N Computer 2 : >*s;>!ͫ !ͻN Uses These : *s;>!ͫ !ͻ !X"j*j&;F3*7R"h!ͻN Expires: *j&;>!ͫ *j&;N͎Eʞ=!ͻͻ * SPECIAL * >>*h!ͦ*h! ͹}o*j&;N͡}oE=!ͻͻ * RENEW * >>*h!E">!ͻͻ * EXPIRED * >>!ͻͻ * ACTIVE * !ͻ*j;!ͫ! #*j;!ͫ !ͻ*j*;!ͫ *jI;N͡Eʺ>!ͻ*jI;!ͫ !ͻ*jh;!ͫͻ, *jx;!ͫͻ *j{;!ͫ !ͻ *jI;N͎E1?!ͻ !!gzʿ?}2^!!gzʨ?}2_!!gzʑ?}2]!ͻ*_&!' *]&#g?!ͻ *_&#R?!ͻ *^&#=?%#! !!*;q!*;e!}oE?!N !N !!^!̀}23*3&En@N3+++ DISK FULL. Exit and ERASE Unnecessary Files +++#!{ F!X"U?%#N&Enter a Carriage Return to Leave Blank#!!NEnter First Name : !+!';*U!!NEnter Last Name : !+*U!';!!NEnter Address1 : !+*U*!';!!NEnter Address2 : !+*UI!';!!NEnter City : !+*Uh!';!!NEnter Two Letter State Code : !+*Ux!';!!!NEnter Zip Code : ! +*U{!'; !!͜!#ͻ3Enter Phone Numbers EXACTLY As You Would Dial Them. ͜ͻ6Use Punctuation To Make Them More Readable If Desired. ͜ͻ>Examples: 15551212 1-555-1212 1(615)555-1212 1/615/555-1212 !!NEnter Home Phone Number : !+*U!';!! NEnter Business Phone Number : !+*U!';!!͚0!! NEnter Occupation : !+*U!';!! NEnter Primary Computer Type : !+*U!';!! NEnter Second Computer Type : !+*U!';NSeparate Topics With a Comma#!! NEnter Areas of Expertise : !+*U!';N&Enter a Carriage Return to Leave Blank#!!NEnter Membership ID Number : !+*U!';!!NEnter Date Member Joined : 0*U!ؼ;!!NEnter Expiration Date : 0*U&!ؼ;NEnter 'Y' or 'N'#!!NAre ALL Entries Correct (Y/N) :/*&&͂!Y͒!y͒PEʍF!ͥ!X !ͦ !!NEnter Another Person (Y/N) :/*&&͂!N͒!n͒PEt@!{ !?! !!?;q!?;e!}oEGG%#N** CANNOT FIND DATA FILE **#!{ !N !X"/N;Enter {NEW} Last Name {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EH!';!e.͎EH*/NH*/!';!}23N} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EH!';!e.͎EHN*/H!';*/!}23N;Enter {NEW} Address1 {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EʚI!';!e.͎EʀI*/*NÓI*/*!';!}23N;Enter {NEW} Address2 {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡E]J!';!e.͎ECJ*/INVJ*/I!';!}23N6Enter {NEW} City {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EK!';!e.͎EK*/hNK*/h!';!}23N} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EK!';!e.͎EK*/xNK*/x!';!!}23N:Enter {NEW} Zip Code {} = No Change {} = Blank#! !N CHANGE TO : ! +! !͚!';N͡EʤL!';!e.͎EʊL*/{N ÝL*/{!'; !}23N} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EhM!';!e.͎ENM*/NaM*/!';!}23N@Enter {NEW} Business Phone {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡E0N!';!e.͎EN*/N)N*/!';!}23N} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EN!';!e.͎EN*/NN*/!';!}23NFEnter {NEW} Membership ID Number {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EO!';!e.͎EʨO*/NûO*/!';!}23NBEnter {NEW} Primary Computer {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EʌP!';!e.͎ErP*/NÅP*/!';!}23NAEnter {NEW} Second Computer {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡EUQ!';!e.͎E;Q*/NNQ*/!';!}23NDEnter {NEW} Areas of Expertise {} = No Change {} = Blank#! !N CHANGE TO : !+! !͚!';N͡E!R!';!e.͎ER*/NR*/!';!}23N=Enter {NEW} Date Joined {} = No Change {} = Blank#! !N CHANGE TO : 0! !͚!';N͡ER!';!e.͎ER*/NR*/!ؼ;!}23NAEnter {NEW} Expiration Date {} = No Change {} = Blank#! !N CHANGE TO : 0! !͚!';N͡EʧS!';!e.͎EʍS*/&NàS*/&!ؼ;!}23"ܸP!޸?!! NEnter !޸;>N : >*ܸ+!';!!*;F!X"Ը!"Ҹ?l!!͜ͻ FULL NAME : !!͜ͻ ADDRESS 1 : !!͜ͻ ADDRESS 2 : !!͜ͻ CITY, STATE & ZIP : !!͜ͻ AREA/HOME PHONE : !!͜ͻAREA/BUSINESS PHONE : !! ͜ͻ OCCUPATION : !! ͜ͻ MEMBERSHIP I.D. : !! ͜ͻ PRIMARY COMPUTER : !!͜ͻ SECONDARY COMPUTER : !!͜ͻ KNOWLEDGEABLE IN : !!͜ͻ MEMBER JOINED : !!͜ͻ MEMBERSHIP EXPIRES : ͅ%#N Searching ...#!J}oEʃZ!*Ҹ !ͥ!Xͷ *VR‡V*Ը;!9WR¦V*Ը;!9WRV*Ըh;!9WRV*Ըx;!9WRW*Ը;!9*V!̀!;!!9;!ͳ!}o*V͂!!͜P!9;!!;ͤl!!;!͎}o}oEtZ!!͚!!͚*Ը;N, >*Ը;>͜!ͫ !!͚*Ը*;͜!ͫ !!͚*ԸI;͜!ͫ !!͚*Ըh;N, >*Ըx;>N >*Ը{;>͜!ͫ !!͚*Ը;͜!ͫ !!͚*Ը;͜!ͫ !! ͚*Ը;͜!ͫ !! ͚*Ը;͜!ͫ !! ͚*Ը;͜!ͫ !!͚*Ը;͜!ͫ !!͚*Ը;͜!ͫ !!͚*Ը;͜!ͫ !!͚*Ը&;͜!ͫ N8{C}hange {D}ial {P}rint {Q}uit {ANY KEY} to CONTINUE#!ͪ!ϸE *ϸ&DRYdRY&8ÇYtZPR ZpRZ:ÇYtZQR'ZqR-ZÌZtZCRAZcRtZTG*3&EqZ!*Ҹ !ͥ!X !}23uW*Ҹ!"Ҹ?V!{ ?!! NEnter Today's Date : 0!ؼ;F3"7!!k5͟%"V*V!̀EZ2?*V!̀EZ)\!*;F!X"NPrinting . . .#!"!J}o͠}o}oE\!* !ͥ!Xͷ *V!̀Ek[= \*V!̀*&;F3*7ͦ}o*&;N͡}oEʱ[= \*V!̀*&;F3*7}oE[= \*V!̀*&;N͎}oE \=*!"[*V!̀EZ͜ l͜ͻ3This program was written so that clubs could create ͜ͻ5a searchable database of their members and distribute ͜ͻ5the database and program to everyone in the club. Up ͜ͻ6until now, most descent database programs were covered ͜ͻ7by copyright law. If you like the program and think it ͜ͻ6is worth any consideration, please send a donation to: ͜ ͜ͻ Joseph Fall ͜ͻ8031 Regency Drive ͜ͻNashville, TN 37221 ͜ ͜ͻTurbo Pascal ver. 1.2 ͜ͻ August, 1986 ͅ!}23͜!̀E^͜!#ͻ +++ ERROR +++ ͜ͻ'Command Syntax : MEMBER  _!~!!!!;N.DTA> !*!!3͟%"V*VR6_N First Name!ͨS8`RW_N Last Name!ͨS8`Rs_NCity!ͨS8`R _NTwo Letter State Code!ͨS8`R_NArea of Expertise!ͨS8`R_͍Z8`R_?8`R8`?!! NExit to CP/M (Y/N) /*&&͂!Y͒!y͒PE8`*\*3&E_! _R͍Z_R?_R?!! Nearchable database of their members and distribute ͜ͻ5the database and program to everyone in the club. Up ͜ͻ MEMBER.PAS 02/07/8 Thi progra i intende t enabl on t kee trac o member o compute user group Thi versio i intende t ru o th Osborn Executiv althoug i wil adap easil t man othe CP/ computers. MEMBER.PAӠ wil maintai membe databas an offer th abilit t prin label base o th member membershi expiratio date I als use smartmode connecte t th Executiv mode por t autodia member' phon numbers. Pleas not tha yo wil Turb Pasca versio 3. o newe i require t compil thi program. Programs required to compile MEMBER.PAS: MEMBER.PAS EQUATES.PAS ALLCAPS.PAS EXIST.PAS CURSOR.PAS VIDEO.PAS STATUS.PAS MENU.PAS GETINSTR.PAS GETYESNO.PAS ERASE.PAS DATE.PAS MODEM.LIB  DIAL.PAS PRINT.PAS ENTRNAME.PAS CHNGNAME.PAS SIGN-OFF.PAS Comment o suggestion ma b lef t Jo Fal o mysel on: F.O.G. RBBS-RCP/M #23 (615) 292-0710 Ernest L. Dryden -Sysop ilit t prin label base o th member membershi expiratio date I als use smartmode connecte t th Executiv mode por t autodia member' phon numbers. Pleas not tha yo wil Turb Pasca versio 3. o newe i require t compil thi program. Programs required to compile MEMBER.PAS: MEMBER.PAS EQUATES.PAS ALLCAPS.PAS EXIST.PAS CURSOR.PAS VIDEO.PAS STATUS.PAS MENU.PAS GETINSTR.PAS GETYESNO.PAS ERASE.PAS DATE.PAS MODEM.LIB  {$I Equates.pas} {$I Allcaps.pas} {$I Exist.pas} {$I Cursor.pas} {$I Video.pas} {$I Status.pas} {$I Menu.pas} {$I Getinstr.pas} {$I Getyesno.pas} {$I Erase.pas} {$I Date.pas} {$C-} const Changed : Boolean = False; DiskFull : Boolean = False; Finished : Boolean = False; Init : Boolean = False; MaxLine1 = 8; MaxLine2 = 6; Lines1 : Array[0..MaxLine1] of String[40] = ('* What Do You Want To Do *', ' First Name (Search) ', ' Last Name (Search)', ' City (Search)', ' State (Search)', ' Topic (Search)', ' Generate Labels', ' Enter New Member', ' Quit: Go to CP/M'); Lines2 : Array[0..Maxline2] of String[40] = ('* Print Labels For *', ' Test Label', ' All Members', ' Paid Members', ' Expired Members ', ' Non - Members', ' Go To Main Menu'); type Entry = record First_Name : String[20]; Last_Name : String[20]; Address1 : String[30]; Address2 : String[30]; City : String[15]; State : String[2]; Zip_Code : String[10]; Home_Phone : String[17]; Business_Phone : String[17]; Occupation : String[30]; Computer1 : String[15]; Computer2 : String[15]; Topics : String[30]; MemberID : String[20]; Joined_Date : String[8]; Exp_Date : String[8];  Extra : String[30]; end; var Reply : Char; Choice : Integer; DataFile : File of Entry; Individual : Entry; Search_For : String[30]; Today : Integer; DTAFile : String[12]; InFile : String[8]; {$I Modem.lib} {$I Dial.pas} {$I Print.pas} {$I Entrname.pas} procedure Open_File (FileName : Str20); begin BDOS(13); assign(DataFile,FileName); if not Exist(FileName) then begin Draw_Status_Border; Write_Status('** CANNOT FIND DATA FILE **'); Close(Datafile); halt; end; reset(DataFile) end; {$I Chngname.pas} procedure Search_Names (Search_Type : Str80; Len : Integer); label Rewrite,Option; var I,J : Integer; Ch : Char; Search_Key : String[30]; begin ClrScr; Get_InStr(4,12,'Enter '+Search_Type+' : ',Len); Search_Key := InStr; Open_File (DTAFile); with Individual do begin I := 0; ClrScr; LowVideo; GotoXY(3,1); write(' FULL NAME :'); GotoXY(3,2); write(' ADDRESS 1 :'); GotoXY(3,3); write(' ADDRESS 2 :'); GotoXY(3,4); write(' CITY, STATE & ZIP :'); GotoXY(3,6); write(' AREA/HOME PHONE :'); GotoXY(3,7); write('AREA/BUSINESS PHONE :'); GotoXY(3,9); write(' OCCUPATION :'); GotoXY(3,11); write(' MEMBERSHIP I.D. :'); GotoXY(3,13); write(' PRIMARY COMPUTER :'); GotoXY(3,14); write(' SECONDARY COMPUTER :'); GotoXY(3,16); write(' KNOWLEDGEABLE IN :'); GotoXY(3,18); write(' MEMBER JOINED :'); GotoXY(3,19); write(' MEMBERSHIP EXPIRES :'); NormVideo; Draw_Status_Border; Write_Status('Searching ...'); while not EOF(DataFile) do begin seek(DataFile,I); read(DataFile,Individual); case Choice of 1 : Search_For := First_Name;  2 : Search_For := Last_Name; 3 : Search_For := City; 4 : Search_For := State; 5 : Search_For := Topics; end; if ((Choice = 5) and (Pos(AllCaps(Search_Key),AllCaps(Search_For)) > 0)) or ((Choice in [1..4]) and (AllCaps(Copy(Search_For,1,length(Search_Key))) = AllCaps(Search_Key))) then begin Rewrite: GotoXY(1,21); ClrEol; GotoXY(25,1); ClrEol; write(Last_Name + ', ' + First_Name); GotoXY(25,2); ClrEol; write(Address1); GotoXY(25,3); ClrEol; write(Address2); GotoXY(25,4); ClrEol; write(City + ', ' + State + ' ' + Zip_Code); GotoXY(25,6); ClrEol; write(Home_Phone); GotoXY(25,7); ClrEol; write(Business_Phone); GotoXY(25,9); ClrEol; write(Occupation); GotoXY(25,11); ClrEol; write(MemberID); GotoXY(25,13); ClrEol; write(Computer1); GotoXY(25,14); ClrEol; write(Computer2); GotoXY(25,16); ClrEol; write(Topics); GotoXY(25,18); ClrEol; write(Joined_Date); GotoXY(25,19); ClrEol; write(Exp_Date); Option: Write_Status('{C}hange {D}ial {P}rint {Q}uit {ANY KEY} to CONTINUE'); read(Kbd,Ch); case Ch of 'D','d' : begin Dial_Number; Goto Option end; 'P','p' : begin Print_Name; Goto Option end; 'Q','q' : Exit; 'C','c' : begin Change_Names; if Changed then begin Seek(DataFile,I); Write(DataFile,Individual);  Changed := False; end; Goto Rewrite; end; end; end; I := I + 1; end; Close(DataFile); end; end; procedure Generate_Labels; var I : Integer; begin ClrScr; Get_Date(4,12,'Enter Today''s Date : '); Today := Int_Date (Date); repeat Choice := Menu(MaxLine2,Lines2); If Choice = 1 then Print_Test_Label; If Choice = 6 then Exit; Open_File (DTAFile); with Individual do begin Write_Status('Printing . . .');  I := 0; while not EOF(DataFile) and not KeyPressed do begin seek(DataFile,I); read(DataFile,Individual); if (Choice = 2) then Print_Label else if (Choice = 3) and (Int_Date (Exp_Date) >= Today) and (Exp_Date <> '') then Print_Label else if (Choice = 4) and (Int_Date (Exp_Date) < Today) then Print_Label else if (Choice = 5) and (Exp_Date = '') then Print_Label; I := I + 1; end end; until Choice = 6 end; { ************************************************************************ * * * MAIN PROGRAM * * * ************************************************************************ } {$I Sign-off.pas} begin If ParamCount = 0 then begin writeln(BEL,'+++ ERROR +++'); writeln('Command Syntax : MEMBER '); Halt end else begin InFile := ParamStr(1); DTAFile := InFile + '.DTA' end; Repeat Choice := Menu(MaxLine1,Lines1); Case Choice of 1 : Search_Names('First Name',20); 2 : Search_Names('Last Name',20); 3 : Search_Names('City',15); 4 : Search_Names('Two Letter State Code',2); 5 : Search_Names('Area of Expertise',30); 6 : Generate_Labels; 7 : Enter_Names; 8 : begin ClrScr; Get_YesNo (1,10,'Exit to CP/M (Y/N) '); If YesNo in ['Y','y'] then Sign_Off; end end Until Finished; Cursor_On; end.  begin InFile := ParamStr(1); DTAFile := InFile + '.DTA' end; Repeat Choice := Menu(MaxLine1,Lines1); Case Choice of 1 : Search_Names('First Name',20); 2 : Search_Names('Last Name',20); 3 : Search_Names('City',15); 4 : Search_Names('Two Letter State Code',2); 5 : Search_Names('Area of Expe { Pass this function a string of up to 80 characters. Converts to uppercase. example: StateCode := AllCaps (StateCode); } Function AllCaps(TempStr : Str80) : Str80; Var I : Integer; Begin For I := 1 To length(TempStr) Do TempStr[I] := Upcase(TempStr[I]); AllCaps := TempStr End;  procedure Change_Names; begin with Individual do begin Write_Status('Enter {NEW} Last Name {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',20); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Last_Name := '' else Last_Name := InStr; Changed := True end; Write_Status('Enter {NEW} First Name {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',20); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then First_Name := '' else  First_Name := InStr; Changed := True end; Write_Status('Enter {NEW} Address1 {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',30); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Address1 := '' else Address1 := InStr; Changed := True end; Write_Status('Enter {NEW} Address2 {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',30); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Address2 := '' else  Address2 := InStr; Changed := True end; Write_Status('Enter {NEW} City {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',15); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then City := '' else City := InStr; Changed := True end; Write_Status('Enter {NEW} State Code {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',2); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then State := '' else State := AllCaps(InStr); Changed := True end; Write_Status('Enter {NEW} Zip Code {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',10); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Zip_Code := '' else Zip_Code := InStr; Changed := True end; Write_Status('Enter {NEW} Home Phone {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',17); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Home_Phone := '' else Home_Phone := InStr; Changed := True end; Write_Status('Enter {NEW} Business Phone {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',17); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Business_Phone := '' else Business_Phone := InStr; Changed := True end; Write_Status('Enter {NEW} Occupation {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',30); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Occupation := '' else Occupation := InStr; Changed := True end; Write_Status('Enter {NEW} Membership ID Number {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',20); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then MemberID := '' else MemberID := InStr; Changed := True end; Write_Status('Enter {NEW} Primary Computer {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',15); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Computer1 := '' else  Computer1 := InStr; Changed := True end; Write_Status('Enter {NEW} Second Computer {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',15); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Computer2 := '' else Computer2 := InStr; Changed := True end; Write_Status('Enter {NEW} Areas of Expertise {} = No Change {} = Blank'); Get_InStr(13,21,'CHANGE TO : ',25); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Topics := '' else  Topics := InStr; Changed := True end; Write_Status('Enter {NEW} Date Joined {} = No Change {} = Blank'); Get_Date(13,21,'CHANGE TO : '); GotoXY(13,21); ClrEol; if InStr <> '' then begin If InStr = ESC then Joined_Date := '' else Joined_Date := Date; Changed := True end; Write_Status('Enter {NEW} Expiration Date {} = No Change {} = Blank'); Get_Date(13,21,'CHANGE TO : '); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Exp_Date := '' else  Exp_Date := Date; Changed := True end end end;  GotoXY(13,21); ClrEol; if InStr <> '' then begin If InStr = ESC then Joined_Date := '' else Joined_Date := Date; Changed := True end; Write_Status('Enter {NEW} Expiration Date {} = No Change {} = Blank'); Get_Date(13,21,'CHANGE TO : '); GotoXY(13,21); ClrEol; if InStr <> '' then begin if InStr = ESC then Exp_Date := '' else  { Contains machine code to turn cursor off on Osborne Executive.} Procedure Cursor_Off; Begin WRITE(ESC+'.'+'0'); End; { Same as above except turns cursor on. } Procedure Cursor_On; Begin WRITE(ESC+'.'+'2'); End; MEMBER DOC BCMEMBER PAS\DEFGHIJKLMNOALLCAPS PASPCHNGNAMEPASBQRSTUVWXYCURSOR $$$type Str8 = string[8]; var Date : string[8]; procedure Get_Date (X,Y : integer; Prompt : Str80); var CurX, Pos : integer; Ch : char; begin CurX := X + length(Prompt); Date := '__/__/__'; LowVideo; gotoXY(X,Y); write(Prompt); gotoXY(CurX,Y); write(Date); NormVideo; Cursor_On; gotoXY(CurX,Y); Pos := 1; InStr := 'DUMMY'; repeat read(kbd,Ch); if (Ch = CR) and (Pos = 1) then begin InStr := ''; Date := ''; Exit end; if (Ch = ESC) and (Pos = 1) then begin InStr := ESC; Exit end; if ((Ch = BS) or (Ch = RUB)) and (Pos > 1) then begin if Pos in [4,7] then Pos := Pos - 2 else Pos := Pos - 1; Date[Pos] := '_' end else if ((Ch) in ['0'..'9']) and (Pos < 9) then begin Date[Pos] := Ch; if Pos in [2,5] then Pos := Pos + 2 else Pos := Pos + 1 end; gotoXY(CurX,Y); write(Date); GotoXY(CurX + Pos - 1,Y); until (Ch = CR) and (Pos = 9); end; function Int_Date (Str_Date : Str8) : Integer; var D1,D2,D7,D8,Code : Integer; begin Val(Str_Date[1],D1,Code); Val(Str_Date[2],D2,Code); Val(Str_Date[7],D7,Code); Val(Str_Date[8],D8,Code); Int_Date := D7 * 1000 + D8 * 100 + (D1 * 10 + D2)* 8 end; = ''; Exit end; if (Ch = ESC) and (Pos = 1) then begin InStr := ESC; Exit end; if ((Ch = BS) or (Ch = RUB)) and (Pos > 1) then begin if Pos in [4,7] then Pos := Pos - 2 else Pos := Pos - 1; Date[Pos] := '_' end else if ((Ch) in ['0'..'9']) and (Pos < 9) then begin Date[Pos] := Ch; if Pos in [2,5] then Pos := Pos + 2 else Pos := Pos + 1 end; gotoXY(CurX,Y); write(D procedure Dial_Number; const Tone : String[4] = 'ATDT'; {Hayes dial with tone} Pulse : String[3] = 'ATDP'; {Hayes dial with pulse} var Ch : Char; Tel_No : String[30]; {Hayes commands & number} Del_Time : String[4]; {Delay time for re-dial} Time : Integer; {Integer of Del_Time} Result : Integer; {Used in Val function} begin With Individual Do {The record variables} begin Write_Status('{H}ome Phone ** TURN MODEM ON ** {B}usiness Phone'); repeat {Force read of H or B} read(Kbd,Ch); until Ch in ['H','h','B','b']; case Ch of {Add appropriate prefix} 'H','h' : Tel_No := Tone + Home_Phone; 'B','b' : Tel_No := Tone + Business_Phone; end; If not Init then begin Write_Status('Initializing Modem ...'); Initialize_Modem; Init := True end; Write_Status('Dialing ...'); Out_Modem (Tel_No + CR); {Send number out modem} Write_Status('{H}ang-Up {C}ontinuous Re-dial'); Repeat {Force read of H or C} Read(Kbd,Ch) Until Ch in ['H','h','C','c']; Case Ch of 'H','h' : begin Write_Status('Disconnecting ...'); Disconnect_Modem {If H then hang-up} end;  'C','c' : begin Write_Status('Enter Number of Seconds to Delay Before Re-Dial {} = 15 sec. '); Read (Del_Time); {Read delay time} If Del_Time = '' then Del_Time := '15'; Val(Del_Time,Time,Result); {Integer} Disconnect_Modem; {Hang-up} Write_Status('{ANY KEY} to Stop Dialing'); repeat Out_Modem (Tel_No + CR); {Dial} Delay(Time * 1000); {Delay} Disconnect_Modem {Hang} until KeyPressed; end end end end;  procedure Enter_Names; var Answer : Char; begin Draw_Status_Border; BDOS(13); assign(DataFile,DTAFile); if not Exist(DTAFile) then Rewrite(DataFile); Reset(DataFile); {$I-} seek(DataFile,FileSize(DataFile)) {$I+}; DiskFull := (IOresult = $F0); if DiskFull then begin Write_Status('+++ DISK FULL. Exit and ERASE Unnecessary Files +++'); Close(Datafile); Exit end; with Individual do begin repeat ClrScr; Draw_Status_Border; Write_Status('Enter a Carriage Return to Leave Blank'); Get_InStr(1,1,'Enter First Name : ',20); First_Name := InStr; Get_InStr(1,2,'Enter Last Name : ',20); Last_Name := InStr; Get_InStr(1,3,'Enter Address1 : ',30); Address1 := InStr; Get_InStr(1,4,'Enter Address2 : ',30); Address2 := InStr; Get_InStr(1,5,'Enter City : ',15); City := InStr; Get_InStr(1,6,'Enter Two Letter State Code : ',2); State := AllCaps(InStr); Get_InStr(1,7,'Enter Zip Code : ',10); Zip_Code := InStr; GotoXY(1,18); writeln(BEL,'Enter Phone Numbers EXACTLY As You Would Dial Them.'); writeln('Use Punctuation To Make Them More Readable If Desired.'); write('Examples: 15551212 1-555-1212 1(615)555-1212 1/615/555-1212'); Get_InStr(1,8,'Enter Home Phone Number : ',17);  Home_Phone := InStr; Get_InStr(1,9,'Enter Business Phone Number : ',17); Business_phone := InStr; EraseXY(18,20); Get_InStr(1,10,'Enter Occupation : ',30); Occupation := InStr; Get_InStr(1,11,'Enter Primary Computer Type : ',15); Computer1 := InStr; Get_InStr(1,12,'Enter Second Computer Type : ',15); Computer2 := InStr; Write_Status('Separate Topics With a Comma'); Get_InStr(1,13,'Enter Areas of Expertise : ',30); Topics := InStr; Write_Status('Enter a Carriage Return to Leave Blank'); Get_InStr(1,14,'Enter Membership ID Number : ',20); MemberID := InStr; Get_Date (1,15,'Enter Date Member Joined : '); Joined_Date := Date;  Get_Date (1,16,'Enter Expiration Date : '); Exp_Date := Date; Write_Status('Enter ''Y'' or ''N'''); Get_YesNo(1,18,'Are ALL Entries Correct (Y/N) :'); If YesNo in ['Y','y'] then begin write(DataFile,Individual); Flush(DataFile); end; Get_YesNo(1,20,'Enter Another Person (Y/N) :'); until YesNo in ['N','n']; end; Close(DataFile); end; Areas of Expertise : ',30); Topics := InStr; Write_Status('Enter a Carriage Return to Leave Blank'); Get_InStr(1,14,'Enter Membership ID Number : ',20); MemberID := InStr; Get_Date (1,15,'Enter Date Member Joined : '); Joined_Date := Date; Const BEL = ^G; { Bell } BS = ^H; { Back-space } TAB = ^I; { Tab } LF = ^J; { Line-feed } FF = ^L; { Form-feed } CR = ^M; { Carriage return } CAN = ^X; { Cancel entry } SUB = ^Z; { Ascii end-of-file marker } ESC = #27; { Escape } SP = #32; { Space } RUB = #127; { Rub-out } IOerror : Boolean = False; { Global for IOCheck routine } Mask = '______________________________________________________________________________'; Spaces = ' '; Type Str20 = String[20]; Str80 = String[80]; Str100 = String[100]; CharSet = Set of Char; Var InStr  : Str80; { Global variables } YesNo : Char; Good : Boolean;  ^I; { Tab } LF = ^J; { Line-feed } FF = ^L; { Form-feed } CR = ^M; { Carriage return } CAN = ^X; { Cancel entry } SUB = ^Z; { Ascii end-of-file marker } ESC = #27; { Escape } SP = #32; { Space } RUB = #127; { Rub-out } IOerror : Boolean = False; { Global for IOCheck routine } Mask = '______________________________________________________________________________'; Spaces = ' '; Type Str20 = String[20]; Str80 = String[80]; Str100 = String[100]; CharSet = Set of Char; Var InStr  { This procedure will erase the lines from X to Y on the screen. example: EraseXY (3,7); <-- erases lines 3 thru 7 on the screen. } Procedure EraseXY (X,Y : Byte); Var I : Byte; Begin For I := X To Y Do Begin GotoXY(1,I); ClrEol End End; CURSOR PASZDATE PAS [\DIAL PAS]^_ENTRNAMEPAS`abcEQUATES PAS deERASE $$$ { Use as a True/False to see if a file exists on the logged drive. example: If Not Exist (filename.ext) Then Writeln (error.msg); } Function Exist (Filename : Str20) : Boolean; Var Fil : File; Begin Assign(Fil,Filename); {$I-} Reset (Fil) {$I+}; Exist := (IOresult = 0) End; CURSOR PASZDATE PAS [\DIAL PAS]^_ENTRNAMEPAS`abcEQUATES PAS deERASE PASfEXIST $$$procedure Get_InStr (X,Y : integer; Prompt : Str80; Max_Len : integer); const editset: charset = [BS, RUB, CAN, TAB]; termset: charset = [LF, CR, SUB]; dispset: charset = [' '..'~']; var Ch : char; CurX, Len : integer; begin CurX := X + length(Prompt); if Max_Len > 80 - length(Prompt) then Max_Len := 80 - length(Prompt); InStr := ''; Len := 0; GotoXY(X,Y); LowVideo; Write(Prompt); Write(copy(Mask,1,Max_Len)); Cursor_On; NormVideo; GotoXY(CurX,Y); repeat read(Kbd, Ch); if Ch = ESC then begin InStr := ESC; write(copy(Spaces,1,Max_Len - Len)); Exit end else if (Ch in dispset) and (Len < Max_Len) then begin InStr := InStr + Ch; write(Ch) end else if ch = TAB then repeat InStr := InStr + ' '; write(' ') until (0 = length(InStr) mod 8) or (length(InStr) >= Max_Len) else if ((Ch = RUB) or (Ch = BS)) and (Len > 0)  then begin delete(InStr, Len, 1); LowVideo; write(BS, copy(Mask,1,1), BS); NormVideo end else if ch = CAN then begin InStr := ''; GotoXY(CurX,Y); LowVideo; write(copy(Mask,1,Max_Len)); NormVideo; GotoXY(CurX,Y) end; Len := length(InStr) until (Ch in termset); write(copy(Spaces,1,Max_Len - Len)) end; Kbd, Ch); if Ch = ESC then begin InStr := ESC; write(copy(Spaces,1,Max_Len - Len)); Exit end else if (Ch in dispset) and (Len < Max_Len) then begin InStr := InStr + Ch; write(Ch) end else if ch = TAB then repeat InStr := InStr + ' '; write(' ') until (0 = length(InStr) mod 8) or (length(InStr) >= Max_Len) else if ((Ch = RUB) or (Ch = BS)) and (Len > 0)  { Pass this procedure the X and Y coordinates of where to place the prompt and the prompt string for a yes or no answer. The reply will appear on the screen as you hit a Y on an N and is available to the programmer in the variable YesNo. } Procedure Get_YesNo (X,Y : Integer; Prompt : Str80); Begin Repeat Cursor_On; GotoXY(X,Y); LowVideo; Write (Prompt); Write('?',BS); NormVideo; Read (Kbd,YesNo) Until YesNo in ['Y','y','N','n']; Case YesNo Of 'Y','y' : Writeln ('Yes'); 'N','n' : Writeln ('No') End End; GETYESNO$$$ { Uses the variable IOerror declared at the beginning of the library to determine if an I/O error has occured and display the corresponding error message in the status line. example: Repeat Reset (filename.ext); IOcheck Until Not IOerror; } Procedure IOcheck; Var IOcode : Integer; Ch : Char; Begin IOcode := IOresult; IOerror := (IOcode <> 0); If IOerror then Begin Case IOcode Of $01 : Write_Status ('+++ File Does NOT Exist +++'); $02 : Write_Status ('+++ File NOT Open For INPUT +++'); $03 : Write_Status ('+++ File NOT Open For OUTPUT +++'); $04 : Write_Status ('+++ File NOT Open +++'); $10 : Write_Status ('+++ ERROR In Numeric Format +++'); $20 : Write_Status ('+++ Operation NOT Allowed On LOGICAL Device +++'); $21 : Write_Status ('+++ NOT Allowed In DIRECT Mode +++'); $22 : Write_Status ('+++ Assign To STANDARD Files NOT Allowed +++'); $90 : Write_Status ('+++ RECORD Length Mismatch +++'); $91 : Write_Status ('+++ Seek BEYOND End-Of-File +++'); $99 : Write_Status ('+++ UNEXPECTED End-Of-File +++'); $F0 : Write_Status ('+++ Disk WRITE Error +++'); $F1 : Write_Status ('+++ Directory Is FULL +++'); $F2 : Write_Status ('+++ File SIZE Overflow +++'); $F3 : Write_Status ('+++ Too MANY Open FILES +++'); $FF : Write_Status ('+++ File DISAPPEARED +++'); Else Write_Status ('+++ Unknown I/O ERROR +++'); End; Read(Kbd,Ch) End End; +++ File NOT Open For OUTPUT +++'); $04 : Write_Status ('+++ File NOT Open +++'); $10 : Write_Status ('+++ ERROR In Numeric Format +++'); $20 : Write_Status ('+++ Operation NOT Allowed On LOGICAL Device +++'); $21 : Write_Status ('+++ NOT Allowed In DIRECT Mode +++'); $22 : Write_Status ('+++ Assign To STANDARD Files NOT Allowe { Used by Menu procedure to highlight menu choice. } Procedure Select(x,y : Integer; choice : Str80); Begin GotoXY(x,y); NormVideo; InVideo(1); Write(choice); End; { Used by Menu procedure to un-highlight menu choice. } Procedure DeSelect(x,y : Integer; choice : Str80); Begin GotoXY(x,y); InVideo(0); LowVideo; Write(choice); End; { Pass this function a number equal to the number of menu choices you want and an array of strings of 40 or less characters each. It will clear the screen and build the menu for you. Each choice is highlighted as you move down the menu with the space bar, up with the back-space. Pressing the first letter of a menu choice moves you to the first choice that starts with the same letter. Uses the above four procedures to put instructions in status line. example: const maxlines = 5; lines: Array[0..maxlines] Of String[40] = (' General Business Menu', <-- menu title / ' Accounts Payable', <-- first choice | ' Accounts Recievable ', <-- second choice (Note leading space)-| ' Payroll', ^ <-- third choice | ' General Ledger', | <-- fourth choice \ ' Exit Program'); | <-- fifth choice var Choice : Integer; | begin +------- trailing space Choice := menu(maxlines,lines); <-- Choice will equal 1 -> 5 end. } Function menu (number : Integer; Var data) : Integer; Type listtype = Array[0..16] Of String[40]; Var list : listtype Absolute data; total_len, ave_len, max_len, col, cur_choice, i : Byte; chr : Char; Top : integer; Begin total_len := 0; max_len := 0; For i := 1 To number Do Begin If Length(list[i]) > max_len then max_len := Length(list[i]) End; col := (80 - max_len + 2) Div 2; For i := 1 To number Do Begin list[i] := list[i] + copy(Spaces,1,max_len - Length(list[i])); End; Top := (21 - number) div 2; ClrScr; Draw_Status_Border; Write_Status('{Space} = Down, {Left-Arrow} = Up, {First Letter} to Find, {Return} to Select'); GotoXY(((80 - Length(list[0])) Div 2),Top); Write(list[0]); LowVideo; For i := 1 To number Do Begin GotoXY(col,i + Top + 1); Write(list[i]); End; GotoXY(col,Top + 2); NormVideo; InVideo(1); cur_choice := 1; Write(list[1]); repeat Read(Kbd,Chr); Case Chr Of #08 : Begin DeSelect(col, Top + 1 + cur_choice, list[cur_choice]); cur_choice := cur_Choice - 1; If cur_choice = 0 Then cur_choice := number; Select(col, Top + 1 + cur_choice, list[cur_choice]); End; #32 : Begin DeSelect(col, Top + 1 + cur_choice, list[cur_choice]); cur_choice := cur_choice + 1; If cur_choice > number Then cur_choice := 1; Select(col, Top + 1 + cur_choice, list[cur_choice]); End; #13 : menu := cur_choice; Else Begin DeSelect(col, Top + 1 + cur_choice, list[cur_choice]); i := cur_choice; chr := UpCase(chr); Repeat i := succ(i); If i > number Then i := 1 Until (i = cur_choice) Or (chr = UpCase(Copy(list[i],2,1))); cur_choice:=i; Select(col, Top + 1 + cur_choice, list[cur_choice]); End; End; until Chr = #13; InVideo(0); Cursor_on; End; oice, list[cur_choice]); End; #32 : Begin DeSelect(col, Top + 1 + cur_choice, list[cur_const SmInit : String[50] = 'ATQ0V0M1X1 S0=0 S2=3 S11=50'; EXTDAT = $0C; {External modem data port} EXTCTL = $0D; {External modem control port} BAUDRP = $04; {Baud rate port} DAV = $01; {Data available} TBE = $04; {Transmit buffer empty} DCD = $08; {Data carrier detect} ERR = $60; {Parity, overrun, and framing error} ERRESET = $30; {Error reset} DTRoff = $68; {Data terminal ready off} DTRon = $E8; {Data terminal ready on} function In_Modem : byte; begin In_Modem := port[EXTDAT] {Read a byte from the modem} end; procedure Out_Modem (Number : Str80); var J : Byte; begin For J := 1 to length(Number) Do begin If Number[J] = ',' then  {If character is comma} Delay(1000) {then pause 1 sec. } else begin repeat {Loop until } until (TBE and port[EXTCTL]) <> 0; {Modem ready then} Port[EXTDAT] := ord(Number[J]) {Output character} end end; Delay(2000); {Pause 2 sec.} end; procedure Initialize_Modem; var Byt : byte; begin port[EXTCTL] := $00; port[EXTCTL] := $18; {Reset SIO channel} port[EXTCTL] := 04; {SIO register 4} port[EXTCTL] := $44; {16x, 1 stop bit, no parity} (* port[EXTCTL] := 1; {SIO register 1} port[EXTCTL] := $00; {Waits, rx, tx disable}*) port[EXTCTL] := 03; {SIO register 3} port[EXTCTL] := $C1;  {8 bits/character, rx enable} port[EXTCTL] := 5; {SIO register 5} port[EXTCTL] := DTRon; {DTR on, 8 bits/char, tx enable, RTS on} (* port[BAUDRP] := 5; {300 baud} delay(500); {Pause 500 ms}*) Out_Modem ('AT' + CR); {Send modem attention} Out_Modem (SmInit + CR); {Send SmartModem init string} Byt := In_Modem; {Read data port} Byt := In_Modem { " " " } end; procedure Disconnect_Modem; var Byt : byte; begin port[EXTCTL] := 5; {SIO register 5} port[EXTCTL] := DTRoff; {Set DTR off} delay(2000); {Pause 2 sec.} port[EXTCTL] := 5; {SIO register 5} port[EXTCTL] := DTRon; {Set DTR on} Out_Modem ('AT H' + CR); {Send modem hang-up string} end;  procedure Print_Name; var Ch : Char; begin With Individual Do begin Write_Status('** Printer ON Then Press RETURN **'); read(Kbd,Ch); writeln(Lst,First_Name,' ',Last_Name); writeln(Lst,Address1); if Address2 <> '' then writeln(Lst,Address2); writeln(Lst,City,', ',State,' ',Zip_Code); writeln(Lst); writeln(Lst,'Home Phone : '+ Home_Phone + ' Bus. Phone : '+ Business_Phone); writeln(Lst,'Occupation : '+ Occupation); writeln(Lst,'Computer 1 : '+ Computer1 + ' Computer 2 : '+ Computer2); writeln(Lst,'Uses These : '+Topics); writeln(Lst) end end; procedure Print_Label; var Date_Factor : Integer;  begin with Individual Do begin Date_Factor := Int_Date(Exp_Date) - Today; write(Lst,'Expires: '+Exp_Date); if Exp_Date = '' then writeln(Lst,' * SPECIAL *') else if (Date_Factor >= 0) and (Date_Factor <= 13) and (Exp_Date <> '') then writeln(Lst,' * RENEW *') else if Date_Factor < 0 then writeln(Lst,' * EXPIRED *') else writeln(Lst,' * ACTIVE *'); writeln(Lst,First_Name,' ',Last_Name); writeln(Lst,Address1); if Address2 <> '' then writeln(Lst,Address2); writeln(Lst,City,', ',State,' ',Zip_Code); writeln(Lst); if Address2 = '' then writeln(Lst) end end; procedure Print_Test_Label; var I,II,J : Byte; begin For II := 1 to 2 Do begin For I := 1 to 5 Do begin For J := 1 to 30 Do write(Lst,I); writeln(Lst) end; writeln(Lst) end end; writeln(Lst,' * EXPIRED *') else writeln(Lst,' * ACTIVE *'); writeln(Lst,First_Name,' ',Last_Name); writeln(Lst,Address1); if Address2 <> '' then writeln(Lst,Address2); writeln(Lst,City,', ',State,' ',Zip_Code); writeln(Lst); if Address2 = '' then writeln(Lst) end end; procedure Print_Test_procedure Sign_Off; begin writeln; LowVideo; writeln('This program was written so that clubs could create'); writeln('a searchable database of their members and distribute'); writeln('the database and program to everyone in the club. Up'); writeln('until now, most descent database programs were covered'); writeln('by copyright law. If you like the program and think it'); writeln('is worth any consideration, please send a donation to:'); writeln; writeln('Joseph Fall'); writeln('8031 Regency Drive'); writeln('Nashville, TN 37221'); writeln; writeln('Turbo Pascal ver. 1.2'); writeln('August, 1986'); NormVideo; Finished := True end;  { Draws two lines across the bottom of the screen with a blank line between them. Use with the Write_Status procedure below to put messages in or get input from a status line. } Procedure Draw_Status_Border; Begin LowVideo; GotoXY(1,22); Write(' =============================================================================='); GotoXY(1,24); Write(' =============================================================================='); NormVideo; End; { Rings bell and writes the passed string centered on line 23. Use with the procedure above. } Procedure Write_Status (Prompt : Str100); Var Margin : Integer; Position : Integer; Begin Cursor_Off; LowVideo; Margin := ((80-length(Prompt)) div 2); While Pos('{',Prompt) <> 0 Do Begin Position := Pos('{', Prompt); Delete(Prompt,Position,1); Insert(ESC+'(',Prompt,Position) End; While Pos('}',Prompt) <> 0 Do Begin Position := Pos('}',Prompt);  Delete(Prompt,Position,1); Insert(' ',Prompt,1); Insert(ESC + ')',Prompt,Position + 1) End; GotoXY(1,23); ClrEol; GotoXY(Margin,23); Write(BEL,Prompt); NormVideo End; 1,22); Write(' =============================================================================='); GotoXY(1,24); Write(' =============================================================================='); NormVideo; End; { Rings bell and writes the passed string centered on line 23. Use with the procedure above. } Procedure Write_Status (Prompt : Str100); Var Margin : Integer; Position : Integer; Begin Cursor_Off; LowVideo; Margin := ((80-length(Prompt)) div 2); While Pos('{',Prompt) <> 0 Do Begin Position := Pos('{', Prompt); Delete(Prompt,Position,1); Insert(ESC+'(',Prompt,Position) End; While Pos('}',Prompt) <> 0 Do Begin Position := Pos('}',Prompt);  { Turns inverse video on or off on Osborne Executive. example: InVideo(1); <---- turns inverse video on. } Procedure InVideo (Switch : Byte); Begin Case (Switch) Of 1 : Write(Chr(27),'j'); 0 : Write(Chr(27),'k'); Else Exit End End; { Turns half intensity video on or off on Osborne Executive. Same as LowVideo command but with syntax like the above procedure. } Procedure HalfVideo (Switch : Byte); Begin Case (Switch) Of 1 : Write(Chr(27),')'); 0 : Write(Chr(27),'('); Else Exit End End; { Turns flashing video on or off on Osborne Executive. } Procedure FlashVideo (Switch : Byte); Begin Case (Switch) Of 1 : Write(Chr(27),'^'); 0 : Write(Chr(27),'q'); Else Exit End End; { Turns underlining on or off on Osborne Executive. } Procedure UnderVideo (Switch : Byte); Begin Case (Switch) Of 1 : Write(Chr(27),'l'); 0 : Write(Chr(27),'m'); Else Exit End End; Video (Switch : Byte); Begin Case (Switch) Of 1 : Write(Chr(27),'j'); 0 : Write(Chr(27),'k'); Else Exit End End; { Turns half intensity video on or off on Osborne Executive. Same as LowVideo command but with syntax like the above procedure. } Procedure HalfVideo (Switch : Byte); Begin Case (Switch) Of 1 : Write(Chr(27),')'); 0 : Write(Chr(27),'('); Else Exit End End; { Turns flashing video on or off on Osborne Executive. } Procedure FlashVideo (Switch : Byte); Begin Case (Switch) Of 1 : Write(Chr(27),'^'); 0 : Write(Chr(27),'q'); Else Exit End End; { Turns underlining on or off on Osborne Executive. } Procedure UnderVideo (Switch : Byte); Begin Case (Switch) Of 1 : Write(Chr(27),'l'!9"e1:] 91:^ ^1:_ ^1:` ^1^͗P1Q^?S<P?<*e` Osborne Executive Screen Command BACKGROUNDS CURSOR A = normal R = invisible 8 = start dim B = dim S = blinking 9 = end dim C = blinking T = steady ( = start blink D = dim blink U = blink under ) = end blink E = reverse V = underline / = start underline F = rev dim \ = end underline G = rev blink MISCELLANEOUS { = start inverse H = rev dim blink } = end inverse I = underline X = key click on & = start reverse J = under dim Y = key click off % = end reverse K = under blink 0 = cpm keys L = under dim blink 1 = wordstar keys M = under rev 2 = key translate enable N = under rev dim 3 = key translate disable O = under rev blink 4 = graphics on P = under rev dim blink 5 = graphics off Q = quit program 6 = alternate characters Z = unscrewup screen 7 = primary characters Screen Selection: $_Q [] \Z@B@x`_65.`_)L(L^LqLlLmLjLkLbLdLkzeLfLgLGLaLALk >0͡WXJYE>?`=`6B!@9@!@9!-@ @@27@!U! W^ (#!-@ :7@    = start reverse J = under dim Y = key click off % = end reverse K = under blink 0 = cpm keys L = under dim blink 1Osborne Executive screen commands. 11/01/85 Executing XECSCRN6 will bring up a menu of commands that demonstrate the screen functions of the Osborne Executive. From 1 thru 4 of these may executed from the command line. herbert simplex Osborne Executive. From 1 thru 4 of these may executed from the command line. CURSOR PASZDATE PAS [\DIAL PAS]^_ENTRNAMEPAS`abcEQUATES PAS deERASE PASfEXIST PASgGETINSTRPAS hiGETYESNOPASjIOCHECK PAS klMENU PASmnopMODEM LIBqrsPRINT PAStuvSIGN-OFFPASwSTATUS PAS xyVIDEO PAS z{XECSCRN6COM|}XECSCRN6$$$1j*I~2"#~2#*U~2$#~2%i^>2G̈́X*""*$"{Rraaa &&&"&! Cannot open PRTSCRN.COM file on default disk$ Cannot read PRTSCRN.COM file$ Cannot write modified record back to COM file$ *** INSTALLED ***$PRTSCRN COMCURSOR PASZDATE PAS [\DIAL PAS]^_ENTRNAMEPAS`abcEQUATES PAS deERASE PASfEXIST PASgGETINSTRPAS hiGETYESNOPASjIOCHECK PAS klMENU PASmnopMODEM LIBqrsPRINT PAStuvSIGN-OFFPASwSTATUS PAS xyVIDEO PAS z{XECSCRN6COM|}XECSCRN6DOC~INSTALL $$$BDOS EQU 05H PUBLIC BD001 ;take character from console and put it in register a. BD001: PUSH B PUSH D PUSH H MVI C,1 ;cp/m read from console CALL BDOS ;call cp/m POP H POP D POP B RET END MEMBER DOC BCMEMBER PAS\DEFGHIJKLMNOALLCAPS PASPCHNGNAMEPASBQRSTUVWXYCURSOR PASZDATE PAS [\DIAL PAS]^_ENTRNAMEPAS`abcEQUATES PAS deERASE PASfEXIST PASgGETINSTRPAS hiGETYESNOPASjIOCHECK PAS klMENU PASmnopMODEM LIBqrsPRINT PAStuvSIGN-OFFPASwSTATUS PAS xyVIDEO PAS z{XECSCRN6COM|}XECSCRN6DOC~INSTALL COMBD001 $$$BDOS EQU 05H PUBLIC BD002 ;write character from e to console BD002: PUSH B PUSH D PUSH H MVI C,2 ;cp/m write to console CALL BDOS POP H POP D POP B RET END BDOS EQU 05H PUBLIC BD006D ;send character in register e to console BD006D: PUSH B PUSH D PUSH H MVI C,06H ;cp/m write direct to console function CALL BDOS ;call cp/m POP H POP D POP B RET END BDOS EQU 05H PUBLIC BD009 ;write string ;this sends a character string to the console ;the starting position of the string is in register de ;the string is terminated by a delimiter ;the default delimiter is a $ sign ;a different delimiter may be specified with bdos110b ;it also checks for ctrl-s(to pause), ctrl-q(end pause) ;and ctrl-p(echo to printer) ;if the console is in the default mode tabs(ctrl-i) wil be expanded ;bd109b sets console mode BD009: PUSH B PUSH D PUSH H MVI C,9 CALL BDOS POP H POP D POP B RET END ESCAPE EQU 1BH EXTRN BD006D,BD001,SNDESC,KEYCPM,KEYWRD PUBLIC DECODE DECODE: ANI 01011111B ;convert to upper case. CPI 'Q' ;was quit selected? RZ ;yes, go home. CPI 10H JZ CPMKEY CPI 11H JZ WRDKEY CPI 12H JZ TRANON CPI 13H JZ TRANOF CPI 14H JZ GRAFON CPI 15H JZ GRAFOF CPI 16H JZ ALTCHR CPI 17H JZ NRMCHR CPI 18H JZ SDIM CPI 19H JZ EDIM CPI 5BH JZ INVON CPI 5DH JZ INVOFF CPI 08h JZ SBLNK CPI 09h JZ EBLNK CPI 0Fh JZ SUNDER CPI 5Ch JZ EUNDER CPI 06H JZ STREV CPI 05H JZ ENDREV CPI 'Z' JZ UNSCRW SUI 40H ;convert a to 1, b to 2, c to 3, etc. JM INERR ;can not be less than 1 SUI 17 ;or greater than 16 JP CURTYP ADI 40H ;add finagle number ;at this point the letter a has been converted to 30h,b to 31h etc ;register a must be saved and two calls must be made as specified ;on pages 451 and 452 of the osborne executive reference guide. SETBCK: PUSH A MVI E,'x' CALL SNDESC POP A MOV E,A CALL BD006D RET CURTYP: SUI 6 JP OTHER ADI 35H PUSH A MVI E,2EH CALL SNDESC POP A MOV E,A CALL BD006D RET SDIM: MVI E,29H JP SNDTWO EDIM: MVI E,28H JP SNDTWO SBLNK: MVI E,5EH JP SNDTWO EBLNK: MVI E,71H JP SNDTWO SUNDER: MVI E,6CH JP SNDTWO EUNDER: MVI E,6DH JP SNDTWO INVON: MVI E,106 JP SNDTWO INVOFF: MVI E,107 JP SNDTWO STREV: MVI E,62H JP SNDTWO ENDREV: MVI E,64H JP SNDTWO CPMKEY: CALL KEYCPM RET WRDKEY: CALL KEYWRD RET TRANON: MVI E,101 JP SNDTWO TRANOF: MVI E,102 JP SNDTWO GRAFON: MVI E,67H JP SNDTWO GRAFOF: MVI E,47H JP SNDTWO ALTCHR: MVI E,61H JP SNDTWO NRMCHR: MVI E,41H JP SNDTWO UNSCRW: CALL KEYCPM CALL NRMCHR CALL TRANON CALL GRAFOF CALL INVOFF MVI A,30h CALL SETBCK CALL EDIM CALL EBLNK CALL EUNDER RET OTHER: ADI 57H CPI 'X' JZ CLKON CPI 'Y' JZ CLKOF INERR: MVI A,'?' ;indicate error RET CLKOF: MVI E,3CH JP SNDTWO CLKON: MVI E,3EH SNDTWO: CALL SNDESC RET ;the click on and off are are incorrect in the osborne executive ;reference guide. they are just the reverse of what it says. END WO EDIM: MVI E,28H JP SNDTWO SBLNK: MVI E,5EH JP SNDTWO EBLNK: MVI E,71H JP SNDTWO SUNDER: MVI E,6CH JP SNDTWO EUNDER: MVI E,6DH JP SNDTWO INVON: MVI E,106 JP SNDTWO INVOFF: MVI E,107 JP SNDTWO STREV: MVI E,62H JP SNDTWO ENDREV: MVI E,64H JP SNDTWO CPMKEY: CALL KEYCPM RET WRDKEY: CALL KEYWRD RET TRANON: MVI E,101 JP SNDTWO TRANOF: MVI E,102 JP SNDTWO GRAFON: MVI E,67H JP SNDTWO GRAFOF: MVI E,47H JP SNDTWO ALTCHR: MVI E,61H JP SNDTWO NRMCHR: MVI E,41H JP SNDTWO UNSCRW: CALL KEYCPM CALL NRMCHR CALL TRANON CALL GRAFOF CALL INVOFF MVI A,30h CALL SETBCK CALL EDIM CALL EBLNK CALL EUNDER RET OTHER: ADI 57H CPI 'X' JZ CLKON CPI 'Y' JZ CLKOF INERR: MVI A,'?' ;indicate error RET CLKOF: MVI E,3CH JP SNDTWO CLKON: MVI E,3EH SNDTWO: CALL SNDESC RET ;the click on and off are are incorrect in the osborne exe EXTRN BD006D,SNDESC PUBLIC HLDCUR ;this repositions cursor HLDCUR: MVI E,'=' CALL SNDESC ;send setcur MVI E,54 ;prepare row y CALL BD006D ;send row y MVI E,66 ;prepare column x CALL BD006D ;send column x RET END ; INSTALL PRTSCRN FOR ANY BIOS LOCATIONS ; ; Copyright 1985 Gordon Wilk ; May by copied for non-commercial, personal use ; ; PURPOSE: Modifies PRTSCRN.COM to run with any version BIOS ; ; Locates the addresses of the MOVE and XMOVE BIOS routines ; and modifies the code of the PRTSCRN program appropriately. ; ; This is a quick and dirty program. It assumes that PRTSCRN ; will be on the default drive. The one and only disk copy is ; modified. Make a copy under another name befor using this ; install to modify. ;------------------------------------------------------------------------- ; --- EQUATE --- ; BEL EQU 07 LF EQU 0Ah CR EQU 0Dh ; BOOT EQU 00 ;warmboot WBOOT EQU 01 ;warmboot jump adr BDOS EQU 05 ;BDOS call DBUFF EQU 80h ;adr of default dma MOVEoffset EQU 49h ;MOVE location in jump table XMOVoffset EQU 55h ;XMOVE location in jump table ; ;-------------------------------------------------------------------------- LXI SP,STAK ;set up stack ; ;Find the addresses of the MOVE and XMOVE Bios routines from the jump table LHLD BOOT+1 ;the jump table address is here LXI D,MOVEoffset ;add the offset into the table DAD D MOV A,M STA AdrMOVE ;store the address found INX H MOV A,M STA AdrMOVE+1 LHLD BOOT+1 ;do it again for the other function LXI D,XMovoffset DAD D MOV A,M STA AdrXMOVE INX H MOV A,M STA AdrXMOVE+1 ; ;Read the 3rd record of PRTSCRN.COM which is where the routine addresses ; are used CALL OPEN ;Get the COM file ORA A JNZ OpErr MVI A,03 ;the code is in the 3rd block STA fcbR1 CALL READ ;read the 3rd block ORA A JNZ RdErr ; ;Modify the call instructions in the object code so they point to ; the correct routine addresses LHLD AdrMOVE ;correct routine address SHLD 0D0h ;<-this is the code location LHLD AdrXMOVE SHLD 0C4h ;<-code location ; ;Write the modified record back into the file CALL WRITE ORA A JNZ WrErr CALL CLOSE ; ;Exit routines ok: LXI D,OkMsg JMP EXIT WrErr: LXI D,WrErrMsg JMP EXIT RdErr LXI D,RdErrMsg JMP EXIT OpErr LXI D,OpErrMsg ; EXIT MVI C,09 ;display string pointed CALL BDOS ;to by DE CALL BOOT ;finished ;---------------------------------------------------------------- ; SUBROUTINES ;--------------------------------------------------------------- OPEN LXI D,FCB ;Open existing file MVI C,15 ; named at fcb1 CALL BDOS RET ; CLOSE MVI C,16 ;Close file LXI D,FCB ; @ FCB CALL BDOS RET ; WRITE LXI D,FCB ;Write random record MVI C,34 ; to file @fcb CALL BDOS RET ; READ LXI D,FCB ;Read random record MVI C,33 ; from file @fcb CALL BDOS RET ; ;----------------------------------------------------------- ; DATA ;----------------------------------------------------------- OpErrMsg: DB BEL,CR,LF DB 'Cannot open PRTSCRN.COM file on default disk$' RdErrMsg DB BEL,CR,LF DB 'Cannot read PRTSCRN.COM file$' WrErrMsg DB BEL,CR,LF DB 'Cannot write modified record back to COM file$' OkMsg DB CR,LF,'*** INSTALLED ***$' ; AdrMOVE DW 0 ;Where we save the addresses AdrXMOVE DW 0 ; FCB: ;File control block for PRTSCRN.COM fcbDR DB 0 ;default drive fcbNAME DB 'PRTSCRN COM' DW 0,0,0,0,0,0,0,0,0,0 fcbCR DB 0 fcbR1 DB 0,0,0 ; DS 32 ;Stack STAK DW 0 END fcb1 CALL BDOS RET ; CLOSE MVI C,16 ;Close file LXI D,FCB ; @ FCB CALL BDOS RET ; WRITE LXI D,FCB ;Write random record MVI C,34 ; to file @fcb CALL BDOS RET ; READ LXI D,FCB ;Read random record MVI C,33 ; from file @fcb CALL BDOS RET ; ;----------------------------------------------------------- ; DATA ;----------------------------------------------------------- OpErrMsg: DB BEL,CR,LF DB 'Cannot open PRTSCRN.COM file on default disk$' RdErrMsg DB BEL,CR,LF DB 'Cannot read PRTSCRN.COM file$' WrErrMsg DB BEL,CR,LF DB 'Cannot write modified record back to COM file$' OkMsg DB CR, MACLIB Z80 OFFSET EQU 4000H ;beyond bank zero. BANK8 EQU 80H KEYSTRT EQU 2155H ;where function key table starts in bank 8. PUBLIC KEYCPM,KEYWRD KEYCPM: LXI H,HEAD LXI D,OFFSET LXI B,FEATHER LDIR CALL XARROW RET KEYWRD: LXI H,HEAD ;the front of my arrow LXI D,OFFSET ;the target LXI B,FEATHER ;length of arrow LDIR ;twang LXI H,ALTBLE ;start of wordstar key table LXI D,402Dh ;position of table to be moved LXI B,0AH ;number of characters in table LDIR CALL XARROW RET ALTBLE: EQU $ DB 01H,05H ;cpm ^e up DB 01H,04H ;cpm ^d right DB 01H,18H ;cpm ^x down DB 01H,13H ;cpm ^s left DB 0,0 MOVCDE: CALL XARROW RET HEAD EQU $ XARROW: EQU $+OFFSET-HEAD DI IN 0 STA SVBANK ORI BANK8 OUT 0 ;switch to bank8 LXI H,2155H ;put key address in register hl MVI C,11 ;maximum number of function key definitions XRA A ;set register a to zero MOV D,A ;move zero to register d XLOOP: EQU $+OFFSET-HEAD ;this loops 11 times. MOV E,M ;puts value pointed to by hl into register e ;this is length of key definition CMP E ;compares e register to zeroed a register RZ ;return if zero. DCR C ;decrement register c DB 28H,04H ;jrz xmove DAD D ;add de to hl ;hl will point to the next function key ;definition length. INX H ;increment hl DB 18H,0F6H ;jr xloop XMOVE: EQU $+OFFSET-HEAD XCHG ;this swaps the contents of hl with de ;de now points the key area to receive the ;new keytable. LXI H,CPTABLE LXI B,10 ;length of cptable LDIR ;move new definitions LDA SVBANK OUT 0 ;back to bank1 EI RET DB 0,0 CPTABLE: EQU $+OFFSET-HEAD DB 01H,0BH ;cpm ^k up DB 01H,0CH ;cpm ^l right DB 01H,0AH ;cpm ^j down DB 01H,08H ;cpm ^h left DB 0,0 SVBANK: EQU $+OFFSET-HEAD DB 0,0 CODEND EQU $ FEATHER EQU CODEND-HEAD END register a to zero MOV D,A ;move zero to register d XLOOP: EQU $+OFFSET-HEAD ;this loops 11 times. MOV E,M ;puts value poBDOS EQU 05H CR EQU 0DH ;carriage return LF EQU 0AH ;line feed ESCAPE EQU 1BH EXTRN SNDESC,BD009 PUBLIC SCRN1 SCRN1: MVI E,1AH ;letter z, to clear screen CALL SNDESC LXI D,OP1 CALL BD009 RET ;the 9's are for tabs OP1 DB 9,9,'Osborne Executive Screen Command',CR,LF,CR,LF DB 'BACKGROUNDS',9,9,' ' DB 'CURSOR',CR,LF,CR,LF DB 'A = normal',9,9,' ' DB 'R = invisible',9,9,' ' DB '8 = start dim',CR,LF DB 'B = dim',9,9,9,' ' DB 'S = blinking',9,9,' ' DB '9 = end dim',CR,LF DB 'C = blinking',9,9,' ' DB 'T = steady',9,9,' ' DB '( = start blink',CR,LF DB 'D = dim blink',9,9,' ' DB 'U = blink under',9,' ' DB ') = end blink',CR,Lf DB 'E = reverse',9,9,' ' DB 'V = underline',9,9,' ' DB '/ = start underline',CR,LF DB 'F = rev dim',9,9,9,9,9,' ' DB '\ = end underline',CR,LF DB 'G = rev blink',9,9,' ' DB 'MISCELLANEOUS',9,9,' ' DB '{ = start inverse',CR,LF DB 'H = rev dim blink',9,9,9,9,' ' DB '} = end inverse',CR,LF DB 'I = underline',9,9,' ' DB 'X = key click on',9,' ' DB '& = start reverse',CR,LF DB 'J = under dim',9,9,' ' DB 'Y = key click off',9,' ' DB '% = end reverse',CR,LF DB 'K = under blink',9,9,' ' DB '0 = cpm keys',CR,LF DB 'L = under dim blink',9,' ' DB '1 = wordstar keys',CR,LF DB 'M = under rev',9,9,' ' DB '2 = key translate enable',CR,LF DB 'N = under rev dim',9,' ' DB '3 = key translate disable',CR,LF DB 'O = under rev blink',9,' ' DB '4 = graphics on',CR,LF DB 'P = under rev dim blink',9,' ' DB '5 = graphics off',CR,LF DB 'Q = quit program',9,' ' DB '6 = alternate characters',CR,LF DB 'Z = unscrewup screen',9,' ' DB '7 = primary characters',CR,LF DB 9,9,' Screen Selection: ','$' END ,CR,LF DB 'F = rev dim',9,9,9,9,9,' ' DB '\ = end underline',CR,LF DB 'G = rev blink',9,9,' ' DB 'MISCELLANEOUS',9,9,' ' DB '{ = start inverse',CR,LF DB 'H = rev dim blink',9,9,9,9,' ' DB '} = end inverse',CR,LF DB 'I = underline',9,ESCAPE EQU 1BH EXTRN BD006D PUBLIC SNDESC SNDESC: PUSH D ;save character passed by calling program MVI E,ESCAPE CALL BD006D ;send escape to direct out. POP D ;restore passed character CALL BD006D ;send passed character RET END SNDESC $$$ ;written by herbert simplex. ;for the osborne executive. BDOS EQU 05H CR EQU 0DH ;carriage return LF EQU 0AH ;line feed FCB1 EQU 05DH FCB2 EQU 05EH FCB3 EQU 05FH FCB4 EQU 060H EXTRN HLDCUR,BD006D,SCRN1,BD001,BD002,DECODE,SNDESC ORG 100H ;sets up user stack START: LXI H,0 ;clear hl DAD SP ;get current stack pointer SHLD OLDSP ;save it LXI SP,STKTOP ;put in new stack pointer LDA FCB1 ;put passed character in register a CPI 20H ;is it equal to space? JZ MENU ;yes. bring up menu CALL DECODE LDA FCB2 CPI 20H JZ DONE CALL DECODE LDA FCB3 CPI 20H JZ DONE CALL DECODE LDA FCB4 CPI 20H JZ DONE CALL DECODE JMP DONE MENU: CALL SCRN1 GETSEL: CALL HLDCUR ;position cursor XRA A ;clear flags and accumulator CALL BD001 ;read selection from console. CALL DECODE CPI 'Q' ;was quit selected? JZ DONE ;yes, go home. CPI '?' ;error detected? JZ ERRIN JMP GETSEL ;get next character from console ERRIN: CALL HLDCUR MVI E,'?' ;indicate error CALL BD002 JMP GETSEL ;back to selection DONE: LHLD OLDSP ;restore old stack pointer SPHL JMP 0000H OLDSP DS 2 ;old stack pointer DS 48 ;new stack STKTOP: ;new stack starts here END up user stack START: LXI H,0 ;clear hl DAD SP ;get current stack pointer SHLD OLDSP ;save it LXI SP,STKTOP ;put in new stack pointer LDA FCB1 ;put passed character in register a CPI 20H ;is it equal to space? JZ MENU ;yes. bring up menu CALL DECODE LDA FCB2 CPI 20H JZ DONE CALL DECODE LDA FCB3 CPI 20H JZ DONE CALL DECODE LDA FCB4 CPI 20H JZ DONE CALL DECODE JMP DONE MENU: CALL SCRN1 GETSEL: CALL HLDCUR ;position cursor XRA A ;clear flags and accumulator CALL BD001 ;read selection from console. CALL DECODE CPI 'Q' ;was quit selected? JZ DONE ;yes, go home. CPI '?' ;error detected? JZ ERRIN JMP GETSEL ;get next character from console ERRIN: CALL HLDCUR MVI E,'?' ;indicate error CALL BD002 JMP GE; ; Z-80 MACRO LIBRARY ; ; THE FOLLOWING MACROS ENABLE ASSEMBLING Z-80 INSTRUCTIONS ; WITH THE DIGITAL RESEARCH MACRO ASSEMBLER. ; ; INVOKE WITH "MACLIB Z80" ; ; ; ; MACRO FORMATS ; ----- ------- ; ; ; MACRO ZILOG TDL ; ----- ----- --- ; ; LDX R,D LD R,(IX+D) MOV R,D(IX) ; LDY R,D LD R,(IY+D) MOV R,D(IY) ; STX R,D LD (IX+D),R MOV D(IX),R ; STY R,D LD (IY+D),R MOV D(IY),R ; MVIX NN,D LD (IX+D),NN MVI D(IX) ; MVIY NN,D LD (IY+D),NN MVI D(IY) ; LDAI LD A,I LDAI ; LDAR LD A,R LDAR ; STAI LD I,A STAI ; STAR LD R,A STAR ; LXIX NNNN LD IX,NNNN LXI IX,NNNN ; LXIY NNNN LD IY,NNNN LXI IY,NNNN ; LBCD NNNN LD BC,(NNNN) LBCD NNNN ; LDED NNNN LD DE,(NNNN) LDED NNNN ; LSPD NNNN LD SP,(NNNN) LSPD NNNN ; LIXD NNNN LD IX,(NNNN) LIXD NNNN ; LIYD NNNN LD IY,(NNNN) LIYD NNNN ; SBCD NNNN LD (NNNN),BC SBCD NNNN ; SDED NNNN LD (NNNN),DE SDED NNNN ; SSPD NNNN LD (NNNN),SP SSPD NNNN ; SIXD NNNN LD (NNNN),IX SIXD NNNN ; SIYD NNNN LD (NNNN),IY SIYD NNNN ; SPIX LD SP,IX SPIX ; SPIY LD SP,IY SPIY ; PUSHIX PUSH IX PUSH IX ; PUSHIY PUSH IY PUSH IY ; POPIX POP IX POP IX ; POPIY POP IY POP IY ; EXAF EX AF,AF' EXAF ; EXX EXX EXX ; XTIX EX (SP),IX XTIX ; XTIY EX (SP),IY XTIY ; LDI LDI LDI ; LDIR LDIR LDIR ; LDD LDD LDD ; LDDR LDDR LDDR ; CCI CPI CCI ; CCIR CPIR CCIR ; CCD CPD CCD ; CCDR CPDR CCDR ; ADDX D ADD (IX+D) ADD D(IX) ; ADDY D ADD (IY+D) ADD D(IY) ; ADCX D ADC (IX+D) ADC D(IX) ; ADCY D ADC (IY+D) ADC D(IY) ; SUBX D SUB (IX+D) SUB D(IX) ; SUBY D SUB (IY+D) SUB D(IY) ; SBCX D SBC (IX+D) SBB D(IX) ; SBCY D SBC (IY+D) SBB D(IY) ; ANDX D AND (IX+D) ANA D(IX) ; ANDY D AND (IY+D) ANA D(IY) ; XORX D XOR (IX+D) XRA D(IX) ; XORY D XOR (IY+D) XRA D(IY) ; ORX D OR (IX+D) ORA D(IX) ; ORY D OR (IY+D) ORA D(IY) ; CMPX D CP (IX+D) CMP D(IX) ; CMPY D CP (IY+D) CMP D(IY) ; INRX D INC (IX+D) INR D(IX) ; INRY D INC (IY+D) INR D(IY) ; DCRX D INC (IX+D) INR D(IX) ; DCRY D DEC (IY+D) DCR D(IY) ; NEG NEG NEG ; IM0 IM0 IM0 ; IM1 IM1 IM1 ; IM2 IM2 IM2 ; DADC RR ADC HL,RR DADC RR ; DSBC RR SBC HL,RR DSBC RR ; DADX RR ADD IX,RR DADX RR ; DADY RR ADD IY,RR DADY RR ; INXIX INC IX INX IX ; INXIY INC IY INX IY ; DCXIX DEC IX DCX IX ; DCXIY DEC IY DCX IY ; BIT B,R BIT B,R BIT B,R ; SETB B,R SET B,R SET B,R ; RES B,R RES B,R RES B,R ; BITX B,D BIT B,(IX+D) BIT B,D(IX) ; BITY B,D BIT B,(IY+D) BIT B,D(IY) ; SETX B,D SET B,(IX+D) SET B,D(IX) ; SETY B,D SET B,(IY+D) SET B,D(IY) ; RESX B,D RES B,(IX+D) RES B,D(IX) ; RESY B,D RES B,(IY+D) RES B,D(IY) ; JR ADDR JR ADDR-$ JMPR ADDR ; JRC ADDR JR C,ADDR-$ JRC ADDR ; JRNC ADDR JR NC,ADDR-$ JRNC ADDR ; JRZ ADDR JR Z,ADDR-$ JRC ADDR ; JRNZ ADDR JR NZ,ADDR-$ JRNZ ADDR ; DJNZ ADDR DJNZ ADDR-$ DJNZ ADDR ; PCIX JMP (IX) PCIX ; PCIY JMP (IY) PCIY ; RETI RETI RETI ; RETN RETN RETN ; INP R IN R,(C) INP R ; OUTP R OUT! (C),R OUTP R ; INI INI INI ; INIR INIR INIR ; OUTI OTI OUTI ; OUTIR OTIR OUTIR ; IND IND IND ; INDR INDR INDR ; OUTD OTD OUTD ; OUTDR OTDR OUTDR ; RLCR R RLC R RLCR R ; RLCX D RLC (IX+D) RLCR D(IX) ; RLCY D RLC (IY+D) RLCR D(IY) ; RALR R RL R RALR R ; RALX D RL (IX+D) RALR D(IX) ; RALY D RL (IY+D) RALR D(IY) ; RRCR R RRC R RRCR R ; RRCX D RRC (IX+D) RRCR D(IX) ; RRCY D RRC (IY+D) RRCR D(IY) ; RARR R RR R RARR R ; RARX D RR (IX+D) RARR D(IX) ; RARY D RR (IY+D) RARR D(IY) ; SLAR R SLA R SLAR R ; SLAX D SLA (IX+D) SLAR D(IX) ; SLAY D SLA (IY+D) SLAR D(IY) ; SRAR R SRA R SRAR R ; SRAX D SRA (IX+D) SRAR D(IX) ; SRAY D SRA (IY+D) SRAR D(IY) ; SRLR R SRL R SRLR R ; SRLX D SRL (IX+D) SRLR D(IX) ; SRLY D SRL (IY+D) SRLR D(IY) ; RLD RLD RLD ; RRD RRD RRD ; ; ; ; @CHK MACRO USED FOR CHECKING 8 BIT DISPLACMENTS ; @CHK MACRO ?DD ; USED FOR CHECKING RANGE OF 8-BIT DISP.S IF (?DD GT 7FH) AND (?DD LT 0FF80H) 'DISPLACEMENT RANGE ERROR - Z80 LIB' ENDIF ENDM LDX MACRO ?R,?D @CHK ?D DB 0DDH,?R*8+46H,?D ENDM LDY MACRO ?R,?D @CHK ?D DB 0FDH,?R*8+46H,?D ENDM STX MACRO ?R,?D @CHK ?D DB 0DDH,70H+?R,?D ENDM STY MACRO ?R,?D @CHK ?D DB 0FDH,70H+?R,?D ENDM MVIX MACRO ?N,?D @CHK ?D DB 0DDH,36H,?D,?N ENDM MVIY MACRO ?N,?D @CHK ?D DB 0FDH,36H,?D,?N ENDM LDAI MACRO DB 0EDH,57H ENDM LDAR MACRO DB 0EDH,5FH ENDM STAI MACRO DB 0EDH,47H ENDM STAR MACRO DB 0EDH,4FH ENDM LXIX MACRO ?NNNN DB 0DDH,21H DW ?NNNN ENDM LXIY MACRO ?NNNN DB 0FDH,21H DW ?NNNN ENDM LDED MACRO ?NNNN DB 0EDH,5BH DW ?NNNN ENDM LBCD MACRO ?NNNN DB 0EDH,4BH DW ?NNNN ENDM LSPD MACRO ?NNNN DB 0EDH,07BH DW ?NNNN ENDM LIXD MACRO ?NNNN DB 0DDH,2AH DW ?NNNN ENDM LIYD MACRO ?NNNN DB 0FDH,2AH DW ?NNNN ENDM SBCD MACRO ?NNNN DB 0EDH,43H DW ?NNNN ENDM SDED MACRO ?NNNN DB 0EDH,53H DW ?NNNN ENDM SSPD MACRO ?NNNN DB 0EDH,73H DW ?NNNN ENDM SIXD MACRO ?NNNN DB 0DDH,22H DW ?NNNN ENDM SIYD MACRO ?NNNN DB 0FDH,22H DW ?NNNN ENDM SPIX MACRO DB 0DDH,0F9H ENDM SPIY MACRO DB 0FDH,0F9H ENDM PUSHIX MACRO DB 0DDH,0E5H ENDM PUSHIY MACRO DB 0FDH,0E5H ENDM POPIX MACRO DB 0DDH,0E1H ENDM POPIY MACRO DB 0FDH,0E1H ENDM EXAF MACRO DB 08H ENDM EXX MACRO DB 0D9H ENDM XTIX MACRO DB 0DDH,0E3H ENDM XTIY MACRO DB 0FDH,0E3H ENDM LDI MACRO DB 0EDH,0A0H ENDM LDIR MACRO DB 0EDH,0B0H ENDM LDD MACRO DB 0EDH,0A8H ENDM LDDR MACRO DB 0EDH,0B8H ENDM CCI MACRO DB 0EDH,0A1H ENDM CCIR MACRO DB 0EDH,0B1H ENDM CCD MACRO DB 0EDH,0A9H ENDM CCDR MACRO DB 0EDH,0B9H ENDM ADDX MACRO ?D @CHK ?D DB 0DDH,86H,?D ENDM ADDY MACRO ?D @CHK ?D DB 0FDH,86H,?D ENDM ADCX MACRO ?D @CHK ?D DB 0DDH,8EH,?D ENDM ADCY MACRO ?D @CHK ?D DB 0FDH,8EH,?D ENDM SUBX MACRO ?D @CHK ?D DB 0DDH,96H,?D ENDM SUBY MACRO ?D @CHK ?D DB 0FDH,96H,?D ENDM SBCX MACRO ?D @CHK ?D DB 0DDH,9EH,?D ENDM SBCY MACRO ?D @CHK ?D DB 0FDH,9EH,?D ENDM ANDX MACRO ?D @CHK ?D DB 0DDH,0A6H,?D ENDM ANDY MACRO ?D @CHK ?D DB 0FDH,0A6H,?D ENDM XORX MACRO ?D @CHK ?D DB 0DDH,0AEH,?D ENDM XORY MACRO ?D @CHK ?D DB 0FDH,0AEH,?D ENDM ORX MACRO ?D @CHK ?D DB 0DDH,0B6H,?D ENDM ORY MACRO ?D @CHK ?D DB 0FDH,0B6H,?D ENDM CMPX MACRO ?D @CHK ?D DB 0DDH,0BEH,?D ENDM CMPY MACRO ?D @CHK ?D DB 0FDH,0BEH,?D ENDM INRX MACRO ?D @CHK ?D DB 0DDH,34H,?D ENDM INRY MACRO ?D @CHK ?D DB 0FDH,34H,?D ENDM DCRX MACRO ?D @CHK ?D DB 0DDH,035H,?D ENDM DCRY MACRO ?D @CHK ?D DB 0FDH,35H,?D ENDM NEG MACRO DB 0EDH,44H ENDM IM0 MACRO DB 0EDH,46H ENDM IM1 MACRO DB 0EDH,56H ENDM IM2 MACRO DB 0EDH,5EH ENDM BC EQU 0 DE EQU 2 HL EQU 4 IX EQU 4 IY EQU 4 DADC MACRO ?R DB 0EDH,?R*8+4AH ENDM DSBC MACRO ?R DB 0EDH,?R*8+42H ENDM DADX MACRO ?R DB 0DDH,?R*8+09H ENDM DADY MACRO ?R DB 0FDH,?R*8+09H ENDM INXIX MACRO DB 0DDH,23H ENDM INXIY MACRO DB 0FDH,23H ENDM DCXIX MACRO DB 0DDH,2BH ENDM DCXIY MACRO DB 0FDH,2BH ENDM BIT MACRO ?N,?R DB 0CBH,?N*8+?R+40H ENDM SETB MACRO ?N,?R DB 0CBH,?N*8+?R+0C0H ENDM RES MACRO ?N,?R DB 0CBH,?N*8+?R+80H ENDM BITX MACRO ?N,?D @CHK ?D DB 0DDH,0CBH,?D,?N*8+46H ENDM BITY MACRO ?N,?D @CHK ?D DB 0FDH,0CBH,?D,?N*8+46H ENDM SETX MACRO ?N,?D @CHK ?D DB 0DDH,0CBH,?D,?N*8+0C6H ENDM SETY MACRO ?N,?D @CHK ?D DB 0FDH,0CBH,?D,?N*8+0C6H ENDM RESX MACRO ?N,?D @CHK ?D DB 0DDH,0CBH,?D,?N*8+86H ENDM RESY MACRO ?N,?D @CHK ?D DB 0FDH,0CBH,?D,?N*8+86H ENDM JR MACRO ?N DB 18H,?N-$-1 ENDM JRC MACRO ?N DB 38H,?N-$-1 ENDM JRNC MACRO ?N DB 30H,?N-$-1 ENDM JRZ MACRO ?N DB 28H,?N-$-1 ENDM JRNZ MACRO ?N DB 20H,?N-$-1 ENDM DJNZ MACRO ?N DB 10H,?N-$-1 ENDM PCIX MACRO DB 0DDH,0E9H ENDM P"CIY MACRO DB 0FDH,0E9H ENDM RETI MACRO DB 0EDH,4DH ENDM RETN MACRO DB 0EDH,45H ENDM INP MACRO ?R DB 0EDH,?R*8+40H ENDM OUTP MACRO ?R DB 0EDH,?R*8+41H ENDM INI MACRO DB 0EDH,0A2H ENDM INIR MACRO DB 0EDH,0B2H ENDM IND MACRO DB 0EDH,0AAH ENDM INDR MACRO DB 0EDH,0BAH ENDM OUTI MACRO DB 0EDH,0A3H ENDM OUTIR MACRO DB 0EDH,0B3H ENDM OUTD MACRO DB 0EDH,0ABH ENDM OUTDR MACRO DB 0EDH,0BBH ENDM RLCR MACRO ?R DB 0CBH, 00H + ?R ENDM RLCX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 06H ENDM RLCY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 06H ENDM RALR MACRO ?R DB 0CBH, 10H+?R ENDM RALX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 16H ENDM RALY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 16H ENDM RRCR MACRO ?R DB 0CBH, 08H + ?R ENDM RRCX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 0EH ENDM RRCY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 0EH ENDM RARR MACRO ?R DB 0CBH, 18H + ?R ENDM RARX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 1EH ENDM RARY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 1EH ENDM SLAR MACRO ?R DB 0CBH, 20H + ?R ENDM SLAX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 26H ENDM SLAY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 26H ENDM SRAR MACRO ?R DB 0CBH, 28H+?R ENDM SRAX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 2EH ENDM SRAY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 2EH ENDM SRLR MACRO ?R DB 0CBH, 38H + ?R ENDM SRLX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 3EH ENDM SRLY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 3EH ENDM RLD MACRO DB 0EDH, 6FH ENDM RRD MACRO DB 0EDH, 67H ENDM M RALR MACRO ?R DB 0CBH, 10H+?R ENDM RALX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 16H ENDM RALY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 16H ENDM RRCR MACRO ?R DB 0CBH, 08H + ?R ENDM RRCX MACRO ?D @CHK ?D DB 0DDH, 0CBH, ?D, 0EH ENDM RRCY MACRO ?D @CHK ?D DB 0FDH, 0CBH, ?D, 0EH ENDM RARR MACRO ?R DB 0CBH, 18H + ?R ENDM RARX MACRO ?D @CHK erase xecscrn6.com link xecscrn6.com=xecscrn6,scrn1,decode,hldcur,sndesc,keycpm,bd001,bd002,bd006d,bd009 d009 HLDCUR ASMINSTALL ASMKEYCPM ASMSCRN1 ASMSNDESC ASMXECSCRN6ASM Z80 LIBMLINKIT $$$ɀPRTSCRN PRTSCRN y& !9"|1 ?*|A͊!0 ;!0P^r# Yp0W    PRTSCRN A MEMORY RESIDENT PRINT SCREEN UTITLTY by Gordon Wilk 6707 Springpark Ave Los Angeles CA 90056 ABSTRACT: A memory resident utility providing the same function as the MSDOS PrtScrn key; i.e. once loaded, pressing ^\ will print the screen to the list device. The program is specific to the Osborne Executive and will not run on any other system although the program needs only one change to run on another CPM3 system. I have long been envious of the IBM PC's "Print Screen" key which allows the user to print the screen from within a parogram as well as from the command line. An early utility of mine (SNAP, submitted to the EXEC library) permitted screen dumps from the command line or by using the SNSP program as a subroutine within a user written program. PRTSCRN provides the full function of the MSDOS "PrtScrn" key from almost any program accepting k#eyboard input. INSTALLATION The file PRTSCRN.COM as supplied will only run on the Exec with BIOS version 1.0 and the original ROM. If you have such a machine, you can run the program as-is. If you have another version (the version appears on the screen after the CPM+ signon), or have another ROM, or if you are not sure, use the INSTALL program to adapt PRTSCRN to your system. If you have the 1.0 BIOS and run INSTALL, no harm is done. TO RUN INSTALL: 1. Make a copy of PRTSCRN.COM under another name for safety. 2. Be sure INSTALL.COM and PRTSCRN.COM are both on one disk in the default drive. 3. Type "INSTALL" at the CPM > prompt. USAGE Using PRTSCRN is a two step process, it must be loaded first, then can be used at any time until the next cold boot (System Reset). To load the program type "PRTSCRN" at the CPM > prompt or include it in your EXECST command line thus: PRTSCRN ! WHATEVER This will load PRTSCRN and then run program WHATEVER (WS, dBase, SC, etc). TO print the screen at any time once PRTSCRN has been loaded, just type ^\ (control backslash), being sure the printer is attached and turned on. The ^\ may be typed while within another program provided that: 1. The program does not use RAM above D400 hex Most programs written for CPM 2.2 can run with a 56K TPA and so can live without using this area of RAM. 2. The program uses BDOS, not BIOS, calls for keyboard input. If PRTSCRN does not work at all with a program and the program does receive the typed ^\, it is probably using BIOS calls. WordStar and dBase use BIOS calls. 3. The program will ignore ^\ when it is typed. I selected ^\ because none of my programs make use of this character. If you wish to change it, change the "Marker" equate in the source code PRTSCRN.ASM and re-assemble. THEORY OF OPERATION PRTSCRN is a resident system extension (RSX) which remains memory resident once loaded just below BDOS. It intercepts all BDOS calls and checks for functions 2 or 6 (console input); other functions are passed on without change. If the call is for console input, PRTSCRN substitutes its own call and then intercepts the character returned. If the character received is not a ^\, it is passed back to the calling program. Control backslashes cause PRTSCRN to call the SNAP routine which prints the screen. The stack is restored and the character returned to the calling program which never knows what happened. Only the ASCII characters are copied and printed, not the attribute bits in the high block. Thus dim, underlined, blinking and alternate characters will be sent to the printer as normal 7 bit ASCII. Graphics will act as control characters and the result depends on the printer. Reverse video is sent through with the high bit set; on most printers they will print as normal characters. The screen is copied using the BIOS interbank move routines which must be called directly not through BDOS function 50; additionally they use register HL so the usual methods of indirect call cannot be used. The address of the BIOS routines are hard coded in the program. The INSTALL program uses the usual techniques to find the addresses in the jump table and modifies the PRTSCRN program accordingly. INSTALL is a quick and dirty utility. It assumes that you are doing things right and makes no safety copy. Make a backup copy of PRTSCRN.COM before using INSTALL. PRTSCRN executes as part of a BDOS 2 or 6 call. Since BDOS trashes all registers except the A register on these calls, I have not preserved them. Almost any program needing information from these registers will save them before the call. PROGRAM MODIFICATION The ^\ marker character is defined in an equate which may be changed without changing anything else in the program. Do not use a character likely to be used by the calling program. ^A, for example is used by WordStar and those using WS-like controls. To re-assemble, use the following series of commands RMAC PRTSCRN LINK PRTSCRN [OP] REN PRTSCRN.RSX=PRTSCRN.PRL GENCOM PRTSCRN [NULL] PRTSCRN can be modified to run on other systems using CPM3 by changing the screen bank and address in the source code and re-assembling. The INSTALL program will do the other modification needed. This program could be changed so that it modifies the BIOS jump table and intercepts BIOS function 3 (conin). This would allow it to work with programs that use direct BIOS calls. You would need to write another RSX to make the modifications after loading and a COM program to call and load the pair. The second RSX could be removed after it does its thing. PROGRAM EXTENSIONS Besides its obvious utility, PRTSCRN is a model of how an RSX may intercept keyboard input or console output to perform various functions. It is possible to use the "RSX Processor" section of the code as the core of a "SideKick" like desk accesory. It is only neccesary to check for various other returned characters and branch to appropriate routines$. by changing the screen bank and address in the source code and re-assembling. The INSTALL program will do the other modification needed. This program could be changed so that it modifies the BIOS jump table and intercepts BIOS function 3 (conin). This would allow it to work with programs that use direct BIOS calls. You would need to write another RSX to make the modifications after loading and a COM program to call and load the pair. The second RSX could be removed after it does its thing. PROGRAM EXTENSIONS Besides its obvious utility, PRTSCRN is a model of how an RSX may intercept keyboard input or console output to perform various functions. It is possible to use the "RSX Processor" section of the code as the core of a "SideKick" like desk accesory. It is only neccesary to check for various other returned characters and branch to appropriate routines; PRTSCRN -- PRINTSCREEN RSX -- ;------------------------------------------------------------------ ; A memory resident print screen utility for the Osborne Exec ; ; USAGE ; Once the command PRTSCRN is issued, the program will remain ; available for use until the next cold boot (System Reset). ; PRTSCRN may be included as a command in the EXECST batch line. ; ; Once loaded typing ^\ (control backslash) will print the ; screen on the listing device. ; ; The command may be used from within any program when the ; program calls for keyboard input so long as the program ; meets the following specifications: ; 1. Does not use RAM above D400 hex ; 2. Use BDOS (not BIOS) calls for keyboard input. ; 3. Will ignore keyboard input of ^\ (otherwise change ; the Marker character in the ASM source and ; re-assemble). ; ; Copyright 1985 by Gordon Wilk ; 6707 Springpark Ave ; Los Angeles CA 9005 ; May be copied for personal non-commercial uses ; ;------------------------------------------------------------------- ; --- RSX HEADER --- ; SERIAL: DB 0,0,0,0,0,0 ;for loader use START: JMP ORIGIN ;to start of RSX code NEXT: JMP $-$ ;filled in by loader PREV: dw 0 ;filled in by loader REMOVE: DB 0 ;DON'T remove NONBANK: DB 0 ;banked RNAME DB 'PRTSCRN ' ;8 char rsx name LOADER: DB 0,0,0 ;for loader use ; ; ; --- EQUATES --- ; CONIN EQU 01 ;console input DIRIO EQU 06 ;console direct input CR EQU 0Dh ;carraige return Scrn1 EQU 0D430h ;put the screen here in bank 1 Scrn7 EQU 0C000h ;the screen is here in bank 7 ScrnSiz EQU 00BCFh ;screen length w/o attribute bytes ScrnWid EQU 80 ; 80 column wide screen ScrnLns EQU 24 ; 24 lines per screen Marker EQU 28 ; The control character to print ; ; the screen = ^\ Bank1 EQU 01H ;Bank one switch byte Bank7 EQU 41H ;Bank 7 switch byte ; ; THE NEXT TWO EQUEATES ARE CORRECT FOR VERSION 1.0 BIOS ONLY ; Run Install to modify for other versions MOVE EQU 0FB3Bh ;address of BIOS routine XMOVE EQU 0FB8Ah ;address of BIOS routine ; ;------------------------------------------------------------- ; RSX PROCESSOR ;------------------------------------------------------------- ORIGIN: MOV A,C ;which BDOS function? CPI CONIN ;catch it JZ Caught CPI DIRIO ;catch it JNZ NEXT ;otherwise pass it on ; ; to BDOS and quit by jump ; Caught: LXI H,0 ;save current stack DAD SP ; in staksav SHLD StakSav LXI SP,LocStak ;set up a local stack ; CALL NEXT ;Pass call on to BDOS ; ; to see what character ; ; comes back ; PUSH PSW ;Save that character CPI Marker ;Is it the char we want to see? CZ SNAP ;If so print the screen POP PSW ;Finished, get the char back LHLD StakSav ;Restore the stack SPHL ; and RET ; quit ;------------------------------------------------ ; SNAP A screen dump routine ;------------------------------------------------ ; SNAP: MVI C,Bank7 ;source bank MVI B,Bank1 ;destination bank CALL XMOVE  ;BIOS set for interbank move ; LXI D,Scrn7 ;source address LXI H,Scrn1 ;destination address LXI B,ScrnSiz ;size CALL MOVE ;BIOS do interbank move ; MVI B,ScrnLns ;B=lines LXI H,Scrn1 ;HL=adr of byte to print ;Loop for each line LineLoop MVI C,ScrnWid ;C=columns ;Loop for each column ColLoop MOV E,M ;put char in E CALL ListChar ;PRINT IT INX H ;next column DCR C ;decrement col count SUB A ; CMP C ; is it zero yet? JNZ ColLoop ;NO, not at end of line DCR B ;EOL - decrement line count CMP B ; is it zero yet? JZ Exit ;YES - done LXI D,128-80 ;NO, skip over line extensions DAD D JMP LineLoop ;Go do next line Exit MVI E,CR ;End with CR ; ListChar PUSH B ;Save BC and HL PUSH H MVI C,05 ;List out CALL NEXT ;which is how an RSX calls BDOS POP H ;restore POP B RET ; StakSav DW 0 ;Where we save the old stack DS 32 ;Our local stack LocStak DW 0 END % This is the release date of the disk. EQUATES PAS dERASE PAS fEXIST PAS gGETINSTRPAS hGETYESNOPAS jIOCHECK PAS kMENU PAS mMODEM LIB q PRINT PAS t SIGN-OFFPAS wSTATUS PAS xVIDEO PAS zXECSCRN6COM |XECSCRN6DOC ~DATE .PAS 31 06 1536 12 DIAL .PAS 97 1B 3072 24 ENTRNAME.PAS BE 14 3712 29 EQUATES .PAS FD C4 1152 9 ERASE .PAS 9E 0F 384 3 EXIST .PAS 60 88 384 3 GETINSTR.PAS D6 D1 1536 12 GETYESNO.PAS 25 69 640 5 IOCHECK .PAS C0 94 1664 13 MENU .PAS 95 9B 3968 31 MODEM .LIB ED DC 3072 24 PRINT .PAS 5D A1 2560 20 SIGN-OFF Fog Library Disk FOG-CPM.038 Copyright (1986) by Fog International Computer Users Group to the extent not copyrighted by the original author for the exclusive use and enjoyment of its members. Any reproduction or distribution for profit or personal gain is strictly forbidden. For information, contact FOG, P. O. Box 3474, Daly City, CA. 94015-0474. as part of the description of a file indicates that the program is distributed on a "try first, pay if you like it" basis. If you find the program(s) meet your need, please refer to the author's documentation for information on becoming a registered user. Only by registering and paying for the programs you like and use will the authors of such programs continue development. Often, more complete documentation, additional modules, and new releases are available only to registered users. Osborne Executive and CPM+ (CP/M 3.0) programs. Filename Description -04-00 .86 This is the release date of the disk. -CPM038 .DOC This is the description of the disk contents. PHONE-16.COM D378 20K ver. 1.6 [Phone list file 1 of 3] A telephone and address filing system for use with a Hayes SmartModem or compatible for autodialing. Turbo Pascal source is included so it might be modified for CP/M 2.0 systems. PHONE-16.DOC 0AF9 2K ver. 1.6 [Phone list file 2 of 3] PHONE-16.PAS D2A2 17K ver. 1.6 [Phone list file 3 of 3] MEMBER .COM 8949 24K [Member database 1 of 3] Maintain a membership database for a computer users group. Turbo Pascal source (for Osborne Executive) is included so that it can be modified for other computers or applications. MEMBER .DOC 9A0A 2K [Member database 2 of 3] MEMBER .PAS 8B07 12K [Member database 3 of 3] ALLCAPS .PAS 5EBB 1K [Pascal Include 1 of 18] A collection of include files for both MEMBER and PHONE-16. CHNGNAME.PAS B7C9 9K [Pascal Include 2 of 18] CURSOR .PAS CC92 1K [Pascal Include 3 of 18] DATE .PAS 3106 2K [Pascal Include 4 of 18] DIAL .PAS 971B 3K [Pascal Include 5 of 18] ENTRNAME.PAS BE14 4K [Pascal Include 6 of 18] EQUATES .PAS FDC4 2K [Pascal Include 7 of 18] ERASE .PAS 9E0F 1K [Pascal Include 8 of 18] EXIST .PAS 6088 1K [Pascal Include 9 of 18] GETINSTR.PAS D6D1 2K [Pascal Include 10 of 18] GETYESNO.PAS 2569 1K [Pascal Include 11 of 18] IOCHECK .PAS C094 2K [Pascal Include 12 of 18] MENU .PAS 959B 4K [Pascal Include 13 of 18] MODEM .LIB EDDC 3K [Pascal Include 14 of 18] PRINT .PAS 5DA1 3K [Pascal Include 15 of 18] SIGN-OFF.PAS 34A6 1K [Pascal Include 16 of 18] STATUS .PAS 6B8B 2K [Pascal Include 17 of 18] VIDEO .PAS FDFC 2K  [Pascal Include 18 of 18] XECSCRN6.COM BA0B 2K ver. 6 [Executive Screen 1 of 16] Demonstrates screen functions on the Osborne Executive. ASM source included. XECSCRN6.DOC 0CA6 1K ver. 6 [Executive Screen 2 of 16] INSTALL .COM 2055 1K ver. 6 [Executive Screen 3 of 16] BD001 .ASM 0232 1K ver. 6 [Executive Screen 4 of 16] BD002 .ASM E7A2 1K ver. 6 [Executive Screen 5 of 16] BD006D .ASM 0AD7 1K ver. 6 [Executive Screen 6 of 16] BD009 .ASM 6E48 1K ver. 6 [Executive Screen 7 of 16] DECODE .ASM BE87 3K ver. 6 [Executive Screen 8 of 16] HLDCUR .ASM 0259 1K ver. 6 [Executive Screen 9 of 16] INSTALL .ASM 2684 4K ver. 6 [Executive Screen 10 of 16] KEYCPM .ASM C1DC 2K ver. 6 [Executive Screen 11 of 16] SCRN1 .ASM 8EB5 2K ver. 6 [Executive Screen 12 of 16] SNDESC .ASM 0A5B 1K ver. 6 [Executive Screen 13 of 16] XECSCRN6.ASM 9FA7 2K ver. 6 [Executiv&e Screen 14 of 16] Z80 .LIB EFB3 10K ver. 6 [Executive Screen 15 of 16] LINKIT .SUB 672A 1K ver. 6 [Executive Screen 16 of 16] PRTSCRN .COM 86D5 1K [PrintScreen 1 of 3] A "print screen" function for the Osborne Executive which stays in memory and provides printer output from screen. PRTSCRN .DOC 0752 7K [PrintScreen 2 of 3] PRTSCRN .ASM A06C 4K [PrintScreen 3 of 3]  [Pascal Include 9 of 18] GETINSTR.PAS D6D1'