home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / S / STCK10.ZIP / !.PPE (.txt) next >
PCBoard Programming Language Executable  |  1995-09-08  |  6KB  |  407 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 3.1O (Encryption type I) - 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.     String   TSTRING001(8)
  26.     String   TSTRING002(1)
  27.     String   STRING003
  28.     String   STRING004
  29.     String   TSTRING005(1)
  30.     String   TSTRING006(1)
  31.     String   STRING007
  32.  
  33. ;------------------------------------------------------------------------------
  34.  
  35.     GetUser
  36.     SaveScrn
  37.     Cls
  38.     FOpen 1, PPEPath() + "stcktext" + LangExt(), 2, 0
  39.     FGet 1, TSTRING001(0)
  40.     For INTEGER003 = 1 To 8
  41.         FGet 1, TSTRING001(INTEGER003)
  42.     Next
  43.     FClose 1
  44.     DOpen 1, PPEPath() + "key" + String(PcbNode()), 0
  45.     Gosub LABEL004
  46.     If (Abort()) Then
  47.         ResetDisp
  48.         Gosub LABEL005
  49.         End
  50.     Endif
  51.     While (STRING004 <> Chr(27)) Do
  52.         If (Abort()) Then
  53.             ResetDisp
  54.             Gosub LABEL005
  55.             End
  56.         Endif
  57.         STRING004 = ""
  58.         While (STRING004 == "") Do
  59.             STRING004 = Upper(Inkey())
  60.             If (STRING004 == "UP") STRING004 = "U"
  61.             If (STRING004 == "DOWN") STRING004 = "D"
  62.             If (InStr("DEMU" + Chr(13) + Chr(27), STRING004) == 0) STRING004 = ""
  63.         EndWhile
  64.         AnsiPos 3, INTEGER001 + 1
  65.         Print TSTRING005(INTEGER001)
  66.         Select Case (STRING004)
  67.             Case "U"
  68.                 If (INTEGER001 == 1) Then
  69.                     INTEGER001 = INTEGER002
  70.                 Else
  71.                     Dec INTEGER001
  72.                 Endif
  73.             Case "D"
  74.                 If (INTEGER001 == INTEGER002) Then
  75.                     INTEGER001 = 1
  76.                 Else
  77.                     Inc INTEGER001
  78.                 Endif
  79.             Case "E"
  80.                 INTEGER006 = DRecCount(1) + 1 - INTEGER001
  81.                 INTEGER006 = INTEGER006
  82.                 DGo 1, INTEGER006
  83.                 DDelete 1
  84.                 Color DefColor()
  85.                 DPack 1
  86.                 Cls
  87.                 Gosub LABEL004
  88.             Case Chr(13)
  89.                 Gosub LABEL005
  90.                 KbdStuff TSTRING002(INTEGER001)
  91.                 End
  92.             Case Chr(27)
  93.                 Gosub LABEL005
  94.                 KbdStuff "^M"
  95.                 End
  96.         End Select
  97.         :LABEL001
  98.         If (STRING004 == "M") Then
  99.             AnsiPos 1, INTEGER002 + 3
  100.             PrintLn TSTRING001(6)
  101.             PrintLn TSTRING001(7)
  102.             Print TSTRING001(8)
  103.             AnsiPos 3, INTEGER001 + 1
  104.             Print TSTRING005(INTEGER001)
  105.             AnsiPos 3, INTEGER001 + 1
  106.             INTEGER004 = 1
  107.             STRING004 = ""
  108.             If (Abort()) Then
  109.                 ResetDisp
  110.                 Gosub LABEL005
  111.                 End
  112.             Endif
  113.             While (STRING004 <> Chr(13)) Do
  114.                 If (Abort()) Then
  115.                     ResetDisp
  116.                     Gosub LABEL005
  117.                     End
  118.                 Endif
  119.                 STRING004 = ""
  120.                 While (STRING004 == "") Do
  121.                     STRING004 = Inkey()
  122.                     If (STRING004 == "RIGHT") STRING004 = Chr(2)
  123.                     If (STRING004 == "LEFT") STRING004 = Chr(3)
  124.                     If (STRING004 == "END") STRING004 = Chr(16)
  125.                     If (STRING004 == "HOME") STRING004 = Chr(23)
  126.                     If (STRING004 == "CTRL LEFT") STRING004 = Chr(1)
  127.                     If (STRING004 == "CTRL RIGHT") STRING004 = Chr(6)
  128.                     If (STRING004 == "CTRL END") STRING004 = Chr(5)
  129.                     If (InStr(Chr(1) + Chr(2) + Chr(3) + Chr(5) + Chr(16) + Chr(23) + Chr(25) + Chr(6) + Chr(8) + Chr(13) + Mask_Ascii(), STRING004) == 0) STRING004 = ""
  130.                 EndWhile
  131.                 If (STRING004 == Chr(2)) Then
  132.                     If (INTEGER004 <> 75) Then
  133.                         Forward 1
  134.                         Inc INTEGER004
  135.                     Endif
  136.                     Continue
  137.                 Endif
  138.                 If (STRING004 == Chr(3)) Then
  139.                     If (INTEGER004 <> 1) Then
  140.                         Backup 1
  141.                         Dec INTEGER004
  142.                     Endif
  143.                     Continue
  144.                 Endif
  145.                 If (STRING004 == Chr(16)) Then
  146.                     STRING003 = Trim(StripAtx(TSTRING005(INTEGER001)), " ")
  147.                     INTEGER005 = Len(STRING003)
  148.                     If (INTEGER005 <> 75) Then
  149.                         INTEGER004 = INTEGER005 + 1
  150.                         Goto LABEL002
  151.                     Endif
  152.                     INTEGER004 = INTEGER005
  153.                     :LABEL002
  154.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  155.                     Continue
  156.                 Endif
  157.                 If (STRING004 == Chr(23)) Then
  158.                     INTEGER004 = 1
  159.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  160.                     Continue
  161.                 Endif
  162.                 If (STRING004 == Chr(1)) Then
  163.                     STRING003 = Trim(StripAtx(TSTRING005(INTEGER001)), " ")
  164.                     If (INTEGER004 <> 1) Then
  165.                         For INTEGER003 = INTEGER004 To 1 Step -1
  166.                             STRING007 = Mid(STRING003, INTEGER003 - 1, 1)
  167.                             If ((STRING007 == Chr(32)) && (INTEGER003 <> INTEGER004)) Break
  168.                         Next
  169.                     Endif
  170.                     INTEGER004 = INTEGER003
  171.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  172.                     Continue
  173.                 Endif
  174.                 If (STRING004 == Chr(6)) Then
  175.                     STRING003 = Trim(StripAtx(TSTRING005(INTEGER001)), " ")
  176.                     INTEGER005 = Len(STRING003)
  177.                     If (INTEGER004 < INTEGER005 + 1) Then
  178.                         For INTEGER003 = INTEGER004 To INTEGER005
  179.                             STRING007 = Mid(STRING003, INTEGER003 + 1, 1)
  180.                             If (STRING007 == Chr(32)) Break
  181.                         Next
  182.                     Endif
  183.                     INTEGER004 = INTEGER003 + 2
  184.                     If (INTEGER004 > INTEGER005) INTEGER004 = INTEGER005 + 1
  185.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  186.                     Continue
  187.                 Endif
  188.                 If (STRING004 == Chr(8)) Then
  189.                     If (INTEGER004 <> 1) Then
  190.                         Dec INTEGER004
  191.                         TSTRING005(INTEGER001) = TSTRING001(5) + Left(StripAtx(TSTRING005(INTEGER001)), INTEGER004 - 1) + Right(StripAtx(TSTRING005(INTEGER001)), 75 - INTEGER004) + " "
  192.                         TSTRING006(INTEGER001) = TSTRING001(4) + StripAtx(TSTRING005(INTEGER001))
  193.                         AnsiPos 3, INTEGER001 + 1
  194.                         Print TSTRING005(INTEGER001)
  195.                         AnsiPos INTEGER004 + 2, INTEGER001 + 1
  196.                     Endif
  197.                     Continue
  198.                 Endif
  199.                 If (STRING004 == Chr(5)) Then
  200.                     STRING003 = Trim(StripAtx(TSTRING005(INTEGER001)), " ")
  201.                     STRING003 = Left(STRING003, INTEGER004 - 1)
  202.                     TSTRING005(INTEGER001) = TSTRING001(5) + STRING003 + Space(75 - INTEGER004)
  203.                     TSTRING006(INTEGER001) = TSTRING001(4) + STRING003 + Space(75 - INTEGER004)
  204.                     AnsiPos 3, INTEGER001 + 1
  205.                     Print TSTRING005(INTEGER001)
  206.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  207.                     Continue
  208.                 Endif
  209.                 If (STRING004 == Chr(13)) Then
  210.                     Continue
  211.                 Endif
  212.                 If (STRING004 == Chr(25)) Then
  213.                     TSTRING005(INTEGER001) = TSTRING001(5) + Space(75)
  214.                     TSTRING006(INTEGER001) = TSTRING001(4) + Space(75)
  215.                     INTEGER004 = 1
  216.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  217.                     Print TSTRING005(INTEGER001)
  218.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  219.                     Continue
  220.                 Endif
  221.                 If (INTEGER004 <> 75) Then
  222.                     Inc INTEGER004
  223.                     Print Upper(STRING004)
  224.                     TSTRING005(INTEGER001) = ScrText(3, 1 + INTEGER001, 75, 1)
  225.                     TSTRING006(INTEGER001) = TSTRING001(4) + StripAtx(TSTRING005(INTEGER001))
  226.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  227.                 Endif
  228.             EndWhile
  229.             If (Trim(StripAtx(TSTRING005(INTEGER001)), " ") == "") Then
  230.                 INTEGER006 = DRecCount(1) + 1 - INTEGER001
  231.                 DGo 1, INTEGER001
  232.                 DDelete 1
  233.                 Color DefColor()
  234.                 DPack 1
  235.                 Cls
  236.                 Gosub LABEL004
  237.                 Goto LABEL003
  238.             Endif
  239.             DNew 1
  240.             DPut 1, "KEY", StripAtx(TSTRING005(INTEGER001))
  241.             DAdd 1
  242.             Color DefColor()
  243.             Cls
  244.             Gosub LABEL004
  245.         Endif
  246.         :LABEL003
  247.         AnsiPos 3, INTEGER001 + 1
  248.         Print TSTRING006(INTEGER001)
  249.     EndWhile
  250.     End
  251.     :LABEL004
  252.     INTEGER002 = U_PageLen - 7
  253.     Redim TSTRING002, INTEGER002
  254.     DBottom 1
  255.     DGet 1, "KEY", TSTRING002(0)
  256.     If ((Trim(TSTRING002(0), " ") == "") && (DRecCount(1) <= 1)) Then
  257.         Gosub LABEL005
  258.         KbdStuff "^M"
  259.         End
  260.     Endif
  261.     PrintLn TSTRING001(1)
  262.     For INTEGER003 = 1 To INTEGER002
  263.         DGet 1, "KEY", TSTRING002(INTEGER003)
  264.         TSTRING002(INTEGER003) = Trim(TSTRING002(INTEGER003), " ")
  265.         If (Len(TSTRING002(INTEGER003)) > 75) Then
  266.             STRING003 = Left(TSTRING002(INTEGER003), 75)
  267.         Else
  268.             STRING003 = TSTRING002(INTEGER003)
  269.         Endif
  270.         If (TSTRING002(INTEGER003) <> "") Then
  271.             OpText STRING003
  272.             PrintLn TSTRING001(2)
  273.         Else
  274.             Dec INTEGER003
  275.         Endif
  276.         If (DRecNo(1) == 1) Then
  277.             INTEGER002 = INTEGER003
  278.             Break
  279.         Endif
  280.         DSkip 1, -1
  281.     Next
  282.     INTEGER001 = 1
  283.     PrintLn TSTRING001(3)
  284.     Redim TSTRING005, INTEGER002
  285.     Redim TSTRING006, INTEGER002
  286.     For INTEGER003 = 1 To INTEGER002
  287.         TSTRING005(INTEGER003) = ScrText(3, 1 + INTEGER003, 75, 1)
  288.         TSTRING006(INTEGER003) = TSTRING001(4) + StripAtx(TSTRING005(INTEGER003))
  289.     Next
  290.     AnsiPos 3, 2
  291.     Print TSTRING006(1)
  292.     Return
  293.     :LABEL005
  294.     DClose 1
  295.     Color DefColor()
  296.     Cls
  297.     RestScrn
  298.     Log " ───────────────────────────────────────────────────── ", 0
  299.     Log "│         SUPPORT THE SHAREWARE CONCEPT!              │", 0
  300.     Log "│                                                     │", 0
  301.     Log "│ the archive for ordering and payment information.   │", 0
  302.     Log "│  only $5.00! See the file ORDER.FRM that came with  │", 0
  303.     Log "│ logs, register them! Registration is available for  │", 0
  304.     Log "│ If you wish to remove this notice from your callers │", 0
  305.     Log "│                                                     │", 0
  306.     Log "│     STACK.PPE AND !.PPE ARE NOT REGISTERED!         │", 0
  307.     Log " ───────────────────────────────────────────────────── ", 0
  308.     Return
  309.  
  310. ;------------------------------------------------------------------------------
  311. ;
  312. ; Usage report (before postprocessing)
  313. ;
  314. ; ■ Statements used :
  315. ;
  316. ;    8       End
  317. ;    5       Cls
  318. ;    4       Color 
  319. ;    76      Goto 
  320. ;    64      Let 
  321. ;    9       Print 
  322. ;    5       PrintLn 
  323. ;    57      If 
  324. ;    1       FOpen 
  325. ;    1       FClose 
  326. ;    2       FGet 
  327. ;    4       ResetDisp
  328. ;    1       GetUser
  329. ;    10      Log 
  330. ;    11      Gosub 
  331. ;    2       Return
  332. ;    3       Inc 
  333. ;    4       Dec 
  334. ;    3       KbdStuff 
  335. ;    1       OpText 
  336. ;    17      AnsiPos 
  337. ;    1       Backup 
  338. ;    1       Forward 
  339. ;    1       SaveScrn
  340. ;    1       RestScrn
  341. ;    3       Redim 
  342. ;    1       DOpen 
  343. ;    1       DClose 
  344. ;    2       DPack 
  345. ;    1       DNew 
  346. ;    1       DAdd 
  347. ;    2       DGo 
  348. ;    1       DBottom 
  349. ;    1       DSkip 
  350. ;    2       DDelete 
  351. ;    2       DGet 
  352. ;    1       DPut 
  353. ;
  354. ;
  355. ; ■ Functions used :
  356. ;
  357. ;    4       -
  358. ;    67      +
  359. ;    9       -
  360. ;    36      ==
  361. ;    10      <>
  362. ;    6       <
  363. ;    6       <=
  364. ;    2       >
  365. ;    10      >=
  366. ;    43      !
  367. ;    12      &&
  368. ;    5       ||
  369. ;    3       Len(
  370. ;    2       Upper()
  371. ;    2       Mid()
  372. ;    3       Left()
  373. ;    1       Right()
  374. ;    4       Space()
  375. ;    35      Chr()
  376. ;    2       InStr()
  377. ;    4       Abort()
  378. ;    7       Trim()
  379. ;    11      StripAtx()
  380. ;    2       Inkey()
  381. ;    1       String()
  382. ;    1       Mask_Ascii()
  383. ;    2       PPEPath()
  384. ;    1       PcbNode()
  385. ;    1       LangExt()
  386. ;    4       DefColor()
  387. ;    2       ScrText()
  388. ;    3       DRecCount()
  389. ;    1       DRecNo()
  390. ;
  391. ;------------------------------------------------------------------------------
  392. ;
  393. ; Analysis flags : No flag
  394. ;
  395. ;------------------------------------------------------------------------------
  396. ;
  397. ; Postprocessing report
  398. ;
  399. ;    5       For/Next
  400. ;    4       While/EndWhile
  401. ;    29      If/Then or If/Then/Else
  402. ;    1       Select Case
  403. ;
  404. ;------------------------------------------------------------------------------
  405. ;                 AEGiS Corp - Break the routines, code against the machines!
  406. ;------------------------------------------------------------------------------
  407.