home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.wwiv.com
/
ftp.wwiv.com.zip
/
ftp.wwiv.com
/
pub
/
BBS
/
CLNP_110.ZIP
/
CLNP.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1995-01-10
|
10KB
|
651 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 3.O1 (Encryption type I) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Boolean BOOLEAN001
Boolean BOOLEAN002
Date DATE001
Date DATE002
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 TSTRING009(8)
String TSTRING010(8)
String TSTRING011(8)
String STRING012
String STRING013
String STRING014
String STRING015
String STRING016
String TSTRING017(2)
String STRING018
String STRING019
String STRING020
String STRING021
String STRING022
String STRING023
String STRING024
String STRING025
String STRING026
String STRING027
String STRING028
String TSTRING029(5)
String STRING030
String STRING031
String STRING032
String STRING033
String STRING034
Double DOUBLE001
Declare Procedure PROC001()
Declare Procedure PROC002()
Declare Procedure PROC004()
Declare Procedure PROC005()
Declare Procedure PROC006()
Declare Procedure PROC007()
Declare Procedure PROC008()
Declare Procedure PROC009(Boolean BOOLEAN003)
Declare Procedure PROC010()
Declare Procedure PROC011()
Declare Procedure PROC012()
;------------------------------------------------------------------------------
STRING001 = Chr(67) + Chr(76) + Chr(78) + Chr(80)
STRING002 = Chr(118) + Chr(49) + Chr(46) + Chr(49) + Chr(48)
STRING013 = "If you have suggestions or requests for permanent or optional features,"
STRING014 = "please send mail to <mslasher@io.org>. - Rob Hunter / CLNP (c)1994-95 "
STRING030 = PPEPath() + STRING001 + Chr(46) + "E" + "X" + "1"
STRING031 = PPEPath() + STRING001 + Chr(46) + "E" + "X" + "2"
STRING004 = PPEPath() + STRING001 + Chr(46) + "D" + "A" + "T"
STRING005 = PPEPath() + STRING001 + Chr(46) + "D" + "S" + "1"
STRING006 = PPEPath() + STRING001 + Chr(46) + "D" + "S" + "2"
STRING007 = PPEPath() + STRING001 + Chr(46) + "N" + "O" + "T"
STRING008 = PPEPath() + STRING001 + Chr(46) + "R" + "E" + "P"
STRING028 = "@X08" + "───────────────────────────────────────────────────────────────────────────────"
TSTRING029(0) = "@X07"
TSTRING029(1) = "@X0F"
TSTRING029(2) = "@X08"
TSTRING029(3) = "@X07"
BOOLEAN002 = 0
STRING027 = 1
STRING024 = 0
STRING019 = 15
STRING021 = "@X08[@X0FS@X08]@X07end or @X08[@X0FA@X08]@X07bort?"
STRING032 = "@X07Write a note to whom? @X08(@X0FEnter@X08)=@X07Abort?"
STRING020 = "@X07Hit @X08[@X0FAny Key@X08]@X07 to Continue ..."
STRING012 = "@X08■@X0F Scanning for Login Notes @X08..."
STRING003 = TokenStr()
PROC005()
If (Exist(STRING004)) PROC001()
If (InStr(Upper(STRING003), "/CHECK") <> 0) Then
PROC007()
Else
PROC008()
Endif
PROC012()
End
;------------------------------------------------------------------------------
Procedure PROC007()
If (!Exist(STRING007)) PROC012()
Print STRING012
If (Exist(STRING008)) PROC002()
PROC006()
If (STRING027) Then
Backup 80
ClrEol
Else
Newline
Endif
If (STRING024) Newline
EndProc
;------------------------------------------------------------------------------
Procedure PROC008()
If (Exist(STRING031)) PROC011()
Newline
If (Exist(STRING005)) DispFile STRING005, 1
If (STRING003 <> "") Then
STRING033 = STRING003
Else
STRING033 = ""
InputStr STRING032 + " _", STRING033, 7, 25, Mask_Ascii(), 4096 + 64 + 8
Endif
If (STRING033 == "") PROC012()
If (U_RecNum(STRING033) == -1) Then
DefColor
PrintLn "Invalid User Name! (User Not Found)"
PROC012()
ElseIf (Exist(STRING030)) Then
PROC010()
Endif
Cls
If (Exist(STRING006)) DispFile STRING006, 1
PrintLn STRING028
PrintLn TSTRING029(1) + Space(24 - Len(RTrim(U_Name(), " ")) / 2) + Chr(46) + Chr(46) + Chr(46) + " " + Mixed(RTrim(U_Name(), " ")) + " has left you this note " + Chr(46) + Chr(46) + Chr(46)
PrintLn STRING028
DefColor
PROC009(0)
TSTRING017(1) = STRING015
BOOLEAN001 = 1
If (!BOOLEAN002) Newline
PROC009(BOOLEAN002)
TSTRING017(2) = STRING015
Newline
DATE001 = Date()
INTEGER004 = DATE001
STRING023 = Left(Time(), 5)
PrintLn STRING028
PrintLn Space(45) + TSTRING029(2) + "└[" + TSTRING029(3) + STRING001 + " " + STRING002 + TSTRING029(2) + "]┘ " + "└[" + TSTRING029(3) + STRING023 + TSTRING029(2) + "][" + TSTRING029(3) + String(DATE001) + TSTRING029(2) + "]┘"
Newline
Print STRING021 + " "
While (Upper(STRING022) <> "A") Do
STRING022 = Inkey()
If (Abort()) ResetDisp
If (Upper(STRING022) == "S") Goto LABEL001
EndWhile
DefColor
PrintLn "A"
PROC012()
:LABEL001
DefColor
Print "*" + "S" + "END" + "ING" + " NOT" + "E" + "*"
If (Exist(STRING007)) Goto LABEL002
FCreate 1, STRING007, 1, 0
PROC004()
FClose 1
Goto LABEL003
:LABEL002
FOpen 1, STRING007, 2, 0
INTEGER001 = 0
While (INTEGER001 < FileInf(STRING007, 4) / 250) Do
Inc INTEGER001
FRead 1, TSTRING009(0), 25
If (TSTRING009(0) == "") Break
If (RTrim(TSTRING009(0), " ") == "<" + STRING001 + ">") Then
FSeek 1, -25, 1
PROC004()
FClose 1
Newlines 2
Log "
" + STRING001 + " " + STRING002 + "
" + "[" + Mixed(STRING033) + "]", 0
PROC012()
Endif
FSeek 1, 225, 1
EndWhile
FClose 1
FAppend 1, STRING007, 2, 0
PROC004()
FClose 1
Newlines 2
Log "
" + STRING001 + " " + STRING002 + "
" + "[" + Mixed(STRING033) + "]", 0
:LABEL003
EndProc
;------------------------------------------------------------------------------
Procedure PROC012()
DefColor
StartDisp 2
End
EndProc
;------------------------------------------------------------------------------
Procedure PROC001()
FOpen 5, STRING004, 0, 0
FGet 5, STRING025
If (Len(StripAtx(STRING025)) == 79) STRING028 = STRING025
FGet 5, STRING025
If ((STRING025 <> "") && (Len(StripAtx(STRING025)) < 70)) STRING012 = STRING025
FGet 5, STRING025
If ((STRING025 <> "") && (Len(StripAtx(STRING025)) < 60)) STRING032 = STRING025
FGet 5, STRING025
If ((STRING025 <> "") && (Len(StripAtx(STRING025)) < 70)) STRING021 = STRING025
FGet 5, STRING025
If ((STRING025 <> "") && (Len(StripAtx(STRING025)) < 44)) STRING020 = STRING025
FGet 5, STRING025
If (STRING025 <> "") TSTRING029(1) = Left(STRING025, 4)
FGet 5, STRING025
If (STRING025 <> "") TSTRING029(2) = Left(STRING025, 4)
FGet 5, STRING025
If (STRING025 <> "") TSTRING029(3) = Left(STRING025, 4)
FGet 5, STRING025
If (STRING025 <> "") STRING019 = STRING025
FClose 5
EndProc
;------------------------------------------------------------------------------
Procedure PROC002()
:LABEL004
FOpen 3, STRING008, 2, 0
INTEGER001 = 0
While (INTEGER001 < FileInf(STRING008, 4) / 60) Do
Inc INTEGER001
FRead 3, TSTRING011(1), 25
If (TSTRING011(1) == "") Then
Break
Endif
If (Upper(Left(TSTRING011(1), Len(U_Name()))) == U_Name()) Then
FSeek 3, -25, 1
FWrite 3, Left("<" + STRING001 + ">", 25), 25
FRead 3, TSTRING011(2), 25
FRead 3, TSTRING011(3), 5
FRead 3, TSTRING011(4), 5
FClose 3
INTEGER005 = TSTRING011(3)
DATE002 = INTEGER005
If (STRING027) Newline
PrintLn TSTRING029(2) + "■" + " [" + TSTRING029(3) + String(DATE002) + TSTRING029(2) + "][" + TSTRING029(3) + String(TSTRING011(4)) + TSTRING029(2) + "] " + TSTRING029(1) + Mixed(RTrim(TSTRING011(2), " ")) + " received your note ..."
STRING027 = 0
Goto LABEL004
Endif
FSeek 3, 35, 1
EndWhile
FClose 3
EndProc
;------------------------------------------------------------------------------
Procedure PROC006()
:LABEL005
STRING026 = Left(Time(), 5)
INTEGER005 = Date()
DOUBLE001 = 0
FOpen 1, STRING007, 2, 0
INTEGER001 = 0
While (INTEGER001 < FileInf(STRING007, 4) / 250) Do
Inc INTEGER001
FRead 1, TSTRING009(1), 25
If (TSTRING009(1) == "") Then
FClose 1
Goto LABEL010
Endif
If (Upper(Left(TSTRING009(1), Len(U_Name()))) == U_Name()) Then
FSeek 1, -25, 1
FWrite 1, Left("<" + STRING001 + ">", 25), 25
FRead 1, TSTRING009(2), 25
FRead 1, TSTRING009(3), 5
FRead 1, TSTRING009(4), 5
FRead 1, TSTRING009(5), 95
FRead 1, TSTRING009(6), 95
FClose 1
If (Exist(STRING008)) Goto LABEL006
FCreate 2, STRING008, 2, 0
FWrite 2, Left(Upper(TSTRING009(2)), 25), 25
FWrite 2, Left(Upper(U_Name()), 25), 25
FWrite 2, Left(INTEGER005, 5), 5
FWrite 2, Left(STRING026, 5), 5
FClose 2
Goto LABEL008
:LABEL006
FOpen 2, STRING008, 2, 0
INTEGER002 = 0
While (INTEGER002 < FileInf(STRING008, 4) / 60) Do
Inc INTEGER002
FRead 2, TSTRING010(1), 25
If (TSTRING010(1) == "") Then
FClose 2
Goto LABEL007
Endif
If (RTrim(TSTRING010(1), " ") == "<" + STRING001 + ">") Then
FSeek 2, -25, 1
FWrite 2, Left(Upper(TSTRING009(2)), 25), 25
FWrite 2, Left(Upper(U_Name()), 25), 25
FWrite 2, Left(INTEGER005, 5), 5
FWrite 2, Left(STRING026, 5), 5
FClose 2
Goto LABEL008
Endif
FSeek 2, 35, 1
EndWhile
FClose 2
:LABEL007
FAppend 2, STRING008, 2, 0
FWrite 2, Left(Upper(TSTRING009(2)), 25), 25
FWrite 2, Left(Upper(U_Name()), 25), 25
FWrite 2, Left(INTEGER005, 5), 5
FWrite 2, Left(STRING026, 5), 5
FClose 2
:LABEL008
INTEGER003 = TSTRING009(3)
DATE001 = INTEGER003
If ((STRING024 == 0) || !AnsiOn()) Then
StartDisp 1
If (STRING027) Newline
Newline
STRING024 = 1
If (STRING024 && !AnsiOn()) Newline
STRING027 = 0
PrintLn STRING028
PrintLn TSTRING029(1) + Space(24 - Len(RTrim(TSTRING009(2), " ")) / 2) + Chr(46) + Chr(46) + Chr(46) + " " + Mixed(RTrim(TSTRING009(2), " ")) + " has left you this note " + Chr(46) + Chr(46) + Chr(46)
PrintLn STRING028
DefColor
PrintLn RTrim(TSTRING009(5), " ") + TSTRING029(0)
DefColor
PrintLn RTrim(TSTRING009(6), " ") + TSTRING029(0)
PrintLn STRING028
Print Space(45) + TSTRING029(2) + "└[" + TSTRING029(3) + STRING001 + " " + STRING002 + TSTRING029(2) + "]┘ " + "└[" + TSTRING029(3) + TSTRING009(4) + TSTRING029(2) + "][" + TSTRING029(3) + String(DATE001) + TSTRING029(2) + "]┘"
Backup 80
DefColor
Print STRING020 + " "
STRING034 = ""
While (STRING034 == "") Do
STRING034 = Inkey()
Delay 3
Inc DOUBLE001
If (DOUBLE001 / 6 > STRING019) Goto LABEL005
EndWhile
Backup 80
Print Space(45)
Backup 80
Goto LABEL009
Endif
Backup 80
Print "A"
DefColor
ClrEol
PrintLn TSTRING029(1) + Space(24 - Len(RTrim(TSTRING009(2), " ")) / 2) + Chr(46) + Chr(46) + Chr(46) + " " + Mixed(RTrim(TSTRING009(2), " ")) + " has left you this note " + Chr(46) + Chr(46) + Chr(46)
Newline
DefColor
ClrEol
PrintLn RTrim(TSTRING009(5), " ") + TSTRING029(0)
DefColor
ClrEol
PrintLn RTrim(TSTRING009(6), " ") + TSTRING029(0)
Newline
DefColor
Print Space(45) + TSTRING029(2) + "└[" + TSTRING029(3) + STRING001 + " " + STRING002 + TSTRING029(2) + "]┘ " + "└[" + TSTRING029(3) + TSTRING009(4) + TSTRING029(2) + "][" + TSTRING029(3) + String(DATE001) + TSTRING029(2) + "]┘" + TSTRING029(0)
Backup 80
Print STRING020 + " "
STRING034 = ""
While (STRING034 == "") Do
STRING034 = Inkey()
Delay 3
Inc DOUBLE001
If (DOUBLE001 / 6 > STRING019) Goto LABEL005
EndWhile
Backup 80
Print Space(45)
Backup 80
:LABEL009
Goto LABEL005
Endif
FSeek 1, 225, 1
EndWhile
FClose 1
:LABEL010
EndProc
;------------------------------------------------------------------------------
Procedure PROC011()
FOpen 6, STRING031, 0, 0
:LABEL011
If (Ferr(6)) Goto LABEL012
FGet 6, STRING025
If (Left(Upper(STRING025), Len(U_Name())) == U_Name()) Then
FClose 6
DefColor
Newline
PrintLn "Invalid Access!"
PROC012()
Endif
Goto LABEL011
:LABEL012
FClose 6
EndProc
;------------------------------------------------------------------------------
Procedure PROC010()
FOpen 6, STRING030, 0, 0
:LABEL013
If (Ferr(6)) Goto LABEL014
FGet 6, STRING025
If (Left(Upper(STRING025), Len(STRING033)) == Upper(STRING033)) Then
FClose 6
DefColor
PrintLn "Invalid User Name! (User does not accept notes)"
PROC012()
Endif
Goto LABEL013
:LABEL014
FClose 6
EndProc
;------------------------------------------------------------------------------
Procedure PROC005()
If (STRING001 <> PPEName()) PROC012()
EndProc
If (FileInf(PPEPath() + PPEName() + ".PPE", 4) <> 9634) PROC012()
EndProc
;------------------------------------------------------------------------------
Procedure PROC009(Boolean BOOLEAN003)
If (BOOLEAN003) Goto LABEL015
DefColor
STRING018 = ""
STRING015 = ""
Goto LABEL016
:LABEL015
STRING015 = STRING016
:LABEL016
While (STRING018 <> Chr(13)) Do
STRING018 = Inkey()
If (Abort()) ResetDisp
If (((InStr(Mask_Ascii(), STRING018) <> 0) && (Len(StripAtx(STRING015)) < 79)) && (Len(STRING015) < 95)) Then
Print STRING018
STRING015 = STRING015 + STRING018
If (Left(Right(STRING015, 4), 2) == "@X") Then
Backup 80
DefColor
Print STRING015
ClrEol
Endif
Continue
Endif
If ((STRING018 == Chr(8)) || (STRING018 == Chr(127))) Then
If (Len(STRING015) > 0) Then
STRING015 = Left(STRING015, Len(STRING015) - 1)
If (Left(Right(STRING015, 3), 2) == "@X") Then
Backup 80
DefColor
Print STRING015
ClrEol
Goto LABEL017
Endif
Backup 1
Print " "
Backup 1
Endif
:LABEL017
Continue
Endif
If ((((InStr(Mask_Ascii(), STRING018) <> 0) && (Len(StripAtx(STRING015)) > 78)) && (Len(STRING015) < 95)) && !BOOLEAN001) Then
For DOUBLE001 = -Len(STRING015) To 0
If (Right(Left(STRING015, -DOUBLE001), 1) == " ") Then
Backup Len(StripAtx(Right(STRING015, Len(STRING015) + DOUBLE001)))
ClrEol
Newline
Print Right(STRING015, Len(STRING015) + DOUBLE001) + STRING018
STRING016 = Right(STRING015, Len(STRING015) + DOUBLE001) + STRING018
STRING015 = Left(STRING015, -DOUBLE001)
BOOLEAN002 = 1
EndProc
Endif
Next
Endif
EndWhile
EndProc
;------------------------------------------------------------------------------
Procedure PROC004()
FWrite 1, Left(Upper(STRING033), 25), 25
FWrite 1, Left(Upper(U_Name()), 25), 25
FWrite 1, Left(Upper(INTEGER004), 5), 5
FWrite 1, Left(Upper(STRING023), 5), 5
FWrite 1, Left(TSTRING017(1), 95), 95
FWrite 1, Left(TSTRING017(2), 95), 95
EndProc
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 2 End
; 1 Cls
; 7 ClrEol
; 69 Goto
; 72 Let
; 15 Print
; 19 PrintLn
; 65 If
; 2 DispFile
; 2 FCreate
; 7 FOpen
; 2 FAppend
; 19 FClose
; 11 FGet
; 2 ResetDisp
; 2 StartDisp
; 17 DefColor
; 2 Log
; 1 InputStr
; 2 Delay
; 6 Inc
; 14 Newline
; 2 Newlines
; 13 Backup
; 8 FSeek
; 12 FRead
; 20 FWrite
; 13 EndProc
;
;
; ■ Functions used :
;
; 8 -
; 9 /
; 185 +
; 4 -
; 22 ==
; 16 <>
; 12 <
; 1 <=
; 4 >
; 2 >=
; 41 !
; 12 &&
; 3 ||
; 23 Len(
; 18 Upper()
; 34 Left()
; 6 Right()
; 8 Space()
; 2 Ferr()
; 37 Chr()
; 3 InStr()
; 2 Abort()
; 13 RTrim()
; 2 Date()
; 2 Time()
; 12 U_Name()
; 8 StripAtx()
; 4 Inkey()
; 5 String()
; 3 Mask_Ascii()
; 8 PPEPath()
; 9 Exist()
; 1 TokenStr()
; 2 AnsiOn()
; 5 FileInf()
; 2 PPEName()
; 1 U_RecNum()
; 6 Mixed()
;
;------------------------------------------------------------------------------
;
; Analysis flags : No flag
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 1 For/Next
; 8 While/EndWhile
; 22 If/Then or If/Then/Else
; 0 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------