home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / S / SSPAGE.ZIP / SYSCHAT.PPE (.txt) < prev   
PCBoard Programming Language Executable  |  1995-09-19  |  9KB  |  365 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.     Boolean  BOOLEAN002
  21.     Integer  INTEGER001
  22.     Integer  INTEGER002
  23.     Integer  INTEGER003
  24.     Integer  INTEGER004
  25.     Integer  INTEGER005
  26.     Integer  INTEGER006
  27.     Integer  INTEGER007
  28.     Integer  INTEGER008
  29.     Integer  INTEGER009
  30.     Integer  INTEGER010
  31.     Integer  INTEGER011
  32.     Integer  INTEGER012
  33.     Integer  INTEGER013
  34.     Integer  INTEGER014
  35.     Integer  INTEGER015
  36.     Integer  INTEGER016
  37.     Integer  INTEGER017
  38.     String   STRING001
  39.     String   STRING002
  40.     String   STRING003
  41.     String   STRING004
  42.     String   STRING005
  43.     String   STRING006
  44.     String   STRING007
  45.     String   TSTRING008(25)
  46.     String   TSTRING009(25)
  47.     String   STRING010
  48.     String   STRING011
  49.     String   STRING012
  50.     String   STRING013
  51.     String   STRING014
  52.  
  53. ;------------------------------------------------------------------------------
  54.  
  55.     FOpen 1, PPEPath() + "PAGE.CFG", 0, 0
  56.     FGet 1, STRING001
  57.     FGet 1, STRING002
  58.     FClose 1
  59.     For STRING005 = 1 To 25
  60.         STRING003 = Mid(STRING001, STRING005, 1)
  61.         INTEGER001 = Asc(STRING003)
  62.         INTEGER002 = INTEGER002 + INTEGER001
  63.     Next
  64.     STRING004 = (((((((INTEGER002 * Len(Strip(STRING001, " "))) * 9) / 6) * 7) / 6) * 7) / 5) * 18
  65.     If (GrafMode() == "N") Goto LABEL008
  66.     AnsiPos 1, 23
  67.     SaveScrn
  68.     If (Exist(PPEPath() + "PAGE." + I2S(PcbNode(), 10))) Then
  69.         FAppend 2, PPEPath() + "PAGE." + I2S(PcbNode(), 10), 1, 0
  70.     Else
  71.         FOpen 2, PPEPath() + "PAGE." + I2S(PcbNode(), 10), 1, 0
  72.     Endif
  73.     STRING013 = Time()
  74.     GetUser
  75.     FPutLn 2
  76.     FPutLn 2, "-=SYSOP CHAT=-"
  77.     FPutLn 2, "USERS NAME : " + U_Name()
  78.     FPutLn 2, "USERS CITY : " + U_City
  79.     FPutLn 2
  80.     STRING014 = Date()
  81.     FPutLn 2, "DATE CHAT OCCURED : " + STRING014
  82.     FPutLn 2, "TIME CHAT STARTED : " + STRING013
  83.     FPutLn 2, "──────────────────────────────────────────────────────────────────────────────"
  84.     BOOLEAN002 = (Upper(Left(ReadLine(PPEPath() + "PAGE.cfg", 5), 1)) == "Y")
  85.     STRING010 = "                                                                                "
  86.     ResetDisp
  87.     Cls
  88.     Print "@CLS@@POFF@"
  89.     PrintLn "@X0F▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄ "
  90.     PrintLn "@X7F█@X0F██@X7F▓@X0F█@X7F▓@X0F██@X7F▓@X0F█@X7F▓▓▓▒▒▒ ░              ░                                          █@X07 "
  91.     PrintLn "@X7F█▒▓@X78█@X08                                                                    @X78░   @X07 "
  92.     PrintLn "@X7F█▒▒@X78▓@X08                                                                    @X7F @X78░ ░@X07 "
  93.     PrintLn "@X7F▒ ░@X78░@X0F                                                                    @X7F▒@X78▒░▓@X07 "
  94.     PrintLn "@X7F░   @X0F                                                                    @X7F▓@X78▒▒█@X07 "
  95.     PrintLn "@X78░  @X7F▒@X0F                                                                    @X7F█@X78▓▓█@X07 "
  96.     PrintLn "@X78▒  @X7F▓@X0F                                                                    @X7F█@X78█▓█@X07 "
  97.     PrintLn "@X78▓  @X7F█@X0F▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄@X7F█@X78███@X07 "
  98.     PrintLn "@X78█                                       @X78░              ░ ░░░▒▒▒▓▓▓█▓▓█▓█▓███@X07 "
  99.     PrintLn "@X08▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀@X07 "
  100.     PrintLn "@X0F      Sysop                                                   @FIRST@       "
  101.     PrintLn "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄ "
  102.     PrintLn "@X7F█@X0F██@X7F▓@X0F█@X7F▓@X0F██@X7F▓@X0F█@X7F▓▓▓▒▒▒ ░              ░                                          █@X07 "
  103.     PrintLn "@X7F█▓▓@X78█@X0F                                                                    @X78▒  @X7F░@X07 "
  104.     PrintLn "@X7F█▒▒@X78▓@X08                                                                    @X7F @X78░ ░@X07 "
  105.     PrintLn "@X7F▓░▒@X78▒@X0F                                                                    @X7F░@X78░░▒@X07 "
  106.     PrintLn "@X78   @X7F░@X0F                                                                    @X7F█@X78▓▒█@X07 "
  107.     PrintLn "@X78░  @X7F▒@X0F                                                                    @X7F█@X78▓▓█@X07 "
  108.     PrintLn "@X78▒  @X7F▓@X0F                                                                    @X7F█@X78█▓█@X07 "
  109.     PrintLn "@X78▓  @X7F█@X0F▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄@X7F█@X78███@X07 "
  110.     PrintLn "@X78█                                       @X78░              ░ ░░░▒▒▒▓▓▓█▓▓█▓█▓███@X07 "
  111.     PrintLn "@X08▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀@X07 "
  112.     AnsiPos 1, 1
  113.     FOpen 1, PPEPath() + "CHAT.CFG", 0, 0
  114.     FGet 1, INTEGER004
  115.     FGet 1, INTEGER005
  116.     FGet 1, INTEGER006
  117.     FGet 1, INTEGER007
  118.     FGet 1, INTEGER008
  119.     FGet 1, INTEGER009
  120.     FGet 1, INTEGER010
  121.     FGet 1, INTEGER011
  122.     FGet 1, STRING011
  123.     FGet 1, STRING012
  124.     FClose 1
  125.     For INTEGER003 = 1 To 23
  126.         TSTRING009(INTEGER003) = ""
  127.         TSTRING008(INTEGER003) = ""
  128.     Next
  129.     INTEGER012 = INTEGER004
  130.     INTEGER013 = INTEGER005
  131.     INTEGER014 = INTEGER008
  132.     INTEGER015 = INTEGER009
  133.     INTEGER017 = 1
  134.     INTEGER016 = 1
  135.     Goto LABEL003
  136.     :LABEL001
  137.     BOOLEAN001 = 1
  138.     If (Len(TSTRING008(INTEGER017)) < INTEGER006 - INTEGER004) Then
  139.         TSTRING008(INTEGER017) = TSTRING008(INTEGER017) + STRING007
  140.         AnsiPos INTEGER012, INTEGER013
  141.         Print STRING011 + STRING007
  142.         Inc INTEGER012
  143.     Else
  144.         FPutLn 2, "S : " + TSTRING008(INTEGER017)
  145.         Inc INTEGER017
  146.         Inc INTEGER013
  147.         If (INTEGER013 > INTEGER007) Then
  148.             For INTEGER003 = 1 To INTEGER017 - 1
  149.                 TSTRING008(INTEGER003) = TSTRING008(INTEGER003 + 1)
  150.                 AnsiPos INTEGER004, INTEGER005 + INTEGER003 - 1
  151.                 Print TSTRING008(INTEGER003 + 1) + Left(STRING010, INTEGER006 - INTEGER004 - Len(TSTRING008(INTEGER003)))
  152.             Next
  153.             INTEGER013 = INTEGER007
  154.             Dec INTEGER017
  155.         Endif
  156.         INTEGER012 = INTEGER004
  157.     Endif
  158.     Goto LABEL003
  159.     :LABEL002
  160.     BOOLEAN001 = 0
  161.     If (Len(TSTRING009(INTEGER016)) < INTEGER010 - INTEGER008) Then
  162.         TSTRING009(INTEGER016) = TSTRING009(INTEGER016) + STRING006
  163.         AnsiPos INTEGER014, INTEGER015
  164.         Print STRING012 + STRING006
  165.         Inc INTEGER014
  166.     Else
  167.         FPutLn 2, "U : " + TSTRING009(INTEGER016)
  168.         Inc INTEGER016
  169.         Inc INTEGER015
  170.         If (INTEGER015 > INTEGER011) Then
  171.             For INTEGER003 = 1 To INTEGER016 - 1
  172.                 TSTRING009(INTEGER003) = TSTRING009(INTEGER003 + 1)
  173.                 AnsiPos INTEGER008, INTEGER009 + INTEGER003 - 1
  174.                 Print TSTRING009(INTEGER003 + 1) + Left(STRING010, INTEGER010 - INTEGER008 - Len(TSTRING009(INTEGER003)))
  175.             Next
  176.             INTEGER015 = INTEGER011
  177.             Dec INTEGER016
  178.         Endif
  179.         INTEGER014 = INTEGER008
  180.     Endif
  181.     :LABEL003
  182.     If (BOOLEAN001) AnsiPos INTEGER012, INTEGER013
  183.     If (!BOOLEAN001) AnsiPos INTEGER014, INTEGER015
  184.     :LABEL004
  185.     STRING007 = KInkey()
  186.     STRING006 = MInkey()
  187.     If ((STRING007 == "") && (STRING006 == "")) Goto LABEL004
  188.     If ((STRING007 == Chr(27)) || ((STRING006 == Chr(27)) && BOOLEAN002)) Goto LABEL007
  189.     If (STRING007 == Chr(8)) Then
  190.         If (Len(TSTRING008(INTEGER017)) > 0) Then
  191.             TSTRING008(INTEGER017) = Left(TSTRING008(INTEGER017), Len(TSTRING008(INTEGER017)) - 1)
  192.             Dec INTEGER012
  193.             AnsiPos INTEGER012, INTEGER013
  194.             Print "  "
  195.             Goto LABEL003
  196.             Goto LABEL005
  197.         Endif
  198.         Goto LABEL003
  199.     Endif
  200.     :LABEL005
  201.     If (STRING006 == Chr(8)) Then
  202.         If (Len(TSTRING009(INTEGER016)) > 0) Then
  203.             TSTRING009(INTEGER016) = Left(TSTRING009(INTEGER016), Len(TSTRING009(INTEGER016)) - 1)
  204.             Dec INTEGER014
  205.             AnsiPos INTEGER014, INTEGER015
  206.             Print "  "
  207.             Goto LABEL003
  208.             Goto LABEL006
  209.         Endif
  210.         Goto LABEL003
  211.     Endif
  212.     :LABEL006
  213.     If (STRING007 == Chr(13)) Then
  214.         FPutLn 2, "S : " + TSTRING008(INTEGER017)
  215.         Inc INTEGER017
  216.         Inc INTEGER013
  217.         If (INTEGER013 > INTEGER007) Then
  218.             For INTEGER003 = 1 To INTEGER017 - 1
  219.                 TSTRING008(INTEGER003) = TSTRING008(INTEGER003 + 1)
  220.                 AnsiPos INTEGER004, INTEGER005 + INTEGER003 - 1
  221.                 Print TSTRING008(INTEGER003 + 1) + Left(STRING010, INTEGER006 - INTEGER004 - Len(TSTRING008(INTEGER003)))
  222.             Next
  223.             INTEGER013 = INTEGER007
  224.             Dec INTEGER017
  225.         Endif
  226.         INTEGER012 = INTEGER004
  227.         Goto LABEL003
  228.     Endif
  229.     If (STRING006 == Chr(13)) Then
  230.         FPutLn 2, "U :" + TSTRING009(INTEGER016)
  231.         Inc INTEGER016
  232.         Inc INTEGER015
  233.         If (INTEGER015 > INTEGER011) Then
  234.             For INTEGER003 = 1 To INTEGER016 - 1
  235.                 TSTRING009(INTEGER003) = TSTRING009(INTEGER003 + 1)
  236.                 AnsiPos INTEGER008, INTEGER009 + INTEGER003 - 1
  237.                 Print TSTRING009(INTEGER003 + 1) + Left(STRING010, INTEGER010 - INTEGER008 - Len(TSTRING009(INTEGER003)))
  238.             Next
  239.             INTEGER015 = INTEGER011
  240.             Dec INTEGER016
  241.         Endif
  242.         INTEGER014 = INTEGER008
  243.         Goto LABEL003
  244.     Endif
  245.     If ((STRING007 >= " ") && (Len(STRING007) == 1)) Goto LABEL001
  246.     If ((STRING006 >= " ") && (Len(STRING006) == 1)) Goto LABEL002
  247.     Goto LABEL004
  248.     :LABEL007
  249.     STRING013 = Time()
  250.     FPutLn 2, "──────────────────────────────────────────────────────────────────────────────"
  251.     FPutLn 2, "                     CHAT ENDED AT " + STRING013
  252.     FPutLn 2, "══════════════════════════════════════════════════════════════════════════════"
  253.     FClose 2
  254.     If (STRING004 <> STRING002) Then
  255.         Cls
  256.         Newlines 2
  257.         PrintLn "@POFF@              @X19┌──────────────────────────────────────────@X10┐@X07 "
  258.         PrintLn "              @X19│     ┌──────────────────────────────@X10┐     │@X08█"
  259.         PrintLn "              @X19│     │   @X14U N R E G I S T E R E D    @X10│     │@X08█"
  260.         PrintLn "              @X19│     └─@X10─────────────────────────────┘     │@X08█"
  261.         PrintLn "              @X19└─@X10─────────────────────────────────────────┘@X08█"
  262.         PrintLn "                ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀"
  263.         PrintLn "                  @X4C┌─────────────────────────────────@X40┐@X08 "
  264.         PrintLn "                  @X4C│@X4A This is an unregistered copy of @X40│@X08█"
  265.         PrintLn "                  @X4C│ @X4AS.S. Page. If you are going to  @X40│@X08█"
  266.         PrintLn "                  @X4C│ @X4Acontinue to use this please     @X40│@X08█"
  267.         PrintLn "                  @X4C│ @X4Aregister. When you register the @X40│@X08█"
  268.         PrintLn "                  @X4C│ @X4Adelays will be removed. If you  @X40│@X08█"
  269.         PrintLn "                  @X4C│ @X4Alike shareware then please      @X40│@X08█"
  270.         PrintLn "                  @X4C│ @X4Aregister for only $10.          @X40│@X08█"
  271.         PrintLn "                  @X4C│                                 @X40│@X08█"
  272.         PrintLn "                  @X4C│ @X4A   Thanks for using S.S. Page!  @X40│@X08█"
  273.         PrintLn "                  @X4C└─@X40────────────────────────────────┘@X08█"
  274.         PrintLn "                    ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀"
  275.         PrintLn "                   @X0A*** 15 sec unregistered pause ***"
  276.         Delay 150
  277.     Endif
  278.     Color 1
  279.     Cls
  280.     RestScrn
  281.     End
  282.     :LABEL008
  283.     End
  284.  
  285. ;------------------------------------------------------------------------------
  286. ;
  287. ; Usage report (before postprocessing)
  288. ;
  289. ; ■ Statements used :
  290. ;
  291. ;    2       End
  292. ;    3       Cls
  293. ;    1       Color 
  294. ;    46      Goto 
  295. ;    49      Let 
  296. ;    9       Print 
  297. ;    42      PrintLn 
  298. ;    27      If 
  299. ;    3       FOpen 
  300. ;    1       FAppend 
  301. ;    3       FClose 
  302. ;    12      FGet 
  303. ;    15      FPutLn 
  304. ;    1       ResetDisp
  305. ;    1       GetUser
  306. ;    1       Delay 
  307. ;    10      Inc 
  308. ;    6       Dec 
  309. ;    1       Newlines 
  310. ;    12      AnsiPos 
  311. ;    1       SaveScrn
  312. ;    1       RestScrn
  313. ;
  314. ;
  315. ; ■ Functions used :
  316. ;
  317. ;    5       *
  318. ;    3       /
  319. ;    45      +
  320. ;    24      -
  321. ;    12      ==
  322. ;    1       <>
  323. ;    8       <
  324. ;    6       <=
  325. ;    6       >
  326. ;    14      >=
  327. ;    21      !
  328. ;    16      &&
  329. ;    7       ||
  330. ;    13      Len(
  331. ;    1       Upper()
  332. ;    1       Mid()
  333. ;    7       Left()
  334. ;    6       Chr()
  335. ;    1       Asc()
  336. ;    1       Date()
  337. ;    2       Time()
  338. ;    1       U_Name()
  339. ;    1       Strip()
  340. ;    6       PPEPath()
  341. ;    3       PcbNode()
  342. ;    1       ReadLine()
  343. ;    1       Exist()
  344. ;    3       I2S()
  345. ;    1       GrafMode()
  346. ;    1       KInkey()
  347. ;    1       MInkey()
  348. ;
  349. ;------------------------------------------------------------------------------
  350. ;
  351. ; Analysis flags : No flag
  352. ;
  353. ;------------------------------------------------------------------------------
  354. ;
  355. ; Postprocessing report
  356. ;
  357. ;    6       For/Next
  358. ;    0       While/EndWhile
  359. ;    14      If/Then or If/Then/Else
  360. ;    0       Select Case
  361. ;
  362. ;------------------------------------------------------------------------------
  363. ;                 AEGiS Corp - Break the routines, code against the machines!
  364. ;------------------------------------------------------------------------------
  365.