home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
M2000PWA.ZIP
/
NUV.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1994-04-11
|
10KB
|
522 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
Boolean BOOLEAN002
Boolean BOOLEAN003
Integer TINTEGER003(500)
Integer INTEGER004
Integer INTEGER005
Integer INTEGER006
Integer INTEGER007
Integer INTEGER008
Integer INTEGER009
Integer INTEGER010
Integer INTEGER011
Integer INTEGER012
String STRING001
String STRING002
String TSTRING003(138)
String TSTRING004(22)
String STRING005
String STRING006
String TSTRING007(40)
String STRING008
String STRING009
String TSTRING010(500)
String TSTRING011(1000)
String TSTRING012(1000)
String STRING013
String STRING014
;------------------------------------------------------------------------------
TSTRING004(1) = PPEPath() + "MATRIX.CFG"
TSTRING004(2) = PPEPath() + "FORM.1"
TSTRING004(3) = PPEPath() + "FORM.2"
TSTRING004(4) = PPEPath() + "FORM.3"
TSTRING004(5) = PPEPath() + "FORM.4"
TSTRING004(6) = PPEPath() + "FORM.5"
TSTRING004(7) = PPEPath() + "CONFIG.1"
TSTRING004(8) = PPEPath() + "CONFIG.2"
TSTRING004(9) = PPEPath() + "CONFIG.3"
TSTRING004(10) = PPEPath() + "CONFIG.4"
TSTRING004(11) = PPEPath() + "CONFIG.5"
TSTRING004(15) = PPEPath() + "TEXT.CFG"
TSTRING004(21) = PPEPath() + "VOTING.SCR"
TSTRING004(22) = PPEPath() + "USERS.VOT"
If (Exist(TSTRING004(1)) == 0) Then
PrintLn "@X0FConfiguration File Missing... (MATRIX.CFG)"
PrintLn "@X0FPlease Report this to the Sysop!"
End
Endif
If (Exist(TSTRING004(15)) == 0) Then
PrintLn "@X0FText Configuration File Missing... (TEXT.CFG)"
PrintLn "@X0FPlease Report this to the Sysop!"
End
Endif
FOpen 15, TSTRING004(15), 0, 0
For INTEGER006 = 1 To 38
FGet 15, TSTRING007(INTEGER006)
Next
FClose 15
FOpen 1, TSTRING004(1), 0, 0
For INTEGER006 = 1 To 138
FGet 1, TSTRING003(INTEGER006)
Next
FClose 1
Shell 1, INTEGER012, "DIR ", PPEPath() + "NUV\*.NUV /B >" + PPEPath() + "USERS.VOT"
FAppend 3, TSTRING004(22), 2, 0
FPutLn 3, "END"
FClose 3
:LABEL001
If (BOOLEAN002) Goto LABEL007
BOOLEAN002 = 0
BOOLEAN003 = 0
FOpen 4, TSTRING004(22), 0, 0
FGet 4, STRING005
If (Left(STRING005, 3) == "END") Then
End
Endif
STRING001 = ""
STRING002 = ""
STRING001 = PPEPath() + "NUV\" + STRING005
INTEGER006 = 1
While (((1 < 0) && (INTEGER006 >= Len(STRING001) - 4)) || ((1 >= 0) && (INTEGER006 <= Len(STRING001) - 4))) Do
STRING002 = STRING002 + Mid(STRING001, INTEGER006, 1)
INTEGER006 = INTEGER006 + 1
EndWhile
STRING002 = STRING002 + ".NFO"
FOpen 2, STRING001, 0, 0
FGet 2, STRING013
FGet 2, INTEGER007
FGet 2, INTEGER008
FGet 2, INTEGER009
FGet 2, INTEGER010
If (INTEGER010 <> 0) Then
For INTEGER006 = 1 To INTEGER010
FGet 2, TSTRING011(INTEGER006)
Next
Endif
FGet 2, INTEGER011
If (INTEGER011 <> 0) Then
For INTEGER006 = 1 To INTEGER011
FGet 2, TSTRING012(INTEGER006)
Next
Endif
FClose 2
If (INTEGER010 > 0) Then
For INTEGER006 = 1 To INTEGER010
If (U_Name() == Upper(TSTRING011(INTEGER006))) BOOLEAN003 = 1
Next
Endif
:LABEL002
If (BOOLEAN003) Goto LABEL006
Color 15
Cls
DispFile TSTRING004(21), 1
AnsiPos TSTRING003(101), TSTRING003(100)
Print TSTRING003(102) + STRING013
AnsiPos TSTRING003(104), TSTRING003(103)
Print TSTRING003(105) + INTEGER007
AnsiPos TSTRING003(107), TSTRING003(106)
Print TSTRING003(108) + INTEGER008
AnsiPos TSTRING003(110), TSTRING003(109)
Print TSTRING003(111) + INTEGER009
For INTEGER006 = 1 To TSTRING003(114)
AnsiPos TSTRING003(113) - 2, TSTRING003(112) + INTEGER006 - 1
If (TSTRING012(INTEGER006) <> "") Print TSTRING003(131) + TSTRING003(132) + "@X0F " + Left(TSTRING012(INTEGER006), TSTRING003(116))
Next
AnsiPos TSTRING003(119), TSTRING003(118)
Print TSTRING003(129) + TSTRING003(117)
INTEGER005 = 1
BOOLEAN001 = 0
:LABEL003
If (BOOLEAN003) Goto LABEL005
STRING006 = Inkey()
Select Case (STRING006)
Case " "
INTEGER005 = INTEGER005 + 1
If (INTEGER005 == 5) Then
INTEGER005 = 1
AnsiPos TSTRING003(128), TSTRING003(127)
Print TSTRING003(130) + TSTRING003(126)
AnsiPos TSTRING003(119), TSTRING003(118)
Print TSTRING003(129) + TSTRING003(117)
Goto LABEL004
Endif
If (INTEGER005 == 2) Then
AnsiPos TSTRING003(119), TSTRING003(118)
Print TSTRING003(130) + TSTRING003(117)
AnsiPos TSTRING003(122), TSTRING003(121)
Print TSTRING003(129) + TSTRING003(120)
Endif
If (INTEGER005 == 3) Then
AnsiPos TSTRING003(122), TSTRING003(121)
Print TSTRING003(130) + TSTRING003(120)
AnsiPos TSTRING003(125), TSTRING003(124)
Print TSTRING003(129) + TSTRING003(123)
Endif
If (INTEGER005 == 4) Then
AnsiPos TSTRING003(125), TSTRING003(124)
Print TSTRING003(130) + TSTRING003(123)
AnsiPos TSTRING003(128), TSTRING003(127)
Print TSTRING003(129) + TSTRING003(126)
Endif
:LABEL004
If ((STRING006 == "LEFT") || (STRING006 == "4")) Then
If (INTEGER005 > 1) INTEGER005 = INTEGER005 - 1
If (INTEGER005 == 1) Then
AnsiPos TSTRING003(122), TSTRING003(121)
Print TSTRING003(130) + TSTRING003(120)
AnsiPos TSTRING003(119), TSTRING003(118)
Print TSTRING003(129) + TSTRING003(117)
Endif
If (INTEGER005 == 2) Then
AnsiPos TSTRING003(125), TSTRING003(124)
Print TSTRING003(130) + TSTRING003(123)
AnsiPos TSTRING003(122), TSTRING003(121)
Print TSTRING003(129) + TSTRING003(120)
Endif
If (INTEGER005 == 3) Then
AnsiPos TSTRING003(128), TSTRING003(127)
Print TSTRING003(130) + TSTRING003(126)
AnsiPos TSTRING003(125), TSTRING003(124)
Print TSTRING003(129) + TSTRING003(123)
Endif
Endif
Case "RIGHT", "6"
If (INTEGER005 < 4) INTEGER005 = INTEGER005 + 1
If (INTEGER005 == 2) Then
AnsiPos TSTRING003(119), TSTRING003(118)
Print TSTRING003(130) + TSTRING003(117)
AnsiPos TSTRING003(122), TSTRING003(121)
Print TSTRING003(129) + TSTRING003(120)
Endif
If (INTEGER005 == 3) Then
AnsiPos TSTRING003(122), TSTRING003(121)
Print TSTRING003(130) + TSTRING003(120)
AnsiPos TSTRING003(125), TSTRING003(124)
Print TSTRING003(129) + TSTRING003(123)
Endif
Case 4
AnsiPos TSTRING003(125), TSTRING003(124)
Print TSTRING003(130) + TSTRING003(123)
AnsiPos TSTRING003(128), TSTRING003(127)
Print TSTRING003(129) + TSTRING003(126)
End Select
If (STRING006 == Chr(13)) Then
BOOLEAN003 = 1
Endif
Goto LABEL003
:LABEL005
Select Case (INTEGER005)
Case 1
INTEGER007 = INTEGER007 + 1
INTEGER010 = INTEGER010 + 1
Gosub LABEL016
Gosub LABEL013
BOOLEAN003 = 1
End
Case 2
INTEGER008 = INTEGER008 + 1
INTEGER010 = INTEGER010 + 1
Gosub LABEL016
Gosub LABEL013
BOOLEAN003 = 1
End
Case 3
INTEGER009 = INTEGER009 + 1
INTEGER010 = INTEGER010 + 1
Gosub LABEL013
BOOLEAN003 = 1
End
Case 4
Gosub LABEL008
BOOLEAN003 = 0
End Select
Goto LABEL002
:LABEL006
Goto LABEL001
:LABEL007
FClose 4
End
:LABEL008
If (Exist(STRING002) == 0) Then
Return
Else
FOpen 4, STRING002, 0, 0
BOOLEAN001 = 0
:LABEL009
If (BOOLEAN001) Goto LABEL010
FGet 4, STRING008
If (STRING008 == "END") BOOLEAN001 = 1
If (STRING008 == "000-555-000") Then
FGet 4, STRING008
If (STRING008 == 0) Return
For INTEGER006 = 1 To STRING008
FGet 4, TSTRING010(INTEGER006)
Next
BOOLEAN001 = 1
Endif
Goto LABEL009
:LABEL010
FClose 4
Color 15
FOpen 4, TSTRING004(11), 0, 0
FGet 4, INTEGER004
For INTEGER006 = 1 To INTEGER004
FGet 4, STRING008
FGet 4, STRING008
FGet 4, TINTEGER003(INTEGER006 * 2)
FGet 4, TINTEGER003(INTEGER006 * 2 + 1)
Next
FClose 4
Endif
If (Exist(STRING002) == 0) Then
Return
Else
FOpen 4, STRING002, 0, 0
BOOLEAN001 = 0
:LABEL011
If (BOOLEAN001) Goto LABEL012
FGet 4, STRING008
If (STRING008 == "END") BOOLEAN001 = 1
If (STRING008 == "000-555-000") Then
FGet 4, STRING008
If (STRING008 == 0) Return
For INTEGER006 = 1 To STRING008
FGet 4, TSTRING010(INTEGER006)
Next
BOOLEAN001 = 1
Endif
Goto LABEL011
:LABEL012
FClose 4
Color 15
Cls
FOpen 4, TSTRING004(11), 0, 0
FGet 4, INTEGER004
For INTEGER006 = 1 To INTEGER004
FGet 4, STRING008
FGet 4, STRING008
FGet 4, TINTEGER003(INTEGER006 * 2)
FGet 4, TINTEGER003(INTEGER006 * 2 + 1)
Next
FClose 4
DispFile TSTRING004(6), 1
If (TSTRING003(134) <> "") Then
TSTRING003(134) = "@X0F"
Endif
For INTEGER006 = 1 To INTEGER004
AnsiPos TINTEGER003(INTEGER006 * 2 + 1), TINTEGER003(INTEGER006 * 2)
Print TSTRING003(134) + TSTRING010(INTEGER006)
Next
AnsiPos 1, TSTRING003(133)
More
FClose 4
Endif
Return
:LABEL013
STRING001 = PPEPath() + "NUV\" + STRING005
Delete STRING001
FCreate 1, STRING001, 2, 0
FOpen 1, STRING001, 2, 0
FPutLn 1, STRING013
FPutLn 1, INTEGER007
FPutLn 1, INTEGER008
FPutLn 1, INTEGER009
FPutLn 1, INTEGER010
If (INTEGER010 == 1) Then
FPutLn 1, Upper(U_Name())
Else
For INTEGER006 = 1 To INTEGER010 - 1
FPutLn 1, TSTRING011(INTEGER006)
Next
FPutLn 1, Upper(U_Name())
Endif
If (INTEGER011 <> 0) Then
FPutLn 1, INTEGER011
For INTEGER006 = 1 To INTEGER011
FPutLn 1, TSTRING012(INTEGER006)
Next
Else
FPutLn 1, "0"
Endif
FClose 1
Gosub LABEL014
Return
:LABEL014
STRING014 = Upper(STRING013)
If (INTEGER007 == TSTRING003(95)) Then
If (TSTRING003(97) == 0) Then
GetAltUser U_RecNum(STRING014)
U_Sec = TSTRING003(97)
PutUser
Delete STRING001
Delete STRING002
Goto LABEL015
Endif
For INTEGER006 = 1 To INTEGER010
If (Upper(TSTRING003(98)) == Upper(TSTRING011(INTEGER006))) Then
GetAltUser U_RecNum(STRING014)
U_Sec = TSTRING003(97)
PutUser
Delete STRING001
Delete STRING002
Endif
Next
Endif
:LABEL015
If (INTEGER008 == TSTRING003(96)) Then
GetAltUser U_RecNum(STRING014)
U_Sec = TSTRING003(98)
U_ExpSec = TSTRING003(98)
PutUser
Delete STRING002
Delete STRING001
Endif
Return
:LABEL016
Color 15
AnsiPos 1, TSTRING003(135)
ClrEol
Print TSTRING007(37) + " "
BOOLEAN001 = 0
STRING008 = ""
:LABEL017
If (BOOLEAN001) Goto LABEL018
STRING008 = Inkey()
If (Len(STRING008)) Then
If (Upper(STRING008) == "Y") Then
Color 15
AnsiPos 1, TSTRING003(135)
ClrEol
Print TSTRING007(38)
InputStr " _", STRING009, 15, TSTRING003(116), Mask_Ascii(), 0
If (STRING009 <> "") Then
INTEGER011 = INTEGER011 + 1
TSTRING012(INTEGER011) = STRING009
BOOLEAN001 = 1
Endif
Endif
If (Upper(STRING008) == "N") Then
AnsiPos 1, TSTRING003(135)
Color 15
ClrEol
BOOLEAN001 = 1
Endif
Endif
Goto LABEL017
:LABEL018
Return
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 7 End
; 2 Cls
; 3 ClrEol
; 1 More
; 6 Color
; 90 Goto
; 90 Let
; 29 Print
; 4 PrintLn
; 68 If
; 2 DispFile
; 1 FCreate
; 9 FOpen
; 1 FAppend
; 11 FClose
; 27 FGet
; 12 FPutLn
; 3 PutUser
; 7 Delete
; 1 InputStr
; 7 Gosub
; 8 Return
; 1 Shell
; 31 AnsiPos
; 3 GetAltUser
;
;
; ■ Functions used :
;
; 6 *
; 81 +
; 7 -
; 39 ==
; 6 <>
; 16 <
; 15 <=
; 2 >
; 30 >=
; 60 !
; 30 &&
; 17 ||
; 3 Len(
; 8 Upper()
; 1 Mid()
; 2 Left()
; 1 Chr()
; 3 U_Name()
; 2 Inkey()
; 1 Mask_Ascii()
; 18 PPEPath()
; 4 Exist()
; 3 U_RecNum()
;
;------------------------------------------------------------------------------
;
; Analysis flags : WRS
;
; 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
;
; 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
;
; S - Shell to DOS ■ 5
; This may be normal if the PPE need to execute an external command,
; but may be actually anything... nasty (formating HD, rebooting,...)
; or usefull (sorting, maintenance,...). Check!
; ■ Search for : SHELL
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 14 For/Next
; 1 While/EndWhile
; 32 If/Then or If/Then/Else
; 2 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------