home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PCBOARD / PCBWHO16.ZIP / PCBWHO.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1994-02-09  |  10KB  |  466 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.     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  INTEGER008
  28.     Integer  INTEGER009
  29.     Integer  INTEGER010
  30.     Integer  INTEGER011
  31.     Integer  INTEGER012
  32.     Integer  INTEGER013
  33.     Integer  INTEGER014
  34.     Integer  INTEGER015
  35.     String   STRING001
  36.     String   STRING002
  37.     String   STRING003
  38.     String   STRING004
  39.     String   STRING005
  40.     String   STRING006
  41.     String   STRING007
  42.     String   TSTRING008(22)
  43.     String   STRING009
  44.     String   STRING010
  45.     String   STRING011
  46.     String   STRING012
  47.     String   STRING013
  48.     String   TSTRING014(50)
  49.     String   STRING015
  50.     String   STRING016
  51.     String   STRING017
  52.     String   STRING018
  53.     String   STRING019
  54.     String   STRING020
  55.     String   TSTRING021(100)
  56.     String   STRING022
  57.     String   STRING023
  58.  
  59. ;------------------------------------------------------------------------------
  60.  
  61.     STRING022 = "1.6"
  62.     INTEGER004 = 34373
  63.     INTEGER005 = 9561
  64.     INTEGER006 = 1
  65.     STRING023 = Chr(85) + Chr(78) + Chr(82) + Chr(69) + Chr(71) + Chr(73) + Chr(83) + Chr(84) + Chr(69) + Chr(82) + Chr(69) + Chr(68)
  66.     STRING004 = "PCBWHO v" + STRING022
  67.     STRING016 = Chr(71) + Chr(82) + Chr(69) + Chr(71) + Chr(71) + Chr(32) + Chr(71) + Chr(82) + Chr(65) + Chr(85) + Chr(66) + Chr(73) + Chr(78) + Chr(83)
  68.     If (Exist(PPEPath() + "PCBWHO.CFG")) Then
  69.         FOpen 1, PPEPath() + "PCBWHO.CFG", 0, 0
  70.         FGet 1, STRING017
  71.         FGet 1, STRING018
  72.         FGet 1, STRING019
  73.         FGet 1, STRING006
  74.         FGet 1, STRING009
  75.         FGet 1, STRING010
  76.         FGet 1, STRING011
  77.         FGet 1, STRING012
  78.         FGet 1, STRING013
  79.         FClose 1
  80.     Else
  81.         PrintLn "@X0CConfiguration file PCBWHO.CFG not found, aborting..."
  82.         Stop
  83.     Endif
  84.     STRING001 = Upper(Trim(LangExt(), " "))
  85.     STRING001 = Replace(STRING001, ".", "")
  86.     If (STRING001 == "") Then
  87.         STRING002 = PPEPath() + "WHOTEXT."
  88.     ElseIf (STRING001 <> "") Then
  89.         STRING002 = PPEPath() + "WHOTEXT." + STRING001
  90.     Endif
  91.     If (!Exist(STRING002)) STRING002 = PPEPath() + "WHOTEXT."
  92.     If (Exist(STRING002)) Then
  93.         FOpen 1, STRING002, 0, 0
  94.         FGet 1, TSTRING008(1)
  95.         FGet 1, TSTRING008(2)
  96.         FGet 1, TSTRING008(3)
  97.         FGet 1, TSTRING008(4)
  98.         FGet 1, TSTRING008(5)
  99.         FGet 1, TSTRING008(6)
  100.         FGet 1, TSTRING008(7)
  101.         FGet 1, TSTRING008(8)
  102.         FGet 1, TSTRING008(9)
  103.         FGet 1, TSTRING008(10)
  104.         FGet 1, TSTRING008(11)
  105.         FGet 1, TSTRING008(12)
  106.         FGet 1, TSTRING008(13)
  107.         FGet 1, TSTRING008(14)
  108.         FGet 1, TSTRING008(15)
  109.         FGet 1, TSTRING008(16)
  110.         FGet 1, TSTRING008(17)
  111.         FGet 1, TSTRING008(18)
  112.         FGet 1, TSTRING008(19)
  113.         FGet 1, TSTRING008(20)
  114.         FGet 1, TSTRING008(21)
  115.         FGet 1, TSTRING008(22)
  116.         FClose 1
  117.     Else
  118.         PrintLn "@X0CWHOTEXT prompt file not found, aborting..."
  119.         Stop
  120.     Endif
  121.     If (INTEGER006 <> 0) Then
  122.         If (Len(Trim(STRING023, " ")) <> 12) Goto LABEL009
  123.         If (FileInf(PPEPath() + PPEName() + ".PPE", 2) <> INTEGER004) Goto LABEL009
  124.         If (FileInf(PPEPath() + PPEName() + ".PPE", 4) <> INTEGER005) Goto LABEL009
  125.     Endif
  126.     Gosub LABEL010
  127.     INTEGER010 = 1
  128.     INTEGER013 = 1
  129.     If (Exist(PPEPath() + "LURK.LST")) Then
  130.         FOpen 2, PPEPath() + "LURK.LST", 0, 0
  131.         INTEGER014 = 1
  132.         INTEGER010 = 0
  133.         :LABEL001
  134.         If (Ferr(2)) Goto LABEL002
  135.         FGet 2, TSTRING014(INTEGER014)
  136.         INTEGER011 = INTEGER014
  137.         INTEGER014 = INTEGER014 + 1
  138.         Goto LABEL001
  139.         :LABEL002
  140.         FClose 2
  141.     Else
  142.         Log "@X0CFile LURK.LST not found", 1
  143.         Log "@X0CBypassing LURK feature", 1
  144.         INTEGER010 = 1
  145.     Endif
  146.     For INTEGER008 = 1 To 21
  147.         TSTRING008(INTEGER008) = Trim(TSTRING008(INTEGER008), " ")
  148.         INTEGER009 = 24
  149.     Next
  150.     BOOLEAN001 = 0
  151.     INTEGER007 = S2I(STRING006, 10)
  152.     GetToken STRING003
  153.     STRING003 = Trim(Upper(STRING003), Chr(32))
  154.     If (Mid(STRING003, 1, 1) == "L") Goto LABEL011
  155.     If (INTEGER001 <> 0) Then
  156.         Newline
  157.         Log "*" + STRING004 + "* (" + Chr(85) + Chr(78) + Chr(82) + Chr(69) + Chr(71) + Chr(73) + Chr(83) + Chr(84) + Chr(69) + Chr(82) + Chr(69) + Chr(68) + ")", 0
  158.         PrintLn "@X07This copy of @X0F" + STRING004 + "@X07 is @X0C" + Chr(85) + Chr(78) + Chr(82) + Chr(69) + Chr(71) + Chr(73) + Chr(83) + Chr(84) + Chr(69) + Chr(82) + Chr(69) + Chr(68) + "@X07."
  159.         Delay 3 * 18.2
  160.     Endif
  161.     :LABEL003
  162.     If (BOOLEAN001) Goto LABEL008
  163.     If (INTEGER013 == 0) Cls
  164.     If (Exist(PPEPath() + "PCBWHO.HDR")) DispFile PPEPath() + "PCBWHO.HDR", 4
  165.     For INTEGER008 = 1 To INTEGER007
  166.         INTEGER012 = 1
  167.         If ((INTEGER001 <> 0) && (INTEGER008 > 5)) Goto LABEL014
  168.         STRING015 = ""
  169.         RdUNet INTEGER008
  170.         If (INTEGER008 > 99) Then
  171.             STRING005 = String(INTEGER008)
  172.         ElseIf (INTEGER008 > 9) Then
  173.             STRING005 = " " + String(INTEGER008)
  174.         Else
  175.             STRING005 = "  " + String(INTEGER008)
  176.         Endif
  177.         Print STRING009, " ", STRING005, " ", STRING010
  178.         If (PcbNode() <> INTEGER008) Then
  179.             Select Case (UN_Stat())
  180.                 Case " "
  181.                     OpText TSTRING008(1)
  182.                 Case "A"
  183.                     OpText TSTRING008(2)
  184.                 Case "B"
  185.                     OpText TSTRING008(3)
  186.                 Case "C"
  187.                     OpText TSTRING008(4)
  188.                 Case "D"
  189.                     OpText TSTRING008(5)
  190.                 Case "E"
  191.                     OpText TSTRING008(6)
  192.                 Case "F"
  193.                     OpText TSTRING008(7)
  194.                 Case "G"
  195.                     OpText TSTRING008(8)
  196.                 Case "L"
  197.                     OpText TSTRING008(9)
  198.                 Case "M"
  199.                     OpText TSTRING008(10)
  200.                 Case "N"
  201.                     OpText TSTRING008(11)
  202.                 Case "O"
  203.                     OpText TSTRING008(12)
  204.                 Case "P"
  205.                     OpText TSTRING008(13)
  206.                 Case "R"
  207.                     OpText TSTRING008(14)
  208.                 Case "S"
  209.                     OpText TSTRING008(15)
  210.                 Case "T"
  211.                     If (Left(UN_Oper(), 3) == "(U)") Then
  212.                         OpText TSTRING008(16)
  213.                     Else
  214.                         OpText TSTRING008(17)
  215.                     Endif
  216.                 Case "U"
  217.                     OpText TSTRING008(18)
  218.                 Case "W"
  219.                     OpText TSTRING008(19)
  220.                 Case "X"
  221.                     OpText TSTRING008(20)
  222.                 Case Else
  223.                     OpText TSTRING008(21)
  224.             End Select
  225.         Else
  226.             If (PcbNode() == INTEGER008) Then
  227.                 OpText TSTRING008(22)
  228.             Endif
  229.         Endif
  230.         STRING015 = STRING015 + "@POS:8@@OPTEXT:23@@POS:32@"
  231.         If (UN_Stat() == "N") Then
  232.             STRING015 = STRING015 + STRING011 + UN_Oper()
  233.         Endif
  234.         INTEGER014 = 0
  235.         If (INTEGER010 <> 0) INTEGER011 = 1
  236.         For INTEGER015 = 1 To INTEGER011
  237.             If (((INTEGER010 == 0) && (Upper(Trim(UN_Name(), " ")) == Upper(Trim(TSTRING014(INTEGER014), " ")))) && (Upper(Trim(UN_Name(), " ")) <> "")) Then
  238.                 INTEGER012 = 0
  239.                 If ((CurSec() >= SysopSec()) || (U_Name() == STRING016)) Then
  240.                     If (UN_Stat() == "D") Then
  241.                         STRING015 = STRING015 + STRING013 + Mid(UN_Oper(), 1, Len(UN_Name())) + " @X08[" + STRING013 + "L@X08]" + STRING012 + " - " + Trim(Mid(UN_Oper(), Len(UN_Name()) + 3, Len(UN_Oper()) - Len(UN_Name())), " ")
  242.                         Goto LABEL004
  243.                     Endif
  244.                     If (UN_Stat() <> "D") Then
  245.                         STRING007 = UN_Name() + " @X08[" + STRING013 + "L@X08]"
  246.                         STRING015 = STRING015 + STRING013 + STRING007
  247.                         If (Trim(UN_City(), " ") <> "") STRING015 = STRING015 + STRING012 + " (" + UN_City() + ")"
  248.                     Endif
  249.                     :LABEL004
  250.                     Goto LABEL006
  251.                 Endif
  252.                 If (PcbNode() == INTEGER008) Then
  253.                     If (UN_Stat() == "D") Then
  254.                         STRING015 = STRING015 + STRING013 + Mid(UN_Oper(), 1, Len(UN_Name())) + " @X08[" + STRING013 + "L@X08]" + STRING012 + " - " + Trim(Mid(UN_Oper(), Len(UN_Name()) + 3, Len(UN_Oper()) - Len(UN_Name())), " ")
  255.                         Goto LABEL005
  256.                     Endif
  257.                     If (UN_Stat() <> "D") Then
  258.                         STRING007 = UN_Name() + " @X08[" + STRING013 + "L@X08]"
  259.                         STRING015 = STRING015 + STRING013 + STRING007
  260.                         If (Trim(UN_City(), " ") <> "") STRING015 = STRING015 + STRING012 + " (" + UN_City() + ")"
  261.                     Endif
  262.                     :LABEL005
  263.                     Goto LABEL006
  264.                 Endif
  265.                 If (CurSec() < SysopSec()) Then
  266.                     STRING015 = "@POS:8@" + TSTRING008(1)
  267.                 Endif
  268.             Endif
  269.             :LABEL006
  270.             INTEGER014 = INTEGER014 + 1
  271.         Next
  272.         If (INTEGER012 <> 0) Then
  273.             If (UN_Stat() == "D") Then
  274.                 STRING015 = STRING015 + STRING011 + UN_Oper()
  275.                 Goto LABEL007
  276.             Endif
  277.             If (UN_Stat() <> "D") Then
  278.                 STRING007 = UN_Name()
  279.                 STRING015 = STRING015 + STRING011 + STRING007 + STRING012
  280.                 If (Trim(UN_City(), " ") <> "") STRING015 = STRING015 + STRING012 + " (" + UN_City() + ")"
  281.             Endif
  282.         Endif
  283.         :LABEL007
  284.         PrintLn STRING015
  285.     Next
  286.     BOOLEAN001 = 1
  287.     Goto LABEL003
  288.     :LABEL008
  289.     Goto LABEL014
  290.     :LABEL009
  291.     Cls
  292.     Beep
  293.     Newlines 2
  294.     Beep
  295.     PrintLn "@X07[@X0CPCBWHO is (c) Copyrighted Software by Whitewater Technologies, Inc.@X07]"
  296.     PrintLn "@X07[@X0FWhitewater Systems - 312-743-4912@X07]"
  297.     Newline
  298.     PrintLn "@X07[@X0CPCBWHO's authentic seal has been altered!@X07]"
  299.     PrintLn "@X07[@X07Please call Whitewater Systems and download the newest release@X07]"
  300.     Log "*PCBWHO* Seal has been ALTERED", 0
  301.     Newlines 2
  302.     Goto LABEL014
  303.     :LABEL010
  304.     INTEGER001 = 1
  305.     STRING020 = ""
  306.     STRING020 = Chr(57) + String(Len(STRING018) - 4)
  307.     STRING020 = STRING020 + Chr(57) + String(Len(STRING018) - 6)
  308.     STRING020 = STRING020 + Chr(48) + String(Len(STRING017) - 5) + Chr(45)
  309.     STRING020 = STRING020 + Chr(51) + String(Len(STRING018) - 3) + Chr(53)
  310.     If (Trim(STRING018, " ") <> Trim(Mid(ReadLine(PCBDat(), 94), 1, Len(STRING018)), " ")) INTEGER001 = 1
  311.     If (Trim(STRING018, " ") == Trim(Mid(ReadLine(PCBDat(), 94), 1, Len(STRING018)), " ")) INTEGER001 = 0
  312.     If (STRING019 <> STRING020) INTEGER001 = 1
  313.     If (STRING019 == STRING020) INTEGER001 = 0
  314.     Return
  315.     :LABEL011
  316.     If (Exist(PPEPath() + "LURK.LST")) Then
  317.         FOpen 1, PPEPath() + "LURK.LST", 0, 0
  318.         INTEGER014 = 1
  319.         INTEGER003 = 0
  320.         Newline
  321.         Print "@X0AReading LURK.LST into memory... "
  322.         :LABEL012
  323.         If (Ferr(1)) Goto LABEL013
  324.         FGet 1, TSTRING021(INTEGER014)
  325.         If (U_Name() == Trim(Upper(TSTRING021(INTEGER014)), " ")) Then
  326.             INTEGER003 = INTEGER014
  327.         ElseIf (";" + U_Name() == Trim(Upper(TSTRING021(INTEGER014)), " ")) Then
  328.             INTEGER003 = INTEGER014
  329.         Endif
  330.         Inc INTEGER014
  331.         Goto LABEL012
  332.         :LABEL013
  333.         PrintLn "@X0F" + String(INTEGER014 - 2) + " record(s) found."
  334.         FClose 1
  335.         If (INTEGER003 <> 0) Then
  336.             If (Mid(TSTRING021(INTEGER003), 1, 1) == ";") Then
  337.                 PrintLn "@X0AToggling lurk mode @X0Fon@X0A...@X07"
  338.                 TSTRING021(INTEGER003) = U_Name()
  339.             Else
  340.                 PrintLn "@X0AToggling lurk mode @X0Foff@X0A...@X07"
  341.                 TSTRING021(INTEGER003) = ";" + U_Name()
  342.             Endif
  343.             INTEGER002 = 1
  344.             Print "@X0ASaving new LURK.LST... "
  345.             FCreate 1, PPEPath() + "LURK.LST", 1, 0
  346.             For INTEGER002 = 1 To INTEGER014 - 2
  347.                 FPutLn 1, TSTRING021(INTEGER002)
  348.             Next
  349.             FClose 1
  350.             PrintLn "@X0F" + String(INTEGER014 - 2) + " record(s) saved."
  351.         Else
  352.             Newline
  353.             PrintLn "@X0CYou were not found in the LURK.LST file - You must"
  354.             PrintLn "be inserted into this file before toggling lurk mode.@X07"
  355.         Endif
  356.         FClose 1
  357.     Else
  358.         PrintLn "@X0CLURK.LST file not found - You must first"
  359.         PrintLn "create one to toggle lurk mode on/off.@X07"
  360.     Endif
  361.     :LABEL014
  362.     End
  363.  
  364. ;------------------------------------------------------------------------------
  365. ;
  366. ; Usage report (before postprocessing)
  367. ;
  368. ; ■ Statements used :
  369. ;
  370. ;    1       End
  371. ;    2       Cls
  372. ;    106     Goto 
  373. ;    74      Let 
  374. ;    3       Print 
  375. ;    16      PrintLn 
  376. ;    71      If 
  377. ;    1       DispFile 
  378. ;    1       FCreate 
  379. ;    4       FOpen 
  380. ;    6       FClose 
  381. ;    33      FGet 
  382. ;    1       FPutLn 
  383. ;    4       Log 
  384. ;    1       Gosub 
  385. ;    1       Return
  386. ;    1       Delay 
  387. ;    1       Inc 
  388. ;    4       Newline
  389. ;    2       Newlines 
  390. ;    1       GetToken 
  391. ;    2       Stop
  392. ;    2       Beep
  393. ;    22      OpText 
  394. ;    1       RdUNet 
  395. ;
  396. ;
  397. ; ■ Functions used :
  398. ;
  399. ;    1       *
  400. ;    144     +
  401. ;    10      -
  402. ;    37      ==
  403. ;    20      <>
  404. ;    5       <
  405. ;    4       <=
  406. ;    3       >
  407. ;    9       >=
  408. ;    56      !
  409. ;    11      &&
  410. ;    5       ||
  411. ;    15      Len(
  412. ;    7       Upper()
  413. ;    8       Mid()
  414. ;    1       Left()
  415. ;    2       Ferr()
  416. ;    57      Chr()
  417. ;    18      Trim()
  418. ;    5       U_Name()
  419. ;    1       Replace()
  420. ;    9       String()
  421. ;    2       PCBDat()
  422. ;    14      PPEPath()
  423. ;    3       PcbNode()
  424. ;    2       ReadLine()
  425. ;    2       SysopSec()
  426. ;    26      UN_Stat()
  427. ;    11      UN_Name()
  428. ;    6       UN_City()
  429. ;    9       UN_Oper()
  430. ;    2       CurSec()
  431. ;    6       Exist()
  432. ;    1       S2I()
  433. ;    1       LangExt()
  434. ;    2       FileInf()
  435. ;    2       PPEName()
  436. ;
  437. ;------------------------------------------------------------------------------
  438. ;
  439. ; Analysis flags : ds
  440. ;
  441. ; d - Access PCBOARD.DAT ■ 2
  442. ;     Program gets the full pathname to PCBOARD.DAT, this may be usefull
  443. ;     for many PPE so they can find various informations on the system
  444. ;     (system paths, max number of lines in messages, ...) but it may also
  445. ;     be a way to gather vital informations.
  446. ;     ■ Search for : PCBDAT()
  447. ;
  448. ; s - Sysop level access ■ 5
  449. ;     Program is reading the sysop access level, this may be normal
  450. ;     but still it is very suspect. It is the best way to give a user
  451. ;     all priviledges. Check!
  452. ;     ■ Search for : SYSOPSEC()
  453. ;
  454. ;------------------------------------------------------------------------------
  455. ;
  456. ; Postprocessing report
  457. ;
  458. ;    4       For/Next
  459. ;    0       While/EndWhile
  460. ;    29      If/Then or If/Then/Else
  461. ;    1       Select Case
  462. ;
  463. ;------------------------------------------------------------------------------
  464. ;                 AEGiS Corp - Break the routines, code against the machines!
  465. ;------------------------------------------------------------------------------
  466.