home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / T / THTAREA.ZIP / THT-AREA.PPE (.txt) < prev   
PCBoard Programming Language Executable  |  1994-05-07  |  7KB  |  465 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.     String   TSTRING001(1000)
  27.     String   STRING002
  28.     String   STRING003
  29.     String   STRING004
  30.     String   STRING005
  31.     String   STRING006
  32.     String   STRING007
  33.     String   STRING008
  34.     String   STRING009
  35.     String   STRING010
  36.     String   STRING011
  37.     String   STRING012
  38.     String   STRING013
  39.     String   STRING014
  40.     String   STRING015
  41.     String   STRING016
  42.     String   STRING017
  43.     String   STRING018
  44.     String   STRING019
  45.     String   STRING020
  46.     String   STRING021
  47.     String   STRING022
  48.     String   STRING023
  49.     String   STRING024
  50.     String   STRING025
  51.     String   STRING026
  52.     String   STRING027
  53.     String   STRING028
  54.  
  55. ;------------------------------------------------------------------------------
  56.  
  57.     STRING028 = TokenStr()
  58.     Tokenize STRING028
  59.     If ((STRING028 == "0") && (CurSec() >= SysopSec())) Then
  60.         KbdStuff "f;" + STRING028
  61.         Stop
  62.     ElseIf (((STRING028 <> "0") && (STRING028 <> "SECOND")) && (STRING028 <> "")) Then
  63.         KbdStuff "f;" + STRING028
  64.         Stop
  65.     Endif
  66.     STRING002 = ReadLine(PCBDat(), 31) + ".@@@"
  67.     INTEGER001 = CurConf() * 548 + 158
  68.     INTEGER002 = CurConf() * 548 + 484
  69.     FOpen 1, PPEPath() + PPEName() + ".CNF", 0, 0
  70.     FGet 1, STRING012
  71.     FGet 1, STRING013
  72.     FGet 1, STRING014
  73.     FGet 1, STRING016
  74.     FGet 1, STRING020
  75.     FGet 1, STRING021
  76.     FGet 1, STRING022
  77.     FGet 1, STRING023
  78.     FGet 1, STRING024
  79.     FGet 1, STRING025
  80.     FGet 1, STRING026
  81.     FGet 1, STRING019
  82.     FClose 1
  83.     STRING027 = STRING022
  84.     FOpen 2, STRING002, 0, 0
  85.     FSeek 2, INTEGER001, 0
  86.     FRead 2, STRING003, 28
  87.     FSeek 2, INTEGER002, 0
  88.     FRead 2, STRING004, 32
  89.     FClose 2
  90.     If (Exist(PPEPath() + PPEName() + ".pcb")) DispFile PPEPath() + PPEName() + ".pcb", 0
  91.     AnsiPos 1, 1
  92.     Print Chr(64) + Chr(88) + Chr(48) + I2S(8, 36) + I2S(12, 36) + I2S(27, 36) + I2S(14, 36) + I2S(10, 36) + I2S(29, 36) + I2S(14, 36) + I2S(13, 36) + " " + Chr(102) + Chr(111) + Chr(114) + " " + I2S(27, 36) + I2S(18, 36) + I2S(15, 36) + I2S(29, 36) + " "
  93.     Print "@POS:60@" + Chr(64) + Chr(88) + Chr(48) + I2S(8, 36) + I2S(12, 36) + I2S(24, 26) + I2S(13, 36) + I2S(14, 36) + I2S(13, 36) + Chr(64) + Chr(88) + Chr(48) + I2S(15, 36) + " " + I2S(11, 36) + I2S(34, 36) + Chr(64) + Chr(88) + Chr(48) + I2S(15, 36) + " " + I2S(29, 36) + I2S(17, 36) + I2S(14, 36) + Chr(64) + Chr(88) + Chr(48) + I2S(8, 36) + " " + I2S(22, 36) + I2S(10, 36) + I2S(28, 36) + I2S(29, 36) + I2S(14, 36) + I2S(27, 36) + " "
  94.     AnsiPos 33, 1
  95.     Print Chr(64) + Chr(88) + Chr(48) + Chr(49) + " " + I2S(29, 36) + I2S(17, 36) + I2S(29, 36) + "-" + I2S(10, 36) + "rea" + Chr(64) + Chr(88) + Chr(48) + Chr(56) + "  v" + Chr(49) + "." + Chr(51) + Chr(48)
  96.     STRING007 = 0
  97.     STRING006 = 0
  98.     StartDisp 1
  99.     FOpen 1, STRING004, 0, 0
  100.     STRING011 = YesChar()
  101.     FSeek 1, 0, 0
  102.     FSeek 1, 60, 1
  103.     FRead 1, TSTRING001(STRING006), 35
  104.     AnsiPos STRING023, STRING022
  105.     Print STRING012 + STRING006
  106.     AnsiPos STRING024, STRING022
  107.     Print STRING013 + STRING021 + STRING013
  108.     Inc STRING007
  109.     Inc STRING006
  110.     Inc STRING022
  111.     AnsiPos STRING023, STRING022
  112.     Print STRING012 + STRING006
  113.     AnsiPos STRING024, STRING022
  114.     Print STRING013 + TSTRING001(STRING006 - 1)
  115.     Inc STRING007
  116.     Inc STRING006
  117.     :LABEL001
  118.     If (Ferr(1)) Goto LABEL014
  119.     Inc STRING022
  120.     :LABEL002
  121.     If (STRING010 == YesChar()) Then
  122.         FClose 1
  123.         FOpen 1, STRING004, 0, 0
  124.         FSeek 1, 0, 0
  125.         FSeek 1, 864, 1
  126.         STRING010 = NoChar()
  127.     Else
  128.         FSeek 1, 1, 1
  129.     Endif
  130.     FRead 1, TSTRING001(STRING006), 30
  131.     FSeek 1, 30, 1
  132.     If (Ferr(1)) Then
  133.         If (STRING007 < 10) Then
  134.             INTEGER005 = STRING007
  135.             For INTEGER004 = 1 To 10 - STRING007
  136.                 AnsiPos STRING023, STRING022
  137.                 Print STRING013 + Space(STRING026)
  138.                 AnsiPos STRING024, STRING022
  139.                 Print STRING013 + Space(STRING025)
  140.                 STRING008 = YesChar()
  141.                 Inc STRING022
  142.                 Inc STRING006
  143.             Next
  144.             STRING007 = 0
  145.             If (STRING006 < 11) Then
  146.                 AnsiPos 1, 21
  147.                 Print STRING014
  148.                 INTEGER006 = GetX()
  149.                 Goto LABEL004
  150.             Else
  151.             Else
  152.             Endif
  153.             FRead 1, TSTRING001(STRING006), 35
  154.             AnsiPos STRING023, STRING022
  155.             Print STRING012 + STRING006
  156.             AnsiPos STRING024, STRING022
  157.             Print STRING013 + TSTRING001(STRING006)
  158.             Inc STRING007
  159.             Inc STRING006
  160.             STRING011 = NoChar()
  161.             If (STRING007 == 10) BOOLEAN001 = 0
  162.             If (STRING007 == 10) Then
  163.                 INTEGER005 = STRING007
  164.                 STRING007 = 0
  165.                 DefColor
  166.                 AnsiPos 1, 21
  167.                 Print STRING014
  168.                 INTEGER006 = GetX()
  169.                 :LABEL003
  170.                 If (BOOLEAN001) Goto LABEL011
  171.             Endif
  172.         Endif
  173.         :LABEL004
  174.         STRING005 = ""
  175.         AnsiPos INTEGER006, 21
  176.         ClrEol
  177.         If (STRING006 == 10) STRING011 = YesChar()
  178.         STRING005 = Upper(Inkey())
  179.         If (STRING005 == "Q") Then
  180.             KbdStuff Chr(13)
  181.             Stop
  182.         Endif
  183.         If (STRING005 == "") Goto LABEL004
  184.         If ((STRING005 == Chr(13)) || (STRING005 == "B")) Goto LABEL009
  185.         If ((((((STRING005 == "S") || (STRING005 == Chr(32))) || (STRING005 == "UP")) || (STRING005 == "DOWN")) || (STRING005 == "RIGHT")) || (STRING005 == "LEFT")) Then
  186.             AnsiPos 1, 20
  187.             Print STRING020
  188.             Goto LABEL005
  189.         Endif
  190.         If ((((((((((STRING005 == 1) || (STRING005 == 2)) || (STRING005 == 3)) || (STRING005 == 4)) || (STRING005 == 5)) || (STRING005 == 6)) || (STRING005 == 7)) || (STRING005 == 8)) || (STRING005 == 9)) || (STRING005 == 0)) Goto LABEL008
  191.         :LABEL005
  192.         STRING018 = STRING023
  193.         INTEGER003 = STRING027 - 1
  194.         KbdStuff Chr(32)
  195.         STRING015 = ""
  196.         :LABEL006
  197.         If (FALSE) Goto LABEL008
  198.         STRING005 = Upper(Inkey())
  199.         If (STRING005 == "Q") Then
  200.             DefColor
  201.             AnsiPos 1, 20
  202.             Print Space(78)
  203.             AnsiPos STRING018, INTEGER003
  204.             Print STRING015
  205.             KbdStuff Chr(13)
  206.             AnsiPos 1, 21
  207.             Stop
  208.         Endif
  209.         If ((STRING005 == Chr(27)) || (STRING005 == "P")) Then
  210.             DefColor
  211.             AnsiPos 1, 20
  212.             Print Space(78)
  213.             AnsiPos STRING018, INTEGER003
  214.             Print STRING015
  215.             Goto LABEL004
  216.         Endif
  217.         If (STRING005 == Chr(13)) Then
  218.             STRING015 = StripAtx(STRING015)
  219.             DefColor
  220.             Cls
  221.             If (Left(STRING015, 2) == 0) STRING015 = "U"
  222.             If (STRING028 == "SECOND") Then
  223.                 KbdStuff Left(STRING015, 2)
  224.                 Stop
  225.                 Goto LABEL007
  226.             Endif
  227.             KbdStuff "F;" + Left(STRING015, 2)
  228.             Stop
  229.         Endif
  230.         :LABEL007
  231.         If ((((STRING005 == Chr(32)) || (STRING005 == "DOWN")) || (STRING005 == "LEFT")) || (STRING005 == "Z")) Then
  232.             Inc INTEGER003
  233.             AnsiPos STRING018, INTEGER003 - 1
  234.             Print STRING015
  235.             If (INTEGER003 == INTEGER005 + 6) INTEGER003 = INTEGER003 - INTEGER005
  236.             AnsiPos STRING018, INTEGER003
  237.             STRING015 = ScrText(STRING018, INTEGER003, STRING019, 1)
  238.             Print STRING016 + RTrim(ScrText(STRING018, INTEGER003, STRING019, 0), " ")
  239.         Endif
  240.         If (((STRING005 == "UP") || (STRING005 == "A")) || (STRING005 == "RIGHT")) Then
  241.             Dec INTEGER003
  242.             AnsiPos STRING018, INTEGER003 + 1
  243.             Print STRING015
  244.             AnsiPos STRING018, INTEGER003
  245.             STRING017 = ScrText(STRING018, INTEGER003, STRING019, 1)
  246.             If (INTEGER003 <> STRING027 - 1) Print STRING016 + RTrim(ScrText(STRING018, INTEGER003, STRING019, 0), " ")
  247.             STRING015 = STRING017
  248.             If (INTEGER003 == STRING027 - 1) Then
  249.                 INTEGER003 = INTEGER003 + INTEGER005
  250.                 STRING017 = ScrText(STRING018, INTEGER003, STRING019, 1)
  251.                 STRING015 = STRING017
  252.                 AnsiPos STRING018, INTEGER003
  253.                 Print STRING016 + RTrim(ScrText(STRING018, INTEGER003, STRING019, 0), " ")
  254.             Endif
  255.         Endif
  256.         Goto LABEL006
  257.         :LABEL008
  258.         If ((((((((((STRING005 == 1) || (STRING005 == 2)) || (STRING005 == 3)) || (STRING005 == 4)) || (STRING005 == 5)) || (STRING005 == 6)) || (STRING005 == 7)) || (STRING005 == 8)) || (STRING005 == 9)) || (STRING005 == 0)) KbdStuff STRING005
  259.         STRING005 = ""
  260.         DefColor
  261.         AnsiPos INTEGER006, 21
  262.         InputStr "_", STRING005, "", 4, "1234567890BbQqSs", 8
  263.         If (STRING005 == "S") Then
  264.             AnsiPos 1, 20
  265.             Print STRING020
  266.             Goto LABEL005
  267.         Endif
  268.         If (STRING005 == "") Then
  269.             KbdStuff Chr(13)
  270.             Goto LABEL004
  271.         Endif
  272.         If (STRING005 == "Q") Then
  273.             KbdStuff Chr(13)
  274.             Stop
  275.         Endif
  276.         If (STRING005 == "B") Goto LABEL009
  277.         If (((STRING005 <> "B") || (STRING005 <> "Q")) || (STRING005 <> "")) Then
  278.             If (STRING005 == 0) Then
  279.                 Cls
  280.                 If (TokenStr() == "SECOND") Then
  281.                     Cls
  282.                     KbdStuff "U"
  283.                     Stop
  284.                 Endif
  285.                 Cls
  286.                 KbdStuff "F;U"
  287.                 Stop
  288.                 Goto LABEL009
  289.             Endif
  290.             Cls
  291.             AnsiPos 5, 22
  292.             If (TokenStr() == "SECOND") Then
  293.                 Cls
  294.                 KbdStuff STRING005
  295.                 Stop
  296.             Endif
  297.             Cls
  298.             KbdStuff "F;" + STRING005
  299.             Stop
  300.         Endif
  301.         :LABEL009
  302.         If ((STRING005 == Chr(13)) && (STRING008 <> YesChar())) Then
  303.             BOOLEAN001 = 1
  304.             STRING022 = STRING027
  305.             Goto LABEL002
  306.             Goto LABEL010
  307.         Endif
  308.         If ((STRING011 <> YesChar()) && (STRING005 == "B")) Then
  309.             Goto LABEL012
  310.             Goto LABEL010
  311.         Endif
  312.         Goto LABEL004
  313.         :LABEL010
  314.         Goto LABEL003
  315.         :LABEL011
  316.         STRING022 = STRING027
  317.     Endif
  318.     Goto LABEL013
  319.     :LABEL012
  320.     STRING009 = 10
  321.     STRING022 = STRING027
  322.     If ((INTEGER004 == 0) || (INTEGER004 >= 10)) Then
  323.         STRING006 = STRING006 - 21
  324.         FSeek 1, -(INTEGER005 + 10) * 96, 1
  325.     Else
  326.         STRING008 = ""
  327.         STRING006 = STRING006 - 21
  328.         FSeek 1, 0, 2
  329.         FSeek 1, -(INTEGER005 + 10) * 96 - 2, 1
  330.     Endif
  331.     If (STRING006 <= 0) Then
  332.         If (STRING006 < 0) STRING006 = 0
  333.         STRING011 = YesChar()
  334.         STRING010 = YesChar()
  335.         FSeek 1, 0, 0
  336.         STRING009 = 9
  337.         AnsiPos STRING023, STRING022
  338.         Print STRING012 + Space(STRING026)
  339.         AnsiPos STRING023, STRING022
  340.         Print STRING012 + STRING006
  341.         AnsiPos STRING024, STRING022
  342.         Print STRING013 + Space(STRING025)
  343.         AnsiPos STRING024, STRING022
  344.         Print STRING013 + STRING021 + STRING013
  345.         Inc STRING022
  346.     Endif
  347.     For INTEGER004 = 1 To STRING009
  348.         If (STRING006 > 0) FSeek 1, 1, 1
  349.         FSeek 1, 60, 1
  350.         FRead 1, TSTRING001(STRING006), 35
  351.         Inc STRING006
  352.         AnsiPos STRING023, STRING022
  353.         Print STRING012 + Space(STRING026)
  354.         AnsiPos STRING023, STRING022
  355.         Print STRING012 + STRING006
  356.         AnsiPos STRING024, STRING022
  357.         Print STRING013 + TSTRING001(STRING006 - 1)
  358.         Inc STRING022
  359.     Next
  360.     Inc STRING006
  361.     INTEGER005 = 10
  362.     If ((((STRING006 < 10) || (STRING006 == 19)) || (STRING007 == 29)) || (STRING006 == 39)) Inc STRING006
  363.     Goto LABEL004
  364.     :LABEL013
  365.     Goto LABEL001
  366.     :LABEL014
  367.     FClose 1
  368.  
  369. ;------------------------------------------------------------------------------
  370. ;
  371. ; Usage report (before postprocessing)
  372. ;
  373. ; ■ Statements used :
  374. ;
  375. ;    7       Cls
  376. ;    1       ClrEol
  377. ;    60      Goto 
  378. ;    52      Let 
  379. ;    31      Print 
  380. ;    46      If 
  381. ;    1       DispFile 
  382. ;    4       FOpen 
  383. ;    4       FClose 
  384. ;    12      FGet 
  385. ;    1       StartDisp 
  386. ;    5       DefColor
  387. ;    1       InputStr 
  388. ;    16      Inc 
  389. ;    1       Dec 
  390. ;    1       Tokenize 
  391. ;    11      Stop
  392. ;    14      KbdStuff 
  393. ;    34      AnsiPos 
  394. ;    14      FSeek 
  395. ;    6       FRead 
  396. ;
  397. ;
  398. ; ■ Functions used :
  399. ;
  400. ;    2       -
  401. ;    4       *
  402. ;    115     +
  403. ;    12      -
  404. ;    63      ==
  405. ;    9       <>
  406. ;    6       <
  407. ;    3       <=
  408. ;    1       >
  409. ;    6       >=
  410. ;    32      !
  411. ;    9       &&
  412. ;    38      ||
  413. ;    2       Upper()
  414. ;    3       Left()
  415. ;    7       Space()
  416. ;    2       Ferr()
  417. ;    40      Chr()
  418. ;    3       RTrim()
  419. ;    2       NoChar()
  420. ;    8       YesChar()
  421. ;    1       StripAtx()
  422. ;    2       Inkey()
  423. ;    2       CurConf()
  424. ;    1       PCBDat()
  425. ;    3       PPEPath()
  426. ;    1       ReadLine()
  427. ;    1       SysopSec()
  428. ;    1       CurSec()
  429. ;    1       Exist()
  430. ;    36      I2S()
  431. ;    3       TokenStr()
  432. ;    2       GetX()
  433. ;    3       PPEName()
  434. ;    6       ScrText()
  435. ;
  436. ;------------------------------------------------------------------------------
  437. ;
  438. ; Analysis flags : ds
  439. ;
  440. ; d - Access PCBOARD.DAT ■ 2
  441. ;     Program gets the full pathname to PCBOARD.DAT, this may be usefull
  442. ;     for many PPE so they can find various informations on the system
  443. ;     (system paths, max number of lines in messages, ...) but it may also
  444. ;     be a way to gather vital informations.
  445. ;     ■ Search for : PCBDAT()
  446. ;
  447. ; s - Sysop level access ■ 5
  448. ;     Program is reading the sysop access level, this may be normal
  449. ;     but still it is very suspect. It is the best way to give a user
  450. ;     all priviledges. Check!
  451. ;     ■ Search for : SYSOPSEC()
  452. ;
  453. ;------------------------------------------------------------------------------
  454. ;
  455. ; Postprocessing report
  456. ;
  457. ;    2       For/Next
  458. ;    0       While/EndWhile
  459. ;    27      If/Then or If/Then/Else
  460. ;    0       Select Case
  461. ;
  462. ;------------------------------------------------------------------------------
  463. ;                 AEGiS Corp - Break the routines, code against the machines!
  464. ;------------------------------------------------------------------------------
  465.