home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Carsten's PPE Collection
/
Carstens_PPE_Collection_2007.zip
/
T
/
TICKLE10.ZIP
/
TKLPACK.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1995-01-03
|
5KB
|
334 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
Real REAL001
Real REAL002
Real REAL003
String STRING001
String STRING002
String STRING003
String STRING004
String STRING005
String STRING006
String STRING007
String STRING008
String STRING009
Int INT001
Int INT002
Int INT003
Int INT004
Int INT005
Int INT006
Int INT007
Int INT008
Int INT009
;------------------------------------------------------------------------------
STRING006 = PPEPath() + "TKLTEXT"
Newlines 3
PrintLn ReadLine(STRING006, 59)
Newlines 2
Delay 18
Print ReadLine(STRING006, 60)
Gosub LABEL008
PrintLn ReadLine(STRING006, 61)
Newline
Print ReadLine(STRING006, 62)
Gosub LABEL007
PrintLn ReadLine(STRING006, 61)
Newline
Print ReadLine(STRING006, 63)
Gosub LABEL011
If (DErr(0)) Then
SPrintLn ReadLine(STRING006, 64)
Log "Cannot open TICKLE.DBF (DataBase) in EXCLUSIVE mode - Aborting", 0
Else
Gosub LABEL012
If (DErr(0)) Then
SPrintLn ReadLine(STRING006, 4)
Log "Cannot open TICKLE.NDX (Index) - Aborting", 0
Else
PrintLn ReadLine(STRING006, 61)
Newline
PrintLn ReadLine(STRING006, 65)
Newline
Delay 36
Gosub LABEL001
If (INT007 > 0) Then
Newlines 2
PrintLn ReadLine(STRING006, 66)
Newlines 2
DTop 0
DPack 0
Endif
FPutLn 2, "Total Number of Records in Database After Pack : ", DRecCount(0)
FPutLn 2
FPutLn 2, "Total Users Deleted : ", INT007
FPutLn 2, " Time Completed : ", Time()
FClose 2
Newline
PrintLn ReadLine(STRING006, 67)
Newline
Goto LABEL009
End
:LABEL001
DTop 0
PrintLn ReadLine(STRING006, 68)
Newline
FAppend 2, PPEPath() + PPEName() + ".log", 1, 0
FPutLn 2
FPutLn 2
FPutLn 2, "========================================================================"
FPutLn 2
FPutLn 2, "Tickle File Packing Program - Version 1.0"
FPutLn 2, "Written by Dan Shore - SysOp - The Shoreline BBS"
FPutLn 2
FPutLn 2, " Date of Pack : ", Date()
FPutLn 2, "Start Time of Pack : ", Time()
FPutLn 2
For INT001 = 1 To DRecCount(0)
StartDisp 1
DGo 0, INT001
STRING001 = DGet(0, DName(0, 1))
STRING003 = Left(STRING001, 1)
If (STRING003 < "A") STRING003 = "A"
If (STRING003 > "Z") STRING003 = "Z"
FPut 2, "Processing Username: ", STRING001
If (INT008) Goto LABEL002
Print ReadLine(STRING006, 69)
INT008 = GetX()
INT009 = GetY()
:LABEL002
AnsiPos INT008, INT009
Print INT001
Gosub LABEL004
If (BOOLEAN002) Goto LABEL003
FPutLn 2, "Not Current User - Deleted"
DDelete 0
Inc INT007
Continue
:LABEL003
FPutLn 2, "Current User - Not Deleted"
Next
PrintLn "@X07"
FPutLn 2
FPutLn 2, "Total Number of Records in Database Before Pack : ", DRecCount(0)
StartDisp 2
Return
:LABEL004
STRING004 = STRING002 + "PCBNDX." + STRING003
INTEGER001 = FileInf(STRING004, 4)
If (INTEGER001 < 27) Then
PrintLn ReadLine(STRING006, 70), STRING004, ReadLine(STRING006, 71)
Endif
INT004 = INTEGER001 / 27
INT005 = 0
FOpen 1, STRING004, 0, 0
BOOLEAN001 = 0
BOOLEAN002 = 0
:LABEL005
If (BOOLEAN001) Goto LABEL006
REAL001 = INT004
REAL002 = INT005
REAL001 = REAL001 / 2
REAL002 = REAL002 / 2
REAL003 = REAL001 + REAL002 + 0.5
INT003 = REAL003
INTEGER002 = (INT003 - 1) * 27
FSeek 1, INTEGER002, 0
FRead 1, INT002, 2
FRead 1, STRING005, 25
If (STRING005 == STRING001) Then
BOOLEAN002 = 1
BOOLEAN001 = 1
ElseIf (INT004 - INT005 < 2) Then
BOOLEAN001 = 1
ElseIf (STRING005 < STRING001) Then
INT005 = INT003
ElseIf (STRING005 > STRING001) Then
INT004 = INT003
Endif
Goto LABEL005
:LABEL006
FClose 1
Return
:LABEL007
Copy PPEPath() + "TICKLE.DBF", PPEPath() + "TICKLE.DBK"
Copy PPEPath() + "TICKLE.NDX", PPEPath() + "TICKLE.NBK"
Return
:LABEL008
FOpen 1, PPEPath() + PPEName() + ".cfg", 0, 0
FGet 1, STRING002
FClose 1
STRING002 = Trim(STRING002, " ")
If (Right(STRING002, 1) <> "\") STRING002 = STRING002 + "\"
Return
Endif
Endif
:LABEL009
DnCloseAll 0
DClose 0
PrintLn ReadLine(STRING006, 72)
Newline
Gosub LABEL010
If (BOOLEAN003) Then
PrintLn " @X0BRegistered to: @X0E", STRING007, "@X07"
Else
Newline
PrintLn " *************************************************"
Newline
PrintLn " [Unregistered Version] - Pausing for 5 Seconds"
Newline
PrintLn " Support the Shareware Concept and Register Today"
Newline
PrintLn " *************************************************"
Delay 90
Endif
End
:LABEL010
FOpen 3, PPEPath() + "TKL.KEY", 0, 0
FGet 3, STRING009
FGet 3, STRING008
STRING009 = RTrim(STRING009, " ")
STRING009 = Mid(STRING009, InStr(STRING009, ":") + 1, Len(STRING009) - InStr(STRING009, ":"))
STRING007 = Trim(STRING009, " ")
STRING009 = Mid(STRING008, 3, Len(STRING008) - 2)
STRING008 = Trim(STRING009, " ")
For INT001 = 1 To Len(STRING007)
INT006 = S2I(Mid(STRING007, INT001, 1), 36) - 9
INTEGER003 = INTEGER003 + INT006
Next
If (INTEGER003 < 0) INTEGER003 = INTEGER003 * -1
If (INTEGER003 == 0) INTEGER003 = INTEGER003 + 384
INTEGER003 = INTEGER003 * 7914
STRING009 = LTrim(String(INTEGER003), " ")
If (STRING009 == STRING008) BOOLEAN003 = 1
FClose 3
Return
:LABEL011
DOpen 0, PPEPath() + "tickle", 1
Return
:LABEL012
If (Exist(PPEPath() + "tickle.ndx")) DnOpen 0, PPEPath() + "tickle"
Return
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 2 End
; 25 Goto
; 43 Let
; 5 Print
; 16 PrintLn
; 21 If
; 3 FOpen
; 1 FAppend
; 4 FClose
; 3 FGet
; 1 FPut
; 18 FPutLn
; 2 StartDisp
; 2 Log
; 7 Gosub
; 7 Return
; 3 Delay
; 1 Inc
; 12 Newline
; 4 Newlines
; 1 AnsiPos
; 2 SPrintLn
; 1 FSeek
; 2 FRead
; 2 Copy
; 1 DOpen
; 1 DClose
; 1 DPack
; 1 DnOpen
; 1 DnCloseAll
; 2 DTop
; 1 DGo
; 1 DDelete
;
;
; ■ Functions used :
;
; 1 -
; 3 *
; 3 /
; 23 +
; 5 -
; 3 ==
; 1 <>
; 7 <
; 2 <=
; 3 >
; 4 >=
; 14 !
; 4 &&
; 2 ||
; 4 Len(
; 3 Mid()
; 1 Left()
; 1 Right()
; 2 InStr()
; 1 LTrim()
; 1 RTrim()
; 3 Trim()
; 1 Date()
; 2 Time()
; 1 String()
; 11 PPEPath()
; 17 ReadLine()
; 1 Exist()
; 1 S2I()
; 1 GetX()
; 1 GetY()
; 1 FileInf()
; 2 PPEName()
; 2 DErr()
; 1 DName()
; 4 DRecCount()
; 1 DGet()
;
;------------------------------------------------------------------------------
;
; Analysis flags : No flag
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 2 For/Next
; 0 While/EndWhile
; 9 If/Then or If/Then/Else
; 0 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------