home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / SL_UTL10.ZIP / SL-1L.PPE (.txt) < prev    next >
Encoding:
PCBoard Programming Language Executable  |  1993-08-28  |  5.1 KB  |  314 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 1.OO (plain) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     String   STRING001
  25.     String   STRING002
  26.     String   STRING003
  27.     String   STRING004
  28.     String   STRING005
  29.     String   STRING006
  30.     String   STRING007
  31.     String   STRING008
  32.     String   TSTRING009(16)
  33.     String   STRING010
  34.     String   TSTRING011(5)
  35.     String   STRING012
  36.     String   STRING013
  37.     String   STRING014
  38.  
  39. ;------------------------------------------------------------------------------
  40.  
  41.     If (Exist(PPEPath() + "SL-1L.CNF")) Then
  42.         Goto LABEL001
  43.     Else
  44.         PrintLn 
  45.         PrintLn "@X8C*** Config File Not Found *** ^G ^G Please Notify Sysop"
  46.         Goto LABEL006
  47.     Endif
  48.     :LABEL001
  49.     FOpen 1, PPEPath() + "SL-1L.CNF", 2, 0
  50.     FGet 1, STRING001
  51.     If (Len(STRING001) == 0) STRING001 = "SL-1L.HDR"
  52.     FGet 1, INTEGER001
  53.     If ((INTEGER001 < 1) || (INTEGER001 > 16)) INTEGER001 = 16
  54.     FGet 1, STRING007
  55.     If (Len(STRING007) == 0) STRING007 = "@X03"
  56.     FGet 1, STRING008
  57.     If (Len(STRING008) == 0) STRING008 = "@X0B"
  58.     FGet 1, STRING002
  59.     FGet 1, STRING003
  60.     FGet 1, INTEGER003
  61.     FGet 1, STRING013
  62.     FClose 1
  63.     GetUser
  64.     If (U_Sec < STRING002) Goto LABEL007
  65.     If (Exist(PPEPath() + STRING001)) Then
  66.         DispFile PPEPath() + STRING001, 4 + 2 + 1
  67.     Else
  68.         PrintLn "@CLS@@X07"
  69.         PrintLn "@X0E           @X0D--==[[░▒▓█     @X0ASurreal BBS's      @X0EOne Liners     @X0D█▓▒░]]==--@X07"
  70.     Endif
  71.     PrintLn 
  72.     If (Exist(PPEPath() + "SL-1l.DAT")) Then
  73.         Goto LABEL002
  74.     Else
  75.         PrintLn "@X0CData file Not Found...Creating..."
  76.         PrintLn 
  77.         FCreate 1, PPEPath() + "SL-1L.DAT", 2, 0
  78.         INTEGER002 = 1
  79.         While (!Ferr(1) && (INTEGER002 <= INTEGER001)) Do
  80.             FPutLn 1, "Call Surreal BBS.  Home of Surreal Oneliners. (219) 262-9371"
  81.             INTEGER002 = INTEGER002 + 1
  82.         EndWhile
  83.     Endif
  84.     FClose 1
  85.     :LABEL002
  86.     FOpen 1, PPEPath() + "SL-1L.DAT", 2, 0
  87.     INTEGER002 = 1
  88.     While (!Ferr(1) && (INTEGER002 <= INTEGER001)) Do
  89.         FGet 1, STRING005
  90.         TSTRING009(INTEGER002) = STRING005
  91.         If (Len(STRING005) > 0) Then
  92.             PrintLn STRING007, Chr(34), STRING008, TSTRING009(INTEGER002), STRING007, Chr(34), "@X07"
  93.         Endif
  94.         INTEGER002 = INTEGER002 + 1
  95.     EndWhile
  96.     FClose 1
  97.     :LABEL003
  98.     STRING006 = ""
  99.     PrintLn 
  100.     InputStr "Would you like to add a oneliner", STRING006, 9, 1, "YNH?", 2 + 4 + 8
  101.     If ((STRING006 == "H") || (STRING006 == "?")) Then
  102.         SaveScrn
  103.         If (Exist(PPEPath() + "SL-1L.HLP")) Then
  104.             DispFile PPEPath() + "SL-1L.HLP", 4 + 2 + 1
  105.             Goto LABEL004
  106.         Endif
  107.         Cls
  108.         AnsiPos 0, 10
  109.         PrintLn "@X0CERROR@X07: SL-1L.HLP File not found... Notify Sysop!@X07"
  110.         :LABEL004
  111.         RestScrn
  112.         Goto LABEL003
  113.     Endif
  114.     If (STRING006 <> "Y") Then
  115.         PrintLn 
  116.     Else
  117.         PrintLn 
  118.         ClrEol
  119.         :LABEL005
  120.         STRING006 = ""
  121.         Cls
  122.         PrintLn "@X0FEnter your oneliner now.  75 Characters max.  Use @X variables for color."
  123.         PrintLn "@X09(─────────────────────────────────────────────────────────────────────────)"
  124.         STRING004 = ">@X07 _"
  125.         InputStr STRING004, STRING006, 9, 75, Mask_Ascii(), 0
  126.         Newline
  127.         If (Len(STRING006) == 0) Then
  128.             PrintLn 
  129.             PrintLn "@X0C Aborted..."
  130.             PrintLn 
  131.         Else
  132.             If (InStr(Upper(STRING006), "@USER@") || InStr(Upper(STRING006), "@HOMEPHONE@")) Then
  133.                 PrintLn "@X0CMACROs of that Type are Not allowed!"
  134.                 Wait
  135.                 Goto LABEL005
  136.             Endif
  137.             FCreate 1, PPEPath() + "SL-1L.DAT", 2, 0
  138.             If (INTEGER002 >= INTEGER001) Then
  139.                 INTEGER002 = 1
  140.                 While ((Len(TSTRING009(INTEGER002 + 1)) > 0) && (INTEGER002 <= INTEGER001)) Do
  141.                     FPutLn 1, TSTRING009(INTEGER002 + 1)
  142.                     INTEGER002 = INTEGER002 + 1
  143.                 EndWhile
  144.             Else
  145.                 While (Len(TSTRING009(INTEGER002)) > 0) Do
  146.                     FPutLn 1, TSTRING009(INTEGER002)
  147.                 EndWhile
  148.             Endif
  149.             FPutLn 1, STRING006
  150.             FClose 1
  151.             PrintLn "@X0CYour oneliner has been added...@X07"
  152.             Goto LABEL008
  153.             :LABEL006
  154.             Log "", 0
  155.             :LABEL007
  156.             PrintLn 
  157.             End
  158.         Endif
  159.     Endif
  160.     :LABEL008
  161.     PrintLn 
  162.     PrintLn "@X0FSurreal Oneliners PPL v1.05 (8.31.93) - by Marcus Breese"
  163.     If (Exist(PPEPath() + "SL-1L.LFC")) Then
  164.         Goto LABEL002
  165.     Else
  166.         PrintLn "@X0CData file Not Found...Creating..."
  167.         PrintLn 
  168.         FCreate 1, PPEPath() + "SL-1L.LFC", 2, 0
  169.         INTEGER002 = 1
  170.         While (!Ferr(1) && (INTEGER002 <= INTEGER003)) Do
  171.             FPutLn 1, "999999  Marcus Breese               Surreal BBS 219-262-9371    57600  5"
  172.             INTEGER002 = INTEGER002 + 1
  173.         EndWhile
  174.     Endif
  175.     FClose 1
  176.     PrintLn 
  177.     PrintLn "@X0FCaller  Name                        City                        Bps    Node"
  178.     PrintLn "@X0F────────────@X07──@X0F────@X07────────@X08─@X07───────────@X08─────────@X07─@X08───────────────────────────────"
  179.     FOpen 1, PPEPath() + "SL-1L.lfc", 2, 0
  180.     INTEGER002 = 1
  181.     While (!Ferr(1) && (INTEGER002 <= INTEGER003)) Do
  182.         FGet 1, STRING005
  183.         TSTRING011(INTEGER002) = STRING005
  184.         If (Len(STRING005) > 0) Then
  185.             PrintLn TSTRING011(INTEGER002)
  186.         Endif
  187.         INTEGER002 = INTEGER002 + 1
  188.     EndWhile
  189.     FClose 1
  190.     PrintLn "@X0F────────────@X07──@X0F────@X07────────@X08─@X07───────────@X08─────────@X07─@X08───────────────────────────────"
  191.     STRING010 = Upper(U_Name())
  192.     STRING012 = Upper(U_City)
  193.     INTEGER004 = PcbNode()
  194.     INTEGER005 = Carrier()
  195.     FOpen 1, PPEPath() + "SL-1L.TMP", 2, 0
  196.     FGet 1, STRING014
  197.     If ((STRING014 == CallNum()) || (STRING014 == "0")) Then
  198.         FClose 1
  199.         Goto LABEL009
  200.     Else
  201.         Frewind 1
  202.         FPutLn 1, CallNum()
  203.     Endif
  204.     FClose 1
  205.     FCreate 1, PPEPath() + "SL-1L.LFC", 2, 0
  206.     If (INTEGER002 >= INTEGER003) Then
  207.         INTEGER002 = 1
  208.         While ((Len(TSTRING011(INTEGER002 + 1)) > 0) && (INTEGER002 <= 5)) Do
  209.             FPutLn 1, TSTRING011(INTEGER002 + 1)
  210.             INTEGER002 = INTEGER002 + 1
  211.         EndWhile
  212.     Endif
  213.     FPut 1, "@X07"
  214.     FPutPad 1, CallNum(), 6
  215.     FPut 1, "@X0B  "
  216.     FPutPad 1, Left(STRING010, 1) + Lower(Right(STRING010, Len(STRING010) - 1)), -28
  217.     FPut 1, "@X09"
  218.     FPutPad 1, Left(STRING012, 1) + Lower(Right(STRING012, Len(STRING012) - 1)), -28
  219.     FPut 1, "@X05"
  220.     FPutPad 1, INTEGER005, -5
  221.     FPut 1, "@X0E  "
  222.     FPutPad 1, INTEGER004, -2
  223.     FPut 1, "@X07"
  224.     FPut 1, Chr(13)
  225.     FClose 1
  226.     :LABEL009
  227.     PrintLn 
  228.     If (Upper(STRING013) <> "YES") Then
  229.         Goto LABEL007
  230.     Else
  231.         Print "@WHO@"
  232.         Goto LABEL007
  233.     Endif
  234.  
  235. ;------------------------------------------------------------------------------
  236. ;
  237. ; Usage report (before postprocessing)
  238. ;
  239. ; ■ Statements used :
  240. ;
  241. ;    1       End
  242. ;    2       Cls
  243. ;    1       ClrEol
  244. ;    1       Wait
  245. ;    50      Goto 
  246. ;    25      Let 
  247. ;    1       Print 
  248. ;    30      PrintLn 
  249. ;    27      If 
  250. ;    2       DispFile 
  251. ;    4       FCreate 
  252. ;    4       FOpen 
  253. ;    9       FClose 
  254. ;    11      FGet 
  255. ;    7       FPut 
  256. ;    7       FPutLn 
  257. ;    5       FPutPad 
  258. ;    1       GetUser
  259. ;    1       Log 
  260. ;    2       InputStr 
  261. ;    1       Newline
  262. ;    1       AnsiPos 
  263. ;    1       SaveScrn
  264. ;    1       RestScrn
  265. ;    1       Frewind 
  266. ;
  267. ;
  268. ; ■ Functions used :
  269. ;
  270. ;    4       -
  271. ;    33      +
  272. ;    2       -
  273. ;    8       ==
  274. ;    2       <>
  275. ;    2       <
  276. ;    6       <=
  277. ;    6       >
  278. ;    2       >=
  279. ;    26      !
  280. ;    6       &&
  281. ;    4       ||
  282. ;    11      Len(
  283. ;    2       Lower()
  284. ;    5       Upper()
  285. ;    2       Left()
  286. ;    2       Right()
  287. ;    4       Ferr()
  288. ;    3       Chr()
  289. ;    2       InStr()
  290. ;    1       U_Name()
  291. ;    1       Mask_Ascii()
  292. ;    15      PPEPath()
  293. ;    1       PcbNode()
  294. ;    5       Exist()
  295. ;    1       Carrier()
  296. ;    3       CallNum()
  297. ;
  298. ;------------------------------------------------------------------------------
  299. ;
  300. ; Analysis flags : No flag
  301. ;
  302. ;------------------------------------------------------------------------------
  303. ;
  304. ; Postprocessing report
  305. ;
  306. ;    0       For/Next
  307. ;    7       While/EndWhile
  308. ;    15      If/Then or If/Then/Else
  309. ;    0       Select Case
  310. ;
  311. ;------------------------------------------------------------------------------
  312. ;                 AEGiS Corp - Break the routines, code against the machines!
  313. ;------------------------------------------------------------------------------
  314.