home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Carsten's PPE Collection
/
Carstens_PPE_Collection_2007.zip
/
S
/
SSI!ALLT.ZIP
/
P!-ALLTM.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1995-10-16
|
9KB
|
469 lines
;------------------------------------------------------------------------------
; .ss.
; `²²'
; .,sS$Ss,,s$ .,sS$$$Ss. .,sS$Ss,,s$ .ss. .sSs.
; .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
; $$$' .$$$' $$$²Sçsµ²' .$$$' .$$$'.$$$' .$$$' `$$b.
; $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$' ;$$$
; `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
; .sS²°$$$²²°"' d²°'
; .$$² .$$'
; $$$.,d$$'
; `²S$$S²'
;------------------------------------------------------------------------------
; P.P.L.X. 2.OO (C)1996 - Lone Runner / AEGiS CoRP'96
;------------------------------------------------------------------------------
; PPE 3.O1 (Encryption type I) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Boolean BOOLEAN001
Integer INTEGER001
Integer INTEGER002
Integer INTEGER003
Integer INTEGER004
Integer INTEGER005
Integer INTEGER006
Integer INTEGER007
Integer TINTEGER008(1)
Integer TINTEGER009(1)
Integer TINTEGER010(1)
Integer INTEGER011
String STRING001
String STRING002
String STRING003
String TSTRING004(1)
String TSTRING005(1)
String STRING006
String TSTRING007(1)
String TSTRING008(1)
String STRING009
String STRING010
String STRING011
String STRING012
String STRING013
String STRING014
String STRING015
String STRING016
String STRING017
String STRING018
String TSTRING019(12)
Double TDOUBLE001(1)
Double TDOUBLE002(1)
;------------------------------------------------------------------------------
If (AnsiOn()) Goto LABEL001
Cls
PrintLn "ANSi REQUiRED...SWiTCH 0N ANSi !"
Delay 20
End
:LABEL001
Goto LABEL005
:LABEL002
STRING003 = ""
If (Len(STRING002) == 1) Then
STRING003 = " " + STRING002
Return
Endif
If (Len(STRING002) == 2) Then
STRING003 = " " + STRING002
Return
Endif
If (Len(STRING002) == 3) Then
STRING003 = " " + STRING002
Return
Endif
If (Len(STRING002) == 4) Then
STRING003 = " " + Left(STRING002, 1) + STRING006 + Mid(STRING002, 2, 3)
Return
Endif
If (Len(STRING002) == 5) Then
STRING003 = " " + Left(STRING002, 2) + STRING006 + Mid(STRING002, 3, 3)
Return
Endif
If (Len(STRING002) == 6) Then
STRING003 = " " + Left(STRING002, 3) + STRING006 + Mid(STRING002, 4, 3)
Return
Endif
If (Len(STRING002) == 7) Then
STRING003 = " " + Left(STRING002, 1) + STRING006 + Mid(STRING002, 2, 3) + STRING006 + Mid(STRING002, 5, 3)
Return
Endif
If (Len(STRING002) == 8) Then
STRING003 = " " + Left(STRING002, 2) + STRING006 + Mid(STRING002, 3, 3) + STRING006 + Mid(STRING002, 6, 3)
Return
Endif
If (Len(STRING002) == 9) Then
STRING003 = " " + Left(STRING002, 3) + STRING006 + Mid(STRING002, 4, 3) + STRING006 + Mid(STRING002, 7, 3)
Return
Endif
If (Len(STRING002) == 10) Then
STRING003 = Left(STRING002, 1) + STRING006 + Mid(STRING002, 2, 3) + STRING006 + Mid(STRING002, 5, 3) + STRING006 + Mid(STRING002, 8, 3)
Return
Endif
Return
:LABEL003
Inc INTEGER011
If (INTEGER011 > INTEGER007) Then
INTEGER011 = 0
AnsiPos 64, 22
Print STRING009 + Mid(STRING018, INTEGER006, 1) + STRING010 + Mid(STRING018, INTEGER006 + 1, 13) + STRING011 + Mid(STRING018, INTEGER006 + 14, 1)
Inc INTEGER006
If (INTEGER006 > Len(STRING018) - 15) INTEGER006 = 1
Endif
Return
:LABEL004
Cls
PrintLn "@X8DMAKiNG iNDEX...PLEASE WAiT..."
INTEGER002 = 0
For INTEGER001 = 2 To INTEGER003
GetAltUser INTEGER001
TSTRING004(INTEGER001 - 1) = U_Name()
TDOUBLE002(INTEGER001 - 1) = U_Bul()
TDOUBLE001(INTEGER001 - 1) = U_Bdl()
Next
Sort TSTRING004, TINTEGER008
Sort TDOUBLE002, TINTEGER010
Sort TDOUBLE001, TINTEGER009
FOpen 1, PPEPath() + "p!-alltm.dat", 1, 3
For INTEGER001 = 1 To 15
FPutLn 1, TSTRING004(TINTEGER010(INTEGER003 - INTEGER001 + 1))
STRING002 = I2S(TDOUBLE002(TINTEGER010(INTEGER003 - INTEGER001 + 1)), 10)
Gosub LABEL002
FPutLn 1, STRING003
Next
For INTEGER001 = 1 To 15
FPutLn 1, TSTRING004(TINTEGER009(INTEGER003 - INTEGER001 + 1))
STRING002 = I2S(TDOUBLE001(TINTEGER009(INTEGER003 - INTEGER001 + 1)), 10)
Gosub LABEL002
FPutLn 1, STRING003
Next
FClose 1
Goto LABEL017
:LABEL005
STRING009 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 1), 4)
STRING010 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 2), 4)
STRING011 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 3), 4)
STRING014 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 4), 4)
STRING015 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 5), 4)
STRING016 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 6), 4)
STRING017 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 7), 4)
STRING012 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 8), 4)
STRING013 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 9), 4)
INTEGER007 = S2I(Left(ReadLine(PPEPath() + "p!-alltm.cfg", 10), 4), 10)
INTEGER003 = FileInf(ReadLine(PCBDat(), 29), 4) / 400
Redim TDOUBLE002, INTEGER003
Redim TDOUBLE001, INTEGER003
Redim TSTRING004, INTEGER003
Redim TINTEGER010, INTEGER003
Redim TINTEGER009, INTEGER003
Redim TINTEGER008, INTEGER003
Redim TSTRING005, INTEGER003
Redim TSTRING007, INTEGER003
Redim TSTRING008, INTEGER003
STRING006 = "∙"
If (INTEGER003 < 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 LABEL004
FOpen 1, PPEPath() + "p!-alltm.dat", 0, 3
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 INTEGER001 = 1 To 15
FGet 1, TSTRING004(INTEGER001)
FGet 1, TSTRING007(INTEGER001)
Next
For INTEGER001 = 1 To 15
FGet 1, TSTRING005(INTEGER001)
FGet 1, TSTRING008(INTEGER001)
Next
FClose 1
INTEGER006 = 1
STRING018 = " " + ReadLine(PPEPath() + "p!-alltm.cfg", 14) + " (C) TYGER/PAiN! "
AnsiPos 1, 1
Print "@POFF@"
DispFile PPEPath() + "p!-alltm.pcb", 1
AnsiPos 3, 22
Print "@X03( @X0B @X03/@X0B @X03/ @X0BCR @X03)"
AnsiPos 8, 5
Print STRING009 + Left(TSTRING004(1), 1) + STRING010 + Mid(TSTRING004(1), 2, Len(TSTRING004(1)) - 2) + STRING011 + Right(TSTRING004(1), 1)
AnsiPos 26, 5
Print STRING014 + Left(TSTRING007(1), Len(TSTRING007(1)) - 1) + Right(TSTRING007(1), 1)
AnsiPos 47, 5
Print STRING009 + Left(TSTRING005(1), 1) + STRING010 + Mid(TSTRING005(1), 2, Len(TSTRING005(1)) - 2) + STRING011 + Right(TSTRING005(1), 1)
AnsiPos 65, 5
Print STRING015 + Left(TSTRING008(1), Len(TSTRING008(1)) - 1) + Right(TSTRING008(1), 1)
For INTEGER001 = 2 To 15
AnsiPos 8, 5 + INTEGER001
Print STRING009 + Left(TSTRING004(INTEGER001), 1) + STRING010 + Mid(TSTRING004(INTEGER001), 2, Len(TSTRING004(INTEGER001)) - 2) + STRING011 + Right(TSTRING004(INTEGER001), 1)
AnsiPos 26, 5 + INTEGER001
Print STRING016 + Left(TSTRING007(INTEGER001), Len(TSTRING007(INTEGER001)) - 1) + Right(TSTRING007(INTEGER001), 1)
AnsiPos 47, 5 + INTEGER001
Print STRING009 + Left(TSTRING005(INTEGER001), 1) + STRING010 + Mid(TSTRING005(INTEGER001), 2, Len(TSTRING005(INTEGER001)) - 2) + STRING011 + Right(TSTRING005(INTEGER001), 1)
AnsiPos 65, 5 + INTEGER001
Print STRING017 + Left(TSTRING008(INTEGER001), Len(TSTRING008(INTEGER001)) - 1) + Right(TSTRING008(INTEGER001), 1)
Next
INTEGER004 = 1
INTEGER005 = 1
:LABEL006
AnsiPos 20, 22
If (!BOOLEAN001) Print "@X7F▌@X70■∙@X7FEXiT@X70∙■@X78▐@X07 ViEW USER "
If (BOOLEAN001) Print "@X07 EXiT @X7F▌@X70■∙@X7FViEW USER@X70∙■@X78▐@X01 "
:LABEL007
Gosub LABEL003
AnsiPos 1, 2
STRING001 = Inkey()
If (STRING001 == "") Goto LABEL007
If (STRING001 == Chr(13)) Goto LABEL008
If (STRING001 == Chr(27)) Goto LABEL017
If ((((STRING001 == "LEFT") || (STRING001 == "UP")) || (STRING001 == "RIGHT")) || (STRING001 == "DOWN")) Then
BOOLEAN001 = !BOOLEAN001
Goto LABEL006
Endif
:LABEL008
If (BOOLEAN001) Then
AnsiPos 3, 22
Print " "
AnsiPos 22, 22
Print "@X03( @X0B @X03/@X0B @X03/ @X0B @X03/@X0B @X03/ @X0BCR @X03/ @X0BESC@X0B ) "
INTEGER004 = 1
INTEGER005 = 1
:LABEL009
If (INTEGER004 == 1) Then
If (INTEGER005 == 1) Then
AnsiPos 8, 5
Goto LABEL010
Endif
AnsiPos 8, 5 + INTEGER005
:LABEL010
Print "@X9F" + TSTRING004(INTEGER005)
Endif
If (INTEGER004 == 2) Then
If (INTEGER005 == 1) Then
AnsiPos 47, 5
Goto LABEL011
Endif
AnsiPos 47, 5 + INTEGER005
:LABEL011
Print "@X9F" + TSTRING005(INTEGER005)
Endif
:LABEL012
Gosub LABEL003
STRING001 = Inkey()
If (STRING001 == "") Goto LABEL012
If (INTEGER004 == 1) Then
If (INTEGER005 == 1) Then
AnsiPos 8, 5
Goto LABEL013
Endif
AnsiPos 8, 5 + INTEGER005
:LABEL013
Print STRING009 + Left(TSTRING004(INTEGER005), 1) + STRING010 + Mid(TSTRING004(INTEGER005), 2, Len(TSTRING004(INTEGER005)) - 2) + STRING011 + Right(TSTRING004(INTEGER005), 1)
Endif
If (INTEGER004 == 2) Then
If (INTEGER005 == 1) Then
AnsiPos 47, 5
Goto LABEL014
Endif
AnsiPos 47, 5 + INTEGER005
:LABEL014
Print STRING009 + Left(TSTRING005(INTEGER005), 1) + STRING010 + Mid(TSTRING005(INTEGER005), 2, Len(TSTRING005(INTEGER005)) - 2) + STRING011 + Right(TSTRING005(INTEGER005), 1)
Endif
AnsiPos 1, 2
If (STRING001 == "UP") Then
Dec INTEGER005
If (INTEGER005 < 1) INTEGER005 = 15
Endif
If (STRING001 == "DOWN") Then
Inc INTEGER005
If (INTEGER005 > 15) INTEGER005 = 1
Endif
If (STRING001 == "LEFT") Then
INTEGER004 = 1
Endif
If (STRING001 == "RIGHT") Then
INTEGER004 = 2
Endif
If (STRING001 == Chr(13)) Goto LABEL015
If (STRING001 == Chr(27)) Then
AnsiPos 20, 22
Print "@X01 "
AnsiPos 3, 22
Print "@X03( @X0B @X03/@X0B @X03/ @X0BCR @X03)"
Goto LABEL006
Endif
Goto LABEL009
:LABEL015
For INTEGER001 = 1 To 12
TSTRING019(INTEGER001) = ScrText(15, 6 + INTEGER001, 38, 1)
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 (INTEGER004 == 1) GetAltUser U_RecNum(TSTRING004(INTEGER005))
If (INTEGER004 == 2) GetAltUser U_RecNum(TSTRING005(INTEGER005))
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
STRING001 = U_LDate()
Print STRING001 + " ("
STRING001 = U_LTime()
Print STRING001 + ")"
:LABEL016
Gosub LABEL003
STRING001 = Inkey()
If (STRING001 <> Chr(13)) Goto LABEL016
For INTEGER001 = 1 To 12
AnsiPos 15, 6 + INTEGER001
Print TSTRING019(INTEGER001)
Next
Goto LABEL009
Endif
:LABEL017
Print "@X01"
Cls
End
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 4 End
; 5 Cls
; 62 Goto
; 64 Let
; 44 Print
; 3 PrintLn
; 51 If
; 1 DispFile
; 2 FOpen
; 2 FClose
; 4 FGet
; 4 FPutLn
; 5 Gosub
; 12 Return
; 3 Delay
; 3 Inc
; 1 Dec
; 47 AnsiPos
; 2 SPrintLn
; 9 Redim
; 3 GetAltUser
; 3 Sort
;
;
; ■ Functions used :
;
; 1 /
; 121 +
; 18 -
; 35 ==
; 1 <>
; 10 <
; 8 <=
; 3 >
; 16 >=
; 39 !
; 16 &&
; 11 ||
; 21 Len(
; 21 Mid()
; 28 Left()
; 10 Right()
; 1 Ferr()
; 5 Chr()
; 2 U_Name()
; 1 U_LDate()
; 1 U_LTime()
; 1 U_Logons()
; 1 U_Ful()
; 1 U_Fdl()
; 1 U_Bdl()
; 1 U_Bul()
; 3 Inkey()
; 1 PCBDat()
; 14 PPEPath()
; 12 ReadLine()
; 2 I2S()
; 1 S2I()
; 1 TokenStr()
; 1 AnsiOn()
; 1 U_Stat()
; 1 FileInf()
; 2 U_RecNum()
; 1 ScrText()
;
;------------------------------------------------------------------------------
;
; Analysis flags : Rd
;
; R - Read user ■ 5
; User records are read, this may signify that someone wants to get
; various informations about a user (for example his password), but
; this may also be normal for a program accessing user records (for
; example a User Editor)
; ■ Search for : GETALTUSER
;
; d - Access PCBOARD.DAT ■ 2
; Program gets the full pathname to PCBOARD.DAT, this may be usefull
; for many PPE so they can find various informations on the system
; (system paths, max number of lines in messages, ...) but it may also
; be a way to gather vital informations.
; ■ Search for : PCBDAT()
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 8 For/Next
; 0 While/EndWhile
; 28 If/Then or If/Then/Else
; 0 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------