home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
PWA-UL21.ZIP
/
UP.PPE
(
.txt
)
< prev
Wrap
PCBoard Programming Language Executable
|
1993-10-29
|
10KB
|
680 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 1.OO (plain) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Boolean BOOLEAN001
Boolean BOOLEAN002
Boolean BOOLEAN003
Boolean BOOLEAN004
Boolean BOOLEAN005
Boolean BOOLEAN006
Boolean BOOLEAN007
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
String STRING001
String STRING002
String STRING003
String TSTRING004(7)
String STRING005
String STRING006
String TSTRING007(100)
String TSTRING008(100)
String STRING009
String STRING010
String STRING011
String STRING012
String STRING013
String STRING014
String STRING015
String STRING016
;------------------------------------------------------------------------------
INTEGER012 = 1
INTEGER010 = 1
BOOLEAN006 = 0
INTEGER007 = PcbNode()
STRING012 = " "
STRING005 = " "
TSTRING004(4) = " "
BOOLEAN004 = 0
INTEGER005 = 0
INTEGER006 = 3
STRING002 = ReadLine(PCBDat(), 198)
FOpen 1, PPEPath() + "UP.CFG", 0, 0
FGet 1, STRING001
FGet 1, TSTRING004(1)
FGet 1, TSTRING004(2)
FGet 1, TSTRING004(3)
FGet 1, TSTRING004(5)
FGet 1, TSTRING004(6)
FGet 1, TSTRING004(7)
FGet 1, STRING006
FGet 1, STRING003
FClose 1
If (Exist(PPEPath() + "UPLD." + I2S(INTEGER007, 10))) Then
Delete PPEPath() + "UPLD." + I2S(INTEGER007, 10)
Endif
BOOLEAN001 = 0
INTEGER001 = 0
While (BOOLEAN001 == 0) Do
Inc INTEGER001
If (Exist(PPEPath() + I2S(INTEGER001, 10) + "." + I2S(INTEGER007, 10))) Then
Delete PPEPath() + I2S(INTEGER001, 10) + "." + I2S(INTEGER007, 10)
Continue
Endif
BOOLEAN001 = 1
EndWhile
Cls
StartDisp 1
BOOLEAN003 = 0
DispFile PPEPath() + "UP.ANS", 1
AnsiPos 71, 18
Print "@X0BFull"
AnsiPos 71, 19
Print "@X0BScreen"
AnsiPos 71, 20
Print "@X0BUpload"
AnsiPos 71, 21
Print "@X0B v2.1"
AnsiPos 71, 22
Print " @X08L@X07F@X0E[@X08P@X07W@X0FA@X0E]"
:LABEL001
Inc INTEGER005
:LABEL002
AnsiPos 8, 21
Print TSTRING004(4)
AnsiPos 8, 21
Print TSTRING004(1)
AnsiPos 5, 5
Print TSTRING004(4)
AnsiPos 15, 3
Print " "
AnsiPos 15, 3
TSTRING007(INTEGER005) = ""
InputStr "_", TSTRING007(INTEGER005), 8, 12, Mask_Ascii(), 4096
If (Lower(TSTRING007(INTEGER005)) == "edit") Then
If (INTEGER005 == 1) Then
INTEGER005 = INTEGER005 - 1
If (INTEGER005 == 0) BOOLEAN003 = 0
Goto LABEL001
Endif
INTEGER005 = INTEGER005 - 1
If (INTEGER005 == 0) BOOLEAN003 = 0
Gosub LABEL015
Goto LABEL001
Endif
INTEGER002 = Len(TSTRING007(INTEGER005))
If ((INTEGER002 >= 1) && (INTEGER002 <= 12)) Then
If ((((((InStr(TSTRING007(INTEGER005), " ") || InStr(TSTRING007(INTEGER005), ",")) || InStr(TSTRING007(INTEGER005), ":")) || InStr(TSTRING007(INTEGER005), "\")) || InStr(TSTRING007(INTEGER005), "*")) || InStr(TSTRING007(INTEGER005), "<")) || InStr(TSTRING007(INTEGER005), ">")) Goto LABEL003
INTEGER003 = InStr(TSTRING007(INTEGER005), ".")
If (Left(TSTRING007(INTEGER005), 1) <> ".") Then
If (((INTEGER003 == 0) && (INTEGER002 <= 8)) || (INTEGER002 - INTEGER003 <= 3)) Then
Else
Endif
:LABEL003
ElseIf ((BOOLEAN003 == 1) && (INTEGER002 == 0)) Then
Goto LABEL013
ElseIf (INTEGER002 == 0) Then
FClose 2
Cls
End
Else
INTEGER005 = INTEGER005 - 1
Goto LABEL001
Endif
Endif
AnsiPos 8, 21
Print STRING005
AnsiPos 8, 21
Print TSTRING004(2)
FOpen 1, STRING001, 0, 0
Frewind 1
BOOLEAN005 = 0
BOOLEAN001 = 0
While (BOOLEAN001 == 0) Do
FGet 1, STRING009
If (Exist(STRING009 + TSTRING007(INTEGER005))) Then
BOOLEAN005 = 1
BOOLEAN001 = 1
Endif
If (Ferr(1)) BOOLEAN001 = 1
EndWhile
If (BOOLEAN005 == 1) Then
AnsiPos 5, 5
Print TSTRING004(4)
AnsiPos 5, 5
Print TSTRING004(5)
For INTEGER014 = 1 To 650
Next
If (CurSec() >= SysopSec()) Then
AnsiPos 5, 5
Print TSTRING004(5)
AnsiPos 5, 5
Print STRING006
:LABEL004
STRING010 = Inkey()
If (Lower(STRING010) == "y") Then
BOOLEAN004 = 1
AnsiPos 5, 5
Print STRING005
FClose 1
Goto LABEL007
Goto LABEL005
Endif
If (Lower(STRING010) == "n") Then
AnsiPos 5, 5
Print STRING005
FClose 1
INTEGER005 = INTEGER005 - 1
If (INTEGER005 == 0) BOOLEAN003 = 0
Goto LABEL001
Endif
:LABEL005
FClose 1
Goto LABEL004
Goto LABEL006
Endif
FClose 1
Goto LABEL002
Endif
:LABEL006
FClose 1
:LABEL007
AnsiPos 8, 21
Print TSTRING004(4)
AnsiPos 8, 21
Print TSTRING004(3)
INTEGER006 = INTEGER006 + 1
If (INTEGER006 == 22) Then
BOOLEAN006 = 1
INTEGER010 = INTEGER010 + 1
INTEGER012 = INTEGER012 + 1
For INTEGER004 = 4 To 21
AnsiPos 52, INTEGER004
Print "@X07 "
Next
INTEGER006 = 4
Endif
AnsiPos 52, INTEGER006
Print "@X07" + Upper(TSTRING007(INTEGER005))
FCreate 2, PPEPath() + I2S(INTEGER005, 10) + "." + I2S(INTEGER007, 10), 2, 0
AnsiPos 5, 5
Print STRING003
:LABEL008
STRING010 = Inkey()
Select Case (Lower(STRING010))
Case "y"
FPutLn 2, TSTRING007(INTEGER005)
If (BOOLEAN004 == 1) FPutLn 2, "Y"
FPutLn 2, "∞ Description in FILE_ID.DIZ ∞"
FPutLn 2
FPutLn 2
FClose 2
AnsiPos 5, 5
Print TSTRING004(4)
Goto LABEL011
Case "n"
AnsiPos 5, 5
Print TSTRING004(4)
Goto LABEL009
End Select
Goto LABEL008
:LABEL009
BOOLEAN002 = 0
INTEGER011 = -1
INTEGER001 = 7
INTEGER004 = 0
While (BOOLEAN002 == 0) Do
Inc INTEGER001
Inc INTEGER004
Inc INTEGER011
If (INTEGER011 == S2I(STRING002, 10)) Then
BOOLEAN002 = 1
Continue
Endif
STRING011 = ""
:LABEL010
AnsiPos 4, INTEGER001
InputStr "_", STRING011, 9, 39, Mask_Ascii(), 4096 + 512
If (((Len(STRING011) > 0) && (Len(STRING011) <= 4)) && (INTEGER004 == 1)) Then
AnsiPos 5, 5
Print TSTRING004(4)
AnsiPos 5, 5
Print TSTRING004(7)
Goto LABEL010
Endif
If (((STRING011 == "") && (INTEGER004 == 1)) && (BOOLEAN003 == 0)) Then
FClose 2
Cls
End
Endif
If ((STRING011 == "") && (INTEGER004 == 1)) Goto LABEL012
If (STRING011 == "") BOOLEAN002 = 1
If (INTEGER001 == 17) Then
For INTEGER001 = 8 To 17
AnsiPos 4, INTEGER001
Print STRING012
Next
INTEGER001 = 7
Endif
If (INTEGER004 == 1) FPutLn 2, TSTRING007(INTEGER005)
If ((INTEGER004 == 1) && (BOOLEAN004 == 1)) FPutLn 2, "Y"
FPutLn 2, STRING011
EndWhile
FPutLn 2
FClose 2
:LABEL011
BOOLEAN003 = 1
:LABEL012
For INTEGER004 = 8 To 17
AnsiPos 4, INTEGER004
Print STRING005
Next
Goto LABEL001
:LABEL013
If ((INTEGER005 == 0) || (INTEGER005 < 0)) Then
Cls
End
Endif
If (Exist(PPEPath() + "1." + I2S(PcbNode(), 10))) Goto LABEL014
Cls
End
:LABEL014
Cls
FCreate 1, PPEPath() + "UPLD." + I2S(INTEGER007, 10), 2, 0
For INTEGER004 = 1 To INTEGER005 - 1
FOpen 2, PPEPath() + I2S(INTEGER004, 10) + "." + I2S(INTEGER007, 10), 0, 0
BOOLEAN001 = 0
While (BOOLEAN001 == 0) Do
FGet 2, STRING013
If (STRING013 <> "") Then
FPutLn 1, STRING013
Continue
Endif
If ((STRING013 == "") && (INTEGER004 <> INTEGER005 - 1)) Then
FPutLn 1
BOOLEAN001 = 1
Continue
Endif
FPutLn 1
FPutLn 1
BOOLEAN001 = 1
EndWhile
FClose 2
Next
FClose 1
KbdStuff "UB" + Chr(13)
KbdFile PPEPath() + "UPLD." + I2S(INTEGER007, 10)
End
:LABEL015
AnsiPos 8, 21
Print TSTRING004(4)
AnsiPos 8, 21
Print TSTRING004(6)
INTEGER008 = 3 + INTEGER005 - (INTEGER010 - 1) * 18
AnsiPos 52, INTEGER008
Goto LABEL020
:LABEL016
BOOLEAN007 = 0
INTEGER001 = 0
While (BOOLEAN007 == 0) Do
Inc INTEGER001
If (INTEGER005 - 18 * INTEGER001 < 0) Then
INTEGER012 = INTEGER001
If (INTEGER012 == 1) BOOLEAN006 = 0
INTEGER006 = 3 + INTEGER005 - (INTEGER012 - 1) * 18
BOOLEAN007 = 1
Endif
EndWhile
STRING014 = Inkey()
If (STRING014 <> "") Then
Select Case (Lower(STRING014))
Case "x"
Gosub LABEL019
INTEGER010 = INTEGER012
Gosub LABEL026
Return
Case "."
Gosub LABEL019
Cls
End
Case "e"
INTEGER009 = INTEGER008 + (INTEGER010 - 1) * 18 - 3
Gosub LABEL021
AnsiPos 52, INTEGER008
Goto LABEL016
Case "d"
Gosub LABEL019
INTEGER009 = INTEGER008 - 3 + (INTEGER010 - 1) * 18
INTEGER001 = 0
If (INTEGER005 == 1) Then
Gosub LABEL019
Delete PPEPath() + I2S(1, 10) + "." + I2S(INTEGER007, 10)
AnsiPos 52, INTEGER008
Print "@X0F "
INTEGER006 = 3
INTEGER005 = 0
Return
Endif
For INTEGER004 = 1 To INTEGER005
Inc INTEGER001
If (INTEGER004 <> INTEGER009) Then
TSTRING008(INTEGER001) = TSTRING007(INTEGER004)
Continue
Endif
INTEGER001 = INTEGER001 - 1
Next
For INTEGER004 = 1 To INTEGER001
TSTRING007(INTEGER004) = TSTRING008(INTEGER004)
Next
Delete PPEPath() + I2S(INTEGER009, 10) + "." + I2S(INTEGER007, 10)
For INTEGER004 = INTEGER009 + 1 To INTEGER005
Rename PPEPath() + I2S(INTEGER004, 10) + "." + I2S(INTEGER007, 10), PPEPath() + I2S(INTEGER004 - 1, 10) + "." + I2S(INTEGER007, 10)
Next
If ((INTEGER008 == 4) && (INTEGER006 == 4)) Then
INTEGER010 = INTEGER010 - 1
INTEGER012 = INTEGER012 - 1
INTEGER006 = 21
INTEGER008 = 21
Gosub LABEL026
Goto LABEL020
ElseIf (INTEGER005 - (INTEGER010 - 1) * 18 + INTEGER008 - 3 == 0) Then
INTEGER008 = INTEGER008 - 1
Endif
INTEGER005 = INTEGER005 - 1
If (INTEGER005 == 0) BOOLEAN003 = 0
INTEGER006 = INTEGER006 - 1
Gosub LABEL026
AnsiPos 52, INTEGER008
Goto LABEL020
Case "z", "DOWN"
Gosub LABEL019
INTEGER008 = INTEGER008 + 1
If (BOOLEAN006 == 0) Then
If (INTEGER008 == 4 + INTEGER005) Then
INTEGER008 = 4
Endif
AnsiPos 52, INTEGER008
Goto LABEL020
ElseIf (INTEGER010 == INTEGER012) Then
If (INTEGER008 == 4 + INTEGER005 - (INTEGER010 - 1) * 18) Then
INTEGER010 = 1
INTEGER008 = 4
Gosub LABEL026
Goto LABEL020
Else
AnsiPos 52, INTEGER008
Goto LABEL020
Endif
ElseIf (INTEGER008 == 22) Then
INTEGER010 = INTEGER010 + 1
INTEGER008 = 4
Gosub LABEL026
Goto LABEL020
Else
AnsiPos 52, INTEGER008
Goto LABEL020
Endif
Case "a", "UP"
Gosub LABEL019
INTEGER008 = INTEGER008 - 1
If (BOOLEAN006 == 0) Then
If (INTEGER008 < 4) Then
INTEGER008 = 3 + INTEGER005
Endif
AnsiPos 52, INTEGER008
Goto LABEL020
Goto LABEL018
Endif
If (INTEGER010 == 1) Then
If (INTEGER008 < 4) Then
INTEGER010 = INTEGER012
INTEGER008 = 3 + INTEGER005 - (INTEGER010 - 1) * 18
Gosub LABEL026
Goto LABEL020
Goto LABEL017
Endif
AnsiPos 52, INTEGER008
Goto LABEL020
:LABEL017
Goto LABEL018
Endif
If (INTEGER008 < 4) Then
INTEGER010 = INTEGER010 - 1
INTEGER008 = 21
Gosub LABEL026
Goto LABEL020
Goto LABEL018
Endif
AnsiPos 52, INTEGER008
Else
End Select
:LABEL018
Goto LABEL016
:LABEL019
AnsiPos 52, INTEGER008
Print STRING015
Return
Endif
:LABEL020
STRING015 = ScrText(52, INTEGER008, 12, 1)
STRING016 = RTrim(ScrText(52, INTEGER008, 12, 0), " ")
Color 112
Print STRING016
Goto LABEL016
:LABEL021
FCreate 4, PPEPath() + I2S(INTEGER009, 10) + "." + I2S(INTEGER007, 10), 2, 0
AnsiPos 5, 5
Print STRING003
:LABEL022
STRING010 = Inkey()
Select Case (Lower(STRING010))
Case "y"
FPutLn 4, TSTRING007(INTEGER009)
If (BOOLEAN004 == 1) FPutLn 4, "Y"
FPutLn 4, "∞ Description in FILE_ID.DIZ ∞"
FPutLn 4
FPutLn 4
FClose 4
AnsiPos 5, 5
Print TSTRING004(4)
Goto LABEL025
Case "n"
AnsiPos 5, 5
Print TSTRING004(4)
Goto LABEL023
End Select
Goto LABEL022
:LABEL023
BOOLEAN002 = 0
INTEGER001 = 7
INTEGER004 = 0
While (BOOLEAN002 == 0) Do
Inc INTEGER001
Inc INTEGER004
STRING011 = ""
:LABEL024
AnsiPos 4, INTEGER001
InputStr "_", STRING011, 9, 39, Mask_Ascii(), 4096 + 512
If (((Len(STRING011) > 0) && (Len(STRING011) <= 4)) && (INTEGER004 == 1)) Then
AnsiPos 5, 5
Print TSTRING004(4)
AnsiPos 5, 5
Print TSTRING004(6)
Goto LABEL024
Endif
If (STRING011 == "") BOOLEAN002 = 1
If (INTEGER001 == 17) Then
For INTEGER001 = 8 To 17
AnsiPos 4, INTEGER001
Print STRING012
Next
INTEGER001 = 7
Endif
If (INTEGER004 == 1) FPutLn 4, TSTRING007(INTEGER009)
FPutLn 4, STRING011
EndWhile
FPutLn 4
FClose 4
:LABEL025
BOOLEAN003 = 1
For INTEGER004 = 8 To 17
AnsiPos 4, INTEGER004
Print STRING005
Next
Return
:LABEL026
For INTEGER001 = 4 To 21
AnsiPos 52, INTEGER001
Print "@X07 "
Next
If (BOOLEAN006 == 0) Then
For INTEGER001 = 1 To INTEGER005
AnsiPos 52, INTEGER001 + 3
Print Upper(TSTRING007(INTEGER001))
Next
Return
Else
INTEGER004 = INTEGER005 - (INTEGER010 - 1) * 18
If (INTEGER004 <= 18) Then
For INTEGER001 = 1 To INTEGER004
INTEGER013 = INTEGER001 + 3
AnsiPos 52, INTEGER013
Print Upper(TSTRING007((INTEGER010 - 1) * 18 + INTEGER001))
Next
Else
For INTEGER001 = 1 To 18
INTEGER013 = INTEGER001 + 3
AnsiPos 52, INTEGER013
Print Upper(TSTRING007((INTEGER010 - 1) * 18 + INTEGER001))
Next
Endif
AnsiPos 52, INTEGER008
Return
Endif
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 6 End
; 7 Cls
; 1 Color
; 156 Goto
; 128 Let
; 44 Print
; 88 If
; 1 DispFile
; 3 FCreate
; 3 FOpen
; 14 FClose
; 11 FGet
; 21 FPutLn
; 1 StartDisp
; 4 Delete
; 3 InputStr
; 15 Gosub
; 6 Return
; 9 Inc
; 1 KbdStuff
; 1 KbdFile
; 56 AnsiPos
; 1 Rename
; 1 Frewind
;
;
; ■ Functions used :
;
; 1 -
; 11 *
; 78 +
; 37 -
; 65 ==
; 5 <>
; 19 <
; 20 <=
; 2 >
; 30 >=
; 74 !
; 41 &&
; 24 ||
; 5 Len(
; 13 Lower()
; 4 Upper()
; 1 Left()
; 1 Ferr()
; 1 Chr()
; 8 InStr()
; 1 RTrim()
; 4 Inkey()
; 3 Mask_Ascii()
; 1 PCBDat()
; 16 PPEPath()
; 2 PcbNode()
; 1 ReadLine()
; 1 SysopSec()
; 1 CurSec()
; 4 Exist()
; 23 I2S()
; 1 S2I()
; 2 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
;
; 14 For/Next
; 6 While/EndWhile
; 42 If/Then or If/Then/Else
; 3 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------