home *** CD-ROM | disk | FTP | other *** search
/ Groovy Bytes: Behind the Moon / groovybytes.iso / GROOVY / PPE / PAIN / P__ALLTM.ZIP / P!-ALLTM.PPE (.txt) < prev    next >
Encoding:
PCBoard Programming Language Executable  |  1995-06-18  |  8.7 KB  |  469 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 3.O1 (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Boolean  BOOLEAN001
  20.     Integer  INTEGER001
  21.     Integer  INTEGER002
  22.     Integer  INTEGER003
  23.     Integer  INTEGER004
  24.     Integer  INTEGER005
  25.     Integer  INTEGER006
  26.     Integer  INTEGER007
  27.     Integer  TINTEGER008(1)
  28.     Integer  TINTEGER009(1)
  29.     Integer  TINTEGER010(1)
  30.     Integer  INTEGER011
  31.     String   STRING001
  32.     String   STRING002
  33.     String   STRING003
  34.     String   TSTRING004(1)
  35.     String   TSTRING005(1)
  36.     String   STRING006
  37.     String   TSTRING007(1)
  38.     String   TSTRING008(1)
  39.     String   STRING009
  40.     String   STRING010
  41.     String   STRING011
  42.     String   STRING012
  43.     String   STRING013
  44.     String   STRING014
  45.     String   STRING015
  46.     String   STRING016
  47.     String   STRING017
  48.     String   STRING018
  49.     String   TSTRING019(12)
  50.     Double   TDOUBLE001(1)
  51.     Double   TDOUBLE002(1)
  52.  
  53. ;------------------------------------------------------------------------------
  54.  
  55.     If (AnsiOn()) Goto LABEL001
  56.     Cls
  57.     PrintLn "ANSi REQUiRED...SWiTCH 0N ANSi !"
  58.     Delay 20
  59.     End
  60.     :LABEL001
  61.     Goto LABEL005
  62.     :LABEL002
  63.     STRING003 = ""
  64.     If (Len(STRING002) == 1) Then
  65.         STRING003 = "            " + STRING002
  66.         Return
  67.     Endif
  68.     If (Len(STRING002) == 2) Then
  69.         STRING003 = "           " + STRING002
  70.         Return
  71.     Endif
  72.     If (Len(STRING002) == 3) Then
  73.         STRING003 = "          " + STRING002
  74.         Return
  75.     Endif
  76.     If (Len(STRING002) == 4) Then
  77.         STRING003 = "        " + Left(STRING002, 1) + STRING006 + Mid(STRING002, 2, 3)
  78.         Return
  79.     Endif
  80.     If (Len(STRING002) == 5) Then
  81.         STRING003 = "       " + Left(STRING002, 2) + STRING006 + Mid(STRING002, 3, 3)
  82.         Return
  83.     Endif
  84.     If (Len(STRING002) == 6) Then
  85.         STRING003 = "      " + Left(STRING002, 3) + STRING006 + Mid(STRING002, 4, 3)
  86.         Return
  87.     Endif
  88.     If (Len(STRING002) == 7) Then
  89.         STRING003 = "    " + Left(STRING002, 1) + STRING006 + Mid(STRING002, 2, 3) + STRING006 + Mid(STRING002, 5, 3)
  90.         Return
  91.     Endif
  92.     If (Len(STRING002) == 8) Then
  93.         STRING003 = "   " + Left(STRING002, 2) + STRING006 + Mid(STRING002, 3, 3) + STRING006 + Mid(STRING002, 6, 3)
  94.         Return
  95.     Endif
  96.     If (Len(STRING002) == 9) Then
  97.         STRING003 = "  " + Left(STRING002, 3) + STRING006 + Mid(STRING002, 4, 3) + STRING006 + Mid(STRING002, 7, 3)
  98.         Return
  99.     Endif
  100.     If (Len(STRING002) == 10) Then
  101.         STRING003 = Left(STRING002, 1) + STRING006 + Mid(STRING002, 2, 3) + STRING006 + Mid(STRING002, 5, 3) + STRING006 + Mid(STRING002, 8, 3)
  102.         Return
  103.     Endif
  104.     Return
  105.     :LABEL003
  106.     Inc INTEGER011
  107.     If (INTEGER011 > INTEGER007) Then
  108.         INTEGER011 = 0
  109.         AnsiPos 64, 22
  110.         Print STRING009 + Mid(STRING018, INTEGER006, 1) + STRING010 + Mid(STRING018, INTEGER006 + 1, 13) + STRING011 + Mid(STRING018, INTEGER006 + 14, 1)
  111.         Inc INTEGER006
  112.         If (INTEGER006 > Len(STRING018) - 15) INTEGER006 = 1
  113.     Endif
  114.     Return
  115.     :LABEL004
  116.     Cls
  117.     PrintLn "@X8DMAKiNG iNDEX...PLEASE WAiT..."
  118.     INTEGER002 = 0
  119.     For INTEGER001 = 2 To INTEGER003
  120.         GetAltUser INTEGER001
  121.         TSTRING004(INTEGER001 - 1) = U_Name()
  122.         TDOUBLE002(INTEGER001 - 1) = U_Bul()
  123.         TDOUBLE001(INTEGER001 - 1) = U_Bdl()
  124.     Next
  125.     Sort TSTRING004, TINTEGER008
  126.     Sort TDOUBLE002, TINTEGER010
  127.     Sort TDOUBLE001, TINTEGER009
  128.     FOpen 1, PPEPath() + "p!-alltm.dat", 1, 3
  129.     For INTEGER001 = 1 To 15
  130.         FPutLn 1, TSTRING004(TINTEGER010(INTEGER003 - INTEGER001 + 1))
  131.         STRING002 = I2S(TDOUBLE002(TINTEGER010(INTEGER003 - INTEGER001 + 1)), 10)
  132.         Gosub LABEL002
  133.         FPutLn 1, STRING003
  134.     Next
  135.     For INTEGER001 = 1 To 15
  136.         FPutLn 1, TSTRING004(TINTEGER009(INTEGER003 - INTEGER001 + 1))
  137.         STRING002 = I2S(TDOUBLE001(TINTEGER009(INTEGER003 - INTEGER001 + 1)), 10)
  138.         Gosub LABEL002
  139.         FPutLn 1, STRING003
  140.     Next
  141.     FClose 1
  142.     Goto LABEL017
  143.     :LABEL005
  144.     STRING009 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 1), 4)
  145.     STRING010 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 2), 4)
  146.     STRING011 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 3), 4)
  147.     STRING014 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 4), 4)
  148.     STRING015 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 5), 4)
  149.     STRING016 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 6), 4)
  150.     STRING017 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 7), 4)
  151.     STRING012 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 8), 4)
  152.     STRING013 = Left(ReadLine(PPEPath() + "p!-alltm.cfg", 9), 4)
  153.     INTEGER007 = S2I(Left(ReadLine(PPEPath() + "p!-alltm.cfg", 10), 4), 10)
  154.     INTEGER003 = FileInf(ReadLine(PCBDat(), 29), 4) / 400
  155.     Redim TDOUBLE002, INTEGER003
  156.     Redim TDOUBLE001, INTEGER003
  157.     Redim TSTRING004, INTEGER003
  158.     Redim TINTEGER010, INTEGER003
  159.     Redim TINTEGER009, INTEGER003
  160.     Redim TINTEGER008, INTEGER003
  161.     Redim TSTRING005, INTEGER003
  162.     Redim TSTRING007, INTEGER003
  163.     Redim TSTRING008, INTEGER003
  164.     STRING006 = "∙"
  165.     If (INTEGER003 < 15) Then
  166.         Cls
  167.         PrintLn "PAiN!-ALLTiME-HiGH D0ESN'T SUPP0RT A USERBASE WiTH LESS THAN 15 USERS !"
  168.         Delay 50
  169.         End
  170.     Endif
  171.     If (Left(TokenStr(), 1) == "S") Goto LABEL004
  172.     FOpen 1, PPEPath() + "p!-alltm.dat", 0, 3
  173.     If (Ferr(1)) Then
  174.         Cls
  175.         SPrintLn "-> SYS0P : PAiN!-ALLTiME HiGH DATA FiLE D0ESN'T EXiSTS..."
  176.         SPrintLn "           FiRST START P!-ALLTM.PPE WiTH PARAMETER ""S"" !!"
  177.         Delay 100
  178.         End
  179.     Endif
  180.     For INTEGER001 = 1 To 15
  181.         FGet 1, TSTRING004(INTEGER001)
  182.         FGet 1, TSTRING007(INTEGER001)
  183.     Next
  184.     For INTEGER001 = 1 To 15
  185.         FGet 1, TSTRING005(INTEGER001)
  186.         FGet 1, TSTRING008(INTEGER001)
  187.     Next
  188.     FClose 1
  189.     INTEGER006 = 1
  190.     STRING018 = "               " + ReadLine(PPEPath() + "p!-alltm.cfg", 14) + " (C) TYGER/PAiN!               "
  191.     AnsiPos 1, 1
  192.     Print "@POFF@"
  193.     DispFile PPEPath() + "p!-alltm.pcb", 1
  194.     AnsiPos 3, 22
  195.     Print "@X03( @X0B @X03/@X0B  @X03/ @X0BCR @X03)"
  196.     AnsiPos 8, 5
  197.     Print STRING009 + Left(TSTRING004(1), 1) + STRING010 + Mid(TSTRING004(1), 2, Len(TSTRING004(1)) - 2) + STRING011 + Right(TSTRING004(1), 1)
  198.     AnsiPos 26, 5
  199.     Print STRING014 + Left(TSTRING007(1), Len(TSTRING007(1)) - 1) + Right(TSTRING007(1), 1)
  200.     AnsiPos 47, 5
  201.     Print STRING009 + Left(TSTRING005(1), 1) + STRING010 + Mid(TSTRING005(1), 2, Len(TSTRING005(1)) - 2) + STRING011 + Right(TSTRING005(1), 1)
  202.     AnsiPos 65, 5
  203.     Print STRING015 + Left(TSTRING008(1), Len(TSTRING008(1)) - 1) + Right(TSTRING008(1), 1)
  204.     For INTEGER001 = 2 To 15
  205.         AnsiPos 8, 5 + INTEGER001
  206.         Print STRING009 + Left(TSTRING004(INTEGER001), 1) + STRING010 + Mid(TSTRING004(INTEGER001), 2, Len(TSTRING004(INTEGER001)) - 2) + STRING011 + Right(TSTRING004(INTEGER001), 1)
  207.         AnsiPos 26, 5 + INTEGER001
  208.         Print STRING016 + Left(TSTRING007(INTEGER001), Len(TSTRING007(INTEGER001)) - 1) + Right(TSTRING007(INTEGER001), 1)
  209.         AnsiPos 47, 5 + INTEGER001
  210.         Print STRING009 + Left(TSTRING005(INTEGER001), 1) + STRING010 + Mid(TSTRING005(INTEGER001), 2, Len(TSTRING005(INTEGER001)) - 2) + STRING011 + Right(TSTRING005(INTEGER001), 1)
  211.         AnsiPos 65, 5 + INTEGER001
  212.         Print STRING017 + Left(TSTRING008(INTEGER001), Len(TSTRING008(INTEGER001)) - 1) + Right(TSTRING008(INTEGER001), 1)
  213.     Next
  214.     INTEGER004 = 1
  215.     INTEGER005 = 1
  216.     :LABEL006
  217.     AnsiPos 20, 22
  218.     If (!BOOLEAN001) Print "@X7F▌@X70■∙@X7FEXiT@X70∙■@X78▐@X07    ViEW USER         "
  219.     If (BOOLEAN001) Print "@X07   EXiT    @X7F▌@X70■∙@X7FViEW USER@X70∙■@X78▐@X01     "
  220.     :LABEL007
  221.     Gosub LABEL003
  222.     AnsiPos 1, 2
  223.     STRING001 = Inkey()
  224.     If (STRING001 == "") Goto LABEL007
  225.     If (STRING001 == Chr(13)) Goto LABEL008
  226.     If (STRING001 == Chr(27)) Goto LABEL017
  227.     If ((((STRING001 == "LEFT") || (STRING001 == "UP")) || (STRING001 == "RIGHT")) || (STRING001 == "DOWN")) Then
  228.         BOOLEAN001 = !BOOLEAN001
  229.         Goto LABEL006
  230.     Endif
  231.     :LABEL008
  232.     If (BOOLEAN001) Then
  233.         AnsiPos 3, 22
  234.         Print "              "
  235.         AnsiPos 22, 22
  236.         Print "@X03( @X0B @X03/@X0B  @X03/ @X0B @X03/@X0B  @X03/ @X0BCR @X03/ @X0BESC@X0B )        "
  237.         INTEGER004 = 1
  238.         INTEGER005 = 1
  239.         :LABEL009
  240.         If (INTEGER004 == 1) Then
  241.             If (INTEGER005 == 1) Then
  242.                 AnsiPos 8, 5
  243.                 Goto LABEL010
  244.             Endif
  245.             AnsiPos 8, 5 + INTEGER005
  246.             :LABEL010
  247.             Print "@X9F" + TSTRING004(INTEGER005)
  248.         Endif
  249.         If (INTEGER004 == 2) Then
  250.             If (INTEGER005 == 1) Then
  251.                 AnsiPos 47, 5
  252.                 Goto LABEL011
  253.             Endif
  254.             AnsiPos 47, 5 + INTEGER005
  255.             :LABEL011
  256.             Print "@X9F" + TSTRING005(INTEGER005)
  257.         Endif
  258.         :LABEL012
  259.         Gosub LABEL003
  260.         STRING001 = Inkey()
  261.         If (STRING001 == "") Goto LABEL012
  262.         If (INTEGER004 == 1) Then
  263.             If (INTEGER005 == 1) Then
  264.                 AnsiPos 8, 5
  265.                 Goto LABEL013
  266.             Endif
  267.             AnsiPos 8, 5 + INTEGER005
  268.             :LABEL013
  269.             Print STRING009 + Left(TSTRING004(INTEGER005), 1) + STRING010 + Mid(TSTRING004(INTEGER005), 2, Len(TSTRING004(INTEGER005)) - 2) + STRING011 + Right(TSTRING004(INTEGER005), 1)
  270.         Endif
  271.         If (INTEGER004 == 2) Then
  272.             If (INTEGER005 == 1) Then
  273.                 AnsiPos 47, 5
  274.                 Goto LABEL014
  275.             Endif
  276.             AnsiPos 47, 5 + INTEGER005
  277.             :LABEL014
  278.             Print STRING009 + Left(TSTRING005(INTEGER005), 1) + STRING010 + Mid(TSTRING005(INTEGER005), 2, Len(TSTRING005(INTEGER005)) - 2) + STRING011 + Right(TSTRING005(INTEGER005), 1)
  279.         Endif
  280.         AnsiPos 1, 2
  281.         If (STRING001 == "UP") Then
  282.             Dec INTEGER005
  283.             If (INTEGER005 < 1) INTEGER005 = 15
  284.         Endif
  285.         If (STRING001 == "DOWN") Then
  286.             Inc INTEGER005
  287.             If (INTEGER005 > 15) INTEGER005 = 1
  288.         Endif
  289.         If (STRING001 == "LEFT") Then
  290.             INTEGER004 = 1
  291.         Endif
  292.         If (STRING001 == "RIGHT") Then
  293.             INTEGER004 = 2
  294.         Endif
  295.         If (STRING001 == Chr(13)) Goto LABEL015
  296.         If (STRING001 == Chr(27)) Then
  297.             AnsiPos 20, 22
  298.             Print "@X01                            "
  299.             AnsiPos 3, 22
  300.             Print "@X03( @X0B @X03/@X0B  @X03/ @X0BCR @X03)"
  301.             Goto LABEL006
  302.         Endif
  303.         Goto LABEL009
  304.         :LABEL015
  305.         For INTEGER001 = 1 To 12
  306.             TSTRING019(INTEGER001) = ScrText(15, 6 + INTEGER001, 38, 1)
  307.         Next
  308.         AnsiPos 15, 7
  309.         Print "@X07▐@X78════════════════════════════════════ "
  310.         AnsiPos 15, 8
  311.         Print "@X78▌ @X70NAME  :                             "
  312.         AnsiPos 15, 9
  313.         Print "@X78▌ @X70CiTY  :                             "
  314.         AnsiPos 15, 10
  315.         Print "@X78▌ @X70LEVEL :                             "
  316.         AnsiPos 15, 11
  317.         Print "@X78▌ @X70CALLS :                             "
  318.         AnsiPos 15, 12
  319.         Print "@X78▌ @X70DL's  :                             "
  320.         AnsiPos 15, 13
  321.         Print "@X78▌ @X70UL's  :                             "
  322.         AnsiPos 15, 14
  323.         Print "@X78▌-─────────────────────────────────-- "
  324.         AnsiPos 15, 15
  325.         Print "@X78▌ @X70FiRST 0N :                         @X78░"
  326.         AnsiPos 15, 16
  327.         Print "@X78▌ @X70LAST  0N :                        @X78░▒"
  328.         AnsiPos 15, 17
  329.         Print "@X78▌═════════════════════════════════ ░▒▓"
  330.         AnsiPos 15, 18
  331.         Print "@X08▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀@X01"
  332.         If (INTEGER004 == 1) GetAltUser U_RecNum(TSTRING004(INTEGER005))
  333.         If (INTEGER004 == 2) GetAltUser U_RecNum(TSTRING005(INTEGER005))
  334.         AnsiPos 25, 8
  335.         Print "@X7F" + U_Name()
  336.         AnsiPos 25, 9
  337.         Print U_City
  338.         AnsiPos 25, 10
  339.         Print U_Sec
  340.         AnsiPos 25, 11
  341.         Print U_Logons()
  342.         AnsiPos 25, 12
  343.         Print U_Fdl()
  344.         AnsiPos 25, 13
  345.         Print U_Ful()
  346.         AnsiPos 28, 15
  347.         Print U_Stat(1)
  348.         AnsiPos 28, 16
  349.         STRING001 = U_LDate()
  350.         Print STRING001 + " ("
  351.         STRING001 = U_LTime()
  352.         Print STRING001 + ")"
  353.         :LABEL016
  354.         Gosub LABEL003
  355.         STRING001 = Inkey()
  356.         If (STRING001 <> Chr(13)) Goto LABEL016
  357.         For INTEGER001 = 1 To 12
  358.             AnsiPos 15, 6 + INTEGER001
  359.             Print TSTRING019(INTEGER001)
  360.         Next
  361.         Goto LABEL009
  362.     Endif
  363.     :LABEL017
  364.     Print "@X01"
  365.     Cls
  366.     End
  367.  
  368. ;------------------------------------------------------------------------------
  369. ;
  370. ; Usage report (before postprocessing)
  371. ;
  372. ; ■ Statements used :
  373. ;
  374. ;    4       End
  375. ;    5       Cls
  376. ;    62      Goto 
  377. ;    64      Let 
  378. ;    44      Print 
  379. ;    3       PrintLn 
  380. ;    51      If 
  381. ;    1       DispFile 
  382. ;    2       FOpen 
  383. ;    2       FClose 
  384. ;    4       FGet 
  385. ;    4       FPutLn 
  386. ;    5       Gosub 
  387. ;    12      Return
  388. ;    3       Delay 
  389. ;    3       Inc 
  390. ;    1       Dec 
  391. ;    47      AnsiPos 
  392. ;    2       SPrintLn 
  393. ;    9       Redim 
  394. ;    3       GetAltUser 
  395. ;    3       Sort 
  396. ;
  397. ;
  398. ; ■ Functions used :
  399. ;
  400. ;    1       /
  401. ;    121     +
  402. ;    18      -
  403. ;    35      ==
  404. ;    1       <>
  405. ;    10      <
  406. ;    8       <=
  407. ;    3       >
  408. ;    16      >=
  409. ;    39      !
  410. ;    16      &&
  411. ;    11      ||
  412. ;    21      Len(
  413. ;    21      Mid()
  414. ;    28      Left()
  415. ;    10      Right()
  416. ;    1       Ferr()
  417. ;    5       Chr()
  418. ;    2       U_Name()
  419. ;    1       U_LDate()
  420. ;    1       U_LTime()
  421. ;    1       U_Logons()
  422. ;    1       U_Ful()
  423. ;    1       U_Fdl()
  424. ;    1       U_Bdl()
  425. ;    1       U_Bul()
  426. ;    3       Inkey()
  427. ;    1       PCBDat()
  428. ;    14      PPEPath()
  429. ;    12      ReadLine()
  430. ;    2       I2S()
  431. ;    1       S2I()
  432. ;    1       TokenStr()
  433. ;    1       AnsiOn()
  434. ;    1       U_Stat()
  435. ;    1       FileInf()
  436. ;    2       U_RecNum()
  437. ;    1       ScrText()
  438. ;
  439. ;------------------------------------------------------------------------------
  440. ;
  441. ; Analysis flags : Rd
  442. ;
  443. ; R - Read user ■ 5
  444. ;     User records are read, this may signify that someone wants to get
  445. ;     various informations about a user (for example his password), but
  446. ;     this may also be normal for a program accessing user records (for
  447. ;     example a User Editor)
  448. ;     ■ Search for : GETALTUSER
  449. ;
  450. ; d - Access PCBOARD.DAT ■ 2
  451. ;     Program gets the full pathname to PCBOARD.DAT, this may be usefull
  452. ;     for many PPE so they can find various informations on the system
  453. ;     (system paths, max number of lines in messages, ...) but it may also
  454. ;     be a way to gather vital informations.
  455. ;     ■ Search for : PCBDAT()
  456. ;
  457. ;------------------------------------------------------------------------------
  458. ;
  459. ; Postprocessing report
  460. ;
  461. ;    8       For/Next
  462. ;    0       While/EndWhile
  463. ;    28      If/Then or If/Then/Else
  464. ;    0       Select Case
  465. ;
  466. ;------------------------------------------------------------------------------
  467. ;                 AEGiS Corp - Break the routines, code against the machines!
  468. ;------------------------------------------------------------------------------
  469.