home *** CD-ROM | disk | FTP | other *** search
- ; -------------------------
- ; PAiN!-ALLTiME HiGH V1.0
- ; -------------------------
- ;
- ; (C) 1995 TYGER/PAiN!
- ;
- ; This was a request by JULiE
- ;
- ; I used some routines from PAiN!-EVER...
- ;
- ;
- ; Do not modify and redistribute...that'll be poooooor...
- ;
-
- string s,ts,tts,cm,ss
- string un(1),un2(1),ex(10),dp,lame,drd,dsr,tu(1),td(1)
- string u1,u2,u3,cuh,chl,cl1,cl2,cl3,cl4,zz,sv(12)
- integer j,i,o,mx,x,y,z,zm
- integer sun(1),stbd(1),stbu(1),zu
- dreal tbd(1),tbu(1)
- boolean t
-
- if (!(ansion())) then
- cls
- println "ANSi REQUiRED...SWiTCH 0N ANSi !"
- delay 20
- end
- endif
-
- goto st
-
- :trn
- let tts=""
- if (len(ts)=1) then let tts=" "+ts:return:endif
- if (len(ts)=2) then let tts=" "+ts:return:endif
- if (len(ts)=3) then let tts=" "+ts:return:endif
- if (len(ts)=4) then let tts=" "+left(ts,1)+dp+mid(ts,2,3):return:endif
- if (len(ts)=5) then let tts=" "+left(ts,2)+dp+mid(ts,3,3):return:endif
- if (len(ts)=6) then let tts=" "+left(ts,3)+dp+mid(ts,4,3):return:endif
- if (len(ts)=7) then let tts=" "+left(ts,1)+dp+mid(ts,2,3)+dp+mid(ts,5,3):return:endif
- if (len(ts)=8) then let tts=" "+left(ts,2)+dp+mid(ts,3,3)+dp+mid(ts,6,3):return:endif
- if (len(ts)=9) then let tts=" "+left(ts,3)+dp+mid(ts,4,3)+dp+mid(ts,7,3):return:endif
- if (len(ts)=10) then let tts=left(ts,1)+dp+mid(ts,2,3)+dp+mid(ts,5,3)+dp+mid(ts,8,3):return:endif
- return
-
- :sc
- inc zu
- if (zu>zm) then
- zu=0
- ansipos 64,22
- print u1+mid(zz,z,1)+u2+mid(zz,z+1,13)+u3+mid(zz,z+14,1)
- inc z
- if (z>len(zz)-15) let z=1
- endif
- return
-
- :doit
-
- cls
- println "@X8DMAKiNG iNDEX...PLEASE WAiT..."
- let o=0
- for i=2 to mx
- getaltuser i
- let un(i-1)=u_name()
- let tbu(i-1)=u_bul()
- let tbd(i-1)=u_bdl()
- next
- sort un,sun
- sort tbu,stbu
- sort tbd,stbd
- fopen 1,ppepath()+"p!-alltm.dat",o_wr,s_db
- for i=1 to 15
- fputln 1,un(stbu(mx-i+1))
- let ts=i2s(tbu(stbu(mx-i+1)),10)
- gosub trn
- fputln 1,tts
- next
- for i=1 to 15
- fputln 1,un(stbd(mx-i+1))
- let ts=i2s(tbd(stbd(mx-i+1)),10)
- gosub trn
- fputln 1,tts
- next
- fclose 1
- goto en
-
- :st
-
- let u1=left(readline(ppepath()+"p!-alltm.cfg",1),4)
- let u2=left(readline(ppepath()+"p!-alltm.cfg",2),4)
- let u3=left(readline(ppepath()+"p!-alltm.cfg",3),4)
- let cl1=left(readline(ppepath()+"p!-alltm.cfg",4),4)
- let cl2=left(readline(ppepath()+"p!-alltm.cfg",5),4)
- let cl3=left(readline(ppepath()+"p!-alltm.cfg",6),4)
- let cl4=left(readline(ppepath()+"p!-alltm.cfg",7),4)
- let cuh=left(readline(ppepath()+"p!-alltm.cfg",8),4)
- let chl=left(readline(ppepath()+"p!-alltm.cfg",9),4)
- let zm=s2i(left(readline(ppepath()+"p!-alltm.cfg",10),4),10)
- let mx=(fileinf(readline(pcbdat(),29),4))/400
- redim tbu,mx
- redim tbd,mx
- redim un,mx
- redim stbu,mx
- redim stbd,mx
- redim sun,mx
- redim un2,mx
- redim tu,mx
- redim td,mx
- let dp="∙"
- if (mx<15) then
- cls
- println "PAiN!-ALLTiME-HiGH D0ESN'T SUPP0RT A USERBASE WiTH LESS THAN 15 USERS !"
- delay 50
- end
- endif
-
- if (left(tokenstr(),1)="S") goto doit
-
- fopen 1,ppepath()+"p!-alltm.dat",o_rd,s_db
- if (ferr(1)) then
- cls
- sprintln "-> SYS0P : PAiN!-ALLTiME HiGH DATA FiLE D0ESN'T EXiSTS..."
- sprintln " FiRST START P!-ALLTM.PPE WiTH PARAMETER ""S"" !!"
- delay 100
- end
- endif
-
- for i=1 to 15
- fget 1,un(i)
- fget 1,tu(i)
- next
- for i=1 to 15
- fget 1,un2(i)
- fget 1,td(i)
- next
- fclose 1
- let z=1
- let zz=" "+readline(ppepath()+"p!-alltm.cfg",14)+" (C) TYGER/PAiN! "
- ansipos 1,1
- print "@POFF@"
- dispfile ppepath()+"p!-alltm.pcb",graph
- ansipos 3,22
- print "@X03( @X0B @X03/@X0B @X03/ @X0BCR @X03)"
- ansipos 8,5
- print u1+left(un(1),1)+u2+mid(un(1),2,len(un(1))-2)+u3+right(un(1),1)
- ansipos 26,5
- print cl1+left(tu(1),len(tu(1))-1)+right(tu(1),1)
- ansipos 47,5
- print u1+left(un2(1),1)+u2+mid(un2(1),2,len(un2(1))-2)+u3+right(un2(1),1)
- ansipos 65,5
- print cl2+left(td(1),len(td(1))-1)+right(td(1),1)
-
- for i=2 to 15
- ansipos 8,5+i
- print u1+left(un(i),1)+u2+mid(un(i),2,len(un(i))-2)+u3+right(un(i),1)
- ansipos 26,5+i
- print cl3+left(tu(i),len(tu(i))-1)+right(tu(i),1)
- ansipos 47,5+i
- print u1+left(un2(i),1)+u2+mid(un2(i),2,len(un2(i))-2)+u3+right(un2(i),1)
- ansipos 65,5+i
- print cl4+left(td(i),len(td(i))-1)+right(td(i),1)
- next
- let x=1
- let y=1
- :lo1
- ansipos 20,22
- if (!t) print "@X7F▌@X70■∙@X7FEXiT@X70∙■@X78▐@X07 ViEW USER "
- if (t) print "@X07 EXiT @X7F▌@X70■∙@X7FViEW USER@X70∙■@X78▐@X01 "
- :lo2
- gosub sc
- ansipos 1,2
- let s=inkey()
- if (s="") goto lo2
- if (s=chr(13)) goto lo4
- if (s=chr(27)) goto en
- if ((s="LEFT")|(s="UP")|(s="RIGHT")|(S="DOWN")) then
- t=!t
- goto lo1
- endif
- :lo4
- if (!t) goto en
- ansipos 3,22
- print " "
- ansipos 22,22
- print "@X03( @X0B @X03/@X0B @X03/ @X0B @X03/@X0B @X03/ @X0BCR @X03/ @X0BESC@X0B ) "
- let x=1
- let y=1
- :lo5
- if (x=1) then
- if (y=1) then ansipos 8,5
- else
- ansipos 8,5+y
- endif
- print "@X9F"+un(y)
- endif
- if (x=2) then
- if (y=1) then ansipos 47,5
- else
- ansipos 47,5+y
- endif
- print "@X9F"+un2(y)
- endif
- :lo6
- gosub sc
- let s=inkey()
- if (s="") goto lo6
- if (x=1) then
- if (y=1) then ansipos 8,5
- else
- ansipos 8,5+y
- endif
- print u1+left(un(y),1)+u2+mid(un(y),2,len(un(y))-2)+u3+right(un(y),1)
- endif
- if (x=2) then
- if (y=1) then ansipos 47,5
- else
- ansipos 47,5+y
- endif
- print u1+left(un2(y),1)+u2+mid(un2(y),2,len(un2(y))-2)+u3+right(un2(y),1)
- endif
- ansipos 1,2
- if (s="UP") then
- dec y
- if (y<1) let y=15
- endif
- if (S="DOWN") then
- inc y
- if (y>15) let y=1
- endif
- if (s="LEFT") then
- x=1
- endif
- if (s="RIGHT") then
- x=2
- endif
- if (s=chr(13)) goto lo7
- if (s=chr(27)) then
- ansipos 20,22
- print "@X01 "
- ansipos 3,22
- print "@X03( @X0B @X03/@X0B @X03/ @X0BCR @X03)"
- goto lo1
- endif
- goto lo5
- :lo7
- for i=1 to 12
- sv(i)=scrtext(15,6+i,38,true)
- next
- ansipos 15,7
- print "@X07▐@X78════════════════════════════════════ "
- ansipos 15,8
- print "@X78▌ @X70NAME : "
- ansipos 15,9
- print "@X78▌ @X70CiTY : "
- ansipos 15,10
- print "@X78▌ @X70LEVEL : "
- ansipos 15,11
- print "@X78▌ @X70CALLS : "
- ansipos 15,12
- print "@X78▌ @X70DL's : "
- ansipos 15,13
- print "@X78▌ @X70UL's : "
- ansipos 15,14
- print "@X78▌-─────────────────────────────────-- "
- ansipos 15,15
- print "@X78▌ @X70FiRST 0N : @X78░"
- ansipos 15,16
- print "@X78▌ @X70LAST 0N : @X78░▒"
- ansipos 15,17
- print "@X78▌═════════════════════════════════ ░▒▓"
- ansipos 15,18
- print "@X08▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀@X01"
- if (x=1) getaltuser u_recnum(un(y))
- if (x=2) getaltuser u_recnum(un2(y))
- ansipos 25,8
- print "@X7F"+u_name()
- ansipos 25,9
- print u_city()
- ansipos 25,10
- print u_sec()
- ansipos 25,11
- print u_logons()
- ansipos 25,12
- print u_fdl()
- ansipos 25,13
- print u_ful()
- ansipos 28,15
- print u_stat(1)
- ansipos 28,16
- let s=u_ldate()
- print s+" ("
- let s=u_ltime()
- print s+")"
- :lo10
- gosub sc
- let s=inkey()
- if (s<>chr(13)) goto lo10
- for i=1 to 12
- ansipos 15,6+i
- print sv(i)
- next
- goto lo5
-
- :en
- print "@X01"
- cls
- end
-