home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PCBOARD / PCBNEW10.ZIP / PCBNEWS.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1994-01-30  |  11KB  |  514 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.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     Integer  INTEGER006
  25.     Integer  INTEGER007
  26.     Integer  INTEGER008
  27.     Integer  INTEGER009
  28.     Integer  INTEGER010
  29.     Integer  INTEGER011
  30.     String   STRING001
  31.     String   STRING002
  32.     String   TSTRING003(17)
  33.     String   STRING004
  34.     String   STRING005
  35.     String   STRING006
  36.     String   STRING007
  37.     String   STRING008
  38.     String   STRING009
  39.     String   STRING010
  40.     String   STRING011
  41.     String   STRING012
  42.     String   TSTRING013(22)
  43.     String   STRING014
  44.     String   STRING015
  45.     String   STRING016
  46.     String   STRING017
  47.     String   STRING018
  48.     String   STRING019
  49.     String   STRING020
  50.     String   STRING021
  51.     String   STRING022
  52.     String   STRING023
  53.     String   STRING024
  54.     String   STRING025
  55.     String   STRING026
  56.     String   STRING027
  57.     String   STRING028
  58.  
  59. ;------------------------------------------------------------------------------
  60.  
  61.     STRING028 = "1.0  (January 30, 1994)"
  62.     INTEGER007 = 34363
  63.     INTEGER008 = 10728
  64.     INTEGER009 = INTEGER007 + 120
  65.     INTEGER011 = 1
  66.     STRING025 = "3"
  67.     STRING027 = Chr(85) + Chr(78) + Chr(82) + Chr(69) + Chr(71) + Chr(73) + Chr(83) + Chr(84) + Chr(69) + Chr(82) + Chr(69) + Chr(68)
  68.     INTEGER006 = 1
  69.     STRING014 = Chr(13)
  70.     GetToken STRING015
  71.     STRING015 = Trim(Upper(STRING015), Chr(32))
  72.     If (INTEGER011 <> 0) Then
  73.         INTEGER010 = Date()
  74.         If (Len(Trim(STRING027, " ")) <> 12) Goto LABEL013
  75.         If (INTEGER010 > INTEGER009) Goto LABEL012
  76.         If (INTEGER010 + 3 == INTEGER009) Then
  77.             Newline
  78.             PrintLn "@X0CThis copy of PCBNEWS expires in @X8C3@X0C days!@X07"
  79.             Log "──── This copy of PCBNEWS expires in 3 days", 1
  80.             Log "──── Call Whitewater Systems - 312-743-4912 to", 1
  81.             Log "──── obtain a newer version", 1
  82.         ElseIf (INTEGER010 == INTEGER009) Then
  83.             Newline
  84.             PrintLn "@X0CThis copy of PCBNEWS expires after today!@X07"
  85.             Log "──── This copy of PCBNEWS expires after today!", 1
  86.             Log "──── Call Whitewater Systems - 312-743-4912 to", 1
  87.             Log "──── obtain a newer version", 1
  88.         Endif
  89.         If (INTEGER007 <> 0) Then
  90.             If (FileInf(PPEPath() + PPEName() + ".PPE", 2) <> INTEGER007) Then
  91.             Else
  92.             Endif
  93.             If (FileInf(PPEPath() + PPEName() + ".PPE", 4) <> INTEGER008) Then
  94.             Else
  95.             Endif
  96.             Gosub LABEL010
  97.             Gosub LABEL001
  98.             If (INTEGER006 <> 0) Then
  99.                 Newline
  100.                 PrintLn "@X07[@X0CThis version of PCBNEWS is " + STRING027 + "@X07]"
  101.                 PrintLn "@X07[@X0ACall Whitewater Systems to register - 312-743-4912@X07]"
  102.                 Log "(" + STRING027 + " version of PCBNEWS)", 0
  103.                 Delay 15 * 18.2
  104.             Endif
  105.             Gosub LABEL002
  106.             Goto LABEL014
  107.             :LABEL001
  108.             STRING026 = ""
  109.             STRING026 = Chr(56) + String(Len(STRING017) - 2)
  110.             STRING026 = STRING026 + Chr(52) + String(Len(STRING017) - 3)
  111.             STRING026 = STRING026 + Chr(57) + String(Len(STRING017) - 5)
  112.             STRING026 = STRING026 + Chr(52) + Chr(49) + String(Len(STRING016) * 2 - 10)
  113.             If (Trim(STRING017, " ") <> Trim(Mid(ReadLine(PCBDat(), 94), 1, Len(STRING017)), " ")) Then
  114.                 INTEGER006 = 1
  115.             ElseIf (STRING018 <> STRING026) Then
  116.                 INTEGER006 = 1
  117.             ElseIf (STRING018 == STRING026) Then
  118.                 INTEGER006 = 0
  119.             Endif
  120.             Return
  121.             :LABEL002
  122.             If (CurSec() >= STRING019) Then
  123.                 Gosub LABEL009
  124.                 If ((STRING006 == STRING004) && (CurSec() < STRING019)) Then
  125.                     KbdStuff "NEWS" + STRING014
  126.                     Goto LABEL014
  127.                 ElseIf (STRING004 <> "") Then
  128.                     If (STRING015 == "") Then
  129.                         Newline
  130.                         PrintLn "@X0AEntering PCBNEWS - v" + STRING028 + " ..."
  131.                     Endif
  132.                     If (STRING015 == "A") Then
  133.                         STRING002 = "A"
  134.                         Goto LABEL003
  135.                     Endif
  136.                     If (STRING015 == "D") Then
  137.                         STRING002 = "D"
  138.                         Goto LABEL003
  139.                     Endif
  140.                     STRING002 = ""
  141.                     :LABEL003
  142.                     If (STRING002 == "") Then
  143.                         STRING002 = "D"
  144.                         STRING001 = "@X0E(@X0F@TIMELEFT@@X0E min left), (A)dd entry, (D)isplay (Enter=D)"
  145.                         InputStr STRING001, STRING002, 14, 1, "DdAa", 128 + 32 + 2 + 4 + 8
  146.                     Endif
  147.                     If ((STRING002 == "D") || (STRING002 == "")) Then
  148.                         KbdStuff "NEWS" + STRING014
  149.                         Goto LABEL004
  150.                     Endif
  151.                     If (STRING002 == "A") Then
  152.                         Gosub LABEL005
  153.                     Endif
  154.                 Endif
  155.                 :LABEL004
  156.             Else
  157.                 KbdStuff "NEWS" + STRING014
  158.             Endif
  159.             End
  160.             :LABEL005
  161.             Newline
  162.             PrintLn "@X0ACreating a @X0FNEW@X0A entry...@X07"
  163.             PrintLn "@X0APress @X0CQ@X0A to exit at anytime."
  164.             Newline
  165.             :LABEL006
  166.             STRING008 = String(Date())
  167.             STRING010 = YesChar()
  168.             STRING011 = NoChar()
  169.             STRING009 = STRING010 + STRING011
  170.             InputStr "@X0FSubject@X07", STRING020, 7, 72 - STRING025 - 1, Mask_Ascii(), 32 + 2
  171.             STRING020 = Trim(STRING020, " ")
  172.             If (Upper(STRING020) == "Q") Goto LABEL014
  173.             If (Upper(STRING020) == "") Goto LABEL006
  174.             InputStr "@X0FDate to display@X07", STRING008, 7, 8, "0123456789-/\.Qq", 32 + 2
  175.             STRING008 = Trim(STRING008, " ")
  176.             If (STRING008 == "") Goto LABEL005
  177.             If (Upper(STRING008) == "Q") Goto LABEL014
  178.             If (Len(STRING008) < 8) Then
  179.                 Newline
  180.                 PrintLn "@X07The date field @X0Ccannot@X07 be less than @X0C8@X07 characters in length."
  181.                 PrintLn "@X07Please re-do your entry."
  182.                 Newline
  183.                 Goto LABEL006
  184.             Endif
  185.             Gosub LABEL011
  186.             STRING012 = STRING010
  187.             InputStr "@X0EIs the above header correct (Y)es, (N)o, (Q)uit", STRING012, 7, 1, STRING009 + "Qq", 32 + 2 + 4 + 8
  188.             STRING012 = Trim(STRING012, " ")
  189.             Select Case (STRING012)
  190.                 Case "Q"
  191.                     Newline
  192.                     PrintLn "@X0CNEWS file not created. Exiting ...@X07"
  193.                     Newline
  194.                     Goto LABEL014
  195.                 Case STRING011
  196.                     Goto LABEL005
  197.             End Select
  198.             INTEGER002 = 0
  199.             INTEGER001 = 100
  200.             Gosub LABEL008
  201.             STRING002 = "L"
  202.             STRING012 = ""
  203.             While (STRING002 == "L") Do
  204.                 PrintLn "@X0A(A)bort, (C)ont Line Editor, (D)elete"
  205.                 PrintLn "@X0A(E)dit, (L)ist Msg, (S)ave, (Enter)=Save"
  206.                 InputStr "@X0EText Entry Command", STRING002, 7, 1, "AaCcDdEeLlSs", 128 + 64 + 8
  207.                 STRING002 = Upper(STRING002)
  208.                 If ((STRING002 == "S") || (STRING002 == "")) Then
  209.                     If (Exist(STRING004)) Copy STRING004, "NEWS" + String(PcbNode()) + ".$$$"
  210.                     FCreate 1, STRING004, 1, 3
  211.                     Cls
  212.                     Gosub LABEL011
  213.                     INTEGER004 = 0
  214.                     INTEGER005 = GetY()
  215.                     Print "@X0AAdding header files into conference news...@X07"
  216.                     Backup 80
  217.                     Print "@CLREOL@"
  218.                     Backup 80
  219.                     For INTEGER004 = 1 To INTEGER005 - 1
  220.                         TSTRING013(INTEGER004) = ScrText(1, INTEGER004, 79, 1)
  221.                         FPutLn 1, TSTRING013(INTEGER004)
  222.                     Next
  223.                     For INTEGER003 = 0 To INTEGER001
  224.                         PrintLn Space(STRING025 - 1) + TSTRING003(INTEGER003)
  225.                         FPutLn 1, Space(STRING025 - 1) + TSTRING003(INTEGER003)
  226.                     Next
  227.                     If (INTEGER006 <> 0) FPutLn 1, Space(17) + "@X08 - @X07This version of PCBNEWS is @X0C" + STRING027 + "@X08 - @X07"
  228.                     FClose 1
  229.                     If (Exist(STRING024)) Then
  230.                         Append STRING024, STRING004
  231.                         DispFile STRING024, 1
  232.                     Endif
  233.                     If (Exist("NEWS" + String(PcbNode()) + ".$$$")) Append "NEWS" + String(PcbNode()) + ".$$$", STRING004
  234.                     If (Exist("NEWS" + String(PcbNode()) + ".$$$")) Delete "NEWS" + String(PcbNode()) + ".$$$"
  235.                     If (Trim(STRING005, " ") == "") STRING005 = "Conference news"
  236.                     PrintLn "@X0A" + STRING005, "@X07 updated."
  237.                     Continue
  238.                 Endif
  239.                 If (STRING002 == "C") Then
  240.                     INTEGER002 = INTEGER001
  241.                     INTEGER001 = 100
  242.                     Gosub LABEL008
  243.                     STRING002 = "L"
  244.                     Continue
  245.                 Endif
  246.                 If (STRING002 == "A") Then
  247.                     STRING012 = NoChar()
  248.                     PromptStr 403, STRING012, 1, STRING009, 4 + 2 + 8 + 128 + 256
  249.                     If (STRING012 == STRING010) Goto LABEL014
  250.                     Newline
  251.                     STRING002 = "L"
  252.                     Continue
  253.                 Endif
  254.                 If (STRING002 == "D") Then
  255.                     STRING012 = ""
  256.                     PromptStr 405, STRING012, 10, Mask_Ascii(), 8 + 128 + 256
  257.                     If (STRING012 <> "") Then
  258.                         STRING002 = "N"
  259.                         PrintLn "@X0A" + String(STRING012) + "@X07: @X07" + TSTRING003(STRING012 - 1)
  260.                         PromptStr 85, STRING002, 1, STRING009, 4 + 8 + 2
  261.                         If (STRING002 == "Y") TSTRING003(STRING012 - 1) = ""
  262.                         Newline
  263.                     Endif
  264.                     STRING002 = "L"
  265.                     Continue
  266.                 Endif
  267.                 If (STRING002 == "E") Then
  268.                     STRING012 = ""
  269.                     PromptStr 408, STRING012, 10, Mask_Num(), 8 + 128 + 256
  270.                     If ((STRING012 > INTEGER001) || (Mid(STRING012, 1, 1) == "0")) Then
  271.                         PrintLn "@X0CThere is no line #@X0F" + STRING012
  272.                         Newline
  273.                         Goto LABEL007
  274.                     Endif
  275.                     If (STRING012 <> "") Then
  276.                         PrintLn "@X0AOld Line:"
  277.                         PrintLn "@X0A" + String(STRING012) + "@X07: " + TSTRING003(STRING012 - 1) + "@CLREOL@"
  278.                         Newline
  279.                         PrintLn "@X0AEnter your new line below or press (Enter) to leave it as it was:@X07"
  280.                         InputStr "@X0A" + String(STRING012) + "@X07: _", TSTRING003(STRING012 - 1), 7, 72 - STRING025 - 1, Mask_Ascii(), 64 + 4
  281.                         If (TSTRING003(STRING012 - 1) == "/") TSTRING003(STRING012 - 1) = ""
  282.                     Endif
  283.                     :LABEL007
  284.                     Newline
  285.                     STRING002 = "L"
  286.                     Continue
  287.                 Endif
  288.                 If (STRING002 == "L") Then
  289.                     INTEGER002 = ""
  290.                     Gosub LABEL011
  291.                     For INTEGER003 = 0 To INTEGER001
  292.                         PrintLn Space(STRING025 - 1) + TSTRING003(INTEGER003)
  293.                     Next
  294.                     If (Exist(STRING024)) DispFile STRING023, 1
  295.                     Newline
  296.                 Endif
  297.             EndWhile
  298.             Return
  299.             :LABEL008
  300.             Newline
  301.             DispText 238, 256
  302.             PrintLn "@X0AType a '@X0C/@X0A' to blank the current line and continue."
  303.             Newline
  304.             While (INTEGER002 < 101) Do
  305.                 InputStr "@X0A" + String(INTEGER002 + 1) + "@X07: @X" + Right("00" + String(DefColor()), 2) + "_", TSTRING003(INTEGER002), 7, 72 - STRING025 - 1, Mask_Ascii(), 512 + 64
  306.                 If (Upper(TSTRING003(INTEGER002)) == "") Then
  307.                     TSTRING003(INTEGER002) = ""
  308.                     INTEGER001 = INTEGER002 - 1
  309.                     INTEGER002 = 101
  310.                 ElseIf (Upper(Trim(TSTRING003(INTEGER002), " ")) == "/") Then
  311.                     TSTRING003(INTEGER002) = ""
  312.                     Inc INTEGER002
  313.                 Else
  314.                     Inc INTEGER002
  315.                 Endif
  316.                 If (INTEGER002 == 96) PrintLn "@X0CWARNING: You have 5 lines left!@X07"
  317.             EndWhile
  318.             Return
  319.             :LABEL009
  320.             STRING007 = ReadLine(PCBDat(), 31)
  321.             STRING006 = ReadLine(STRING007, 13)
  322.             INTEGER003 = CurConf()
  323.             If (INTEGER003 > 0) Then
  324.                 STRING004 = ReadLine(STRING007, 13 + INTEGER003 * 33)
  325.             Else
  326.                 STRING004 = STRING006
  327.             Endif
  328.             Return
  329.             :LABEL010
  330.             If (Exist(PPEPath() + "PCBNEWS.CFG")) Then
  331.                 FOpen 1, PPEPath() + "PCBNEWS.CFG", 0, 0
  332.                 FGet 1, STRING016
  333.                 FGet 1, STRING017
  334.                 FGet 1, STRING018
  335.                 FGet 1, STRING019
  336.                 FGet 1, STRING020
  337.                 FGet 1, STRING021
  338.                 FGet 1, STRING022
  339.                 FGet 1, STRING023
  340.                 FGet 1, STRING024
  341.                 FGet 1, STRING025
  342.                 FClose 1
  343.                 STRING016 = Upper(Trim(STRING016, " "))
  344.                 STRING019 = Upper(Trim(STRING019, " "))
  345.                 STRING020 = Trim(STRING020, " ")
  346.                 STRING021 = RTrim(PPEPath(), "\") + "\" + Upper(Trim(STRING021, " "))
  347.                 STRING022 = RTrim(PPEPath(), "\") + "\" + Upper(Trim(STRING022, " "))
  348.                 STRING023 = RTrim(PPEPath(), "\") + "\" + Upper(Trim(STRING023, " "))
  349.                 STRING024 = RTrim(PPEPath(), "\") + "\" + Upper(Trim(STRING024, " "))
  350.             Else
  351.                 Newlines 2
  352.                 PrintLn "@X0CConfiguration file not found! Please Notify Sysop!"
  353.                 Newlines 2
  354.                 Wait
  355.                 KbdStuff STRING014
  356.                 Log "Error: *PCBNEWS* PCBNEWS.CFG not found!", 0
  357.                 Goto LABEL014
  358.             Endif
  359.             If (INTEGER006 <> 0) Log "*PCBNEWS* Executed at " + Left(Time(), 5) , 0
  360.             Return
  361.             :LABEL011
  362.             Newline
  363.             If (Exist(STRING021)) Then
  364.                 OpText STRING008
  365.                 DispFile STRING021, 1
  366.             Else
  367.                 Newline
  368.             Endif
  369.             If (Exist(STRING022)) Then
  370.                 OpText STRING020
  371.                 DispFile STRING022, 1
  372.             Else
  373.                 PrintLn "@X07[@X0CNo subject header file exists - Please create one@X07]"
  374.                 Log "*PCBNEWS* No Subject header file exists!", 0
  375.                 Log "--------- This file is mandatory!", 0
  376.                 Newline
  377.             Endif
  378.             If (Exist(STRING023)) Then
  379.                 DispFile STRING023, 1
  380.             Else
  381.                 Newline
  382.             Endif
  383.             Return
  384.             :LABEL012
  385.             Newline
  386.             PrintLn "@X07[@X0CThis version of PCBNEWS has expired@X07]"
  387.             PrintLn "@X07[@X07Please tell the Sysop to obtain a newer version@X07]"
  388.             Newline
  389.             Log "──── This copy of PCBNEWS has EXPIRED!", 1
  390.             Log "──── Call Whitewater Systems to obtain a newer version", 1
  391.             Goto LABEL014
  392.         Endif
  393.     Endif
  394.     :LABEL013
  395.     Cls
  396.     Beep
  397.     Newlines 2
  398.     PrintLn "@X07[@X0CPCBNEWS is (c) Copyrighted Software by Whitewater Technologies, Inc.@X07]"
  399.     PrintLn "@X07[@X0FWhitewater Systems - 312-743-4912@X07]"
  400.     Newline
  401.     PrintLn "@X07[@X0CPCBNEWS - Authentic seal has been altered!@X07]"
  402.     PrintLn "@X07[@X07Please call Whitewater Systems and download the newest release@X07]"
  403.     Log "*PCBNEWS* Seal has been ALTERED", 0
  404.     Newline
  405.     :LABEL014
  406.     End
  407.  
  408. ;------------------------------------------------------------------------------
  409. ;
  410. ; Usage report (before postprocessing)
  411. ;
  412. ; ■ Statements used :
  413. ;
  414. ;    2       End
  415. ;    2       Cls
  416. ;    1       Wait
  417. ;    89      Goto 
  418. ;    76      Let 
  419. ;    2       Print 
  420. ;    30      PrintLn 
  421. ;    61      If 
  422. ;    5       DispFile 
  423. ;    1       FCreate 
  424. ;    1       FOpen 
  425. ;    2       FClose 
  426. ;    10      FGet 
  427. ;    3       FPutLn 
  428. ;    1       Delete 
  429. ;    14      Log 
  430. ;    7       InputStr 
  431. ;    10      Gosub 
  432. ;    6       Return
  433. ;    4       PromptStr 
  434. ;    1       Delay 
  435. ;    2       Inc 
  436. ;    26      Newline
  437. ;    3       Newlines 
  438. ;    1       GetToken 
  439. ;    1       DispText 
  440. ;    1       Beep
  441. ;    4       KbdStuff 
  442. ;    2       OpText 
  443. ;    2       Backup 
  444. ;    2       Append 
  445. ;    1       Copy 
  446. ;
  447. ;
  448. ; ■ Functions used :
  449. ;
  450. ;    3       *
  451. ;    107     +
  452. ;    22      -
  453. ;    33      ==
  454. ;    13      <>
  455. ;    6       <
  456. ;    3       <=
  457. ;    3       >
  458. ;    7       >=
  459. ;    44      !
  460. ;    7       &&
  461. ;    6       ||
  462. ;    7       Len(
  463. ;    13      Upper()
  464. ;    2       Mid()
  465. ;    1       Left()
  466. ;    1       Right()
  467. ;    4       Space()
  468. ;    19      Chr()
  469. ;    4       RTrim()
  470. ;    16      Trim()
  471. ;    2       Date()
  472. ;    1       Time()
  473. ;    2       NoChar()
  474. ;    1       YesChar()
  475. ;    15      String()
  476. ;    1       Mask_Num()
  477. ;    4       Mask_Ascii()
  478. ;    1       CurConf()
  479. ;    2       PCBDat()
  480. ;    8       PPEPath()
  481. ;    5       PcbNode()
  482. ;    4       ReadLine()
  483. ;    2       CurSec()
  484. ;    9       Exist()
  485. ;    1       GetY()
  486. ;    1       DefColor()
  487. ;    2       FileInf()
  488. ;    2       PPEName()
  489. ;    1       ScrText()
  490. ;
  491. ;------------------------------------------------------------------------------
  492. ;
  493. ; Analysis flags : d
  494. ;
  495. ; d - Access PCBOARD.DAT ■ 2
  496. ;     Program gets the full pathname to PCBOARD.DAT, this may be usefull
  497. ;     for many PPE so they can find various informations on the system
  498. ;     (system paths, max number of lines in messages, ...) but it may also
  499. ;     be a way to gather vital informations.
  500. ;     ■ Search for : PCBDAT()
  501. ;
  502. ;------------------------------------------------------------------------------
  503. ;
  504. ; Postprocessing report
  505. ;
  506. ;    3       For/Next
  507. ;    2       While/EndWhile
  508. ;    37      If/Then or If/Then/Else
  509. ;    1       Select Case
  510. ;
  511. ;------------------------------------------------------------------------------
  512. ;                 AEGiS Corp - Break the routines, code against the machines!
  513. ;------------------------------------------------------------------------------
  514.