* (OLC) On-Line Configuration: by Douglas Bell Copyright 1991 * TBBS Version Required: 2.2+ ***************************** ** Assign PUBLIC variables ** ***************************** public tdbs, iscls public prg_chk, key_chk, sys_name, bbs_name, ser_no public towhom, privsec, version public key, line public name, local, info, password, expert, security, expire public length, width, ansi, ibm, case, lfeeds, nulls public cls1, cls2, cls3, cls4, cls5, cls6, clscodes, clsdesc, oldcls public sendmsg, msgpntr, fse, inprompt public upnum, downnum, uprot, dprot public tcall, thour, tmin, ttime, tup, tdown public daycall, daymin, daybyte, callmin, lastmsg public netfree, netcrash, netdb, netcr public auth1, auth2, auth3, auth4 *************************************************** ** Default settings for dBase III+ compatibility ** *************************************************** set talk off set status off set scoreboard off **************************************** ** Optional settings for this program ** **************************************** on disconnect dotbbs type 10 optdata "*none*" on error quit set typeahead to 3 set bell off set exact on set exclusive off set escape off ************************** ** Start of the program ** ************************** tmp = right(ltrim(rtrim(opdata())),len(opdata())-(at("+",opdata()))) tmp1 = 0 if .NOT. empty(tmp) do while "+" $ tmp if "+" $ tmp tmp1 = tmp1 + 1 tmp = stuff(tmp,at("+",tmp),1,"þ") endif enddo if tmp1 <> 0 private tmp0[tmp1] endif tmp1 = 0 do while "þ" $ tmp tmp1 = tmp1 + 1 tmp = iif(empty(substr(tmp,1,at("þ",tmp))),tmp,stuff(tmp,1,len(substr(tmp,1,at("þ",tmp))),"")) tmp0[tmp1] = left(ltrim(rtrim(tmp)),at("]",tmp)-1) tmp0[tmp1] = stuff(tmp0[tmp1],at("[",tmp0[tmp1]),1,"þ") tmp = stuff(tmp,at(tmp0[tmp1],tmp),len(tmp0[tmp1]),"") enddo endif tmp2 = tmp1 tmp1 = 0 do while tmp1 < tmp2 tmp1 = tmp1 + 1 tmp = "Pþ" && Password for SysOp over-ride if tmp $ upper(tmp0[tmp1]) pwsysop = stuff(tmp0[tmp1],1,len(tmp),"") pwsysop = left(pwsysop,8) endif tmp = "Sþ" && Off Switchs if tmp $ upper(tmp0[tmp1]) switch = stuff(upper(tmp0[tmp1]),1,len(tmp),"") ** The following makes sure that these switches can NOT be de-activated! tmp = "Q" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "T" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "N" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "P" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "`" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "~" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "S" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "X" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "J" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "K" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "Y" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "V" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "$" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "*" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "-" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "+" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "1" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "2" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "3" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) tmp = "4" switch = iif(tmp $ switch, stuff(switch,at(tmp,switch),1,""), switch) endif enddo pwsysop = iif("+P" $ upper(opdata()),pwsysop,"") switch = iif("+S" $ upper(opdata()),switch,"") ************************************************ ** Clear the screen using ANSI or Ascii codes ** ************************************************ iscls = 0 if uansi() @ 0,0 clear else ?? chr(12) endif ************************* ** To whom OLC belongs ** ************************* privsec = 254 prg_chk = "OLC" version = "Version: 1.1a" do c_str with version,23,"Y" do key_verify if key_chk = 2 .OR. key_chk = 3 ? ? " The OLC Key File Is In-Valid/Missing ... Please Notify The SysOp .." ? wait " ... Press A Key To Continue ..." quit else towhom = left(bbs_name,10) endif do c_str with towhom,10,"Y" ************************** ** Start of the program ** ************************** if upriv() = 255 .AND. file(homepath()+"\ATTEMPT.OLC") set color to r+/n tmpstr = "* * * WARNING: Someone has attempted to break into " + ltrim(rtrim(towhom)) + " * * *" do c_str with tmpstr,79,"Y" ? chr(13) + chr(13) + chr(13) ? chr(13) + tmpstr + chr(13) set color to w+/n type (homepath()+"\ATTEMPT.OLC") set color to r+/n tmpstr = "(Press any key to continue)" do c_str with tmpstr,79,"Y" ? tmpstr + chr(13) set color to tmp = "ATTEMPT.OLC" tmp1 = "ATTEMPT.OLD" erase &tmp1 rename &tmp to &tmp1 tmp = inkey(0) endif ************************** if uibm() bee = "á" dot = "ú" else bee = "B" dot = "." endif store " " to key clsdesc = "UNKNOWN" width = str(uwidth(),3) length = str(umore(),3) tmp = ulreplace(uwidth,80) tmp = ulreplace(umore,24) do while .T. do userinfo do protocol do showscreen do userinput enddo set color to tmp = ulreplace(uwidth,val(width)) tmp = ulreplace(umore,val(length)) quit **************************************** ** Retreive UserInfo from Userlog.bbs ** **************************************** procedure userinfo line = right(space(2)+uline(),2) name = left(uname()+space(30),30) local = left(ltrim(rtrim(ulocation()))+space(30),30) info = left(ltrim(rtrim(unotes()))+space(64),64) password = left(ltrim(rtrim(ulpeek(50,6,8)))+space(8),8) expert = ltrim(str(ulpeek(69,1))) security = right(space(3)+str(upriv(),3),3) secdesc = space(15) expire = transform(ulpeek(440,7),"99/99/99") expire = iif(expire=" / / ","* None *",expire) length = ltrim(rtrim(length)) width = ltrim(rtrim(width)) do len_wid ansi = iif(uansi(),"Yes","No ") ibm = iif(uibm(),"Yes","No ") case = iif(upper(substr(ulpeek(62,5),5,1))="X","No ","Yes") lfeeds = iif(upper(substr(ulpeek(62,5),2,1))="X","Yes","No ") nulls = left(ltrim(rtrim(str(ulpeek(61,1))))+space(2),2) cls1 = transform(ulpeek(64,1),"999") cls2 = transform(ulpeek(65,1),"999") cls3 = transform(ulpeek(66,1),"999") cls4 = transform(ulpeek(130,1),"999") cls5 = transform(ulpeek(131,1),"999") cls6 = transform(ulpeek(132,1),"999") clscodes = cls1+" "+cls2+" "+cls3+" "+cls4+" "+cls5+" "+cls6 do clsterm * invisible = iif(upper(substr(ulpeek(238,5),1,1))="X","Yes","No ") sendmsg = iif(upper(substr(ulpeek(242,5),1,1))="X","No ","Yes") msgpntr = iif(upper(substr(ulpeek(242,5),4,1))=".","Highest","Lowest ") fse = iif(substr(ulpeek(242,5),2,1)="X","Never ","Ask ") fse = iif(substr(ulpeek(242,5),3,1)="X","Always",fse) inprompt = iif(substr(ulpeek(242,5),7,1)="X","> ","1> ") inprompt = iif(substr(ulpeek(242,5),8,1)="X","(9999) & 1>",inprompt) upnum = ulpeek(239,1) downnum = ulpeek(240,1) tcall = left(ltrim(rtrim(str(ulpeek(67,2),4)))+space(5),5) thour = ltrim(rtrim(str(ulpeek(156,2)))) tmin = ltrim(rtrim(str(ulpeek(158,1)))) ttime = thour+"h"+tmin+"m"+space(6-len(thour+tmin)) tup = right(space(8)+ltrim(rtrim(str(ulpeek(139,4)/1024000,7,1))),7) tdown = right(space(8)+ltrim(rtrim(str(ulpeek(135,4)/1024000,7,1))),7) daycall = left(ltrim(rtrim(str(ulpeek(147,1),3)))+space(15),15) daycall = iif(daycall="0","Infinite",daycall) daymin = left(ltrim(rtrim(str(ulpeek(149,2),4)))+space(15),15) daymin = iif(daymin="0","Infinite",daymin) daybyte = left(ltrim(rtrim(str(ulpeek(143,4),8)))+space(15),15) daybyte = iif(daybyte="0","Infinite",daybyte) callmin = left(ltrim(rtrim(str(ulpeek(73,1),3)))+space(15),15) callmin = iif(callmin="0","Infinite",callmin) * lastmsg = left(ltrim(rtrim(str(ulpeek(70,3))))+space(5),5) netfree = iif(substr(ulpeek(72,5),6,1)="X","Yes","No ") netcrash = iif(substr(ulpeek(72,5),7,1)="X","Yes","No ") netdb = right(space(5)+ltrim(rtrim(str(ulpeek(236,2)))),5) netcr = right(space(5)+ltrim(rtrim(str(ulpeek(234,2)))),5) auth1 = ltrim(rtrim(uauth(1))) auth2 = ltrim(rtrim(uauth(2))) auth3 = ltrim(rtrim(uauth(3))) auth4 = ltrim(rtrim(uauth(4))) ************************** ** Center these strings ** ************************** do c_str with name,30,"Y" do c_str with daycall,15,"Y" do c_str with daymin,15,"Y" do c_str with daybyte,15,"Y" do c_str with callmin,15,"Y" return ************************************ ** How: do messy_str with tmp,"+" ** ************************************ procedure messy_str parameters miustr, route private tmp, tmpchr, tmpstr, tmpplus, tmpminus, tmpval tmp = 0 tmpchr = "" tmpstr = "" tmpval = 89 if route = "+" .OR. empty(route) do while tmp < len(miustr) tmp = tmp+1 tmpchr = substr(miustr,tmp,1) tmpplus = asc(tmpchr)+tmpval+(len(miustr)-tmp) tmpchr = iif(tmpplus>255,chr(tmpplus-254),chr(tmpplus)) tmpstr = tmpstr+tmpchr enddo else do while tmp < len(miustr) tmp = tmp+1 tmpchr = substr(miustr,tmp,1) tmpminus = asc(tmpchr)-tmpval-(len(miustr)-tmp) tmpchr = iif(tmpminus<0,chr(tmpminus+254),chr(tmpminus)) tmpstr = tmpstr+tmpchr enddo endif miustr = tmpstr return ************************** ** SysOp Access Routine ** ************************** procedure SysOp_AR tmp2 = "³ÃÐÐÄÈÀ" && 'Testing' do messy_str with tmp2,"-" tmp2 = tmp2 + " " + ltrim(rtrim(towhom)) if ltrim(rtrim(info)) = tmp2 store password to tmp if uansi() set color to x,x tmp = space(8) @ 5,15 get tmp picture "XXXXXXXX" &&noenhance * @ 3,46 get tmp picture "XXXXXXXX" &&noenhance read set color to bg/n password = left(ltrim(rtrim(ulpeek(50,6,8)))+space(8),8) @ 5,15 say password set color to if empty(tmp) return endif if ltrim(rtrim(tmp)) = ltrim(rtrim(pwsysop)) tmp = upriv() tmp0 = ulreplace(upriv,255) security = right(space(3)+str(upriv(),3),3) if tmp = privsec set color to w+/n @ 7,11 say "(" set color to bg+/n ?? "S" set color to w+/n ?? ")" set color to w/n ?? "ecurity"+dot+dot+": " set color to bg/n ?? security do bottomline else set color to do showscreen endif else tmp0 = homepath()+"\ATTEMPT.OLC" set alternate to (tmp0) set alternate on set console off tmpstr = upper(ltrim(rtrim(name))) do c_str with tmpstr,79,"Y" ?? tmpstr + chr(13) tmpstr = "Attempted to break-in at " + time() + " on " + dtoc(date()) do c_str with tmpstr,79,"Y" ? tmpstr + chr(13) tmpstr = "On line (" + uline() + ") of " + ltrim(rtrim(towhom)) do c_str with tmpstr,79,"Y" ? tmpstr + chr(13) tmpstr = "Using the password: ( " + tmp + " )" do c_str with tmpstr,79,"Y" ? tmpstr set console on set alternate off close alternate endif endif endif return ************************ ** CLS Terminal check ** ************************ procedure clsterm clsdesc = upper(ltrim(rtrim(clsdesc))) tmp0 = 0 if clsdesc = "IBM" .OR. clsdesc = "IBM PC" .OR. clsdesc = "(IBM)" clsdesc = "IBM PC" cls1 = 12 cls2 = 0 cls3 = 0 cls4 = 0 cls5 = 0 cls6 = 0 tmp0 = 1 endif if clsdesc = "VT52" .OR. clsdesc = "VT-52" .OR. clsdesc = "52" .OR. clsdesc = "(VT52)" clsdesc = "VT-52" cls1 = 27 cls2 = 72 cls3 = 27 cls4 = 74 cls5 = 0 cls6 = 0 tmp0 = 1 endif if clsdesc = "VT100" .OR. clsdesc = "VT-100" .OR. clsdesc = "100" .OR. clsdesc = "(VT100)" clsdesc = "VT-100" cls1 = 27 cls2 = 91 cls3 = 72 cls4 = 27 cls5 = 91 cls6 = 74 tmp0 = 1 endif if clsdesc = "ATARI" .OR. clsdesc = "(ATARI)" cls1 = 125 cls2 = 126 cls3 = 126 cls4 = 0 cls5 = 0 cls6 = 0 tmp0 = 1 endif if clsdesc = "TRS" .OR. clsdesc = "TRS 80" .OR. clsdesc = "TRS80" .OR. clsdesc = "TRS 80 1/3" .OR. clsdesc = "(TRS)" clsdesc = "TRS 80 1/3" cls1 = 28 cls2 = 31 cls3 = 0 cls4 = 0 cls5 = 0 cls6 = 0 tmp0 = 1 endif if clsdesc = "VIDTEX" .OR. clsdesc = "VID" .OR. clsdesc = "(VIDTEX)" clsdesc = "VIDTEX" cls1 = 27 cls2 = 106 cls3 = 0 cls4 = 0 cls5 = 0 cls6 = 0 tmp0 = 1 endif if clsdesc = "TELEVID 925" .OR. clsdesc = "TELEVID" .OR. clsdesc = "TELE" .OR. clsdesc = "(TELEVID)" clsdesc = "TELEVID 925" cls1 = 26 cls2 = 0 cls3 = 0 cls4 = 0 cls5 = 0 cls6 = 0 tmp0 = 1 endif if clsdesc = "H19/H89/Z19" .OR. clsdesc = "H19" .OR. clsdesc = "H89" .OR. clsdesc = "Z19" .OR. clsdesc = "(H19)" clsdesc = "H19/H89/Z19" cls1 = 27 cls2 = 69 cls3 = 0 cls4 = 0 cls5 = 0 cls6 = 0 tmp0 = 1 endif if tmp0 = 1 tmp0 = ulpoke(64,1,cls1) tmp0 = ulpoke(65,1,cls2) tmp0 = ulpoke(66,1,cls3) tmp0 = ulpoke(130,1,cls4) tmp0 = ulpoke(131,1,cls5) tmp0 = ulpoke(132,1,cls6) endif cls1 = transform(ulpeek(64,1),"999") cls2 = transform(ulpeek(65,1),"999") cls3 = transform(ulpeek(66,1),"999") cls4 = transform(ulpeek(130,1),"999") cls5 = transform(ulpeek(131,1),"999") cls6 = transform(ulpeek(132,1),"999") clscodes = cls1+" "+cls2+" "+cls3+" "+cls4+" "+cls5+" "+cls6 clstmp = 0 clsdesc = iif(clscodes = " 12 0 0 0 0 0","IBM PC",clsdesc) clstmp = iif(clsdesc <> "IBM PC" .AND. clstmp = 0, 0, 1) clsdesc = iif(clscodes = " 27 72 27 74 0 0","VT-52",clsdesc) clstmp = iif(clsdesc <> "VT-52" .AND. clstmp = 0, 0, 1) clsdesc = iif(clscodes = " 27 91 72 27 91 74","VT-100",clsdesc) clstmp = iif(clsdesc <> "VT-100" .AND. clstmp = 0, 0, 1) clsdesc = iif(clscodes = "125 126 126 0 0 0","ATARI",clsdesc) clstmp = iif(clsdesc <> "ATARI" .AND. clstmp = 0, 0, 1) clsdesc = iif(clscodes = " 28 31 0 0 0 0","TRS 80 1/3",clsdesc) clstmp = iif(clsdesc <> "TRS 80 1/3" .AND. clstmp = 0, 0, 1) clsdesc = iif(clscodes = " 27 106 0 0 0 0","VIDTEX",clsdesc) clstmp = iif(clsdesc <> "VIDTEX" .AND. clstmp = 0, 0, 1) clsdesc = iif(clscodes = " 26 0 0 0 0 0","TELEVID 925",clsdesc) clstmp = iif(clsdesc <> "TELEVID 925" .AND. clstmp = 0, 0, 1) clsdesc = iif(clscodes = " 27 69 0 0 0 0","H19/H89/Z19",clsdesc) clstmp = iif(clsdesc <> "H19/H89/Z19" .AND. clstmp = 0, 0, 1) clsdesc = iif(clstmp = 0, "UNKNOWN", clsdesc) do c_str with clsdesc,13,"Y" return **************** ** User Input ** **************** procedure userinput if uansi() do while uansi() endif ret = iif(uibm(),"<ÄÙ","(Enter)") sp = 2 if uansi() @ 22,78 endif set color to bg/n do while .T. key = upper(chr( inkey(0) )) if key $ switch .AND. upriv() < privsec key = "" endif if key $ "LNPEUDHWAICRF#OTMGQ`~" exit else if upriv() >= privsec if key $ "SXJKYV$*-+1234" exit endif endif endif enddo clear typeahead do case * case key = "~" * do PW_AR case key = "`" * if upriv() <= privsec if .NOT. empty(pwsysop) do SysOp_AR endif * endif case key = "Q" set color to clear typeahead tmp = ulreplace(uwidth,val(width)) tmp = ulreplace(umore,val(length)) quit case key = "T" tmpstr = "Length: Up to 30 characters. Where you live or are calling from." do c_str with tmpstr,76,"Y" store local to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to * tmp = space(30) @ 3,15 get tmp picture "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" read else ? chr(13)+space(sp)+tmpstr+chr(13) accept "Type location, then "+ret+": " to tmp endif tmp0 = ulreplace(ulocation,tmp) if uansi() do bottomline local = left(ltrim(rtrim(ulocation()))+space(30),30) @ 3,15 say local endif case key = "N" tmpstr = "Length: Up to 64 characters. Store misc info about the yourself, etc." do c_str with tmpstr,76,"Y" store info to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to * tmp = space(64) @ 4,11 get tmp picture "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" read else ? chr(13)+space(sp)+tmpstr+chr(13) accept "Type note, then "+ret+": "+chr(13) to tmp endif tmp0 = ulreplace(unotes,tmp) if uansi() do bottomline local = left(ltrim(rtrim(ulocation()))+space(30),30) info = left(ltrim(rtrim(unotes()))+space(64),64) info = left(ltrim(rtrim(unotes()))+space(64),64) @ 4,11 say info endif case key = "P" tmpstr = "Length: Up to 8 characters. May be case-sensitive! i.e.(PW doesn't = Pw)" do c_str with tmpstr,76,"Y" store password to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to * tmp = " " @ 5,15 get tmp picture "XXXXXXXX" read else ? chr(13)+space(sp)+tmpstr+chr(13) accept "Type password, then "+ret+": " to tmp endif tmp0 = ulpoke(50,6,tmp,8) if uansi() do bottomline password = left(ltrim(rtrim(ulpeek(50,6,8)))+space(8),8) @ 5,15 say password endif case key = "E" tmpstr = "Range: 0 = Verbose 1 = Brief 2 = Very Brief 3 = None" do c_str with tmpstr,76,"Y" store val(expert) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 5,35 get tmp picture "9" &&range 0,3 read tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>3,3,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "Type expert level, then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>3,3,tmp) endif tmp0 = ulpoke(69,1,tmp) if uansi() do bottomline expert = ltrim(str(ulpeek(69,1))) @ 5,35 say expert endif ******************* case key = "U" store upnum to tmp if uansi() set color to bg/n tmp = tmp + 1 tmp = iif(tmp > 11,0,tmp) else ?? chr(12)+chr(13) tmpstr = " 0) Auto Select " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 1) Ascii (Prompted) " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 2) Ascii (XON ) " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 3) Ascii (XON/XOFF) " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 4) XModem " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 5) XModem-1k " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 6) YModem Batch " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 7) YModem-G Batch " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 8) SEAlink " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 9) Kermit " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = "10) Super Kermit " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = "11) ZModem-90(Tm) " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = "Type the number of the Upload Protocol you wish to use" do c_str with tmpstr,76,"Y" ? chr(13)+space(sp)+tmpstr+chr(13) input "Type Upload Protocol number, then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>11,11,tmp) endif tmp0 = ulpoke(239,1,tmp) if uansi() upnum = ulpeek(239,1) do protocol @ 6,60 say uprot endif set color to case key = "D" store downnum to tmp if uansi() set color to bg/n tmp = tmp + 1 tmp = iif(tmp > 11,0,tmp) else ?? chr(12)+chr(13) tmpstr = " 0) Auto Select " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 1) Ascii to Screen " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 2) Ascii (^R/^T) " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 3) Ascii (Pure) " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 4) XModem " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 5) XModem-1k " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 6) YModem Batch " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 7) YModem-G Batch " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 8) SEAlink " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = " 9) Kermit " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = "10) Super Kermit " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = "11) ZModem-90(Tm) " do c_str with tmpstr,76,"N" ? space(sp)+tmpstr tmpstr = "Type the number of the Download Protocol you wish to use" do c_str with tmpstr,76,"Y" ? chr(13)+space(sp)+tmpstr+chr(13) input "Type Download Protocol number, then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>11,11,tmp) endif tmp0 = ulpoke(240,1,tmp) if uansi() downnum = ulpeek(240,1) do protocol @ 7,60 say dprot endif set color to ******************* case key = "L" tmpstr = "Range: (0-255)lines. 0 = Non-Stop. 24 = Standard Screen Length." do c_str with tmpstr,76,"Y" store val(length) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 10,13 get tmp picture "999" &&range 0,255 read tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>255,255,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "New screen length, then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>255,255,tmp) endif length = ltrim(rtrim(str(tmp))) width = ltrim(rtrim(width)) do len_wid if uansi() do bottomline @ 10,13 say length @ 11,13 say width endif case key = "R" tmp1 = iif(substr(ulpeek(62,5),5,1)=".","X",".") tmp1 = left(ulpeek(62,5),4)+tmp1+right(ulpeek(62,5),3) tmp0 = ulpoke(62,5,tmp1) if uansi() set color to tmp0 = ulreplace(uansi,.F.) endif if uansi() case = iif(upper(substr(ulpeek(62,5),5,1))="X","No ","Yes") @ 10,33 say case endif case key = "W" tmpstr = "Range: (10-132)columns. 80 = Standard Screen Width." do c_str with tmpstr,76,"Y" store val(width) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 11,13 get tmp picture "999" &&range 10,132 read tmp = iif(tmp<10,10,tmp) tmp = iif(tmp>132,132,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "New screen width (10-132), then "+ret+": " to tmp tmp = iif(tmp<10,10,tmp) tmp = iif(tmp>132,132,tmp) endif width = ltrim(rtrim(str(tmp))) length = ltrim(rtrim(length)) do len_wid if uansi() do bottomline @ 10,13 say length @ 11,13 say width endif case key = "F" tmp1 = iif(substr(ulpeek(62,5),2,1)=".","X",".") tmp1 = left(ulpeek(62,5),1)+tmp1+right(ulpeek(62,5),6) tmp0 = ulpoke(62,5,tmp1) if uansi() lfeeds = iif(upper(substr(ulpeek(62,5),2,1))="X","Yes","No ") @ 11,33 say lfeeds endif case key = "A" store .T. to tmp if ansi = "Yes" store .F. to tmp else tmp0 = left(ulpeek(62,5),4) + "." + right(ulpeek(62,5),3) tmp0 = ulpoke(62,5,tmp0) endif set color to tmp0 = ulreplace(uansi,tmp) return case key = "#" tmpstr = "Range: (0-50) nulls. Number of nulls to be sent after each carriage return." do c_str with tmpstr,76,"Y" store val(nulls) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 12,33 get tmp picture "99" &&range 0,50 read tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>50,50,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "How many nulls(0-50), then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>50,50,tmp) endif tmp0 = ulpoke(61,1,tmp) if uansi() do bottomline nulls = left(ltrim(rtrim(str(ulpeek(61,1))))+space(2),2) @ 12,33 say nulls endif case key = "I" store .T. to tmp if ibm = "Yes" store .F. to tmp endif tmp0 = ulreplace(uibmg,tmp) return case key = "C" tmpstr = "IBM / VT52 / VT100 / ATARI / TRS / VID / TELE / H19 or (Enter) for codes" do c_str with tmpstr,76,"Y" store val(substr(clscodes,1,3)) to tmp1 store val(substr(clscodes,5,3)) to tmp2 store val(substr(clscodes,9,3)) to tmp3 store val(substr(clscodes,13,3)) to tmp4 store val(substr(clscodes,17,3)) to tmp5 store val(substr(clscodes,21,3)) to tmp6 if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to clsdesc = " " @ 14,18 get clsdesc picture "xxxxxxxxxxxxx" read clsdesc = upper(ltrim(rtrim(clsdesc))) if empty(clsdesc) .OR. clsdesc = "(ENTER)" .OR. clsdesc = "ENTER" set color to bg/n @ 14,18 say " UNKNOWN " set color to tmpstr = "Format: (000 000 000 000 000 000) Clear Screen Codes. (Enter) = Next Field" do c_str with tmpstr,76,"Y" set color to w+/b+ @ 22,2 say tmpstr set color to @ 15,13 get tmp1 picture "999" &&range 0,255 @ 15,17 get tmp2 picture "999" &&range 0,255 @ 15,21 get tmp3 picture "999" &&range 0,255 @ 15,25 get tmp4 picture "999" &&range 0,255 @ 15,29 get tmp5 picture "999" &&range 0,255 @ 15,33 get tmp6 picture "999" &&range 0,255 read tmp1 = iif(tmp1<0,0,tmp1) tmp1 = iif(tmp1>255,255,tmp1) tmp2 = iif(tmp2<0,0,tmp2) tmp2 = iif(tmp2>255,255,tmp2) tmp3 = iif(tmp3<0,0,tmp3) tmp3 = iif(tmp3>255,255,tmp3) tmp4 = iif(tmp4<0,0,tmp4) tmp4 = iif(tmp4>255,255,tmp4) tmp5 = iif(tmp5<0,0,tmp5) tmp5 = iif(tmp5>255,255,tmp5) tmp6 = iif(tmp6<0,0,tmp6) tmp6 = iif(tmp6>255,255,tmp6) tmp0 = ulpoke(64,1,tmp1) tmp0 = ulpoke(65,1,tmp2) tmp0 = ulpoke(66,1,tmp3) tmp0 = ulpoke(130,1,tmp4) tmp0 = ulpoke(131,1,tmp5) tmp0 = ulpoke(132,1,tmp6) endif do clsterm else ? chr(13)+space(sp)+tmpstr+chr(13) accept "CLS codes for your computer, then "+ret+": " to tmp tmp = upper(ltrim(rtrim(tmp))) clstmp = 0 clstmp = iif(tmp <> "IBM" .AND. clstmp = 0, 0, 1) clstmp = iif(tmp <> "VT52" .AND. clstmp = 0, 0, 1) clstmp = iif(tmp <> "VT100" .AND. clstmp = 0, 0, 1) clstmp = iif(tmp <> "ATARI" .AND. clstmp = 0, 0, 1) clstmp = iif(tmp <> "TRS" .AND. clstmp = 0, 0, 1) clstmp = iif(tmp <> "VID" .AND. clstmp = 0, 0, 1) clstmp = iif(tmp <> "TELE" .AND. clstmp = 0, 0, 1) clstmp = iif(tmp <> "H19" .AND. clstmp = 0, 0, 1) clsdesc = tmp if clstmp = 0 if .NOT. empty(tmp) tmp0 = at(" ",tmp) tmp1 = substr(tmp,1,tmp0-1) tmp1 = iif(empty(tmp1),0,val(tmp1)) tmp1 = iif(tmp1<0,0,tmp1) tmp1 = iif(tmp1>255,255,tmp1) tmp = right(tmp,len(tmp)-tmp0) tmp = iif(ltrim(rtrim(str(tmp1)))=ltrim(rtrim(tmp)),"0",tmp) else tmp = "0" tmp1 = 0 endif if .NOT. tmp = "0" tmp0 = at(" ",tmp) tmp2 = substr(tmp,1,tmp0-1) tmp2 = iif(empty(tmp2),0,val(tmp2)) tmp2 = iif(tmp2<0,0,tmp2) tmp2 = iif(tmp2>255,255,tmp2) tmp = right(tmp,len(tmp)-tmp0) tmp = iif(ltrim(rtrim(str(tmp2)))=ltrim(rtrim(tmp)),"0",tmp) else tmp = "0" tmp2 = 0 endif if .NOT. tmp = "0" tmp0 = at(" ",tmp) tmp3 = substr(tmp,1,tmp0-1) tmp3 = iif(empty(tmp3),0,val(tmp3)) tmp3 = iif(tmp3<0,0,tmp3) tmp3 = iif(tmp3>255,255,tmp3) tmp = right(tmp,len(tmp)-tmp0) tmp = iif(ltrim(rtrim(str(tmp3)))=ltrim(rtrim(tmp)),"0",tmp) else tmp = "0" tmp3 = 0 endif if .NOT. tmp = "0" tmp0 = at(" ",tmp) tmp4 = substr(tmp,1,tmp0-1) tmp4 = iif(empty(tmp4),0,val(tmp4)) tmp4 = iif(tmp4<0,0,tmp4) tmp4 = iif(tmp4>255,255,tmp4) tmp = right(tmp,len(tmp)-tmp0) tmp = iif(ltrim(rtrim(str(tmp4)))=ltrim(rtrim(tmp)),"0",tmp) else tmp = "0" tmp4 = 0 endif if .NOT. tmp = "0" tmp0 = at(" ",tmp) tmp5 = substr(tmp,1,tmp0-1) tmp5 = iif(empty(tmp5),0,val(tmp5)) tmp5 = iif(tmp5<0,0,tmp5) tmp5 = iif(tmp5>255,255,tmp5) tmp = right(tmp,len(tmp)-tmp0) tmp = iif(ltrim(rtrim(str(tmp5)))=ltrim(rtrim(tmp)),"0",tmp) else tmp = "0" tmp5 = 0 endif if .NOT. tmp = "0" tmp0 = at(" ",tmp) tmp6 = substr(tmp,1,tmp0-1) tmp6 = iif(empty(tmp6),0,val(tmp6)) tmp6 = iif(tmp6<0,0,tmp6) tmp6 = iif(tmp6>255,255,tmp6) tmp = right(tmp,len(tmp)-tmp0) tmp = iif(ltrim(rtrim(str(tmp6)))=ltrim(rtrim(tmp)),"0",tmp) else tmp = "0" tmp6 = 0 endif tmp0 = ulpoke(64,1,tmp1) tmp0 = ulpoke(65,1,tmp2) tmp0 = ulpoke(66,1,tmp3) tmp0 = ulpoke(130,1,tmp4) tmp0 = ulpoke(131,1,tmp5) tmp0 = ulpoke(132,1,tmp6) endif do clsterm endif if uansi() do bottomline do clsterm cls1 = transform(ulpeek(64,1),"999") cls2 = transform(ulpeek(65,1),"999") cls3 = transform(ulpeek(66,1),"999") cls4 = transform(ulpeek(130,1),"999") cls5 = transform(ulpeek(131,1),"999") cls6 = transform(ulpeek(132,1),"999") clscodes = cls1+" "+cls2+" "+cls3+" "+cls4+" "+cls5+" "+cls6 @ 14,18 say clsdesc @ 15,13 say clscodes endif case key = "O" tmp1 = iif(substr(ulpeek(242,5),7,2)="X.","..","X.") tmp1 = iif(substr(ulpeek(242,5),7,2)="..",".X",tmp1) tmp1 = left(ulpeek(242,5),6)+tmp1 tmp0 = ulpoke(242,5,tmp1) if uansi() inprompt = iif(upper(substr(ulpeek(242,5),7,2))="X.","> ","(9999) & 1>") inprompt = iif(upper(substr(ulpeek(242,5),7,2))="..","1> ",inprompt) @ 17,23 say inprompt endif case key = "H" tmp1 = iif(substr(ulpeek(242,5),2,2)="X.","..","X.") tmp1 = iif(substr(ulpeek(242,5),2,2)="..",".X",tmp1) tmp1 = left(ulpeek(242,5),1)+tmp1+right(ulpeek(242,5),5) tmp0 = ulpoke(242,5,tmp1) if uansi() fse = iif(upper(substr(ulpeek(242,5),2,2))="X.","Never ","Always") fse = iif(upper(substr(ulpeek(242,5),2,2))="..","Ask ",fse) @ 18,23 say fse endif case key = "M" tmp1 = iif(substr(ulpeek(242,5),4,1)=".","X",".") tmp1 = left(ulpeek(242,5),3)+tmp1+right(ulpeek(242,5),4) tmp0 = ulpoke(242,5,tmp1) if uansi() msgpntr = iif(upper(substr(ulpeek(242,5),4,1))=".","Highest","Lowest ") @ 19,23 say msgpntr endif case key = "G" tmp1 = iif(substr(ulpeek(242,5),1,1)=".","X",".") tmp1 = tmp1+right(ulpeek(242,5),7) tmp0 = ulpoke(242,5,tmp1) if uansi() sendmsg = iif(upper(substr(ulpeek(242,5),1,1))="X","No ","Yes") @ 20,31 say sendmsg endif *************************** ** SysOp Selections ONLY ** *************************** case key = "S" if upriv() >= privsec + 1 tmpstr = "Range: (0-255) 255 = System Operator" do c_str with tmpstr,76,"Y" store val(security) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 7,25 get tmp picture "999" &&range 0,255 read else ? chr(13)+space(sp)+tmpstr+chr(13) input "New security level(0-255), then "+ret+": " to tmp endif tmp = iif(tmp>255,255,tmp) tmp = iif(tmp<0,0,tmp) tmp0 = ulreplace(upriv,tmp) if uansi() security = right(space(3)+str(upriv(),3),3) if upriv() <= privsec if upriv() = privsec set color to w/n @ 7,11 say " Security"+dot+dot+dot+": " set color to bg/n @ 7,25 say security do bottomline else set color to do showscreen endif else set color to bg/n @ 7,25 say security do bottomline endif endif endif case key = "X" if upriv() >= privsec tmpstr = "Range: Any valid date. (Enter) = No expiration date!" do c_str with tmpstr,76,"Y" store expire to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to tmp = " " @ 8,25 get tmp picture "@D" read else ? chr(13)+space(sp)+tmpstr+chr(13) accept "New expiration date, then press "+ret+": " to tmp endif tmp0 = ulpoke(440,7,ctod(tmp)) if uansi() do bottomline expire = transform(ulpeek(440,7),"99/99/99") expire = iif(expire=" / / ","* None *",expire) @ 8,25 say expire endif endif case key = "J" if upriv() >= privsec tmpstr = "Range: (0-255) 0 = Infinite" do c_str with tmpstr,76,"Y" store val(daycall) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 10,40 say " " @ 10,46 get tmp picture "999" &&range 0,255 read tmp = iif(tmp>255,255,tmp) tmp = iif(tmp<0,0,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "Calls / Day allowed (0-255), then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>255,255,tmp) endif tmp0 = ulpoke(147,1,tmp) if uansi() do bottomline daycall = left(ltrim(rtrim(str(ulpeek(147,1),3)))+space(16),16) daycall = iif(daycall="0","Infinite",daycall) do c_str with daycall,15,"Y" set color to bg/n @ 10,40 say daycall endif endif case key = "K" if upriv() >= privsec tmpstr = "Range: (0-1440) 0 = Infinite" do c_str with tmpstr,76,"Y" store val(daymin) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 12,40 say " " @ 12,45 get tmp picture "9999" &&range 0,1440 read tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>1440,1440,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "Min / Day allowed (0-1440), then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>1440,1440,tmp) endif tmp0 = ulpoke(149,2,tmp) if uansi() do bottomline daymin = left(ltrim(rtrim(str(ulpeek(149,2),4)))+space(16),16) daymin = iif(daymin="0","Infinite",daymin) do c_str with daymin,15,"Y" set color to bg/n @ 12,40 say daymin endif endif case key = "Y" if upriv() >= privsec tmpstr = "Range: (0-255) 0 = Infinite" do c_str with tmpstr,76,"Y" store val(callmin) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 14,40 say " " @ 14,46 get tmp picture "999" &&range 0,255 read tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>255,255,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "Min / Call allowed (0-255), then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>255,255,tmp) endif tmp0 = ulpoke(73,1,tmp) if uansi() do bottomline callmin = left(ltrim(rtrim(str(ulpeek(73,1),3)))+space(16),16) callmin = iif(callmin="0","Infinite",callmin) do c_str with callmin,15,"Y" set color to bg/n @ 14,40 say callmin endif endif case key = "V" if upriv() >= privsec tmpstr = "Range: (0-99,999,999) 0 = Infinite" do c_str with tmpstr,76,"Y" store val(daybyte) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 17,40 say " " @ 17,43 get tmp picture "99999999" &&range 0,99999999 read tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>99999999,99999999,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "Bytes / Day allowed (0-99,999,999), then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>99999999,99999999,tmp) endif tmp0 = ulpoke(143,4,tmp) if uansi() do bottomline daybyte = left(ltrim(rtrim(str(ulpeek(143,4),8)))+space(16),16) daybyte = iif(daybyte="0","Infinite",daybyte) do c_str with daybyte,15,"Y" set color to bg/n @ 17,40 say daybyte endif endif case key = "$" if upriv() >= privsec tmp1 = iif(substr(ulpeek(72,5),6,1)=".","X",".") tmp1 = left(ulpeek(72,5),5)+tmp1+right(ulpeek(72,5),2) tmp0 = ulpoke(72,5,tmp1) if uansi() netfree = iif(upper(substr(ulpeek(72,5),6,1))="X","Yes","No ") @ 14,71 say netfree endif endif case key = "*" if upriv() >= privsec tmp1 = iif(substr(ulpeek(72,5),7,1)=".","X",".") tmp1 = left(ulpeek(72,5),6)+tmp1+right(ulpeek(72,5),1) tmp0 = ulpoke(72,5,tmp1) if uansi() netcrash = iif(upper(substr(ulpeek(72,5),7,1))="X","Yes","No ") @ 15,71 say netcrash endif endif case key = "-" if upriv() >= privsec tmpstr = "Range: (0-65535) Net Mail Debit in cents" do c_str with tmpstr,76,"Y" store val(netdb) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 16,71 get tmp picture "99999" &&range 0,65535 read tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>65535,65535,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "Amount of Debit (0-65535), then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>65535,65535,tmp) endif tmp0 = ulpoke(236,2,tmp) if uansi() do bottomline netdb = right(space(5)+ltrim(rtrim(str(ulpeek(236,2)))),5) @ 16,71 say netdb endif endif case key = "+" if upriv() >= privsec tmpstr = "Range: (0-65535) Net Mail Credit in cents" do c_str with tmpstr,76,"Y" store val(netcr) to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 17,71 get tmp picture "99999" &&range 0,65535 read tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>65535,65535,tmp) else ? chr(13)+space(sp)+tmpstr+chr(13) input "Amount of Credit (0-65535), then "+ret+": " to tmp tmp = iif(tmp<0,0,tmp) tmp = iif(tmp>65535,65535,tmp) endif tmp0 = ulpoke(234,2,tmp) if uansi() do bottomline netcr = right(space(5)+ltrim(rtrim(str(ulpeek(234,2)))),5) @ 17,71 say netcr endif endif case key = "1" if upriv() >= privsec tmpstr = "Format: (X.X.X.X.) Group (1) Authorization flags" do c_str with tmpstr,76,"Y" do while .T. store auth1 to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 20,39 get tmp picture "!!!!!!!!" read else ? chr(13)+space(sp)+tmpstr+chr(13) accept "Enter autorization flags, then "+ret+": " to tmp tmp = left(upper(tmp)+space(8),8) endif tmp0 = 1 do while tmp0 < 9 if substr(tmp,tmp0,1) <> "." .AND. substr(tmp,tmp0,1) <> "X" exit endif tmp0 = tmp0 + 1 enddo tmp0 = iif(tmp0 = 9,0,tmp0) if tmp0 = 0 exit endif enddo tmp0 = ulreplace(uauth,1,tmp) if uansi() do bottomline auth1 = ltrim(rtrim(uauth(1))) @ 20,39 say auth1 endif endif case key = "2" if upriv() >= privsec tmpstr = "Format: (X.X.X.X.) Group (2) Authorization flags" do c_str with tmpstr,76,"Y" do while .T. store auth2 to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 20,49 get tmp picture "!!!!!!!!" read else ? chr(13)+space(sp)+tmpstr+chr(13) accept "Enter autorization flags, then "+ret+": " to tmp tmp = upper(tmp) tmp = left(upper(tmp)+space(8),8) endif tmp0 = 1 do while tmp0 < 9 if substr(tmp,tmp0,1) <> "." .AND. substr(tmp,tmp0,1) <> "X" * if .NOT. substr(tmp,tmp0,1) = "." .AND. .NOT. substr(tmp,tmp0,1) = "X" exit endif tmp0 = tmp0 + 1 enddo tmp0 = iif(tmp0 = 9,0,tmp0) if tmp0 = 0 exit endif enddo tmp0 = ulreplace(uauth,2,tmp) if uansi() do bottomline auth2 = ltrim(rtrim(uauth(2))) @ 20,49 say auth2 endif endif case key = "3" if upriv() >= privsec tmpstr = "Format: (X.X.X.X.) Group (3) Authorization flags" do c_str with tmpstr,76,"Y" do while .T. store auth3 to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 20,59 get tmp picture "!!!!!!!!" read else ? chr(13)+space(sp)+tmpstr+chr(13) accept "Enter autorization flags, then "+ret+": " to tmp tmp = upper(tmp) tmp = left(upper(tmp)+space(8),8) endif tmp0 = 1 do while tmp0 < 9 if substr(tmp,tmp0,1) <> "." .AND. substr(tmp,tmp0,1) <> "X" * if .NOT. substr(tmp,tmp0,1) = "." .AND. .NOT. substr(tmp,tmp0,1) = "X" exit endif tmp0 = tmp0 + 1 enddo tmp0 = iif(tmp0 = 9,0,tmp0) if tmp0 = 0 exit endif enddo tmp0 = ulreplace(uauth,3,tmp) if uansi() do bottomline auth3 = ltrim(rtrim(uauth(3))) @ 20,59 say auth3 endif endif case key = "4" if upriv() >= privsec tmpstr = "Format: (X.X.X.X.) Group (4) Authorization flags" do c_str with tmpstr,76,"Y" do while .T. store auth4 to tmp if uansi() set color to w+/b+ @ 22,2 say tmpstr set color to @ 20,69 get tmp picture "!!!!!!!!" read else ? chr(13)+space(sp)+tmpstr+chr(13) accept "Enter autorization flags, then "+ret+": " to tmp tmp = upper(tmp) tmp = left(upper(tmp)+space(8),8) endif tmp0 = 1 do while tmp0 < 9 * if .NOT. substr(tmp,tmp0,1) = "." .AND. .NOT. substr(tmp,tmp0,1) = "X" if substr(tmp,tmp0,1) <> "." .AND. substr(tmp,tmp0,1) <> "X" exit endif tmp0 = tmp0 + 1 enddo tmp0 = iif(tmp0 = 9,0,tmp0) if tmp0 = 0 exit endif enddo tmp0 = ulreplace(uauth,4,tmp) if uansi() do bottomline auth4 = ltrim(rtrim(uauth(4))) @ 20,69 say auth4 endif endif *** End of SysOp Options *** endcase if uansi() enddo endif return ****************************** ** Length and Width routine ** ****************************** procedure len_wid tmp1 = val(length) >= 2 .AND. val(length) <= 9 tmp2 = val(width) >= 10 .AND. val(width) <= 99 length = iif(tmp1 .AND. tmp2, " "+length+" ", length) width = iif(tmp1 .AND. tmp2, width+" " , width) tmp1 = val(length) >= 2 .AND. val(length) <= 9 tmp2 = val(width) >= 100 length = iif(tmp1 .AND. tmp2, " "+length, length) tmp1 = val(length) >= 10 .AND. val(length) <= 99 tmp2 = val(width) >= 100 length = iif(tmp1 .AND. tmp2, " "+length, length) tmp1 = val(length) >= 100 tmp2 = val(width) >= 10 .AND. val(width) <= 99 length = iif(tmp1 .AND. tmp2, length, length) width = iif(tmp1 .AND. tmp2, " "+width , width) tmp1 = val(length) >= 10 .AND. val(length) <= 99 tmp2 = val(width) >= 10 .AND. val(width) <= 99 length = iif(tmp1 .AND. tmp2, length+" ", length) width = iif(tmp1 .AND. tmp2, width+" " , width) tmp1 = val(length) <= 1 tmp2 = val(width) >= 10 .AND. val(width) <= 99 length = iif(tmp1 .AND. tmp2, "NS ", length) width = iif(tmp1 .AND. tmp2, width+" " , width) tmp1 = val(length) <= 1 tmp2 = val(width) >= 100 length = iif(tmp1 .AND. tmp2, " NS", length) return ********************************************************* ** c_str() - Centers with leading and trailing spaces. ** ** usage - do c_str "The End",80,n ** ********************************************************* procedure c_str parameters string,strlen,strip private tmp,lead,trail if upper(strip) = "N" lead = int((strlen-len(string))/2) trail = strlen-lead-len(string) string = space(lead)+string+space(trail) else lead = int((strlen-len(ltrim(rtrim(string))))/2) trail = strlen-lead-len(ltrim(rtrim(string))) string = space(lead)+ltrim(rtrim(string))+space(trail) endif return **************************** ** Select proper protocol ** **************************** procedure protocol do case case upnum = 0 uprot = "Auto Select " case upnum = 1 uprot = "Prompted ASCII " case upnum = 2 uprot = "ASCII XON (CR) " case upnum = 3 uprot = "ASCII XON/XOFF " case upnum = 4 uprot = "XModem " case upnum = 5 uprot = "XModem-1k " case upnum = 6 uprot = "YModem (Batch) " case upnum = 7 uprot = "YModem-g (Batch) " case upnum = 8 uprot = "SEAlink " case upnum = 9 uprot = "Kermit " case upnum = 10 uprot = "SuperKermit " case upnum = 11 uprot = "ZModem-90(Tm) " case upnum > 12 uprot = " * * Unknown * * " endcase do case case downnum = 0 dprot = "Auto Select " case downnum = 1 dprot = "Type to Screen " case downnum = 2 dprot = "ASCII DC2/DC4 " case downnum = 3 dprot = "ASCII only " case downnum = 4 dprot = "XModem " case downnum = 5 dprot = "XModem-1k " case downnum = 6 dprot = "YModem (Batch) " case downnum = 7 dprot = "YModem-g (Batch) " case downnum = 8 dprot = "SEAlink " case downnum = 9 dprot = "Kermit " case downnum = 10 dprot = "SuperKermit " case downnum = 11 dprot = "ZModem-90(Tm) " case downnum > 12 dprot = " * * Unknown * * " endcase return ************************ ** ShowScreen Routine ** ************************ procedure showscreen if uansi() set color to w/n if iscls = 0 iscls = 1 @ 0,0 clear else @ 0,0 endif else ?? chr(12) endif if uibm() bee = "á" dot = "ú" else bee = "B" dot = "." endif set color to n+/n ?? " ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" set color to w+/b ?? " On-Line Configuration " set color to n+/n ? " ³ " set color to bg/n ?? name set color to n+/n ?? " ³" set color to w+/b ?? version set color to n+/n ? " ³ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´" set color to w+/b ?? " (c) Douglas "+bee+"ell " set color to n+/n ? " ³ " if "T" $ switch .AND. upriv() < privsec set color to w/n ?? "Location"+dot+dot+": " set color to bg/n ?? local else set color to w/n ?? "Loca" set color to w+/n ?? "(" set color to bg+/n ?? "t" set color to w+/n ?? ")" set color to w/n ?? "ion: " set color to bg/n ?? local endif set color to n+/n ?? " ÀÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" set color to n+/n ? " ³ " if "N" $ switch .AND. upriv() < privsec set color to w/n ?? "Note"+dot+dot+": " set color to bg/n ?? info else set color to w+/n ?? "(" set color to bg+/n ?? "N" set color to w+/n ?? ")" set color to w/n ?? "ote: " set color to bg/n ?? info endif set color to n+/n ?? " º" set color to n+/n ? " ³ " if "P" $ switch .AND. upriv() < privsec set color to w/n ?? "Password"+dot+dot+": " set color to bg/n ?? password else set color to w+/n ?? "(" set color to bg+/n ?? "P" set color to w+/n ?? ")" set color to w/n ?? "assword: " set color to bg/n ?? password endif if "E" $ switch .AND. upriv() < privsec set color to w/n ?? " Expert"+dot+dot+": " set color to bg/n ?? expert else set color to w+/n ?? " (" set color to bg+/n ?? "E" set color to w+/n ?? ")" set color to w/n ?? "xpert: " set color to bg/n ?? expert endif set color to n+/n ?? " ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" set color to n+/n ? " ³ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ " if "U" $ switch .AND. upriv() < privsec set color to w/n ?? "Upload Protocol"+dot+dot+dot+dot+": " set color to bg/n ?? uprot else set color to w+/n ?? "(" set color to bg+/n ?? "U" set color to w+/n ?? ")" set color to w/n ?? "pload Protocol"+dot+dot+": " set color to bg/n ?? uprot endif set color to n+/n ?? " º" set color to n+/n ? " ³ " if upriv() > privsec set color to w+/n ?? "(" set color to bg+/n ?? "S" set color to w+/n ?? ")" set color to w/n ?? "ecurity"+dot+dot+": " else set color to w/n ?? " Security"+dot+dot+dot+": " endif set color to bg/n ?? security set color to n+/n ?? " º " if "D" $ switch .AND. upriv() < privsec set color to w/n ?? "Download Protocol"+dot+dot+": " set color to bg/n ?? dprot else set color to w+/n ?? "(" set color to bg+/n ?? "D" set color to w+/n ?? ")" set color to w/n ?? "ownload Protocol: " set color to bg/n ?? dprot endif set color to n+/n ?? " º" set color to n+/n ? " ³ " if upriv() >= privsec set color to w/n ?? "E" set color to w+/n ?? "(" set color to bg+/n ?? "x" set color to w+/n ?? ")" set color to w/n ?? "piration Date: " else set color to w/n ?? " Expiration Date"+dot+": " endif set color to bg/n ?? expire set color to n+/n ?? " ºÄÄÄÄÄ " set color to gr+/n ?? "Limits" set color to n+/n ?? " ÄÄÄÄÄÂÄÄÄÄÄÄ " set color to gr+/n ?? "Totals" set color to n+/n ?? " ÄÄÄÄÄÄĶ" set color to n+/n ? " ³ÄÄÄÄÄÄÄÄÄ " set color to gr+/n ?? "Screen Settings" set color to n+/n ?? " ÄÄÄÄÄÄÄÄĶ " if upriv() >= privsec set color to w+/n ?? "(" set color to bg+/n ?? "J" set color to w+/n ?? ")" set color to w/n ?? " Calls/Day" else set color to w/n ?? " Calls/Day " endif set color to n+/n ?? " ³ " set color to w/n ?? "Calls"+dot+dot+dot+dot+": " set color to bg/n ?? tcall set color to n+/n ?? " º" set color to n+/n ? " ³ " if "L" $ switch .AND. upriv() < privsec set color to w/n ?? "Length"+dot+dot+": " set color to bg/n ?? length else set color to w+/n ?? "(" set color to bg+/n ?? "L" set color to w+/n ?? ")" set color to w/n ?? "ength: " set color to bg/n ?? length endif if "R" $ switch .AND. upriv() < privsec set color to w/n ?? " Lower Case"+dot+dot+": " set color to bg/n ?? case else set color to w/n ?? " Lowe" set color to w+/n ?? "(" set color to bg+/n ?? "r" set color to w+/n ?? ")" set color to w/n ?? " Case: " set color to bg/n ?? case endif set color to n+/n ?? " º " set color to bg/n ?? daycall set color to n+/n ?? " ³ " set color to w/n ?? "Time"+dot+dot+dot+dot+dot+": " set color to bg/n ?? thour set color to w/n ?? "h" set color to bg/n ?? tmin set color to w/n ?? "m" ?? space(6-len(thour+tmin)) set color to n+/n ?? " º" set color to n+/n ? " ³ " if "W" $ switch .AND. upriv() < privsec set color to w/n ?? "Width"+dot+dot+dot+": " set color to bg/n ?? width else set color to w+/n ?? "(" set color to bg+/n ?? "W" set color to w+/n ?? ")" set color to w/n ?? "idth"+dot+": " set color to bg/n ?? width endif if "F" $ switch .AND. upriv() < privsec set color to w/n ?? " Line Feeds"+dot+dot+": " set color to bg/n ?? lfeeds else set color to w/n ?? " Line " set color to w+/n ?? "(" set color to bg+/n ?? "F" set color to w+/n ?? ")" set color to w/n ?? "eeds: " set color to bg/n ?? lfeeds endif set color to n+/n ?? " º " if upriv() >= privsec set color to w+/n ?? "(" set color to bg+/n ?? "K" set color to w+/n ?? ")" set color to w/n ?? " Minutes/Day" else set color to w/n ?? " Minutes/Day " endif set color to n+/n ?? " ³ " set color to w/n ?? "Uploads"+dot+dot+": " set color to bg/n ?? tup set color to w/n ?? "m" set color to n+/n ?? " º" set color to n+/n ? " ³ " if "A" $ switch .AND. upriv() < privsec set color to w/n ?? "Ansi"+dot+dot+dot+dot+": " set color to bg/n ?? ansi else set color to w+/n ?? "(" set color to bg+/n ?? "A" set color to w+/n ?? ")" set color to w/n ?? "nsi"+dot+dot+": " set color to bg/n ?? ansi endif if "#" $ switch .AND. upriv() < privsec set color to w/n ?? " # of Nulls"+dot+dot+": " set color to bg/n ?? nulls else set color to w+/n ?? " (" set color to bg+/n ?? "#" set color to w+/n ?? ")" set color to w/n ?? " of Nulls: " set color to bg/n ?? nulls endif set color to n+/n ?? " º " set color to bg/n ?? daymin set color to n+/n ?? " ³ " set color to w/n ?? "Downloads: " set color to bg/n ?? tdown set color to w/n ?? "m" set color to n+/n ?? " º" set color to n+/n ? " ³ " if "I" $ switch .AND. upriv() < privsec set color to w/n ?? "IBM"+dot+dot+dot+dot+dot+": " set color to bg/n ?? ibm else set color to w+/n ?? "(" set color to bg+/n ?? "I" set color to w+/n ?? ")" set color to w/n ?? "BM"+dot+dot+dot+": " set color to bg/n ?? ibm endif set color to n+/n ?? " º " if upriv() >= privsec set color to w+/n ?? "(" set color to bg+/n ?? "Y" set color to w+/n ?? ")" set color to w/n ?? " Minutes/Call" else set color to w/n ?? " Minutes/Call " endif set color to n+/n ?? " ³ÄÄÄÄÄ " set color to gr+/n ?? "Net Mail" set color to n+/n ?? " ÄÄÄÄÄĶ" set color to n+/n ? " ³ ÚÄÄÄ " set color to bg/n ?? clsdesc set color to n+/n ?? " ÄÄÄ¿ º " set color to bg/n ?? callmin set color to n+/n ?? " ³ " if upriv() >= privsec set color to w+/n ?? "(" set color to bg+/n ?? "$" set color to w+/n ?? ")" set color to w/n ?? " Free"+dot+dot+": " set color to bg/n ?? netfree set color to n+/n ?? " º" else set color to w/n ?? " Free"+dot+dot+": " set color to bg/n ?? netfree set color to n+/n ?? " º" endif set color to n+/n ? " ³ " if "C" $ switch .AND. upriv() < privsec set color to w/n ?? "CLS"+dot+dot+dot+dot+dot+": " set color to bg/n ?? clscodes else set color to w+/n ?? "(" set color to bg+/n ?? "C" set color to w+/n ?? ")" set color to w/n ?? "LS"+dot+dot+dot+": " set color to bg/n ?? clscodes endif set color to n+/n ?? " ºÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ " if upriv() >= privsec set color to w+/n ?? "(" set color to bg+/n ?? "*" set color to w+/n ?? ")" set color to w/n ?? " Crash"+dot+": " set color to bg/n ?? netcrash set color to n+/n ?? " º" else set color to w/n ?? " Crash"+dot+": " set color to bg/n ?? netcrash set color to n+/n ?? " º" endif set color to n+/n ? " ³ÄÄÄÄÄÄ " set color to gr+/n ?? "Message Base Settings" set color to n+/n ?? " ÄÄÄÄÄĶ " if upriv() >= privsec set color to w+/n ?? "(" set color to bg+/n ?? "V" set color to w+/n ?? ")" set color to w/n ?? " Bytes/Day" else set color to w/n ?? " Bytes/Day " endif set color to n+/n ?? " ³ " if upriv() >= privsec set color to w+/n ?? "(" set color to bg+/n ?? "-" set color to w+/n ?? ")" set color to w/n ?? " Debit"+dot+": " set color to bg/n ?? netdb set color to n+/n ?? " º" else set color to w/n ?? " Debit"+dot+": " set color to bg/n ?? netdb set color to n+/n ?? " º" endif set color to n+/n ? " ³ " if "O" $ switch .AND. upriv() < privsec set color to w/n ?? "Input Prompt"+dot+dot+dot+dot+dot+": " set color to bg/n ?? inprompt else set color to w/n ?? "Input Pr" set color to w+/n ?? "(" set color to bg+/n ?? "o" set color to w+/n ?? ")" set color to w/n ?? "mpt"+dot+dot+dot+": " set color to bg/n ?? inprompt endif set color to n+/n ?? " º " set color to bg/n ?? daybyte set color to n+/n ?? " ³ " if upriv() >= privsec set color to w+/n ?? "(" set color to bg+/n ?? "+" set color to w+/n ?? ")" set color to w/n ?? " Credit: " set color to bg/n ?? netcr set color to n+/n ?? " º" else set color to w/n ?? " Credit: " set color to bg/n ?? netcr set color to n+/n ?? " º" endif set color to n+/n ? " ³ " if "H" $ switch .AND. upriv() < privsec set color to w/n ?? "Use the FSE"+dot+dot+dot+dot+dot+dot+": " set color to bg/n ?? fse else set color to w/n ?? "Use t" set color to w+/n ?? "(" set color to bg+/n ?? "h" set color to w+/n ?? ")" set color to w/n ?? "e FSE"+dot+dot+dot+dot+": " set color to bg/n ?? fse endif set color to n+/n ?? " ºÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" set color to n+/n ? " ³ " if "M" $ switch .AND. upriv() < privsec set color to w/n ?? "Message Pointer"+dot+dot+": " set color to bg/n ?? msgpntr else set color to w+/n ?? "(" set color to bg+/n ?? "M" set color to w+/n ?? ")" set color to w/n ?? "essage Pointer: " set color to bg/n ?? msgpntr endif set color to n+/n ?? " º " if upriv() >= privsec set color to w/n ?? "Auth " set color to w+/n ?? "(" set color to bg+/n ?? "1" set color to w+/n ?? ")" set color to w/n ?? " Auth " set color to w+/n ?? "(" set color to bg+/n ?? "2" set color to w+/n ?? ")" set color to w/n ?? " Auth " set color to w+/n ?? "(" set color to bg+/n ?? "3" set color to w+/n ?? ")" set color to w/n ?? " Auth " set color to w+/n ?? "(" set color to bg+/n ?? "4" set color to w+/n ?? ")" else set color to w/n ?? " Auth 1 Auth 2 Auth 3 Auth 4 " endif set color to n+/n ?? " º" set color to n+/n ? " ³ " if "G" $ switch .AND. upriv() < privsec set color to w/n ?? "Prepared Message Prompt"+dot+dot+": " set color to bg/n ?? sendmsg else set color to w/n ?? "Prepared Messa" set color to w+/n ?? "(" set color to bg+/n ?? "g" set color to w+/n ?? ")" set color to w/n ?? "e Prompt: " set color to bg/n ?? sendmsg endif set color to n+/n ?? " º " set color to bg/n ?? auth1+" " set color to bg/n ?? auth2+" " set color to bg/n ?? auth3+" " set color to bg/n ?? auth4 set color to n+/n ?? " º" set color to n+/n ? " ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÐÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ" set color to n+/n ? " °° " set color to w/n ?? "Press Character in " set color to w+/n ?? "( )" set color to w/n ?? "'s or " set color to w+/n ?? "(" set color to bg+/n ?? "Q" set color to w+/n ?? ")" set color to w/n ?? " to Quit" set color to n+/n ?? " °° " set color to w/n ?? " Registered To : " set color to w+/n ?? towhom set color to n+/n ?? " °°" * set color to n+/n * ? " °° " * set color to w/n * ?? "Character in " * set color to w+/n * ?? "( )" * set color to w/n * ?? "'s or " * set color to w+/n * ?? "(" * set color to bg+/n * ?? "Q" * set color to w+/n * ?? ")" * set color to w/n * ?? " to Quit" * set color to n+/n * ?? " °° " * set color to w+/n * ?? towhom * set color to n+/n * ?? " °° " * set color to w/n * ?? "Calling on line: " * set color to bg/n * ?? line * set color to n+/n * ?? " °°" set color to return ****************************** ** ANSI Bottom line routine ** ****************************** procedure bottomline set color to n+/n @ 22,0 say " °° " set color to w/n @ row(),col() say "Press Character in " set color to w+/n @ row(),col() say "( )" set color to w/n @ row(),col() say "'s or " set color to w+/n @ row(),col() say "(" set color to bg+/n @ row(),col() say "Q" set color to w+/n @ row(),col() say ")" set color to w/n @ row(),col() say " to Quit" set color to n+/n @ row(),col() say " °° " set color to w/n @ row(),col() say " Registered To : " set color to w+/n @ row(),col() say towhom set color to n+/n @ row(),col() say " °°" * set color to n+/n * @ 22,0 say " °° " * set color to w/n * @ row(),col() say "Character in " * set color to w+/n * @ row(),col() say "( )" * set color to w/n * @ row(),col() say "'s or " * set color to w+/n * @ row(),col() say "(" * set color to bg+/n * @ row(),col() say "Q" * set color to w+/n * @ row(),col() say ")" * set color to w/n * @ row(),col() say " to Quit" * set color to n+/n * @ row(),col() say " °° " * set color to w+/n * @ row(),col() say towhom * set color to n+/n * @ row(),col() say " °° " * set color to w/n * @ row(),col() say "Calling on line: " * set color to bg/n * @ row(),col() say line * set color to n+/n * @ row(),col() say " °°" set color to bg/n return *********************************** ** Program Routine To Verify Key ** *********************************** * Variables To Use For Accessing: * * KEY_CHK = (0) = Verified (1) = Demo Only! * (2) = Missing Key (3) = In-Valid Key * * PRG_CHK = Compare With PRG_NAME * SER_NO = Serial Number Of The Program .. * SYS_NAME = Name Of The SysOp The Program Is Registered To .. * BBS_NAME = Name Of The BBS The Program Is Registered To .. procedure key_verify key_chk = 1 if file("OLC.KEY") use OLC.KEY alias KEY if key->program = "Demo Key" key_chk = 1 else key_chk = 0 endif else if file("DEMO.KEY") key_chk = 1 use DEMO.KEY alias KEY else key_chk = 2 return endif endif ** Load Key Variables .. prg_name = ltrim(rtrim(key->program)) sys_name = ltrim(rtrim(key->sysop)) bbs_name = ltrim(rtrim(key->bbs)) ser_no = ltrim(rtrim(key->serial_no)) ** Verify Prg_Name count = 0 cnttmp = "" prgval = 0 hold_tmp = len(prg_name) do while count < len(prg_name) count = count + 1 cnttmp = right(ltrim(rtrim(str(count))),1) if cnttmp $ "13579" prgval = prgval + asc(substr(prg_name,count,1)) + count + 13 else prgval = prgval + asc(substr(prg_name,count,1)) + count + 17 endif enddo prgval = prgval + hold_tmp prgstr = ltrim(rtrim(str(prgval))) ** Process sys_name .. tmp1 = 0 tmp2 = 0 sysval = 0 cnttmp = "" systmp = "" sysstr = "" do while tmp1 < len(sys_name) tmp1 = tmp1 + 1 tmp2 = iif(tmp2 = len(prgstr),1,tmp2 + 1) systmp = right( space(3) + str(asc(substr(sys_name,tmp1,1)) +; val(substr(prgstr,tmp2,1))),3) cnttmp = right(ltrim(rtrim(str(tmp1))),1) if cnttmp $ "13579" sysstr = sysstr + chr(val(substr(systmp,1,1) + substr(systmp,3,1) +; substr(systmp,2,1)) + tmp1) sysval = sysval + val(substr(systmp,1,1) + substr(systmp,3,1) +; substr(systmp,2,1)) else sysstr = sysstr + chr(val(substr(systmp,1,1) + substr(systmp,2,1) +; substr(systmp,3,1)) + tmp1 - tmp2) sysval = sysval + val(substr(systmp,1,1) + substr(systmp,3,1) +; substr(systmp,2,1)) + (asc(substr(prg_name,tmp2,1)) * tmp2) endif enddo sysval = sysval * len(ltrim(rtrim(sys_name))) + prgval ** Process Bbs_Name .. tmp1 = 0 tmp2 = 0 bbsval = 0 cnttmp = "" bbstmp = "" bbsstr = "" do while tmp1 < len(bbs_name) tmp1 = tmp1 + 1 tmp2 = iif(tmp2 = len(prgstr),1,tmp2 + 1) bbstmp = right( space(3) + str(asc(substr(bbs_name,tmp1,1)) +; val(substr(prgstr,tmp2,1))),3) cnttmp = right(ltrim(rtrim(str(tmp1))),1) if cnttmp $ "13579" bbsstr = bbsstr + chr(val(substr(bbstmp,1,1) + substr(bbstmp,2,1) +; substr(bbstmp,3,1)) + tmp2) * bbsstr = bbsstr + chr(val(substr(bbstmp,1,1) + substr(bbstmp,3,1) +; * substr(bbstmp,2,1)) + tmp2) bbsval = bbsval + val(substr(bbstmp,1,1) + substr(bbstmp,3,1) +; substr(bbstmp,2,1)) else bbsstr = bbsstr + chr(val(substr(bbstmp,1,1) + substr(bbstmp,3,1) +; substr(bbstmp,2,1)) + tmp1) * bbsstr = bbsstr + chr(val(substr(bbstmp,1,1) + substr(bbstmp,2,1) +; * substr(bbstmp,3,1)) + tmp2) bbsval = bbsval + val(substr(bbstmp,1,1) + substr(bbstmp,3,1) +; substr(bbstmp,2,1)) + (asc(substr(prg_name,tmp2,1)) * tmp2) endif enddo * bbsval = bbsval * len(ltrim(rtrim(bbs_name))) + prgval bbsval = bbsval * len(ltrim(rtrim(bbs_name))) - prgval ** Process Ser_no .. tmp1 = 0 tmp2 = 0 snval = 0 cnttmp = "" sntmp = "" snstr = "" do while tmp1 < len(ser_no) tmp1 = tmp1 + 1 tmp2 = iif(tmp2 = len(prgstr),1,tmp2 + 1) sntmp = right(space(3) + str(asc(substr(ser_no,tmp1,1)) +; val(substr(prgstr,tmp2,1))),3) cnttmp = right(ltrim(rtrim(str(tmp1))),1) if cnttmp $ "13579" snstr = snstr + chr(val(substr(sntmp,1,1) + substr(sntmp,3,1) +; substr(sntmp,2,1))) else snstr = snstr + chr(val(substr(sntmp,1,1) + substr(sntmp,2,1) +; substr(sntmp,3,1)) - tmp2) endif snval = snval + val(substr(sntmp,1,1) + substr(sntmp,3,1) +; substr(sntmp,2,1)) enddo * snval = snval * len(ltrim(rtrim(ser_no))) + prgval snval = (snval * len(ltrim(rtrim(ser_no))) + prgval) - val(cnttmp) * chk_total = int(((sysval + bbsval + snval) * 3) - 2) chk_total = int((((sysval * 2) - bbsval + snval) * 3) - 2) ** Compare Results .. if snstr = rtrim(key->en_sn) .AND. snval = key->chk_sn .AND.; sysstr = rtrim(key->en_sys) .AND. sysval = key->chk_sys .AND.; bbsstr = rtrim(key->en_bbs) .AND. bbsval = key->chk_bbs .AND.; chk_total = key->last_chk if prg_chk = rtrim(key->program) key_chk = 0 else if .NOT. key_chk = 1 key_chk = 3 endif endif else key_chk = 3 endif use return