home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
agspgp01.zip
/
PGPSERVR.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1995-05-18
|
16KB
|
1,209 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
Boolean BOOLEAN003
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
Integer INTEGER016
Integer INTEGER017
Integer INTEGER018
Integer INTEGER019
Integer INTEGER020
Integer INTEGER021
Integer INTEGER022
Integer INTEGER023
Integer INTEGER024
Integer INTEGER025
Integer INTEGER026
Integer INTEGER034
Real REAL001
Real REAL002
String STRING001
String STRING002
String STRING003
String STRING004
String STRING005
String STRING006
String TSTRING007(20)
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 STRING028
String STRING030
String STRING031
String STRING032
Time TIME001
BigStr BIGSTR001
BigStr BIGSTR002
Declare Function FUNCTION001(Integer INTEGER030) String
Declare Function FUNCTION002(Integer INTEGER031, Integer INTEGER032, Integer INTEGER033, String STRING029) String
Declare Procedure PROC001(String STRING025)
Declare Procedure PROC002()
Declare Procedure PROC003(Integer INTEGER027)
Declare Procedure PROC004(Integer INTEGER028)
Declare Procedure PROC005()
Declare Procedure PROC006()
Declare Procedure PROC007()
Declare Procedure PROC008(String STRING026)
Declare Procedure PROC009(String STRING027)
Declare Procedure PROC010()
Declare Procedure PROC011()
Declare Procedure PROC012(Boolean BOOLEAN004)
Declare Procedure PROC013()
Declare Procedure PROC014()
Declare Procedure PROC015(Integer INTEGER029)
Declare Procedure PROC016()
Declare Procedure PROC017()
Declare Procedure PROC018()
Declare Procedure PROC019()
;------------------------------------------------------------------------------
For INTEGER002 = 0 To MaxNode()
RdUNet INTEGER002
If (UN_Oper() == "iN PGP SERVER 0.1ß") Then
PrintLn STRING023 + "Sorry, the server is already in use on another node..."
PrintLn "Try again later..."
PrintLn
Wait
End
Endif
Next
RdUNet PcbNode()
WrUNet PcbNode(), "Q", UN_Name(), UN_City(), "iN PGP SERVER 0.1ß", " "
Cls
StartDisp 1
DispFile PPEPath() + "PGPSERVR", 1 + 4
BOOLEAN001 = 1
STRING004 = PPEPath() + "PGP.$$$"
PROC002()
PROC006()
If (INTEGER021 > 0) STRING009 = "There are new keys!"
INTEGER001 = 1
:LABEL001
INTEGER008 = 3
INTEGER009 = 9
INTEGER010 = 36
If (BOOLEAN001) Goto LABEL002
Cls
DispFile PPEPath() + "PGPSERVR", 1 + 4
Goto LABEL003
:LABEL002
BOOLEAN001 = 0
:LABEL003
PROC007()
PROC003(INTEGER001)
If (STRING009 <> "") Then
PROC009(STRING009)
STRING009 = ""
Endif
While (1) Do
If ((TIME001 <> 0) && (Time() > TIME001 + 5)) PROC009("")
STRING002 = Inkey()
If (STRING002 <> "") Then
If ((STRING002 == "DOWN") || (STRING002 == "2")) Then
PROC004(INTEGER001)
INTEGER001 = INTEGER001 + 1
If (INTEGER001 == 5) INTEGER001 = 6
If (INTEGER001 == 8) INTEGER001 = 1
PROC003(INTEGER001)
Continue
Endif
If ((STRING002 == "UP") || (STRING002 == "8")) Then
PROC004(INTEGER001)
INTEGER001 = INTEGER001 - 1
If (INTEGER001 == 5) INTEGER001 = 4
If (INTEGER001 == 0) INTEGER001 = 7
PROC003(INTEGER001)
Continue
Endif
If (STRING002 == Chr(13)) Then
If (INTEGER001 == 1) Then
Copy STRING017, STRING015
PROC012(0)
If (BOOLEAN002) Goto LABEL004
STRING009 = String(INTEGER012) + " key(s) downloaded!"
INTEGER019 = INTEGER019 + INTEGER012
PROC013()
:LABEL004
INTEGER001 = 1
Goto LABEL001
Goto LABEL005
Endif
If (INTEGER001 == 2) Then
PROC014()
INTEGER001 = 2
Goto LABEL001
Goto LABEL005
Endif
If (INTEGER001 == 3) Then
PROC012(1)
INTEGER001 = 3
Goto LABEL001
Goto LABEL005
Endif
If (INTEGER001 == 4) Then
PROC017()
INTEGER001 = 4
Goto LABEL001
Goto LABEL005
Endif
If (INTEGER001 == 6) Then
AnsiPos 1, 23
Download STRING019
StartDisp 1
INTEGER001 = 6
Goto LABEL001
Goto LABEL005
Endif
If (INTEGER001 == 7) Then
AnsiPos 1, 23
Download STRING020
StartDisp 1
INTEGER001 = 7
Goto LABEL001
Endif
:LABEL005
Continue
Endif
If (STRING002 == Chr(27)) Then
Break
Endif
Endif
EndWhile
PROC019()
End
;------------------------------------------------------------------------------
Procedure PROC003(Integer INTEGER027)
AnsiPos INTEGER008, INTEGER009 + INTEGER027 - 1
STRING003 = ScrText(INTEGER008, INTEGER009 + INTEGER027 - 1, INTEGER010, 1)
Print "@X1F", Upper(ScrText(INTEGER008, INTEGER009 + INTEGER027 - 1, INTEGER010, 0))
PROC005()
EndProc
;------------------------------------------------------------------------------
Procedure PROC004(Integer INTEGER028)
AnsiPos INTEGER008, INTEGER009 + INTEGER028 - 1
Print STRING023, STRING003
PROC005()
EndProc
;------------------------------------------------------------------------------
Procedure PROC005()
AnsiPos 2, 22
Color 0
Print " "
Backup 1
EndProc
;------------------------------------------------------------------------------
Procedure PROC001(String STRING025)
PROC010()
Shell 1, INTEGER006, PPEPath() + "PGP.BAT", "+batchmode " + STRING025
PROC011()
EndProc
;------------------------------------------------------------------------------
Procedure PROC002()
STRING005 = "Test"
TpaGet "PGPSERVR", STRING005
If (STRING005 == "Test") Then
PrintLn "@X04TPA PGPSERVR IS NOT INSTALLED! CHECK DOC!"
Wait
End
Endif
STRING006 = ReadLine("PCBOARD.DAT", 45)
FClose -1
STRING008 = "RCVD.DAT"
STRING011 = PPEPath() + "PGPSERVR.DAT"
STRING012 = PPEPath() + "PGPTEMP.$$$"
STRING013 = PPEPath() + "PGPTEMP.$$#"
STRING014 = PPEPath() + "TAGS.$$$"
STRING015 = PPEPath() + "KEYS.PGP"
STRING016 = PPEPath() + "SCREEN.RAW"
STRING001 = ReadLine(PPEPath() + "PGPSERVR.CFG", 1)
STRING017 = ReadLine(PPEPath() + "PGPSERVR.CFG", 2)
STRING019 = ReadLine(PPEPath() + "PGPSERVR.CFG", 3)
STRING020 = ReadLine(PPEPath() + "PGPSERVR.CFG", 4)
STRING021 = ReadLine(PPEPath() + "PGPSERVR.CFG", 5)
STRING022 = ReadLine(PPEPath() + "PGPSERVR.CFG", 6)
STRING023 = ReadLine(PPEPath() + "PGPSERVR.CFG", 7)
STRING024 = ReadLine(PPEPath() + "PGPSERVR.CFG", 8)
FClose -1
INTEGER013 = ToInt(ReadLine(PPEPath() + "PGPSERVR.CNT", 1))
FClose -1
Inc INTEGER013
FOpen 1, PPEPath() + "PGPSERVR.CNT", 1, 0
FPutLn 1, INTEGER013
FClose 1
DoIntr 16, 3840, 0, 0, 0, 0, 0, 0, 0, 0
If (And(RegAX(), 255) == 7) Then
INTEGER025 = 45056
Else
INTEGER025 = 47104
Endif
EndProc
;------------------------------------------------------------------------------
Procedure PROC006()
PROC009("Loading data... stand by!")
PROC001("-kv")
FOpen 1, STRING004, 0, 0
:LABEL006
If (Ferr(1)) Goto LABEL007
FGet 1, STRING005
If (Left(STRING005, 3) == "pub") Inc INTEGER012
Goto LABEL006
:LABEL007
FClose 1
While (GetToken() <> "") Do
EndWhile
TpaGet "PGPSERVR", STRING005
Tokenize STRING005
INTEGER018 = ToInt(GetToken())
Inc INTEGER018
INTEGER020 = ToInt(GetToken())
INTEGER019 = ToInt(GetToken())
INTEGER017 = ToInt(GetToken())
INTEGER026 = INTEGER017
PROC013()
INTEGER021 = (FileInf(STRING011, 4) - INTEGER017) / 80
PROC009("")
EndProc
;------------------------------------------------------------------------------
Procedure PROC007()
AnsiPos 67, 8
PROC008(STRING001)
AnsiPos 67, 9
PROC008(String(INTEGER012))
AnsiPos 67, 10
PROC008(String(INTEGER013))
AnsiPos 67, 14
PROC008(String(INTEGER018))
AnsiPos 67, 15
PROC008(String(INTEGER020))
AnsiPos 67, 16
PROC008(String(INTEGER019))
AnsiPos 67, 17
PROC008(String(INTEGER021))
EndProc
;------------------------------------------------------------------------------
Procedure PROC008(String STRING026)
STRING026 = STRING021 + Left(STRING026, 1) + STRING022 + Mid(STRING026, 2, 1) + STRING023 + Right(STRING026, Len(STRING026) - 2)
Print STRING026
EndProc
;------------------------------------------------------------------------------
Procedure PROC009(String STRING027)
AnsiPos 52, 21
PROC008(STRING027 + Space(27 - Len(STRING027)))
If (STRING027 <> "") Then
TIME001 = Time()
Else
TIME001 = 0
Endif
AnsiPos 50, 21
If (STRING027 <> "") Then
Print "@X8" + Right(STRING022, 1) + "»"
Else
Print " "
Endif
PROC005()
EndProc
;------------------------------------------------------------------------------
Procedure PROC010()
VarOff STRING016, INTEGER023
VarSeg STRING016, INTEGER024
DoIntr 33, 15360, 0, 0, INTEGER023, 0, 0, 0, INTEGER024, 0
INTEGER022 = RegAX()
DoIntr 33, 16384, INTEGER022, 4000, 0, 0, 0, 0, INTEGER025, 0
DoIntr 33, 15872, INTEGER022, 0, 0, 0, 0, 0, 0, 0
EndProc
;------------------------------------------------------------------------------
Procedure PROC011()
VarOff STRING016, INTEGER023
VarSeg STRING016, INTEGER024
DoIntr 33, 15616, 0, 0, INTEGER023, 0, 0, 0, INTEGER024, 0
INTEGER022 = RegAX()
DoIntr 33, 16128, INTEGER022, 4000, 0, 0, 0, 0, INTEGER025, 0
DoIntr 33, 15872, INTEGER022, 0, 0, 0, 0, 0, 0, 0
Delete STRING016
EndProc
;------------------------------------------------------------------------------
Procedure PROC012(Boolean BOOLEAN004)
BOOLEAN002 = 0
Cls
DispFile PPEPath() + "XFERMENU", 0
INTEGER002 = 0
INTEGER003 = 0
While (1) Do
Inc INTEGER002
STRING005 = ReadLine(STRING006, INTEGER002)
If (Trim(STRING005, " ") == "") Break
If (Mid(STRING005, 3, 1) == "I") Continue
Inc INTEGER003
TSTRING007(INTEGER003) = Left(STRING005, 1)
STRING005 = Mid(STRING005, 5, Len(STRING005) - 4)
STRING005 = Mid(STRING005, InStr(STRING005, ",") + 1, Len(STRING005) - InStr(STRING005, ","))
STRING005 = Mid(STRING005, 1, InStr(STRING005, ",") - 1)
FOpen 2, PPEPath() + "PROTO.DEF", 0, 0
:LABEL008
If (Ferr(2)) Goto LABEL009
FGet 2, STRING010
If (Left(STRING010, 1) == TSTRING007(INTEGER003)) Then
STRING005 = Right(STRING010, Len(STRING010) - 2)
Else
Goto LABEL008
Endif
:LABEL009
FClose 2
AnsiPos 31 - Len(StripAtx(STRING005)) / 2, 9 + INTEGER003 - 1
Print STRING023 + STRING005
EndWhile
INTEGER005 = INTEGER003
FClose -1
INTEGER008 = 6
INTEGER009 = 9
INTEGER010 = 51
INTEGER001 = 1
PROC003(INTEGER001)
While (1) Do
STRING002 = Inkey()
If (STRING002 <> "") Then
If ((STRING002 == "DOWN") || (STRING002 == "2")) Then
PROC004(INTEGER001)
INTEGER001 = INTEGER001 + 1
If (INTEGER001 == INTEGER005 + 1) INTEGER001 = 1
PROC003(INTEGER001)
Continue
Endif
If ((STRING002 == "UP") || (STRING002 == "8")) Then
PROC004(INTEGER001)
INTEGER001 = INTEGER001 - 1
If (INTEGER001 == 0) INTEGER001 = INTEGER005
PROC003(INTEGER001)
Continue
Endif
If (STRING002 == Chr(13)) Then
Print STRING023
If (OnLocal()) Then
Cls
If (Exist(STRING008)) Delete STRING008
PrintLn STRING023 + "Local mode detected..."
If (BOOLEAN004) Then
InputStr STRING023 + "What is the name of your file ", STRING005, STRING023, 50, Mask_Path() + Mask_File(), 8 + 256
Goto LABEL010
Endif
InputStr STRING023 + "Directory for local download ", STRING005, STRING023, 50, Mask_Path() + Mask_File(), 8 + 256
:LABEL010
PrintLn
If (BOOLEAN004) Then
If (STRING005 == "") Goto LABEL015
If (Exist(STRING005)) Goto LABEL011
PrintLn STRING023 + "This file does not exist!"
Goto LABEL015
:LABEL011
Copy STRING005, STRING008
Goto LABEL014
Goto LABEL013
Endif
If (STRING005 == "") Goto LABEL015
If ((Right(STRING005, 1) <> ":") && (Right(STRING005, 1) <> "\")) STRING005 = STRING005 + "\"
If (Exist(STRING005 + "NUL")) Goto LABEL012
PrintLn STRING023 + "Invalid directory!"
Goto LABEL015
:LABEL012
If (BOOLEAN004) Then
Copy STRING005, STRING008
Goto LABEL014
Goto LABEL013
Endif
Copy STRING015, STRING005 + "KEYS.PGP"
Goto LABEL016
Endif
:LABEL013
If (BOOLEAN004) Then
STRING005 = ReadLine(PPEPath() + "XFER.CFG", PcbNode()) + " " + String(Carrier()) + " " + STRING008 + " " + String(Carrier()) + " " + String(Carrier()) + " " + PPEPath()
Shell 1, INTEGER002, "PCBR" + TSTRING007(INTEGER001) + ".BAT", STRING005
Backup 80
ClrEol
Goto LABEL014
Endif
STRING005 = ReadLine(PPEPath() + "XFER.CFG", PcbNode()) + " " + String(Carrier()) + " " + STRING015 + " " + String(Carrier()) + " " + String(Carrier()) + " " + PPEPath()
Shell 1, INTEGER002, "PCBS" + TSTRING007(INTEGER001) + ".BAT", STRING005
Backup 80
ClrEol
:LABEL014
If (BOOLEAN004) Then
If (!Exist(STRING008) || (FileInf(STRING008, 4) == 0)) Then
:LABEL015
PrintLn STRING023 + "Upload aborted"
BOOLEAN002 = 1
Wait
Goto LABEL022
Endif
:LABEL016
If (BOOLEAN004) Then
PrintLn STRING023 + "Analysing... stand by!"
PROC001("-ka " + STRING008)
INTEGER002 = 0
FOpen 1, STRING004, 0, 0
:LABEL017
If (Ferr(1)) Goto LABEL021
FGet 1, STRING005
If (Mid(STRING005, 6, 10) == "new key(s)") Then
INTEGER002 = ToInt(Left(STRING005, 5))
STRING009 = String(INTEGER002) + " new key(s) inserted !"
INTEGER012 = INTEGER012 + INTEGER002
INTEGER020 = INTEGER020 + INTEGER002
PROC013()
FOpen 2, STRING004, 0, 0
FAppend 3, STRING011, 2, 0
:LABEL018
If (Ferr(2)) Goto LABEL020
FGet 2, STRING005
If (Left(STRING005, 22) == "Checking signatures...") Goto LABEL020
If (Left(STRING005, 3) == "pub") Then
STRING010 = Mid(STRING005, 6, 4) + ";" + Mid(STRING005, 11, 8)
If (Mid(STRING010, 12, 1) == " ") Then
STRING010 = Mid(STRING010, 1, 11) + " "
STRING010 = Mid(STRING010 + ";" + Right(STRING005, Len(STRING005) - 29), 1, 78)
Goto LABEL019
Endif
STRING010 = Mid(STRING010 + ";" + Right(STRING005, Len(STRING005) - 31), 1, 78)
:LABEL019
FPutLn 3, STRING010
Endif
Goto LABEL018
:LABEL020
FClose 2
FClose 3
Goto LABEL021
Endif
Goto LABEL017
:LABEL021
FClose 1
If (INTEGER002 == 0) STRING009 = "No new key inserted."
Endif
Endif
:LABEL022
If (BOOLEAN004) Delete STRING008
Break
Continue
Endif
If (STRING002 == Chr(27)) Then
BOOLEAN002 = 1
Break
Endif
Endif
EndWhile
EndProc
;------------------------------------------------------------------------------
Procedure PROC013()
STRING005 = String(INTEGER018) + ";" + String(INTEGER020) + ";" + String(INTEGER019) + ";" + String(INTEGER026)
TpaPut "PGPSERVR", STRING005
EndProc
;------------------------------------------------------------------------------
Procedure PROC014()
PROC009("Gathering data... stand by!")
PROC001("-kv")
FOpen 1, STRING004, 0, 0
FCreate 2, STRING012, 1, 0
INTEGER002 = 0
:LABEL023
If (Ferr(1)) Goto LABEL025
FGet 1, STRING005
If (Left(STRING005, 3) == "pub") Then
STRING010 = Mid(STRING005, 6, 4) + ";" + Mid(STRING005, 11, 8)
If (Mid(STRING010, 12, 1) == " ") Then
STRING010 = Mid(STRING010, 1, 11) + " "
STRING010 = Mid(STRING010 + ";" + Right(STRING005, Len(STRING005) - 29), 1, 78)
Goto LABEL024
Endif
STRING010 = Mid(STRING010 + ";" + Right(STRING005, Len(STRING005) - 31), 1, 78)
:LABEL024
FPutLn 2, STRING010
Inc INTEGER002
Endif
Goto LABEL023
:LABEL025
FClose 1
FClose 2
PROC010()
Shell 1, INTEGER006, PPEPath() + "SORT.EXE", "/+15 < " + STRING012 + " > " + STRING013
PROC011()
If (INTEGER002 == 0) Then
STRING009 = "No key found!"
Else
PROC018()
Endif
EndProc
;------------------------------------------------------------------------------
Procedure PROC015(Integer INTEGER029)
FSeek 1, INTEGER029 * 80, 0
FSeek 2, INTEGER029, 0
For INTEGER002 = 1 To 17
If (INTEGER029 + INTEGER002 - 1 >= INTEGER007) Then
For INTEGER002 = INTEGER002 To 17
AnsiPos 1, INTEGER002 + 2
ClrEol
Next
Break
Endif
AnsiPos 4, INTEGER002 + 2
FRead 2, STRING010, 1
If (STRING010 == Chr(1)) Then
Print STRING022 + "■ "
Else
Print STRING022 + " "
Endif
FRead 1, STRING005, 78
PROC008(Mid(STRING005, 1, 4))
Print " " + STRING022 + "· "
PROC008(Mid(STRING005, 6, 8))
Print " " + STRING022 + "· "
PROC008(Mid(STRING005, 15, 56))
FSeek 1, 2, 1
Next
EndProc
;------------------------------------------------------------------------------
Procedure PROC016()
BigStr BIGSTR001
If (Exist(STRING015)) Delete STRING015
Cls
DispFile PPEPath() + "EXTRACT", 1 + 4
PROC005()
FSeek 2, 0, 0
INTEGER011 = 0
REAL001 = 0
While (1) Do
Inc INTEGER011
INTEGER016 = 0
FRead 2, BIGSTR001, 2048
While (Len(BIGSTR001) > 0) Do
INTEGER002 = InStr(BIGSTR001, Chr(1))
If (INTEGER002 == 0) Break
BIGSTR001 = Right(BIGSTR001, Len(BIGSTR001) - INTEGER002)
STRING005 = FUNCTION001((INTEGER011 - 1) * 2048 + INTEGER002 + INTEGER016)
PROC001("-kx 0x" + STRING005 + " " + STRING015)
INTEGER016 = INTEGER016 + INTEGER002
Inc REAL001
REAL002 = (REAL001 / INTEGER015) * 32
STRING010 = Space(REAL002)
STRING010 = STRING024 + ReplaceStr(STRING010, " ", "░")
AnsiPos 24, 13
Print STRING010
PROC005()
EndWhile
If (REAL001 == INTEGER015) Break
EndWhile
EndProc
;------------------------------------------------------------------------------
Function FUNCTION001(Integer INTEGER030) String
BigStr BIGSTR002
While (GetToken() <> "") Do
EndWhile
FSeek 1, (INTEGER030 - 1) * 80, 0
FRead 1, STRING005, 78
Tokenize Trim(STRING005, " ")
STRING005 = GetToken()
FUNCTION001 = GetToken()
EndFunc
;------------------------------------------------------------------------------
Procedure PROC018()
BigStr BIGSTR002
BIGSTR002 = Space(2048)
BIGSTR002 = ReplaceStr(BIGSTR002, " ", Chr(0))
FCreate 1, STRING014, 1, 0
For INTEGER002 = 1 To INTEGER012 / 2048 + 1
FWrite 1, BIGSTR002, 2048
Next
INTEGER015 = 0
FClose 1
PROC009("")
Cls
DispFile PPEPath() + "PGPLIST", 1 + 4
AnsiPos 8, 21
PROC008("[SPACE] = Tag/Untag ")
PROC008("[S] = Search UserID ")
PROC008("[D] = Download Key(s) ")
INTEGER007 = FileInf(STRING013, 4) / 80
FOpen 1, STRING013, 0, 0
FOpen 2, STRING014, 2, 0
INTEGER014 = 1
PROC015((INTEGER014 - 1) * 17)
INTEGER008 = 1
INTEGER009 = 3
INTEGER010 = 79
INTEGER001 = 1
PROC003(INTEGER001)
While (1) Do
If ((TIME001 <> 0) && (Time() > TIME001 + 5)) Then
TIME001 = 0
AnsiPos 35, 1
Print Space(44)
PROC005()
Endif
STRING002 = Upper(Inkey())
:LABEL026
If (STRING002 <> "") Then
If ((STRING002 == "DOWN") || (STRING002 == "2")) Then
If ((INTEGER014 - 1) * 17 + INTEGER001 <= INTEGER007 - 1) Then
PROC004(INTEGER001)
If (INTEGER001 < 17) Then
Inc INTEGER001
Goto LABEL027
Endif
If (INTEGER014 * 17 <= INTEGER007) Then
Inc INTEGER014
INTEGER001 = 1
PROC015((INTEGER014 - 1) * 17)
Endif
:LABEL027
PROC003(INTEGER001)
Endif
Continue
Endif
If ((STRING002 == "UP") || (STRING002 == "8")) Then
If ((INTEGER014 > 1) || (INTEGER001 > 1)) Then
PROC004(INTEGER001)
If (INTEGER001 > 1) Then
Dec INTEGER001
Goto LABEL028
Endif
If (INTEGER014 > 1) Then
Dec INTEGER014
INTEGER001 = 17
PROC015((INTEGER014 - 1) * 17)
Endif
:LABEL028
PROC003(INTEGER001)
Endif
Continue
Endif
If ((STRING002 == "PGUP") || (STRING002 == "9")) Then
If (INTEGER014 > 1) Then
PROC004(INTEGER001)
Dec INTEGER014
INTEGER001 = 1
PROC015((INTEGER014 - 1) * 17)
PROC003(INTEGER001)
Endif
Continue
Endif
If ((STRING002 == "PGDN") || (STRING002 == "3")) Then
If (INTEGER014 * 17 <= INTEGER007) Then
PROC004(INTEGER001)
Inc INTEGER014
INTEGER001 = 1
PROC015((INTEGER014 - 1) * 17)
PROC003(INTEGER001)
Endif
Continue
Endif
If ((STRING002 == "END") || (STRING002 == "1")) Then
If ((INTEGER014 - 1) * 17 + INTEGER001 <> INTEGER007) Then
PROC004(INTEGER001)
INTEGER003 = INTEGER014
INTEGER014 = INTEGER007 / 17 + 1
If (INTEGER007 > 17) Then
INTEGER001 = INTEGER007 % 17
Goto LABEL029
Endif
INTEGER001 = INTEGER007
:LABEL029
If (INTEGER003 <> INTEGER014) PROC015((INTEGER014 - 1) * 17)
PROC003(INTEGER001)
Endif
Continue
Endif
If ((STRING002 == "HOME") || (STRING002 == "7")) Then
If ((INTEGER014 - 1) * 17 + INTEGER001 <> 1) Then
PROC004(INTEGER001)
If (INTEGER014 > 1) Then
INTEGER014 = 1
PROC015((INTEGER014 - 1) * 17)
Endif
INTEGER001 = 1
PROC003(INTEGER001)
Endif
Continue
Endif
If (STRING002 == "S") Then
PROC004(INTEGER001)
AnsiPos 35, 1
PROC008("Search : ")
Print STRING023 + "[@X1F······························" + STRING023 + "]"
STRING005 = FUNCTION002(45, 1, 29, STRING018)
AnsiPos 35, 1
Print Space(44)
PROC005()
If (STRING005 <> "") Then
STRING018 = STRING005
AnsiPos 50, 1
PROC008("Scanning...")
PROC005()
INTEGER003 = INTEGER014
FSeek 1, ((INTEGER014 - 1) * 17 + INTEGER001) * 80, 0
INTEGER002 = (INTEGER014 - 1) * 17 + INTEGER001
BOOLEAN003 = 0
:LABEL030
If (Ferr(1)) Goto LABEL032
Inc INTEGER002
FRead 1, STRING005, 78
FSeek 1, 2, 1
If (InStr(Upper(STRING005), STRING018) <> 0) Then
BOOLEAN003 = 1
INTEGER014 = INTEGER002 / 17 + 1
If (INTEGER002 > 17) Then
INTEGER001 = INTEGER002 % 17
Goto LABEL031
Endif
INTEGER001 = INTEGER002
:LABEL031
Goto LABEL032
Endif
Goto LABEL030
:LABEL032
AnsiPos 35, 1
Print Space(44)
If (BOOLEAN003) Goto LABEL033
AnsiPos 51, 1
PROC008("Not found!")
TIME001 = Time()
:LABEL033
PROC005()
If (INTEGER003 <> INTEGER014) PROC015((INTEGER014 - 1) * 17)
PROC003(INTEGER001)
Goto LABEL034
Endif
PROC003(INTEGER001)
:LABEL034
Continue
Endif
If (STRING002 == " ") Then
FSeek 2, (INTEGER014 - 1) * 17 + INTEGER001 - 1, 0
AnsiPos 4, INTEGER001 + 2
FRead 2, STRING005, 1
If (STRING005 == Chr(1)) Then
FSeek 2, (INTEGER014 - 1) * 17 + INTEGER001 - 1, 0
FWrite 2, 0, 1
Print "@X1F "
Dec INTEGER015
STRING003 = Left(STRING003, 11) + " " + Right(STRING003, Len(STRING003) - 12)
Goto LABEL035
Endif
FSeek 2, (INTEGER014 - 1) * 17 + INTEGER001 - 1, 0
FWrite 2, 1, 1
Print "@X1F■"
Inc INTEGER015
STRING003 = Left(STRING003, 11) + "■" + Right(STRING003, Len(STRING003) - 12)
:LABEL035
PROC005()
STRING002 = "DOWN"
Goto LABEL026
Continue
Endif
If (STRING002 == "D") Then
If (INTEGER015 > 0) Then
PROC016()
PROC012(0)
If (BOOLEAN002) Goto LABEL036
STRING009 = String(INTEGER015) + " key(s) downloaded!"
INTEGER019 = INTEGER019 + INTEGER015
PROC013()
:LABEL036
Break
Endif
Continue
Endif
If (STRING002 == Chr(27)) Then
Break
Endif
Endif
EndWhile
FClose 1
FClose 2
EndProc
;------------------------------------------------------------------------------
Procedure PROC017()
If (INTEGER021 == 0) Goto LABEL037
PROC009("Gathering data... stand by!")
INTEGER003 = FileInf(STRING011, 4) / 80
If (INTEGER003 == 0) Goto LABEL037
FOpen 1, STRING011, 0, 0
FCreate 2, STRING012, 1, 0
INTEGER002 = 0
FSeek 1, INTEGER017, 0
For INTEGER002 = INTEGER017 / 80 To INTEGER003 - 1
FRead 1, STRING005, 78
FPutLn 2, STRING005
Inc INTEGER004
FSeek 1, 2, 1
Next
INTEGER026 = INTEGER002 * 80
PROC013()
FClose 1
FClose 2
PROC010()
Shell 1, INTEGER006, PPEPath() + "SORT.EXE", "/+15 < " + STRING012 + " > " + STRING013
PROC011()
If (INTEGER004 == 0) Then
:LABEL037
STRING009 = "No new key found!"
Else
PROC018()
Endif
EndProc
;------------------------------------------------------------------------------
Function FUNCTION002(Integer INTEGER031, Integer INTEGER032, Integer INTEGER033, String STRING029) String
Integer INTEGER034
String STRING031
String STRING032
AnsiPos INTEGER031, INTEGER032
Print "@X1F" + STRING029
INTEGER034 = Len(STRING029)
STRING031 = STRING029
While (1) Do
STRING002 = Upper(Inkey())
If (STRING002 == Chr(27)) Then
FUNCTION002 = ""
Break
Continue
Endif
If (STRING002 == Chr(13)) Then
FUNCTION002 = STRING031
Break
Continue
Endif
If (STRING002 == Chr(8)) Then
If (STRING031 <> "") Then
STRING031 = Left(STRING031, Len(STRING031) - 1)
Backup 1
Print "·"
Backup 1
Endif
Continue
Endif
If (((Len(STRING031) < INTEGER033) && (Len(STRING002) == 1)) && (Asc(STRING002) > 31)) Then
STRING031 = STRING031 + STRING002
Print STRING002
Endif
EndWhile
PROC005()
EndFunc
;------------------------------------------------------------------------------
Procedure PROC019()
String STRING032
If (Random(10) == 5) Then
STRING032 = " <┤EGiS CoRP'95 "
Else
STRING032 = "LoNE RuNNeR/AGS'95"
Endif
Color 15
Cls
AnsiPos 31, 12
Print STRING032
Delay 2
Backup 18
Color 7
Print STRING032
Delay 2
Backup 18
Color 8
Print STRING032
Delay 2
Backup 18
Color 15
Print Space(Len(STRING032))
Delay 2
AnsiPos 1, 1
If (Exist(STRING012)) Delete STRING012
If (Exist(STRING013)) Delete STRING013
If (Exist(STRING004)) Delete STRING004
If (Exist(STRING016)) Delete STRING016
If (Exist(STRING014)) Delete STRING014
If (Exist(STRING015)) Delete STRING015
End
EndProc
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 4 End
; 7 Cls
; 3 ClrEol
; 3 Wait
; 5 Color
; 198 Goto
; 168 Let
; 26 Print
; 10 PrintLn
; 132 If
; 5 DispFile
; 3 FCreate
; 9 FOpen
; 1 FAppend
; 17 FClose
; 5 FGet
; 4 FPutLn
; 3 StartDisp
; 10 Delete
; 2 InputStr
; 4 Delay
; 14 Inc
; 4 Dec
; 2 Tokenize
; 5 Shell
; 2 RdUNet
; 1 WrUNet
; 7 DoIntr
; 2 VarSeg
; 2 VarOff
; 29 AnsiPos
; 8 Backup
; 12 FSeek
; 7 FRead
; 3 FWrite
; 4 Copy
; 2 Download
; 2 TpaGet
; 1 TpaPut
; 19 EndProc
; 2 EndFunc
;
;
; ■ Functions used :
;
; 4 -
; 24 *
; 10 /
; 2 %
; 169 +
; 48 -
; 70 ==
; 19 <>
; 7 <
; 8 <=
; 14 >
; 11 >=
; 102 !
; 15 &&
; 17 ||
; 19 Len(
; 4 Upper()
; 21 Mid()
; 11 Left()
; 12 Right()
; 7 Space()
; 6 Ferr()
; 12 Chr()
; 1 Asc()
; 5 InStr()
; 2 Trim()
; 1 Random()
; 4 Time()
; 1 StripAtx()
; 4 Inkey()
; 19 String()
; 2 Mask_File()
; 2 Mask_Path()
; 30 PPEPath()
; 4 PcbNode()
; 13 ReadLine()
; 1 OnLocal()
; 1 UN_Name()
; 1 UN_City()
; 1 UN_Oper()
; 8 GetToken()
; 3 RegAX()
; 11 Exist()
; 6 Carrier()
; 1 And()
; 4 FileInf()
; 2 MaxNode()
; 2 ScrText()
; 2 ReplaceStr()
; 6 ToInt()
;
;------------------------------------------------------------------------------
;
; Analysis flags : SI
;
; 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
;
; I - Interrupt call ■ 5
; This is rare in PPE... Although it may be a way to replace a PPE
; command by its fast interrupt equivalent. Be aware that an
; interrupt call may do anything... nasty (formating HD, rebooting,...)
; or usefull (fast screen i/o, hardware ressource access,...). Check!
; ■ Search for : DOINTR
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 5 For/Next
; 9 While/EndWhile
; 75 If/Then or If/Then/Else
; 0 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------