home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Carsten's PPE Collection
/
Carstens_PPE_Collection_2007.zip
/
T
/
THTUP111.ZIP
/
UPLOAD.PPE
(
.txt
)
< prev
Wrap
PCBoard Programming Language Executable
|
1993-12-28
|
10KB
|
676 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
;------------------------------------------------------------------------------
Integer INTEGER001
Integer INTEGER002
Integer INTEGER003
Integer INTEGER004
Integer INTEGER005
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
String STRING039
String STRING040
String STRING041
String STRING042
String STRING043
String STRING044
String STRING045
String STRING046
String STRING047
String STRING048
String STRING049
String STRING050
String STRING051
String STRING052
String STRING053
String STRING054
String STRING055
String STRING056
String STRING057
String STRING058
String STRING059
String STRING060
String STRING061
String STRING062
String STRING063
String STRING064
String STRING065
String STRING066
String STRING067
String STRING068
String STRING069
String STRING070
String STRING071
String STRING072
;------------------------------------------------------------------------------
STRING050 = Chr(13) + Chr(10)
INTEGER001 = 0
STRING051 = 0
STRING052 = 0
STRING057 = 1
INTEGER003 = 0
STRING048 = STRING057 + "." + String(PcbNode())
Delete STRING057 + "." + String(PcbNode())
STRING055 = CurConf()
STRING055 = Strip(STRING055, "(")
STRING055 = Strip(STRING055, ")")
AnsiPos 1, 10
STRING019 = "@X71" + Chr(84) + Chr(72) + Chr(84) + "-" + Chr(85) + Chr(80) + Chr(76) + " @X74v" + Chr(49) + "." + Chr(49) + Chr(49) + " " + "@X76Compiled on @X7012-28-93"
STRING031 = "@X71" + Chr(67) + Chr(111) + Chr(100) + Chr(101) + Chr(100) + "@X74 " + Chr(66) + Chr(121) + "@X70 " + Chr(84) + Chr(104) + Chr(101) + "@X71 " + Chr(77) + Chr(97) + Chr(115) + Chr(116) + Chr(101) + Chr(114)
If (Exist(PPEPath() + PPEName() + "." + STRING055)) Then
DispFile PPEPath() + PPEName() + "." + STRING055, 2 + 4 + 1
Goto LABEL001
Endif
:LABEL001
FOpen 1, PPEPath() + PPEName() + ".cnf", 2, 0
If (Ferr(1)) Goto LABEL002
FGet 1, STRING024
FGet 1, STRING062
FGet 1, STRING065
FGet 1, STRING066
FGet 1, STRING067
FGet 1, STRING068
FGet 1, STRING069
FGet 1, STRING063
FGet 1, STRING064
FGet 1, STRING033
FGet 1, STRING020
FGet 1, STRING021
FGet 1, STRING022
FGet 1, STRING023
FGet 1, STRING029
FGet 1, STRING034
:LABEL002
FClose 1
Tokenize STRING021
GetToken STRING052
GetToken STRING053
STRING049 = "FLIST" + "." + String(PcbNode())
If (Exist(STRING049)) Then
Gosub LABEL019
Goto LABEL003
Endif
:LABEL003
Cls
STRING046 = ScrText(1, 1, 48, 0)
StartDisp 1
If (STRING019 <> "@X71THT-UPL @X74v1.11" + " " + "@X76Compiled on @X7012-28-93") Goto LABEL028
AnsiPos 2, 1
PrintLn STRING019 + "@POS:60@" + STRING031
DispFile PPEPath() + "BOX2", 2 + 4 + 1
STRING032 = ReadLine(PCBDat(), 96)
AnsiPos 20, 5
PrintLn STRING032 + STRING033
:LABEL004
DefColor
Tokenize STRING022
GetToken STRING056
GetToken STRING030
STRING072 = ""
STRING059 = ""
Tokenize STRING029
GetToken STRING027
GetToken STRING028
AnsiPos STRING027, STRING028
PrintLn " "
AnsiPos STRING052, STRING053
ClrEol
If (STRING051 <> 0) Then
AnsiPos STRING056, STRING030
Print STRING046
AnsiPos STRING056, STRING030 + 1
Print STRING046
AnsiPos STRING056, STRING030 + 2
Print STRING046
AnsiPos STRING056, STRING030 + 3
Print STRING046
AnsiPos STRING056, STRING030 + 4
Print STRING046
AnsiPos STRING056, STRING030 + 5
Print STRING046
AnsiPos STRING056, STRING030 + 6
Print STRING046
AnsiPos STRING056, STRING030 + 7
Print STRING046
AnsiPos STRING056, STRING030 + 8
Print STRING046
AnsiPos STRING056, STRING030 + 9
Print STRING046
AnsiPos STRING056, STRING030 + 10
Print STRING046
AnsiPos STRING056, STRING030 + 11
Print STRING046
Endif
AnsiPos STRING027, STRING028
InputStr "_", STRING059, "", 12, Mask_File(), 8 + 0
If (STRING059 == "") Goto LABEL025
Gosub LABEL017
Gosub LABEL014
If (Exist(STRING057 + "." + String(PcbNode()))) Then
FOpen 1, STRING057 + "." + String(PcbNode()), 0, 0
Endif
:LABEL005
If (Ferr(1)) Goto LABEL006
FGet 1, STRING070
If (STRING070 == STRING058) Goto LABEL020
Goto LABEL005
:LABEL006
STRING060 = "Y"
ClrEol
AnsiPos STRING052, STRING053
PrintLn STRING064
AnsiPos STRING052, STRING053 + 1
InputYN STRING063, STRING060, " "
If (STRING060 == YesChar()) Goto LABEL007
If (STRING060 == NoChar()) Goto LABEL008
:LABEL007
AnsiPos 0, 23
ClrEol
Goto LABEL011
:LABEL008
AnsiPos 0, 22
ClrEol
AnsiPos 0, 23
ClrEol
:LABEL009
FClose 1
STRING051 = 1
INTEGER002 = ReadLine(PCBDat(), 198)
For STRING061 = 1 To INTEGER002
STRING018 = ""
If (STRING051 == INTEGER002) Gosub LABEL010
AnsiPos STRING056, STRING030
PrintLn "@X0D" + STRING051 + "@X0E>"
AnsiPos STRING056 + 3, STRING030
InputStr "_", STRING018, " ", 45, Mask_Ascii(), 512
If (STRING018 == "") Goto LABEL023
If (Len(STRING018) >= 1) Then
If ((Len(STRING018) < STRING020) && (STRING051 == 1)) Then
AnsiPos STRING052, STRING053
ClrEol
PrintLn STRING065
Delay 25
AnsiPos STRING052, STRING053
ClrEol
Goto LABEL009
Continue
Endif
FAppend 1, STRING057 + "." + String(PcbNode()), 1, 0
If (STRING051 == 1) FPutLn 1, STRING058
If ((INTEGER003 + STRING028 > 20) && (STRING051 == 1)) Then
Gosub LABEL013
Endif
If (INTEGER003 + STRING028 < 20) Then
AnsiPos STRING056 + 54, INTEGER003 + STRING028
PrintLn STRING034 + RTrim(STRING058, " ")
Endif
If (STRING051 <> INTEGER002) FPutLn 1, STRING018
If (STRING051 == INTEGER002) FPut 1, STRING018
Inc STRING030
Inc STRING051
If (STRING030 > 20) Then
STRING030 = 9
Inc STRING030
STRING035 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING036 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING037 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING038 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING039 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING040 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING041 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING042 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING043 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING044 = ScrText(11, STRING030, 48, 1)
Inc STRING030
STRING045 = ScrText(11, STRING030, 48, 1)
Tokenize STRING022
GetToken STRING056
GetToken STRING030
AnsiPos STRING056, STRING030
Print STRING035
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING036
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING037
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING038
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING039
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING040
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING041
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING042
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING043
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING044
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING045
Inc STRING030
AnsiPos STRING056, STRING030
Print STRING046
Endif
Endif
Next
Goto LABEL023
:LABEL010
Tokenize STRING023
GetToken STRING025
GetToken STRING026
AnsiPos 1, STRING026
ClrEol
AnsiPos STRING025, STRING026
PrintLn "@X8CLast Description Line@X07"
Return
:LABEL011
FClose 1
FAppend 1, STRING057 + "." + String(PcbNode()), 1, 0
FPut 1, STRING058 + STRING050
If (STRING072 == YesChar()) FPutLn 1, STRING072
FPut 1, STRING062 + STRING050 + STRING050
If (INTEGER003 + STRING028 > 20) Then
Gosub LABEL013
INTEGER003 = 21
FClose 1
Else
AnsiPos STRING056 + 54, INTEGER003 + STRING028
PrintLn STRING034 + RTrim(STRING058, " ")
FClose 1
If (Exist(STRING048)) Then
Inc INTEGER003
Goto LABEL004
Goto LABEL012
Endif
:LABEL012
End
:LABEL013
INTEGER003 = 3
Inc INTEGER003
STRING001 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING002 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING003 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING004 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING005 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING006 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING007 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING008 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING009 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING010 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING011 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING012 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING013 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING014 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING015 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING016 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
Inc INTEGER003
STRING017 = RTrim(ScrText(STRING056 + 54, INTEGER003, 12, 1), " ")
INTEGER003 = 3
AnsiPos STRING056 + 54, INTEGER003
Print STRING001
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING002
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING003
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING004
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING005
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING006
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING007
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING008
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING009
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING010
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING011
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING012
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING013
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING014
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING015
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING016
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print STRING017
Inc INTEGER003
AnsiPos STRING056 + 54, INTEGER003
Print " "
AnsiPos STRING056 + 54, INTEGER003
Print STRING034 + STRING058
Return
:LABEL014
AnsiPos STRING052, STRING053
ClrEol
PrintLn STRING066
STRING054 = STRING024
FOpen 1, STRING054, 2, 0
:LABEL015
If (Ferr(1)) Goto LABEL016
FGet 1, STRING061
If (Exist(STRING061 + STRING058)) Goto LABEL021
Goto LABEL015
:LABEL016
FClose 1
Return
End
:LABEL017
INTEGER005 = Len(STRING059)
If ((INTEGER005 >= 1) && (INTEGER005 <= 12)) Then
INTEGER004 = InStr(STRING059, ".")
If (INTEGER004 == 0) INTEGER004 = INTEGER005 + 1
If (INTEGER004 > 9) Gosub LABEL022
If (INTEGER004 == 1) Gosub LABEL022
If ((INTEGER004 - INTEGER005 > 1) || (INTEGER004 - INTEGER005 < -3)) Gosub LABEL022
If (((FileInf(STRING059, 9) == ".") || (FileInf(STRING059, 9) == "..")) || (FileInf(STRING059, 9) == "...")) Gosub LABEL022
If (FileInf(STRING059, 9) == "") Then
STRING059 = Strip(STRING059, ".")
STRING058 = STRING059 + STRING032
Return
Goto LABEL018
Endif
STRING058 = STRING059
Return
Endif
:LABEL018
End
:LABEL019
Cls
AnsiPos STRING052, STRING053
ClrEol
PrintLn STRING067
Newline
STRING071 = "N"
PromptStr 449, STRING071, 1, "YyNn", 2 + 4 + 8 + 128
If (STRING071 == NoChar()) Goto LABEL028
If (STRING071 == YesChar()) Then
FAppend 1, STRING057 + "." + String(PcbNode()), 1, 0
FPut 1, STRING071 + STRING050
FClose 1
FreshLine
Return
Endif
:LABEL020
AnsiPos STRING052, STRING053
ClrEol
PrintLn "@X0E" + STRING058 + " " + "@X0CIs Already in the List"
Delay 20
FClose 1
Goto LABEL004
End
:LABEL021
If (CurSec() >= SysopSec()) Then
AnsiPos STRING052, STRING053
ClrEol
InputStr "@X0F" + STRING058 + "@X0E Already Exist Replace It ", STRING060, 1, 14, "YyNncC", 4 + 8
Endif
If (STRING060 == NoChar()) Goto LABEL004
If (STRING060 == YesChar()) Then
STRING072 = YesChar()
Return
Endif
If (CurSec() < SysopSec()) Then
AnsiPos STRING052, STRING053
ClrEol
PrintLn "@X0E" + STRING058 + " " + STRING068
Delay 20
FClose 1
Goto LABEL004
Return
Endif
End
:LABEL022
AnsiPos STRING052, STRING053
PrintLn "@X0E" + STRING059 + " " + STRING069
Delay 20
Goto LABEL004
End
STRING047 = STRING062 + STRING050 + STRING050
KbdStuff STRING047
Return
Endif
:LABEL023
If ((INTEGER002 == STRING051) && (STRING018 <> "")) Goto LABEL024
If ((STRING051 == 1) && (STRING018 == "")) Goto LABEL004
If (STRING051 == 1) Goto LABEL024
FPut 1, Chr(13)
:LABEL024
FClose 1
Inc INTEGER003
Goto LABEL004
End
:LABEL025
If (Exist(STRING048)) Goto LABEL026
Goto LABEL028
Goto LABEL027
:LABEL026
FAppend 1, STRING057 + "." + String(PcbNode()), 1, 0
FPut 1, STRING050
FClose 1
:LABEL027
Cls
KbdStuff "UB"
KbdFile STRING048
End
:LABEL028
Cls
KbdStuff STRING050
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 8 End
; 4 Cls
; 13 ClrEol
; 54 Goto
; 65 Let
; 43 Print
; 14 PrintLn
; 44 If
; 2 DispFile
; 3 FOpen
; 4 FAppend
; 11 FClose
; 18 FGet
; 6 FPut
; 3 FPutLn
; 1 StartDisp
; 1 DefColor
; 1 Delete
; 3 InputStr
; 1 InputYN
; 10 Gosub
; 9 Return
; 1 PromptStr
; 4 Delay
; 60 Inc
; 1 Newline
; 5 Tokenize
; 10 GetToken
; 3 KbdStuff
; 1 KbdFile
; 68 AnsiPos
; 1 FreshLine
;
;
; ■ Functions used :
;
; 1 -
; 157 +
; 2 -
; 25 ==
; 4 <>
; 5 <
; 2 <=
; 5 >
; 5 >=
; 22 !
; 7 &&
; 4 ||
; 3 Len(
; 3 Ferr()
; 28 Chr()
; 1 InStr()
; 19 RTrim()
; 3 NoChar()
; 5 YesChar()
; 3 Strip()
; 9 String()
; 1 Mask_File()
; 1 Mask_Ascii()
; 1 CurConf()
; 2 PCBDat()
; 4 PPEPath()
; 9 PcbNode()
; 2 ReadLine()
; 2 SysopSec()
; 2 CurSec()
; 6 Exist()
; 4 FileInf()
; 3 PPEName()
; 29 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
;
; 1 For/Next
; 0 While/EndWhile
; 17 If/Then or If/Then/Else
; 0 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------