home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / U / USRPRF13.ZIP / STUD.PPE (.txt) < prev   
PCBoard Programming Language Executable  |  1994-06-12  |  6KB  |  270 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 2.OO (plain) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Date     DATE001
  20.     Integer  INTEGER001
  21.     Integer  INTEGER002
  22.     Integer  INTEGER003
  23.     Integer  INTEGER004
  24.     Integer  INTEGER005
  25.     BigStr   BIGSTR001
  26.     BigStr   BIGSTR002
  27.     BigStr   BIGSTR003
  28.     BigStr   BIGSTR004
  29.     BigStr   BIGSTR005
  30.     BigStr   BIGSTR006
  31.     BigStr   BIGSTR007
  32.     BigStr   BIGSTR008
  33.     BigStr   BIGSTR009
  34.     BigStr   BIGSTR010
  35.     BigStr   BIGSTR011
  36.  
  37. ;------------------------------------------------------------------------------
  38.  
  39.     GetUser
  40.     If (CurSec() < SysopSec()) End
  41.     Log "  Sysop Tool for User Deletion  ", 1
  42.     Cls
  43.     PrintLn "@X1B  Initializing Sysop Tool for User Deletion                 @X1E(C)94 GO/4 Software  @X0F"
  44.     :LABEL001
  45.     INTEGER001 = FileInf(PPEPath() + "Profile.dat", 4) / 100
  46.     BIGSTR011 = ""
  47.     INTEGER003 = 100
  48.     Cls
  49.     PrintLn "@X10┌────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
  50.     PrintLn "@X10│ @X1BThis section of User Profiler will allow you to remove the profiles of     @X19│@X0F"
  51.     PrintLn "@X10│ @X1Bparticular users.  This command deletes the users from the PROFILE.DAT.    @X19│@X0F"
  52.     PrintLn "@X10└@X19────────────────────────────────────────────────────────────────────────────┘@X0F"
  53.     PrintLn 
  54.     InputStr "@X0AThe full user name to Delete (@X0CQ@X0A = @X0Cquit@X0A) _", BIGSTR011, 10, 25, Mask_Ascii(), 0
  55.     If (Upper(BIGSTR011) == "Q") Goto LABEL005
  56.     If (Upper(BIGSTR011) == "") Goto LABEL001
  57.     FOpen 4, PPEPath() + "Profile.dat", 0, 0
  58.     For INTEGER002 = 1 To INTEGER001
  59.         FSeek 4, INTEGER003, 0
  60.         FRead 4, BIGSTR002, 25
  61.         If (Upper(BIGSTR011) == Upper(Left(BIGSTR002, Len(BIGSTR011)))) Then
  62.             FClose 4
  63.             Goto LABEL002
  64.         Endif
  65.         INTEGER003 = INTEGER003 + 100
  66.     Next
  67.     FClose 4
  68.     Goto LABEL003
  69.     :LABEL002
  70.     FOpen 4, PPEPath() + "Profile.dat", 0, 0
  71.     FSeek 4, INTEGER003, 0
  72.     FRead 4, BIGSTR002, 25
  73.     PrintLn 
  74.     PrintLn 
  75.     PrintLn "@X0CShort User Summary"
  76.     PrintLn "@X08──────────────────"
  77.     PrintLn 
  78.     PrintLn "@X0AUser Name         :@X0B ", Mixed(BIGSTR002)
  79.     FRead 4, BIGSTR003, 1
  80.     Select Case (Upper(BIGSTR003))
  81.         Case "M"
  82.             BIGSTR003 = "Male"
  83.         Case "F"
  84.             BIGSTR003 = "Female"
  85.     End Select
  86.     PrintLn "@X0ASex               :@X0B ", BIGSTR003
  87.     FRead 4, DATE001, 2
  88.     PrintLn "@X0ABirth Date        :@X0B ", DATE001
  89.     FRead 4, BIGSTR004, 1
  90.     Select Case (BIGSTR004)
  91.         Case "1"
  92.             BIGSTR004 = "Heterosexual"
  93.         Case "2"
  94.             BIGSTR004 = "Bi-Sexual"
  95.         Case "3"
  96.             BIGSTR004 = "Gay"
  97.         Case "4"
  98.             BIGSTR004 = "Lesbian"
  99.         Case "5"
  100.             BIGSTR004 = "Androgenous"
  101.         Case "6"
  102.             BIGSTR004 = "None of your business"
  103.     End Select
  104.     PrintLn "@X0ASexual Preference :@X0B ", BIGSTR004
  105.     FRead 4, BIGSTR006, 1
  106.     Select Case (BIGSTR006)
  107.         Case "1"
  108.             BIGSTR006 = "Married, and loving it!"
  109.         Case "2"
  110.             BIGSTR006 = "Married, but I am looking."
  111.         Case "3"
  112.             BIGSTR006 = "In a significant relationship (other than marrige)."
  113.         Case "4"
  114.             BIGSTR006 = "Single, with a significant other."
  115.         Case "5"
  116.             BIGSTR006 = "Single with no one in my life now."
  117.         Case "6"
  118.             BIGSTR006 = "None of your business"
  119.     End Select
  120.     PrintLn "@X0AMarital Status    :@X0B ", BIGSTR006
  121.     FRead 4, BIGSTR007, 2
  122.     FRead 4, BIGSTR010, 3
  123.     FRead 4, BIGSTR008, 1
  124.     FRead 4, BIGSTR009, 1
  125.     FClose 4
  126.     PrintLn 
  127.     PrintLn "Profiled User, ", Mixed(BIGSTR002), " is ", BIGSTR007, " inches tall, weighs ", BIGSTR010, " pounds and"
  128.     Select Case (BIGSTR008)
  129.         Case "1"
  130.             BIGSTR008 = "blond"
  131.         Case "2"
  132.             BIGSTR008 = "brown"
  133.         Case "3"
  134.             BIGSTR008 = "gray"
  135.         Case "4"
  136.             BIGSTR008 = "black"
  137.         Case "5"
  138.             BIGSTR008 = "red"
  139.         Case "6"
  140.             BIGSTR008 = "white"
  141.     End Select
  142.     Select Case (BIGSTR009)
  143.         Case "1"
  144.             BIGSTR009 = "brown"
  145.         Case "2"
  146.             BIGSTR009 = "blue"
  147.         Case "3"
  148.             BIGSTR009 = "green"
  149.         Case "4"
  150.             BIGSTR009 = "black"
  151.         Case "5"
  152.             BIGSTR009 = "violet"
  153.         Case "6"
  154.             BIGSTR009 = "hazel"
  155.     End Select
  156.     PrintLn "has ", BIGSTR008, " hair and ", BIGSTR009, " eyes."
  157.     Newlines 2
  158.     InputYN "Would you like to DELETE this User (@X0CY@X0B/@X0Cn@X0B) _", BIGSTR005, 14
  159.     If (Upper(BIGSTR005) == "Y") Goto LABEL004
  160.     Goto LABEL001
  161.     :LABEL003
  162.     Newlines 2
  163.     PrintLn "@X10┌────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
  164.     PrintLn "@X10│ @X1CThe name you entered was not found please check the spelling and try again @X19│@X0F"
  165.     PrintLn "@X10│ @X1Cor the person you are trying to DELETE might not be in our database!       @X19│@X0F"
  166.     PrintLn "@X10└@X19────────────────────────────────────────────────────────────────────────────┘@X0F"
  167.     AnsiPos 25, 22
  168.     Print ""
  169.     Wait
  170.     Goto LABEL001
  171.     :LABEL004
  172.     INTEGER004 = 0
  173.     INTEGER005 = INTEGER003 / 100 + 1
  174.     FOpen 6, PPEPath() + "Profile.NEW", 2, 0
  175.     FOpen 5, PPEPath() + "Profile.dat", 0, 0
  176.     For INTEGER002 = 1 To INTEGER001
  177.         FSeek 5, INTEGER004, 0
  178.         FRead 5, BIGSTR001, 100
  179.         If (INTEGER002 == INTEGER005) Then
  180.             Print " @X8CUser Deleted!@X0F"
  181.             Delay (3 * 182) / 10
  182.         ElseIf (INTEGER002 <> INTEGER005) Then
  183.             FWrite 6, BIGSTR001, 100
  184.         Endif
  185.         INTEGER004 = INTEGER004 + 100
  186.     Next
  187.     FClose 5
  188.     FClose 6
  189.     Rename PPEPath() + "profile.dat", PPEPath() + "profile.old"
  190.     Delete PPEPath() + "profile.dat"
  191.     Rename PPEPath() + "profile.new", PPEPath() + "profile.DAT"
  192.     :LABEL005
  193.     End
  194.  
  195. ;------------------------------------------------------------------------------
  196. ;
  197. ; Usage report (before postprocessing)
  198. ;
  199. ; ■ Statements used :
  200. ;
  201. ;    2       End
  202. ;    2       Cls
  203. ;    1       Wait
  204. ;    62      Goto 
  205. ;    37      Let 
  206. ;    2       Print 
  207. ;    23      PrintLn 
  208. ;    35      If 
  209. ;    4       FOpen 
  210. ;    5       FClose 
  211. ;    1       GetUser
  212. ;    1       Delete 
  213. ;    1       Log 
  214. ;    1       InputStr 
  215. ;    1       InputYN 
  216. ;    1       Delay 
  217. ;    2       Newlines 
  218. ;    1       AnsiPos 
  219. ;    2       Rename 
  220. ;    3       FSeek 
  221. ;    11      FRead 
  222. ;    1       FWrite 
  223. ;
  224. ;
  225. ; ■ Functions used :
  226. ;
  227. ;    1       *
  228. ;    3       /
  229. ;    15      +
  230. ;    31      ==
  231. ;    1       <>
  232. ;    3       <
  233. ;    2       <=
  234. ;    4       >=
  235. ;    31      !
  236. ;    4       &&
  237. ;    2       ||
  238. ;    1       Len(
  239. ;    7       Upper()
  240. ;    1       Left()
  241. ;    1       Mask_Ascii()
  242. ;    10      PPEPath()
  243. ;    1       SysopSec()
  244. ;    1       CurSec()
  245. ;    1       FileInf()
  246. ;    2       Mixed()
  247. ;
  248. ;------------------------------------------------------------------------------
  249. ;
  250. ; Analysis flags : s
  251. ;
  252. ; s - Sysop level access ■ 5
  253. ;     Program is reading the sysop access level, this may be normal
  254. ;     but still it is very suspect. It is the best way to give a user
  255. ;     all priviledges. Check!
  256. ;     ■ Search for : SYSOPSEC()
  257. ;
  258. ;------------------------------------------------------------------------------
  259. ;
  260. ; Postprocessing report
  261. ;
  262. ;    2       For/Next
  263. ;    0       While/EndWhile
  264. ;    3       If/Then or If/Then/Else
  265. ;    5       Select Case
  266. ;
  267. ;------------------------------------------------------------------------------
  268. ;                 AEGiS Corp - Break the routines, code against the machines!
  269. ;------------------------------------------------------------------------------
  270.