home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Carsten's PPE Collection
/
Carstens_PPE_Collection_2007.zip
/
T
/
THTAREA.ZIP
/
THT-AREA.PPE
(
.txt
)
< prev
Wrap
PCBoard Programming Language Executable
|
1994-05-07
|
7KB
|
465 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
Integer INTEGER001
Integer INTEGER002
Integer INTEGER003
Integer INTEGER004
Integer INTEGER005
Integer INTEGER006
String TSTRING001(1000)
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
;------------------------------------------------------------------------------
STRING028 = TokenStr()
Tokenize STRING028
If ((STRING028 == "0") && (CurSec() >= SysopSec())) Then
KbdStuff "f;" + STRING028
Stop
ElseIf (((STRING028 <> "0") && (STRING028 <> "SECOND")) && (STRING028 <> "")) Then
KbdStuff "f;" + STRING028
Stop
Endif
STRING002 = ReadLine(PCBDat(), 31) + ".@@@"
INTEGER001 = CurConf() * 548 + 158
INTEGER002 = CurConf() * 548 + 484
FOpen 1, PPEPath() + PPEName() + ".CNF", 0, 0
FGet 1, STRING012
FGet 1, STRING013
FGet 1, STRING014
FGet 1, STRING016
FGet 1, STRING020
FGet 1, STRING021
FGet 1, STRING022
FGet 1, STRING023
FGet 1, STRING024
FGet 1, STRING025
FGet 1, STRING026
FGet 1, STRING019
FClose 1
STRING027 = STRING022
FOpen 2, STRING002, 0, 0
FSeek 2, INTEGER001, 0
FRead 2, STRING003, 28
FSeek 2, INTEGER002, 0
FRead 2, STRING004, 32
FClose 2
If (Exist(PPEPath() + PPEName() + ".pcb")) DispFile PPEPath() + PPEName() + ".pcb", 0
AnsiPos 1, 1
Print Chr(64) + Chr(88) + Chr(48) + I2S(8, 36) + I2S(12, 36) + I2S(27, 36) + I2S(14, 36) + I2S(10, 36) + I2S(29, 36) + I2S(14, 36) + I2S(13, 36) + " " + Chr(102) + Chr(111) + Chr(114) + " " + I2S(27, 36) + I2S(18, 36) + I2S(15, 36) + I2S(29, 36) + " "
Print "@POS:60@" + Chr(64) + Chr(88) + Chr(48) + I2S(8, 36) + I2S(12, 36) + I2S(24, 26) + I2S(13, 36) + I2S(14, 36) + I2S(13, 36) + Chr(64) + Chr(88) + Chr(48) + I2S(15, 36) + " " + I2S(11, 36) + I2S(34, 36) + Chr(64) + Chr(88) + Chr(48) + I2S(15, 36) + " " + I2S(29, 36) + I2S(17, 36) + I2S(14, 36) + Chr(64) + Chr(88) + Chr(48) + I2S(8, 36) + " " + I2S(22, 36) + I2S(10, 36) + I2S(28, 36) + I2S(29, 36) + I2S(14, 36) + I2S(27, 36) + " "
AnsiPos 33, 1
Print Chr(64) + Chr(88) + Chr(48) + Chr(49) + " " + I2S(29, 36) + I2S(17, 36) + I2S(29, 36) + "-" + I2S(10, 36) + "rea" + Chr(64) + Chr(88) + Chr(48) + Chr(56) + " v" + Chr(49) + "." + Chr(51) + Chr(48)
STRING007 = 0
STRING006 = 0
StartDisp 1
FOpen 1, STRING004, 0, 0
STRING011 = YesChar()
FSeek 1, 0, 0
FSeek 1, 60, 1
FRead 1, TSTRING001(STRING006), 35
AnsiPos STRING023, STRING022
Print STRING012 + STRING006
AnsiPos STRING024, STRING022
Print STRING013 + STRING021 + STRING013
Inc STRING007
Inc STRING006
Inc STRING022
AnsiPos STRING023, STRING022
Print STRING012 + STRING006
AnsiPos STRING024, STRING022
Print STRING013 + TSTRING001(STRING006 - 1)
Inc STRING007
Inc STRING006
:LABEL001
If (Ferr(1)) Goto LABEL014
Inc STRING022
:LABEL002
If (STRING010 == YesChar()) Then
FClose 1
FOpen 1, STRING004, 0, 0
FSeek 1, 0, 0
FSeek 1, 864, 1
STRING010 = NoChar()
Else
FSeek 1, 1, 1
Endif
FRead 1, TSTRING001(STRING006), 30
FSeek 1, 30, 1
If (Ferr(1)) Then
If (STRING007 < 10) Then
INTEGER005 = STRING007
For INTEGER004 = 1 To 10 - STRING007
AnsiPos STRING023, STRING022
Print STRING013 + Space(STRING026)
AnsiPos STRING024, STRING022
Print STRING013 + Space(STRING025)
STRING008 = YesChar()
Inc STRING022
Inc STRING006
Next
STRING007 = 0
If (STRING006 < 11) Then
AnsiPos 1, 21
Print STRING014
INTEGER006 = GetX()
Goto LABEL004
Else
Else
Endif
FRead 1, TSTRING001(STRING006), 35
AnsiPos STRING023, STRING022
Print STRING012 + STRING006
AnsiPos STRING024, STRING022
Print STRING013 + TSTRING001(STRING006)
Inc STRING007
Inc STRING006
STRING011 = NoChar()
If (STRING007 == 10) BOOLEAN001 = 0
If (STRING007 == 10) Then
INTEGER005 = STRING007
STRING007 = 0
DefColor
AnsiPos 1, 21
Print STRING014
INTEGER006 = GetX()
:LABEL003
If (BOOLEAN001) Goto LABEL011
Endif
Endif
:LABEL004
STRING005 = ""
AnsiPos INTEGER006, 21
ClrEol
If (STRING006 == 10) STRING011 = YesChar()
STRING005 = Upper(Inkey())
If (STRING005 == "Q") Then
KbdStuff Chr(13)
Stop
Endif
If (STRING005 == "") Goto LABEL004
If ((STRING005 == Chr(13)) || (STRING005 == "B")) Goto LABEL009
If ((((((STRING005 == "S") || (STRING005 == Chr(32))) || (STRING005 == "UP")) || (STRING005 == "DOWN")) || (STRING005 == "RIGHT")) || (STRING005 == "LEFT")) Then
AnsiPos 1, 20
Print STRING020
Goto LABEL005
Endif
If ((((((((((STRING005 == 1) || (STRING005 == 2)) || (STRING005 == 3)) || (STRING005 == 4)) || (STRING005 == 5)) || (STRING005 == 6)) || (STRING005 == 7)) || (STRING005 == 8)) || (STRING005 == 9)) || (STRING005 == 0)) Goto LABEL008
:LABEL005
STRING018 = STRING023
INTEGER003 = STRING027 - 1
KbdStuff Chr(32)
STRING015 = ""
:LABEL006
If (FALSE) Goto LABEL008
STRING005 = Upper(Inkey())
If (STRING005 == "Q") Then
DefColor
AnsiPos 1, 20
Print Space(78)
AnsiPos STRING018, INTEGER003
Print STRING015
KbdStuff Chr(13)
AnsiPos 1, 21
Stop
Endif
If ((STRING005 == Chr(27)) || (STRING005 == "P")) Then
DefColor
AnsiPos 1, 20
Print Space(78)
AnsiPos STRING018, INTEGER003
Print STRING015
Goto LABEL004
Endif
If (STRING005 == Chr(13)) Then
STRING015 = StripAtx(STRING015)
DefColor
Cls
If (Left(STRING015, 2) == 0) STRING015 = "U"
If (STRING028 == "SECOND") Then
KbdStuff Left(STRING015, 2)
Stop
Goto LABEL007
Endif
KbdStuff "F;" + Left(STRING015, 2)
Stop
Endif
:LABEL007
If ((((STRING005 == Chr(32)) || (STRING005 == "DOWN")) || (STRING005 == "LEFT")) || (STRING005 == "Z")) Then
Inc INTEGER003
AnsiPos STRING018, INTEGER003 - 1
Print STRING015
If (INTEGER003 == INTEGER005 + 6) INTEGER003 = INTEGER003 - INTEGER005
AnsiPos STRING018, INTEGER003
STRING015 = ScrText(STRING018, INTEGER003, STRING019, 1)
Print STRING016 + RTrim(ScrText(STRING018, INTEGER003, STRING019, 0), " ")
Endif
If (((STRING005 == "UP") || (STRING005 == "A")) || (STRING005 == "RIGHT")) Then
Dec INTEGER003
AnsiPos STRING018, INTEGER003 + 1
Print STRING015
AnsiPos STRING018, INTEGER003
STRING017 = ScrText(STRING018, INTEGER003, STRING019, 1)
If (INTEGER003 <> STRING027 - 1) Print STRING016 + RTrim(ScrText(STRING018, INTEGER003, STRING019, 0), " ")
STRING015 = STRING017
If (INTEGER003 == STRING027 - 1) Then
INTEGER003 = INTEGER003 + INTEGER005
STRING017 = ScrText(STRING018, INTEGER003, STRING019, 1)
STRING015 = STRING017
AnsiPos STRING018, INTEGER003
Print STRING016 + RTrim(ScrText(STRING018, INTEGER003, STRING019, 0), " ")
Endif
Endif
Goto LABEL006
:LABEL008
If ((((((((((STRING005 == 1) || (STRING005 == 2)) || (STRING005 == 3)) || (STRING005 == 4)) || (STRING005 == 5)) || (STRING005 == 6)) || (STRING005 == 7)) || (STRING005 == 8)) || (STRING005 == 9)) || (STRING005 == 0)) KbdStuff STRING005
STRING005 = ""
DefColor
AnsiPos INTEGER006, 21
InputStr "_", STRING005, "", 4, "1234567890BbQqSs", 8
If (STRING005 == "S") Then
AnsiPos 1, 20
Print STRING020
Goto LABEL005
Endif
If (STRING005 == "") Then
KbdStuff Chr(13)
Goto LABEL004
Endif
If (STRING005 == "Q") Then
KbdStuff Chr(13)
Stop
Endif
If (STRING005 == "B") Goto LABEL009
If (((STRING005 <> "B") || (STRING005 <> "Q")) || (STRING005 <> "")) Then
If (STRING005 == 0) Then
Cls
If (TokenStr() == "SECOND") Then
Cls
KbdStuff "U"
Stop
Endif
Cls
KbdStuff "F;U"
Stop
Goto LABEL009
Endif
Cls
AnsiPos 5, 22
If (TokenStr() == "SECOND") Then
Cls
KbdStuff STRING005
Stop
Endif
Cls
KbdStuff "F;" + STRING005
Stop
Endif
:LABEL009
If ((STRING005 == Chr(13)) && (STRING008 <> YesChar())) Then
BOOLEAN001 = 1
STRING022 = STRING027
Goto LABEL002
Goto LABEL010
Endif
If ((STRING011 <> YesChar()) && (STRING005 == "B")) Then
Goto LABEL012
Goto LABEL010
Endif
Goto LABEL004
:LABEL010
Goto LABEL003
:LABEL011
STRING022 = STRING027
Endif
Goto LABEL013
:LABEL012
STRING009 = 10
STRING022 = STRING027
If ((INTEGER004 == 0) || (INTEGER004 >= 10)) Then
STRING006 = STRING006 - 21
FSeek 1, -(INTEGER005 + 10) * 96, 1
Else
STRING008 = ""
STRING006 = STRING006 - 21
FSeek 1, 0, 2
FSeek 1, -(INTEGER005 + 10) * 96 - 2, 1
Endif
If (STRING006 <= 0) Then
If (STRING006 < 0) STRING006 = 0
STRING011 = YesChar()
STRING010 = YesChar()
FSeek 1, 0, 0
STRING009 = 9
AnsiPos STRING023, STRING022
Print STRING012 + Space(STRING026)
AnsiPos STRING023, STRING022
Print STRING012 + STRING006
AnsiPos STRING024, STRING022
Print STRING013 + Space(STRING025)
AnsiPos STRING024, STRING022
Print STRING013 + STRING021 + STRING013
Inc STRING022
Endif
For INTEGER004 = 1 To STRING009
If (STRING006 > 0) FSeek 1, 1, 1
FSeek 1, 60, 1
FRead 1, TSTRING001(STRING006), 35
Inc STRING006
AnsiPos STRING023, STRING022
Print STRING012 + Space(STRING026)
AnsiPos STRING023, STRING022
Print STRING012 + STRING006
AnsiPos STRING024, STRING022
Print STRING013 + TSTRING001(STRING006 - 1)
Inc STRING022
Next
Inc STRING006
INTEGER005 = 10
If ((((STRING006 < 10) || (STRING006 == 19)) || (STRING007 == 29)) || (STRING006 == 39)) Inc STRING006
Goto LABEL004
:LABEL013
Goto LABEL001
:LABEL014
FClose 1
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 7 Cls
; 1 ClrEol
; 60 Goto
; 52 Let
; 31 Print
; 46 If
; 1 DispFile
; 4 FOpen
; 4 FClose
; 12 FGet
; 1 StartDisp
; 5 DefColor
; 1 InputStr
; 16 Inc
; 1 Dec
; 1 Tokenize
; 11 Stop
; 14 KbdStuff
; 34 AnsiPos
; 14 FSeek
; 6 FRead
;
;
; ■ Functions used :
;
; 2 -
; 4 *
; 115 +
; 12 -
; 63 ==
; 9 <>
; 6 <
; 3 <=
; 1 >
; 6 >=
; 32 !
; 9 &&
; 38 ||
; 2 Upper()
; 3 Left()
; 7 Space()
; 2 Ferr()
; 40 Chr()
; 3 RTrim()
; 2 NoChar()
; 8 YesChar()
; 1 StripAtx()
; 2 Inkey()
; 2 CurConf()
; 1 PCBDat()
; 3 PPEPath()
; 1 ReadLine()
; 1 SysopSec()
; 1 CurSec()
; 1 Exist()
; 36 I2S()
; 3 TokenStr()
; 2 GetX()
; 3 PPEName()
; 6 ScrText()
;
;------------------------------------------------------------------------------
;
; Analysis flags : ds
;
; 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()
;
; s - Sysop level access ■ 5
; Program is reading the sysop access level, this may be normal
; but still it is very suspect. It is the best way to give a user
; all priviledges. Check!
; ■ Search for : SYSOPSEC()
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 2 For/Next
; 0 While/EndWhile
; 27 If/Then or If/Then/Else
; 0 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------