home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Carsten's PPE Collection
/
Carstens_PPE_Collection_2007.zip
/
U
/
USRPRO14.ZIP
/
STUD.PPE
(
.txt
)
< prev
Wrap
PCBoard Programming Language Executable
|
1994-06-12
|
6KB
|
270 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 2.OO (plain) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Date DATE001
Integer INTEGER001
Integer INTEGER002
Integer INTEGER003
Integer INTEGER004
Integer INTEGER005
BigStr BIGSTR001
BigStr BIGSTR002
BigStr BIGSTR003
BigStr BIGSTR004
BigStr BIGSTR005
BigStr BIGSTR006
BigStr BIGSTR007
BigStr BIGSTR008
BigStr BIGSTR009
BigStr BIGSTR010
BigStr BIGSTR011
;------------------------------------------------------------------------------
GetUser
If (CurSec() < SysopSec()) End
Log " Sysop Tool for User Deletion ", 1
Cls
PrintLn "@X1B Initializing Sysop Tool for User Deletion @X1E(C)94 GO/4 Software @X0F"
:LABEL001
INTEGER001 = FileInf(PPEPath() + "Profile.dat", 4) / 100
BIGSTR011 = ""
INTEGER003 = 100
Cls
PrintLn "@X10┌────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
PrintLn "@X10│ @X1BThis section of User Profiler will allow you to remove the profiles of @X19│@X0F"
PrintLn "@X10│ @X1Bparticular users. This command deletes the users from the PROFILE.DAT. @X19│@X0F"
PrintLn "@X10└@X19────────────────────────────────────────────────────────────────────────────┘@X0F"
PrintLn
InputStr "@X0AThe full user name to Delete (@X0CQ@X0A = @X0Cquit@X0A) _", BIGSTR011, 10, 25, Mask_Ascii(), 0
If (Upper(BIGSTR011) == "Q") Goto LABEL005
If (Upper(BIGSTR011) == "") Goto LABEL001
FOpen 4, PPEPath() + "Profile.dat", 0, 0
For INTEGER002 = 1 To INTEGER001
FSeek 4, INTEGER003, 0
FRead 4, BIGSTR002, 25
If (Upper(BIGSTR011) == Upper(Left(BIGSTR002, Len(BIGSTR011)))) Then
FClose 4
Goto LABEL002
Endif
INTEGER003 = INTEGER003 + 100
Next
FClose 4
Goto LABEL003
:LABEL002
FOpen 4, PPEPath() + "Profile.dat", 0, 0
FSeek 4, INTEGER003, 0
FRead 4, BIGSTR002, 25
PrintLn
PrintLn
PrintLn "@X0CShort User Summary"
PrintLn "@X08──────────────────"
PrintLn
PrintLn "@X0AUser Name :@X0B ", Mixed(BIGSTR002)
FRead 4, BIGSTR003, 1
Select Case (Upper(BIGSTR003))
Case "M"
BIGSTR003 = "Male"
Case "F"
BIGSTR003 = "Female"
End Select
PrintLn "@X0ASex :@X0B ", BIGSTR003
FRead 4, DATE001, 2
PrintLn "@X0ABirth Date :@X0B ", DATE001
FRead 4, BIGSTR004, 1
Select Case (BIGSTR004)
Case "1"
BIGSTR004 = "Heterosexual"
Case "2"
BIGSTR004 = "Bi-Sexual"
Case "3"
BIGSTR004 = "Gay"
Case "4"
BIGSTR004 = "Lesbian"
Case "5"
BIGSTR004 = "Androgenous"
Case "6"
BIGSTR004 = "None of your business"
End Select
PrintLn "@X0ASexual Preference :@X0B ", BIGSTR004
FRead 4, BIGSTR006, 1
Select Case (BIGSTR006)
Case "1"
BIGSTR006 = "Married, and loving it!"
Case "2"
BIGSTR006 = "Married, but I am looking."
Case "3"
BIGSTR006 = "In a significant relationship (other than marrige)."
Case "4"
BIGSTR006 = "Single, with a significant other."
Case "5"
BIGSTR006 = "Single with no one in my life now."
Case "6"
BIGSTR006 = "None of your business"
End Select
PrintLn "@X0AMarital Status :@X0B ", BIGSTR006
FRead 4, BIGSTR007, 2
FRead 4, BIGSTR010, 3
FRead 4, BIGSTR008, 1
FRead 4, BIGSTR009, 1
FClose 4
PrintLn
PrintLn "Profiled User, ", Mixed(BIGSTR002), " is ", BIGSTR007, " inches tall, weighs ", BIGSTR010, " pounds and"
Select Case (BIGSTR008)
Case "1"
BIGSTR008 = "blond"
Case "2"
BIGSTR008 = "brown"
Case "3"
BIGSTR008 = "gray"
Case "4"
BIGSTR008 = "black"
Case "5"
BIGSTR008 = "red"
Case "6"
BIGSTR008 = "white"
End Select
Select Case (BIGSTR009)
Case "1"
BIGSTR009 = "brown"
Case "2"
BIGSTR009 = "blue"
Case "3"
BIGSTR009 = "green"
Case "4"
BIGSTR009 = "black"
Case "5"
BIGSTR009 = "violet"
Case "6"
BIGSTR009 = "hazel"
End Select
PrintLn "has ", BIGSTR008, " hair and ", BIGSTR009, " eyes."
Newlines 2
InputYN "Would you like to DELETE this User (@X0CY@X0B/@X0Cn@X0B) _", BIGSTR005, 14
If (Upper(BIGSTR005) == "Y") Goto LABEL004
Goto LABEL001
:LABEL003
Newlines 2
PrintLn "@X10┌────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
PrintLn "@X10│ @X1CThe name you entered was not found please check the spelling and try again @X19│@X0F"
PrintLn "@X10│ @X1Cor the person you are trying to DELETE might not be in our database! @X19│@X0F"
PrintLn "@X10└@X19────────────────────────────────────────────────────────────────────────────┘@X0F"
AnsiPos 25, 22
Print ""
Wait
Goto LABEL001
:LABEL004
INTEGER004 = 0
INTEGER005 = INTEGER003 / 100 + 1
FOpen 6, PPEPath() + "Profile.NEW", 2, 0
FOpen 5, PPEPath() + "Profile.dat", 0, 0
For INTEGER002 = 1 To INTEGER001
FSeek 5, INTEGER004, 0
FRead 5, BIGSTR001, 100
If (INTEGER002 == INTEGER005) Then
Print " @X8CUser Deleted!@X0F"
Delay (3 * 182) / 10
ElseIf (INTEGER002 <> INTEGER005) Then
FWrite 6, BIGSTR001, 100
Endif
INTEGER004 = INTEGER004 + 100
Next
FClose 5
FClose 6
Rename PPEPath() + "profile.dat", PPEPath() + "profile.old"
Delete PPEPath() + "profile.dat"
Rename PPEPath() + "profile.new", PPEPath() + "profile.DAT"
:LABEL005
End
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 2 End
; 2 Cls
; 1 Wait
; 62 Goto
; 37 Let
; 2 Print
; 23 PrintLn
; 35 If
; 4 FOpen
; 5 FClose
; 1 GetUser
; 1 Delete
; 1 Log
; 1 InputStr
; 1 InputYN
; 1 Delay
; 2 Newlines
; 1 AnsiPos
; 2 Rename
; 3 FSeek
; 11 FRead
; 1 FWrite
;
;
; ■ Functions used :
;
; 1 *
; 3 /
; 15 +
; 31 ==
; 1 <>
; 3 <
; 2 <=
; 4 >=
; 31 !
; 4 &&
; 2 ||
; 1 Len(
; 7 Upper()
; 1 Left()
; 1 Mask_Ascii()
; 10 PPEPath()
; 1 SysopSec()
; 1 CurSec()
; 1 FileInf()
; 2 Mixed()
;
;------------------------------------------------------------------------------
;
; Analysis flags : s
;
; 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
;
; 2 For/Next
; 0 While/EndWhile
; 3 If/Then or If/Then/Else
; 5 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------