home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Carsten's PPE Collection
/
Carstens_PPE_Collection_2007.zip
/
T
/
THTMT221.ZIP
/
THT-INFO.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1994-01-20
|
14KB
|
580 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 2.OO (plain) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Boolean BOOLEAN001
Date DATE001
Integer INTEGER002
Integer INTEGER003
Integer INTEGER004
Integer INTEGER005
Integer INTEGER006
Integer INTEGER007
Integer INTEGER008
Integer INTEGER009
Integer INTEGER010
String STRING001
String STRING002
String STRING003
String STRING004
String STRING005
String STRING006
String STRING007
String STRING008
String STRING009
String STRING010
String STRING011
String STRING012
String STRING013
String STRING014
String STRING015
String STRING016
String STRING017
String STRING018
String STRING019
String STRING020
String STRING021
String STRING022
String STRING023
String STRING024
String STRING025
String STRING026
String STRING027
String STRING028
String STRING029
String STRING030
String STRING031
String STRING032
String STRING033
String STRING034
String STRING035
String STRING036
String STRING037
String STRING038
;------------------------------------------------------------------------------
STRING031 = Chr(48) + Chr(49) + "-" + Chr(50) + Chr(48) + "-" + Chr(57) + Chr(52)
STRING032 = Chr(50) + Chr(46) + Chr(48) + Chr(56)
STRING025 = Chr(64) + Chr(88) + Chr(48) + Chr(69) + Chr(84) + Chr(72) + Chr(84) + Chr(45) + Chr(73) + Chr(110) + Chr(102) + Chr(111) + Chr(70) + Chr(111) + Chr(114) + Chr(109) + " " + Chr(64) + Chr(88) + Chr(48) + Chr(57) + STRING032 + " " + Chr(64) + Chr(88) + Chr(48) + Chr(69) + Chr(67) + Chr(111) + Chr(109) + Chr(112) + Chr(105) + Chr(108) + Chr(101) + Chr(100) + " " + Chr(111) + Chr(110) + " " + Chr(64) + Chr(88) + Chr(48) + Chr(67) + STRING031 + Chr(64) + Chr(88) + Chr(48) + Chr(55)
STRING036 = Chr(64) + Chr(88) + Chr(56) + Chr(67) + Chr(60) + Chr(60) + Chr(60) + Chr(64) + Chr(88) + Chr(56) + Chr(67) + Chr(85) + Chr(110) + Chr(82) + Chr(101) + Chr(103) + Chr(105) + Chr(115) + Chr(116) + Chr(101) + Chr(114) + Chr(101) + Chr(100) + Chr(64) + Chr(88) + Chr(56) + Chr(67) + Chr(62) + Chr(62) + Chr(62)
DATE001 = Chr(48) + Chr(50) + "-" + Chr(50) + Chr(48) + "-" + Chr(57) + Chr(52)
STRING033 = ReadLine(PCBDat(), 2)
STRING034 = ReadLine(PCBDat(), 94)
For STRING037 = 0 To 64
STRING033 = Strip(STRING033, Chr(STRING037))
STRING034 = Strip(STRING034, Chr(STRING037))
Next
For STRING037 = 91 To 96
STRING033 = Strip(STRING033, Chr(STRING037))
STRING034 = Strip(STRING034, Chr(STRING037))
Next
For STRING037 = 123 To 255
STRING033 = Strip(STRING033, Chr(STRING037))
STRING034 = Strip(STRING034, Chr(STRING037))
Next
INTEGER009 = Len(STRING033)
If (INTEGER009 < 2) STRING033 = "if"
STRING033 = Right(STRING033, 2)
INTEGER010 = Len(STRING034)
If (INTEGER010 < 2) STRING034 = "if"
STRING034 = Right(STRING034, 2)
STRING035 = STRING033 + STRING034 + "FO"
STRING024 = Carrier()
STRING007 = Time()
STRING006 = Date()
FDefIn 1
FDefOut 4
If (STRING025 <> Chr(64) + Chr(88) + Chr(48) + Chr(69) + Chr(84) + Chr(72) + Chr(84) + Chr(45) + Chr(73) + Chr(110) + Chr(102) + Chr(111) + Chr(70) + Chr(111) + Chr(114) + Chr(109) + " " + Chr(64) + Chr(88) + Chr(48) + Chr(57) + STRING032 + " " + Chr(64) + Chr(88) + Chr(48) + Chr(69) + Chr(67) + Chr(111) + Chr(109) + Chr(112) + Chr(105) + Chr(108) + Chr(101) + Chr(100) + " " + Chr(111) + Chr(110) + " " + Chr(64) + Chr(88) + Chr(48) + Chr(67) + +STRING031 + Chr(64) + Chr(88) + Chr(48) + Chr(55)) Then
PrintLn "@X0FHacked Copy Do not Hexedit this File"
Delete PPEPath() + PPEName() + Chr(46) + Chr(112) + Chr(112) + Chr(101)
Else
GetUser
FClose 1
FOpen 1, PPEPath() + PPEName() + ".LVL", 0, 0
FDGet STRING023
FDGet STRING026
FDGet INTEGER006
FDGet STRING016
FDGet STRING038
FClose 1
FClose 1
StartDisp 1
DispFile PPEPath() + "dsclm.pcb", 0
STRING022 = YesChar()
InputYN " Do You Agree To This@X0F ???", STRING022, 9
If (STRING022 == "N") Then
U_Sec = 0
DelUser
PutUser
Hangup
Goto LABEL001
Endif
:LABEL001
Cls
StartDisp 1
RestScrn
STRING011 = 10
STRING012 = 1
AnsiPos 18, 1
PrintLn STRING025
AnsiPos 23, 2
PrintLn "@X0F┌──────────────────────────────┐@X07"
AnsiPos 23, 3
PrintLn "@X07│@X1F ∙ New User InfoForms ∙ @X07│@X07"
AnsiPos 23, 4
PrintLn "@X08└──────────────────────────────┘@X07"
AnsiPos 2, 5
PrintLn "@X0EUse Cursor Keys to move the @X74HighLighted Bar@X0E or @X0C""@X09A@X0C""@X0F,@X0C ""@X09Z@X0C""@X0E or @X0FSpaceBar@X0
AnsiPos 2, 6
PrintLn "@X0F▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄@X07▄@X07"
AnsiPos 2, 7
PrintLn "@X0F█@X71 @X08█@X07"
AnsiPos 2, 8
PrintLn "@X0F█@X71 No. InfoForm Title Status Req'd @X08█ @X0F▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄@X07▄@X07"
AnsiPos 2, 9
PrintLn "@X0F█@X71─────────────────────────────────────────────────@X08█ @X0F█@X71 @X08█@X07"
FOpen 1, PPEPath() + PPEName() + ".cfg", 0, 0
FDGet INTEGER007
For STRING008 = 1 To INTEGER007
Delete STRING008 + ".lck"
Next
For STRING008 = 1 To INTEGER007
Delete STRING008 + ".YES"
Next
For INTEGER005 = 1 To INTEGER007
AnsiPos 2, STRING011
PrintLn "@X0F█@X71 @X08█ @X0F█@X71 @X08█@X07"
FOpen 2, PPEPath() + "infocfg." + STRING012, 0, 0
FGet 2, STRING010
FDGet STRING003
Gosub LABEL007
If (!Exist(STRING012 + ".lck") && (STRING010 == "YES")) FCreate 3, STRING012 + "." + STRING010, 1, 0
FClose 3
If (Exist(STRING012 + ".lck")) Then
AnsiPos 3, STRING011
PrintLn "@X79(@X7E" + STRING012 + "@X79)@X78 " + STRING003 + "@POS:32@@X74Completed@X71" + "@POS:46@" + STRING010
AnsiPos 3 + 53, STRING011
PrintLn "@X71" + STRING038 + STRING012
Else
AnsiPos 3, STRING011
PrintLn "@X79(@X7E" + STRING012 + "@X79)@X78 " + STRING003 + "@POS:32@@X71InCompleted@X74" + "@POS:46@" + STRING010
AnsiPos 3 + 53, STRING011
PrintLn "@X71" + STRING038 + STRING012
Endif
Inc STRING011
Inc STRING012
FClose 2
Next
FClose 1
AnsiPos 2, STRING011
PrintLn "@X0F█@X71 @X08█ @X0F█@X71Quit Infoform Booth @X08█@X07"
Inc STRING011
AnsiPos 2, STRING011
PrintLn "@X0F█@X71 @X08█ @X07▀@X08▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀@X07"
Inc STRING011
AnsiPos 2, STRING011
PrintLn "@X07▀@X08▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀@X07"
If (STRING026 == S2I(STRING035, 34)) Goto LABEL002
If (STRING036 <> Chr(64) + Chr(88) + Chr(56) + Chr(67) + Chr(60) + Chr(60) + Chr(60) + Chr(64) + Chr(88) + Chr(56) + Chr(67) + Chr(85) + Chr(110) + Chr(82) + Chr(101) + Chr(103) + Chr(105) + Chr(115) + Chr(116) + Chr(101) + Chr(114) + Chr(101) + Chr(100) + Chr(64) + Chr(88) + Chr(56) + Chr(67) + Chr(62) + Chr(62) + Chr(62)) Then
AnsiPos 10, 19
STRING017 = "@X8C" + Chr(72) + Chr(97) + Chr(99) + Chr(107) + Chr(101) + Chr(100) + "!!!! Copy oF InFoForM"
Delete PPEPath() + PPEName() + Chr(46) + Chr(112) + Chr(112) + Chr(101)
Print STRING017
AnsiPos 10, 20
Print "@X0FPlease Get a Real Copy from <<THT>> @ 314-355-5472"
Goto LABEL020
Else
If (Date() >= DATE001) Then
AnsiPos 20, 7
PrintLn "@X8FThis PPE has Expired!!!!"
Goto LABEL020
Endif
AnsiPos 20, 7
Print STRING036
AnsiPos 58, 9
Print STRING036
Endif
:LABEL002
Inc STRING011
Inc STRING011
Inc STRING011
STRING009 = ""
RestScrn
AnsiPos 2, STRING011 - 2
STRING014 = GetY()
STRING015 = STRING014 - 3
KbdStuff Chr(32)
:LABEL003
If (BOOLEAN001) Goto LABEL005
STRING013 = Inkey()
If (STRING013 == Chr(13)) Then
STRING004 = Left(ScrText(58, STRING015 + 1, 22, 0), 1)
STRING004 = STRING004 + RTrim(ScrText(58, STRING015 + 1, 22, 0), " ")
STRING004 = STRING004 + Right(STRING004, 1)
STRING004 = Right(STRING004, 1)
Else
If ((STRING013 == "Q") || (STRING013 == "q")) Goto LABEL020
If (((((((((STRING013 == Chr(32)) || (STRING013 == "UP")) || (STRING013 == "DOWN")) || (STRING013 == "LEFT")) || (STRING013 == "RIGHT")) || (STRING013 == "z")) || (STRING013 == "Z")) || (STRING013 == "a")) || (STRING013 == "A")) Then
AnsiPos 55, STRING015
If (STRING015 == STRING014 - 3) Then
Print STRING009
Goto LABEL004
Endif
AnsiPos 55, STRING015 + 1
Print STRING009
:LABEL004
AnsiPos 55, STRING015
If (STRING015 == 9) STRING015 = STRING015 + INTEGER007 + 1
AnsiPos 55, STRING015
STRING009 = ScrText(55, STRING015, 25, 1) + "@X08"
Color 78
AnsiPos 55, STRING015
Print ScrText(55, STRING015, 25, 0) + "@X08"
Dec STRING015
Endif
Goto LABEL003
Endif
:LABEL005
If (Exist(STRING004 + ".lck")) Then
Inc STRING011
AnsiPos 15, 21
PrintLn "@X0EYou have Already Filled Out that One@X07"
Dec STRING011
Wait
Goto LABEL001
ElseIf ((STRING004 <= INTEGER007) && (STRING004 <> "h")) Then
FCreate 1, STRING004 + ".lck", 1, 0
FClose 1
Goto LABEL009
ElseIf (!Exist("*.YES") && (STRING004 == "h")) Then
Goto LABEL013
Else
Goto LABEL006
Endif
FClose 1
:LABEL006
Inc STRING011
AnsiPos 15, STRING011
For STRING008 = 1 To INTEGER007
FreshLine
If (Exist(STRING008 + ".YES")) PrintLn "@X0EInfoForm @X8C" + STRING008 + "@X0E is Required!!!"
Next
Wait
AnsiPos 15, STRING011
For STRING008 = 1 To INTEGER007
FreshLine
If (Exist(STRING008 + ".YES")) PrintLn " "
Next
Dec STRING011
Goto LABEL001
End
:LABEL007
Tokenize U_Name()
If (TokCount() == 3) Then
GetToken STRING027
GetToken STRING028
GetToken STRING029
STRING027 = Strip(STRING027, " ")
STRING028 = Strip(STRING028, " ")
STRING027 = Strip(STRING027, ".")
STRING028 = Strip(STRING028, ".")
STRING027 = Left(STRING027, 3)
STRING028 = Right(STRING029, 4)
If (Exist(PPEPath() + "APPS\" + STRING027 + "_" + STRING028 + "." + STRING012)) Then
FCreate 5, STRING012 + ".lck", 1, 0
FClose 5
Endif
ElseIf (TokCount() <= 2) Then
GetToken STRING027
GetToken STRING028
STRING027 = Strip(STRING027, " ")
STRING028 = Strip(STRING028, " ")
STRING027 = Strip(STRING027, ".")
STRING028 = Strip(STRING028, ".")
STRING027 = Left(STRING027, 3)
STRING028 = Right(STRING028, 4)
If (Exist(PPEPath() + "APPS\" + STRING027 + "_" + STRING028 + "." + STRING012)) Then
FCreate 5, STRING012 + ".lck", 1, 0
FClose 5
If (Exist(PPEPath() + "APPS\" + STRING027 + "_" + STRING028 + ".grp")) Goto LABEL008
FCreate 5, PPEPath() + "APPS\" + STRING027 + "_" + STRING028 + ".GRP", 1, 0
FPutLn 5, U_City
FClose 5
Endif
Endif
:LABEL008
Return
:LABEL009
FClose 2
Newline
StartDisp 1
FCreate 5, PPEPath() + "APPS\" + STRING027 + "_" + STRING028 + "." + "vot", 1, 0
FClose 5
DispFile PPEPath() + PPEName() + "." + STRING004, 0
FAppend 3, PPEPath() + "APPS\" + STRING027 + "_" + STRING028 + "." + STRING004, 1, 0
FAppend 4, PPEPath() + "APPS\answers." + STRING004, 1, 0
FOpen 2, PPEPath() + "infocfg." + STRING004, 0, 0
FGet 2, STRING010
FGet 2, STRING002
FreshLine
FPutLn 3, "─────────────────────────────────────────"
FPutLn 4, "─────────────────────────────────────────"
FPutLn 3, " InfoForm PPE " + STRING006 + " " + STRING007
FPutLn 4, " InfoForm PPE " + STRING006 + " " + STRING007
FPutLn 3, " "
FPutLn 4, " "
FPutLn 3, "User: " + U_Name() + " " + "City " + U_City
FPutLn 4, "User: " + U_Name() + " " + "City " + U_City
FPutLn 3, "Connected @ " + STRING024 + " To Node " + String(PcbNode())
FPutLn 4, "Connected @ " + STRING024 + " To Node " + String(PcbNode())
FPutLn 3, "─────────────────────────────────────────"
FPutLn 4, "─────────────────────────────────────────"
For INTEGER005 = 1 To STRING002
FGet 2, STRING001
Tokenize STRING001
GetToken INTEGER002
GetToken INTEGER003
GetToken INTEGER004
AnsiPos INTEGER002, INTEGER003
:LABEL010
STRING005 = ""
InputStr "_", STRING005, 14, INTEGER004, Mask_Ascii(), 0
If (STRING005 == "") Goto LABEL010
FPutLn 3, STRING005
FPutLn 4, STRING005
Next
FClose 4
FClose 3
FClose 2
STRING011 = 1
For INTEGER005 = 1 To INTEGER007
FOpen 2, PPEPath() + "infocfg." + STRING011, 0, 0
FGet 2, STRING010
If (Exist(STRING011 + "." + STRING010) && Exist(STRING011 + ".lck")) Delete STRING011 + "." + STRING010
Inc STRING011
FClose 2
Next
FClose 1
If (!Exist(PPEPath() + "APPS\WAITING.app")) FCreate 1, PPEPath() + "APPS\WAITING.app", 1, 0
FOpen 1, PPEPath() + "APPS\WAITING.app", 2, 0
:LABEL011
If (Ferr(1)) Goto LABEL012
FDGet STRING030
If (STRING030 == U_Name()) Then
FClose 1
Goto LABEL001
Endif
Goto LABEL011
:LABEL012
FClose 1
Goto LABEL001
:LABEL013
Cls
FClose 1
STRING020 = 1
STRING021 = 1
FClose 1
FCreate 1, "MESS.TMP", 1, 0
DispFile PPEPath() + "goodbye.pcb", 0
:LABEL014
If (Abort()) Goto LABEL015
STRING019 = ""
FreshLine
InputStr STRING021 + " >_", STRING019, 9, 74, Mask_Ascii(), 512 + 2 + 4 + 256
If ((STRING020 == 1) && (STRING019 == "")) Goto LABEL013
If (STRING019 == "") Goto LABEL015
FPutLn 1, STRING019
Inc STRING020
Inc STRING021
Goto LABEL014
:LABEL015
FClose 1
Message INTEGER006, "SYSOP", U_Name(), "Validation Please!!!", "R", 0, 0, 0, "MESS.TMP"
FOpen 1, PPEPath() + PPEName() + ".LVL", 0, 0
FDGet STRING023
If (STRING023 == "NONE") Goto LABEL017
If (U_Sec >= STRING023) Goto LABEL020
If (CDOn()) Goto LABEL016
For INTEGER008 = 1 To INTEGER007
If (Exist(PPEPath() + "APPS\" + STRING027 + "_" + STRING028 + "." + INTEGER008)) Delete PPEPath() + "APPS\" + STRING027 + "_" + STRING028 + "." + INTEGER008
Next
Goto LABEL020
:LABEL016
:LABEL017
FClose 1
FOpen 1, PPEPath() + "APPS\WAITING.app", 2, 0
:LABEL018
If (Ferr(1)) Goto LABEL019
FDGet STRING030
If (STRING030 == U_Name()) Then
FClose 1
Else
Goto LABEL018
:LABEL019
FClose 1
FClose 4
FAppend 4, PPEPath() + "APPS\WAITING.app", 1, 0
FDPutLn U_Name()
FClose 4
Endif
If (STRING023 <> "NONE") Then
U_Sec = STRING023
Endif
FClose 1
PutUser
Endif
:LABEL020
FClose 1
For STRING008 = 1 To INTEGER007
Delete STRING008 + ".lck"
Next
For STRING008 = 1 To INTEGER007
Delete STRING008 + ".YES"
Next
BOOLEAN001 = 1
If (STRING016 == "TRUE") Hangup
End
STRING018 = "Do Not HEX-Edit this PPE, You Will Be Sorry!!!!"
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 2 End
; 2 Cls
; 2 Wait
; 1 Color
; 83 Goto
; 84 Let
; 7 Print
; 22 PrintLn
; 54 If
; 3 DispFile
; 8 FCreate
; 8 FOpen
; 3 FAppend
; 30 FClose
; 5 FGet
; 16 FPutLn
; 3 StartDisp
; 2 Hangup
; 1 GetUser
; 2 PutUser
; 8 Delete
; 1 DelUser
; 2 InputStr
; 1 InputYN
; 1 Gosub
; 1 Return
; 12 Inc
; 3 Dec
; 1 Newline
; 2 Tokenize
; 8 GetToken
; 1 KbdStuff
; 32 AnsiPos
; 4 FreshLine
; 1 Message
; 2 RestScrn
; 1 FDefIn
; 1 FDefOut
; 10 FDGet
; 1 FDPutLn
;
;
; ■ Functions used :
;
; 1 +
; 343 +
; 3 -
; 27 ==
; 4 <>
; 15 <
; 15 <=
; 28 >=
; 41 !
; 31 &&
; 22 ||
; 2 Len(
; 3 Left()
; 6 Right()
; 2 Ferr()
; 183 Chr()
; 1 Abort()
; 1 RTrim()
; 2 Date()
; 1 Time()
; 7 U_Name()
; 1 YesChar()
; 14 Strip()
; 1 Inkey()
; 2 String()
; 2 Mask_Ascii()
; 2 PCBDat()
; 25 PPEPath()
; 2 PcbNode()
; 2 ReadLine()
; 13 Exist()
; 1 S2I()
; 1 Carrier()
; 1 CDOn()
; 1 GetY()
; 6 PPEName()
; 2 TokCount()
; 4 ScrText()
;
;------------------------------------------------------------------------------
;
; Analysis flags : WDBd
;
; W - Write user ■ 5
; Program writes a user record. Although this may be normal for a
; User Editor, it may also be a way to modify an account level.
; ■ Search for : PUTUSER
;
; D - Delete user ■ 5
; Program is deleting account(s)... Check!
; ■ Search for : DELUSER
;
; B - Brute hangup ■ 1
; Program hangup without notification. This may be a good way to
; disconnect a user, but if used randomly, may be very nasty
; ■ Search for : HANGUP, DTROFF
;
; 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
;
; 13 For/Next
; 0 While/EndWhile
; 18 If/Then or If/Then/Else
; 0 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------