home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PCBOARD
/
PCBWHO16.ZIP
/
PCBWHO.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1994-02-09
|
10KB
|
466 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
Integer INTEGER007
Integer INTEGER008
Integer INTEGER009
Integer INTEGER010
Integer INTEGER011
Integer INTEGER012
Integer INTEGER013
Integer INTEGER014
Integer INTEGER015
String STRING001
String STRING002
String STRING003
String STRING004
String STRING005
String STRING006
String STRING007
String TSTRING008(22)
String STRING009
String STRING010
String STRING011
String STRING012
String STRING013
String TSTRING014(50)
String STRING015
String STRING016
String STRING017
String STRING018
String STRING019
String STRING020
String TSTRING021(100)
String STRING022
String STRING023
;------------------------------------------------------------------------------
STRING022 = "1.6"
INTEGER004 = 34373
INTEGER005 = 9561
INTEGER006 = 1
STRING023 = Chr(85) + Chr(78) + Chr(82) + Chr(69) + Chr(71) + Chr(73) + Chr(83) + Chr(84) + Chr(69) + Chr(82) + Chr(69) + Chr(68)
STRING004 = "PCBWHO v" + STRING022
STRING016 = Chr(71) + Chr(82) + Chr(69) + Chr(71) + Chr(71) + Chr(32) + Chr(71) + Chr(82) + Chr(65) + Chr(85) + Chr(66) + Chr(73) + Chr(78) + Chr(83)
If (Exist(PPEPath() + "PCBWHO.CFG")) Then
FOpen 1, PPEPath() + "PCBWHO.CFG", 0, 0
FGet 1, STRING017
FGet 1, STRING018
FGet 1, STRING019
FGet 1, STRING006
FGet 1, STRING009
FGet 1, STRING010
FGet 1, STRING011
FGet 1, STRING012
FGet 1, STRING013
FClose 1
Else
PrintLn "@X0CConfiguration file PCBWHO.CFG not found, aborting..."
Stop
Endif
STRING001 = Upper(Trim(LangExt(), " "))
STRING001 = Replace(STRING001, ".", "")
If (STRING001 == "") Then
STRING002 = PPEPath() + "WHOTEXT."
ElseIf (STRING001 <> "") Then
STRING002 = PPEPath() + "WHOTEXT." + STRING001
Endif
If (!Exist(STRING002)) STRING002 = PPEPath() + "WHOTEXT."
If (Exist(STRING002)) Then
FOpen 1, STRING002, 0, 0
FGet 1, TSTRING008(1)
FGet 1, TSTRING008(2)
FGet 1, TSTRING008(3)
FGet 1, TSTRING008(4)
FGet 1, TSTRING008(5)
FGet 1, TSTRING008(6)
FGet 1, TSTRING008(7)
FGet 1, TSTRING008(8)
FGet 1, TSTRING008(9)
FGet 1, TSTRING008(10)
FGet 1, TSTRING008(11)
FGet 1, TSTRING008(12)
FGet 1, TSTRING008(13)
FGet 1, TSTRING008(14)
FGet 1, TSTRING008(15)
FGet 1, TSTRING008(16)
FGet 1, TSTRING008(17)
FGet 1, TSTRING008(18)
FGet 1, TSTRING008(19)
FGet 1, TSTRING008(20)
FGet 1, TSTRING008(21)
FGet 1, TSTRING008(22)
FClose 1
Else
PrintLn "@X0CWHOTEXT prompt file not found, aborting..."
Stop
Endif
If (INTEGER006 <> 0) Then
If (Len(Trim(STRING023, " ")) <> 12) Goto LABEL009
If (FileInf(PPEPath() + PPEName() + ".PPE", 2) <> INTEGER004) Goto LABEL009
If (FileInf(PPEPath() + PPEName() + ".PPE", 4) <> INTEGER005) Goto LABEL009
Endif
Gosub LABEL010
INTEGER010 = 1
INTEGER013 = 1
If (Exist(PPEPath() + "LURK.LST")) Then
FOpen 2, PPEPath() + "LURK.LST", 0, 0
INTEGER014 = 1
INTEGER010 = 0
:LABEL001
If (Ferr(2)) Goto LABEL002
FGet 2, TSTRING014(INTEGER014)
INTEGER011 = INTEGER014
INTEGER014 = INTEGER014 + 1
Goto LABEL001
:LABEL002
FClose 2
Else
Log "@X0CFile LURK.LST not found", 1
Log "@X0CBypassing LURK feature", 1
INTEGER010 = 1
Endif
For INTEGER008 = 1 To 21
TSTRING008(INTEGER008) = Trim(TSTRING008(INTEGER008), " ")
INTEGER009 = 24
Next
BOOLEAN001 = 0
INTEGER007 = S2I(STRING006, 10)
GetToken STRING003
STRING003 = Trim(Upper(STRING003), Chr(32))
If (Mid(STRING003, 1, 1) == "L") Goto LABEL011
If (INTEGER001 <> 0) Then
Newline
Log "*" + STRING004 + "* (" + Chr(85) + Chr(78) + Chr(82) + Chr(69) + Chr(71) + Chr(73) + Chr(83) + Chr(84) + Chr(69) + Chr(82) + Chr(69) + Chr(68) + ")", 0
PrintLn "@X07This copy of @X0F" + STRING004 + "@X07 is @X0C" + Chr(85) + Chr(78) + Chr(82) + Chr(69) + Chr(71) + Chr(73) + Chr(83) + Chr(84) + Chr(69) + Chr(82) + Chr(69) + Chr(68) + "@X07."
Delay 3 * 18.2
Endif
:LABEL003
If (BOOLEAN001) Goto LABEL008
If (INTEGER013 == 0) Cls
If (Exist(PPEPath() + "PCBWHO.HDR")) DispFile PPEPath() + "PCBWHO.HDR", 4
For INTEGER008 = 1 To INTEGER007
INTEGER012 = 1
If ((INTEGER001 <> 0) && (INTEGER008 > 5)) Goto LABEL014
STRING015 = ""
RdUNet INTEGER008
If (INTEGER008 > 99) Then
STRING005 = String(INTEGER008)
ElseIf (INTEGER008 > 9) Then
STRING005 = " " + String(INTEGER008)
Else
STRING005 = " " + String(INTEGER008)
Endif
Print STRING009, " ", STRING005, " ", STRING010
If (PcbNode() <> INTEGER008) Then
Select Case (UN_Stat())
Case " "
OpText TSTRING008(1)
Case "A"
OpText TSTRING008(2)
Case "B"
OpText TSTRING008(3)
Case "C"
OpText TSTRING008(4)
Case "D"
OpText TSTRING008(5)
Case "E"
OpText TSTRING008(6)
Case "F"
OpText TSTRING008(7)
Case "G"
OpText TSTRING008(8)
Case "L"
OpText TSTRING008(9)
Case "M"
OpText TSTRING008(10)
Case "N"
OpText TSTRING008(11)
Case "O"
OpText TSTRING008(12)
Case "P"
OpText TSTRING008(13)
Case "R"
OpText TSTRING008(14)
Case "S"
OpText TSTRING008(15)
Case "T"
If (Left(UN_Oper(), 3) == "(U)") Then
OpText TSTRING008(16)
Else
OpText TSTRING008(17)
Endif
Case "U"
OpText TSTRING008(18)
Case "W"
OpText TSTRING008(19)
Case "X"
OpText TSTRING008(20)
Case Else
OpText TSTRING008(21)
End Select
Else
If (PcbNode() == INTEGER008) Then
OpText TSTRING008(22)
Endif
Endif
STRING015 = STRING015 + "@POS:8@@OPTEXT:23@@POS:32@"
If (UN_Stat() == "N") Then
STRING015 = STRING015 + STRING011 + UN_Oper()
Endif
INTEGER014 = 0
If (INTEGER010 <> 0) INTEGER011 = 1
For INTEGER015 = 1 To INTEGER011
If (((INTEGER010 == 0) && (Upper(Trim(UN_Name(), " ")) == Upper(Trim(TSTRING014(INTEGER014), " ")))) && (Upper(Trim(UN_Name(), " ")) <> "")) Then
INTEGER012 = 0
If ((CurSec() >= SysopSec()) || (U_Name() == STRING016)) Then
If (UN_Stat() == "D") Then
STRING015 = STRING015 + STRING013 + Mid(UN_Oper(), 1, Len(UN_Name())) + " @X08[" + STRING013 + "L@X08]" + STRING012 + " - " + Trim(Mid(UN_Oper(), Len(UN_Name()) + 3, Len(UN_Oper()) - Len(UN_Name())), " ")
Goto LABEL004
Endif
If (UN_Stat() <> "D") Then
STRING007 = UN_Name() + " @X08[" + STRING013 + "L@X08]"
STRING015 = STRING015 + STRING013 + STRING007
If (Trim(UN_City(), " ") <> "") STRING015 = STRING015 + STRING012 + " (" + UN_City() + ")"
Endif
:LABEL004
Goto LABEL006
Endif
If (PcbNode() == INTEGER008) Then
If (UN_Stat() == "D") Then
STRING015 = STRING015 + STRING013 + Mid(UN_Oper(), 1, Len(UN_Name())) + " @X08[" + STRING013 + "L@X08]" + STRING012 + " - " + Trim(Mid(UN_Oper(), Len(UN_Name()) + 3, Len(UN_Oper()) - Len(UN_Name())), " ")
Goto LABEL005
Endif
If (UN_Stat() <> "D") Then
STRING007 = UN_Name() + " @X08[" + STRING013 + "L@X08]"
STRING015 = STRING015 + STRING013 + STRING007
If (Trim(UN_City(), " ") <> "") STRING015 = STRING015 + STRING012 + " (" + UN_City() + ")"
Endif
:LABEL005
Goto LABEL006
Endif
If (CurSec() < SysopSec()) Then
STRING015 = "@POS:8@" + TSTRING008(1)
Endif
Endif
:LABEL006
INTEGER014 = INTEGER014 + 1
Next
If (INTEGER012 <> 0) Then
If (UN_Stat() == "D") Then
STRING015 = STRING015 + STRING011 + UN_Oper()
Goto LABEL007
Endif
If (UN_Stat() <> "D") Then
STRING007 = UN_Name()
STRING015 = STRING015 + STRING011 + STRING007 + STRING012
If (Trim(UN_City(), " ") <> "") STRING015 = STRING015 + STRING012 + " (" + UN_City() + ")"
Endif
Endif
:LABEL007
PrintLn STRING015
Next
BOOLEAN001 = 1
Goto LABEL003
:LABEL008
Goto LABEL014
:LABEL009
Cls
Beep
Newlines 2
Beep
PrintLn "@X07[@X0CPCBWHO is (c) Copyrighted Software by Whitewater Technologies, Inc.@X07]"
PrintLn "@X07[@X0FWhitewater Systems - 312-743-4912@X07]"
Newline
PrintLn "@X07[@X0CPCBWHO's authentic seal has been altered!@X07]"
PrintLn "@X07[@X07Please call Whitewater Systems and download the newest release@X07]"
Log "*PCBWHO* Seal has been ALTERED", 0
Newlines 2
Goto LABEL014
:LABEL010
INTEGER001 = 1
STRING020 = ""
STRING020 = Chr(57) + String(Len(STRING018) - 4)
STRING020 = STRING020 + Chr(57) + String(Len(STRING018) - 6)
STRING020 = STRING020 + Chr(48) + String(Len(STRING017) - 5) + Chr(45)
STRING020 = STRING020 + Chr(51) + String(Len(STRING018) - 3) + Chr(53)
If (Trim(STRING018, " ") <> Trim(Mid(ReadLine(PCBDat(), 94), 1, Len(STRING018)), " ")) INTEGER001 = 1
If (Trim(STRING018, " ") == Trim(Mid(ReadLine(PCBDat(), 94), 1, Len(STRING018)), " ")) INTEGER001 = 0
If (STRING019 <> STRING020) INTEGER001 = 1
If (STRING019 == STRING020) INTEGER001 = 0
Return
:LABEL011
If (Exist(PPEPath() + "LURK.LST")) Then
FOpen 1, PPEPath() + "LURK.LST", 0, 0
INTEGER014 = 1
INTEGER003 = 0
Newline
Print "@X0AReading LURK.LST into memory... "
:LABEL012
If (Ferr(1)) Goto LABEL013
FGet 1, TSTRING021(INTEGER014)
If (U_Name() == Trim(Upper(TSTRING021(INTEGER014)), " ")) Then
INTEGER003 = INTEGER014
ElseIf (";" + U_Name() == Trim(Upper(TSTRING021(INTEGER014)), " ")) Then
INTEGER003 = INTEGER014
Endif
Inc INTEGER014
Goto LABEL012
:LABEL013
PrintLn "@X0F" + String(INTEGER014 - 2) + " record(s) found."
FClose 1
If (INTEGER003 <> 0) Then
If (Mid(TSTRING021(INTEGER003), 1, 1) == ";") Then
PrintLn "@X0AToggling lurk mode @X0Fon@X0A...@X07"
TSTRING021(INTEGER003) = U_Name()
Else
PrintLn "@X0AToggling lurk mode @X0Foff@X0A...@X07"
TSTRING021(INTEGER003) = ";" + U_Name()
Endif
INTEGER002 = 1
Print "@X0ASaving new LURK.LST... "
FCreate 1, PPEPath() + "LURK.LST", 1, 0
For INTEGER002 = 1 To INTEGER014 - 2
FPutLn 1, TSTRING021(INTEGER002)
Next
FClose 1
PrintLn "@X0F" + String(INTEGER014 - 2) + " record(s) saved."
Else
Newline
PrintLn "@X0CYou were not found in the LURK.LST file - You must"
PrintLn "be inserted into this file before toggling lurk mode.@X07"
Endif
FClose 1
Else
PrintLn "@X0CLURK.LST file not found - You must first"
PrintLn "create one to toggle lurk mode on/off.@X07"
Endif
:LABEL014
End
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 1 End
; 2 Cls
; 106 Goto
; 74 Let
; 3 Print
; 16 PrintLn
; 71 If
; 1 DispFile
; 1 FCreate
; 4 FOpen
; 6 FClose
; 33 FGet
; 1 FPutLn
; 4 Log
; 1 Gosub
; 1 Return
; 1 Delay
; 1 Inc
; 4 Newline
; 2 Newlines
; 1 GetToken
; 2 Stop
; 2 Beep
; 22 OpText
; 1 RdUNet
;
;
; ■ Functions used :
;
; 1 *
; 144 +
; 10 -
; 37 ==
; 20 <>
; 5 <
; 4 <=
; 3 >
; 9 >=
; 56 !
; 11 &&
; 5 ||
; 15 Len(
; 7 Upper()
; 8 Mid()
; 1 Left()
; 2 Ferr()
; 57 Chr()
; 18 Trim()
; 5 U_Name()
; 1 Replace()
; 9 String()
; 2 PCBDat()
; 14 PPEPath()
; 3 PcbNode()
; 2 ReadLine()
; 2 SysopSec()
; 26 UN_Stat()
; 11 UN_Name()
; 6 UN_City()
; 9 UN_Oper()
; 2 CurSec()
; 6 Exist()
; 1 S2I()
; 1 LangExt()
; 2 FileInf()
; 2 PPEName()
;
;------------------------------------------------------------------------------
;
; 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
;
; 4 For/Next
; 0 While/EndWhile
; 29 If/Then or If/Then/Else
; 1 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------