home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / T / THTLC114.ZIP / THTLC.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1994-11-09  |  7KB  |  482 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.     Integer  INTEGER012
  31.     Integer  INTEGER013
  32.     Integer  INTEGER014
  33.     Integer  INTEGER015
  34.     Integer  INTEGER016
  35.     Integer  INTEGER017
  36.     Integer  INTEGER018
  37.     Integer  INTEGER019
  38.     Integer  INTEGER020
  39.     String   STRING002
  40.     String   STRING003
  41.     String   STRING004
  42.     String   STRING005
  43.     String   STRING006
  44.     String   STRING007
  45.     String   STRING008
  46.     String   STRING009
  47.     String   STRING010
  48.     String   STRING011
  49.     String   STRING012
  50.     String   STRING013
  51.     String   STRING014
  52.     String   STRING015
  53.     String   STRING016
  54.     String   STRING017
  55.     String   STRING018
  56.     String   STRING019
  57.     String   STRING020
  58.     String   STRING021
  59.     String   STRING022
  60.     String   STRING023
  61.     String   STRING024
  62.     String   STRING025
  63.     String   STRING026
  64.     String   STRING027
  65.     String   STRING028
  66.     String   STRING029
  67.     String   STRING030
  68.     String   STRING031
  69.     String   STRING032
  70.     String   STRING033
  71.     String   STRING034
  72.     String   STRING035
  73.     String   STRING036
  74.     String   STRING037
  75.     String   STRING038
  76.     String   STRING039
  77.     String   STRING040
  78.     String   STRING041
  79.     String   STRING042
  80.     String   STRING043
  81.     String   STRING044
  82.     String   STRING045
  83.     String   STRING046
  84.     String   STRING047
  85.     String   STRING048
  86.     Time     TIME001
  87.     Time     TIME002
  88.  
  89. ;------------------------------------------------------------------------------
  90.  
  91.     If (!OnLocal()) CdChkOff
  92.     If (!"0") Print "" ; PPLC BUG!
  93.     STRING038 = Chr(83) + Chr(117) + Chr(112) + Chr(101) + Chr(114) + Chr(45) + Chr(65) + Chr(77) + Chr(73) + Chr(45) + Chr(88) + Chr(32) + Chr(76) + Chr(111) + Chr(103) + Chr(32) + Chr(66) + Chr(121) + Chr(32) + Chr(84) + Chr(104) + Chr(101) + Chr(32) + Chr(77) + Chr(97) + Chr(115) + Chr(116) + Chr(101) + Chr(114) + Chr(32) + Chr(118) + Chr(49) + Chr(46) + Chr(49) + Chr(52) + Space(22) + Chr(40) + Chr(67) + Chr(41) + Chr(32) + Chr(60) + Chr(60) + Chr(84) + Chr(72) + Chr(84) + Chr(62) + Chr(62)
  94.     INTEGER019 = ReadLine(PPEPath() + PPEName() + ".cnf", 1)
  95.     STRING004 = ReadLine(PPEPath() + PPEName() + ".cnf", 14)
  96.     FClose -1
  97.     GetUser
  98.     U_Alias = RTrim(U_Alias, " ")
  99.     If ((Alias() == 1) && (U_Alias <> "")) Then
  100.         STRING048 = U_Alias
  101.     Else
  102.         STRING048 = U_Name()
  103.     Endif
  104.     FDefIn 1
  105.     FDefOut 2
  106.     STRING003 = Right(Modem(), Len(Modem()) - 8)
  107.     STRING003 = Left(STRING003, 5)
  108.     STRING037 = PPEPath() + PPEName() + ".tmp"
  109.     STRING002 = PPEPath() + "NODETMP"
  110.     STRING039 = TokenStr()
  111.     If (Upper(STRING039) == "/UPDATE") Goto LABEL002
  112.     If (U_Sec < INTEGER019) Goto LABEL001
  113.     Cls
  114.     DispFile PPEPath() + PPEName() + ".pcb", 0
  115.     INTEGER011 = GetY()
  116.     AnsiPos 1, 1
  117.     Print "@X07" + STRING038
  118.     AnsiPos 1, INTEGER011
  119.     DispFile STRING037, 1 + 4
  120.     DispFile PPEPath() + PPEName() + ".ftr", 0
  121.     Print STRING004
  122.     :LABEL001
  123.     FCreate 2, STRING002 + "." + String(PcbNode()), 1, 0
  124.     FDPutLn Left(Time(), 5)
  125.     FDPutLn U_MsgWr()
  126.     FDPutLn U_MsgRd()
  127.     FDPutLn U_Stat(3)
  128.     FDPutLn U_Stat(2)
  129.     FDPutLn U_Ful()
  130.     FDPutLn U_Fdl()
  131.     FDPutLn Date()
  132.     FDPutLn STRING048
  133.     FDPutLn String(U_Stat(10))
  134.     FDPutLn String(U_Bdl() / 1024)
  135.     FDPutLn String(U_Bul() / 1024)
  136.     FDPutLn STRING003
  137.     FDPutLn U_Stat(12)
  138.     FDPutLn U_Stat(14)
  139.     FClose 2
  140.     If (!OnLocal()) CdChkOn
  141.     End
  142.     :LABEL002
  143.     If (Exist(PPEPath() + PPEName() + ".loc")) Goto LABEL002
  144.     FCreate 1, PPEPath() + PPEName() + ".loc", 1, 0
  145.     FClose 1
  146.     FOpen 1, PPEPath() + PPEName() + ".cnf", 0, 0
  147.     FDGet INTEGER019
  148.     FDGet INTEGER018
  149.     FDGet STRING024
  150.     FDGet STRING025
  151.     FDGet STRING026
  152.     FDGet STRING027
  153.     FDGet STRING028
  154.     FDGet STRING029
  155.     FDGet STRING030
  156.     FDGet STRING030
  157.     FDGet STRING031
  158.     FDGet STRING040
  159.     FDGet STRING041
  160.     FDGet STRING004
  161.     FDGet STRING005
  162.     FClose 1
  163.     TIME002 = Left(Time(), 5)
  164.     INTEGER012 = U_MsgWr()
  165.     INTEGER013 = U_MsgRd()
  166.     STRING014 = U_Stat(3)
  167.     STRING013 = U_Stat(2)
  168.     INTEGER014 = U_Ful()
  169.     INTEGER015 = U_Fdl()
  170.     STRING017 = Date()
  171.     STRING012 = STRING048
  172.     STRING015 = U_Stat(10)
  173.     INTEGER016 = U_Bdl() / 1024
  174.     INTEGER017 = U_Bul() / 1024
  175.     STRING016 = U_City
  176.     STRING042 = U_Stat(12)
  177.     STRING043 = U_Stat(14)
  178.     If (Exist(STRING002 + "." + String(PcbNode()))) Then
  179.         FOpen 1, STRING002 + "." + String(PcbNode()), 0, 0
  180.         FDGet TIME001
  181.         FDGet INTEGER002
  182.         FDGet INTEGER001
  183.         FDGet STRING009
  184.         FDGet STRING008
  185.         FDGet INTEGER003
  186.         FDGet INTEGER004
  187.         FDGet STRING007
  188.         FDGet STRING006
  189.         FDGet STRING010
  190.         FDGet INTEGER005
  191.         FDGet INTEGER006
  192.         FDGet STRING003
  193.         FDGet STRING044
  194.         FDGet STRING045
  195.         FClose 1
  196.         If (STRING044 <> STRING042) Then
  197.             STRING046 = "!"
  198.             Goto LABEL003
  199.         Endif
  200.         STRING046 = "-"
  201.         :LABEL003
  202.         If (STRING045 <> STRING043) Then
  203.             STRING047 = "X"
  204.             Goto LABEL004
  205.         Endif
  206.         STRING047 = "-"
  207.         :LABEL004
  208.         If (STRING015 <> STRING010) Then
  209.             STRING035 = "H"
  210.             Goto LABEL005
  211.         Endif
  212.         STRING035 = "-"
  213.         :LABEL005
  214.         If (!CDOn() && !OnLocal()) Then
  215.             STRING034 = "C"
  216.             Goto LABEL006
  217.         Endif
  218.         STRING034 = "-"
  219.         :LABEL006
  220.         If (STRING003 == "     ") Then
  221.             STRING003 = "LoCL"
  222.             If (STRING005 == YesChar()) Goto LABEL021
  223.             Goto LABEL008
  224.         Endif
  225.         If (Mid(STRING003, 5, 1) <> "/") Then
  226.             STRING003 = STRING003
  227.             Goto LABEL007
  228.         Endif
  229.         STRING003 = " " + STRING003
  230.         :LABEL007
  231.         STRING003 = Left(STRING003, 3)
  232.         STRING003 = Left(STRING003, 2) + "." + Right(STRING003, 1)
  233.         :LABEL008
  234.         If (INTEGER016 - INTEGER005 == 0) Then
  235.             STRING033 = "   0"
  236.             Goto LABEL009
  237.         Endif
  238.         INTEGER009 = Len(INTEGER016 - INTEGER005)
  239.         If (INTEGER009 == 4) Then
  240.             STRING033 = Space(4 - INTEGER009) + String(INTEGER016 - INTEGER005)
  241.             Goto LABEL009
  242.         Endif
  243.         STRING033 = Space(4 - INTEGER009) + String(INTEGER016 - INTEGER005)
  244.         :LABEL009
  245.         If (INTEGER017 - INTEGER006 == 0) Then
  246.             STRING032 = "   0"
  247.             Goto LABEL010
  248.         Endif
  249.         INTEGER009 = Len(INTEGER017 - INTEGER006)
  250.         If (INTEGER009 == 4) Then
  251.             STRING032 = Space(4 - INTEGER009) + String(INTEGER017 - INTEGER006)
  252.             Goto LABEL010
  253.         Endif
  254.         STRING032 = Space(4 - INTEGER009) + String(INTEGER017 - INTEGER006)
  255.         :LABEL010
  256.         If (INTEGER012 > INTEGER002) Then
  257.             STRING020 = "W"
  258.             Goto LABEL011
  259.         Endif
  260.         STRING020 = "-"
  261.         :LABEL011
  262.         If (INTEGER013 > INTEGER001) Then
  263.             STRING021 = "R"
  264.             Goto LABEL012
  265.         Endif
  266.         STRING021 = "-"
  267.         :LABEL012
  268.         If (INTEGER015 > INTEGER004) Then
  269.             STRING022 = "D"
  270.             Goto LABEL013
  271.         Endif
  272.         STRING022 = "-"
  273.         :LABEL013
  274.         If (INTEGER014 > INTEGER003) Then
  275.             STRING023 = "U"
  276.             Goto LABEL014
  277.         Endif
  278.         STRING023 = "-"
  279.         :LABEL014
  280.         If (STRING014 > STRING009) Then
  281.             STRING018 = "G"
  282.             Goto LABEL015
  283.         Endif
  284.         STRING018 = "-"
  285.         :LABEL015
  286.         If (STRING013 > STRING008) Then
  287.             STRING019 = "P"
  288.             Goto LABEL016
  289.         Endif
  290.         STRING019 = "-"
  291.         :LABEL016
  292.         INTEGER008 = TIME001
  293.         INTEGER007 = TIME002
  294.         INTEGER007 = TIME002 - TIME001
  295.         TIME001 = INTEGER007
  296.         STRING011 = Left(TIME001, 5)
  297.         If ((Mid(STRING011, 1, 1) == 0) && (Mid(STRING011, 1, 2) <> ":")) STRING011 = Mid(STRING011, 2, 4)
  298.         FAppend 2, PPEPath() + PPEName() + ".WRK", 1, 0
  299.         FDPutLn STRING024 + STRING003 + STRING025 + "@POS:6@" + String(PcbNode()) + "@POS:8@" + STRING026 + Left(STRING048, 14) + "@POS:25@" + STRING027 + Left(STRING016, 17) + "@POS:43@" + STRING028 + String(TIME002) + "@POS:52@" + STRING029 + "[" + STRING020 + STRING021 + STRING022 + STRING023 + STRING018 + STRING019 + STRING034 + STRING035 + STRING046 + STRING047 + "@POS:63@]" + "@POS:65@" + STRING030 + STRING011 + "@POS:70@" + STRING030 + STRING032 + "@POS:75@" + STRING031 + STRING033
  300.         FOpen 1, PPEPath() + PPEName() + ".tmp", 0, 0
  301.         :LABEL017
  302.         If (Ferr(1)) Goto LABEL018
  303.         FDGet STRING036
  304.         If (Ferr(1)) Goto LABEL018
  305.         FDPutLn STRING036
  306.         Goto LABEL017
  307.         :LABEL018
  308.         FClose 2
  309.         FClose 1
  310.         If (Exist(PPEPath() + PPEName() + ".wrk")) Then
  311.             Delete PPEPath() + PPEName() + ".tmp"
  312.             Rename PPEPath() + PPEName() + ".wrk", PPEPath() + PPEName() + ".tmp"
  313.         Endif
  314.         INTEGER010 = 1
  315.         FOpen 1, PPEPath() + PPEName() + ".tmp", 0, 0
  316.         :LABEL019
  317.         If (Ferr(1)) Goto LABEL020
  318.         FDGet STRING036
  319.         If (Ferr(1)) Goto LABEL020
  320.         Inc INTEGER010
  321.         Goto LABEL019
  322.         :LABEL020
  323.         If (INTEGER010 > INTEGER018) Then
  324.             FAppend 2, PPEPath() + PPEName() + ".wrk", 1, 0
  325.             Frewind 1
  326.             For INTEGER020 = 1 To INTEGER018
  327.                 FDGet STRING036
  328.                 If (Ferr(1)) Break
  329.                 FDPutLn STRING036
  330.             Next
  331.             FClose 1
  332.             FClose 2
  333.         Endif
  334.         :LABEL021
  335.         If (Exist(PPEPath() + PPEName() + ".wrk")) Then
  336.             Delete PPEPath() + PPEName() + ".tmp"
  337.             Rename PPEPath() + PPEName() + ".wrk", PPEPath() + PPEName() + ".tmp"
  338.         Endif
  339.     Endif
  340.     FClose 1
  341.     If (Exist(STRING002 + "." + String(PcbNode()))) Delete STRING002 + "." + String(PcbNode())
  342.     If (STRING040 == YesChar()) Then
  343.         FCreate 2, STRING041 + PPEName() + ".blt", 1, 0
  344.         FOpen 1, PPEPath() + PPEName() + ".pcb", 0, 0
  345.         :LABEL022
  346.         If (Ferr(1)) Goto LABEL023
  347.         FDGet STRING036
  348.         If (Ferr(1)) Goto LABEL023
  349.         FDPutLn STRING036
  350.         Goto LABEL022
  351.         :LABEL023
  352.         FClose 1
  353.         FOpen 1, PPEPath() + PPEName() + ".tmp", 0, 0
  354.         :LABEL024
  355.         If (Ferr(1)) Goto LABEL025
  356.         FDGet STRING036
  357.         If (Ferr(1)) Goto LABEL025
  358.         FDPutLn STRING036
  359.         Goto LABEL024
  360.         :LABEL025
  361.         FClose 1
  362.         FOpen 1, PPEPath() + PPEName() + ".ftr", 0, 0
  363.         :LABEL026
  364.         If (Ferr(1)) Goto LABEL027
  365.         FDGet STRING036
  366.         If (Ferr(1)) Goto LABEL027
  367.         FDPutLn STRING036
  368.         Goto LABEL026
  369.         :LABEL027
  370.         FClose 1
  371.         FClose 2
  372.     Endif
  373.     If (Exist(PPEPath() + PPEName() + ".loc")) Delete PPEPath() + PPEName() + ".loc"
  374.     Stop
  375.  
  376. ;------------------------------------------------------------------------------
  377. ;
  378. ; Usage report (before postprocessing)
  379. ;
  380. ; ■ Statements used :
  381. ;
  382. ;    1       End
  383. ;    1       Cls
  384. ;    61      Goto 
  385. ;    69      Let 
  386. ;    3       Print 
  387. ;    44      If 
  388. ;    3       DispFile 
  389. ;    3       FCreate 
  390. ;    7       FOpen 
  391. ;    2       FAppend 
  392. ;    14      FClose 
  393. ;    1       GetUser
  394. ;    4       Delete 
  395. ;    1       CdChkOn
  396. ;    1       CdChkOff
  397. ;    1       Inc 
  398. ;    1       Stop
  399. ;    2       AnsiPos 
  400. ;    2       Rename 
  401. ;    1       Frewind 
  402. ;    1       FDefIn 
  403. ;    1       FDefOut 
  404. ;    36      FDGet 
  405. ;    21      FDPutLn 
  406. ;
  407. ;
  408. ; ■ Functions used :
  409. ;
  410. ;    1       -
  411. ;    4       /
  412. ;    155     +
  413. ;    14      -
  414. ;    11      ==
  415. ;    6       <>
  416. ;    2       <
  417. ;    1       <=
  418. ;    7       >
  419. ;    2       >=
  420. ;    40      !
  421. ;    5       &&
  422. ;    1       ||
  423. ;    3       Len(
  424. ;    1       Upper()
  425. ;    4       Mid()
  426. ;    8       Left()
  427. ;    2       Right()
  428. ;    5       Space()
  429. ;    11      Ferr()
  430. ;    46      Chr()
  431. ;    1       RTrim()
  432. ;    2       Date()
  433. ;    2       Time()
  434. ;    1       U_Name()
  435. ;    2       U_Ful()
  436. ;    2       U_Fdl()
  437. ;    2       U_Bdl()
  438. ;    2       U_Bul()
  439. ;    2       YesChar()
  440. ;    14      String()
  441. ;    26      PPEPath()
  442. ;    2       U_MsgRd()
  443. ;    2       U_MsgWr()
  444. ;    6       PcbNode()
  445. ;    2       ReadLine()
  446. ;    3       OnLocal()
  447. ;    6       Exist()
  448. ;    1       TokenStr()
  449. ;    1       CDOn()
  450. ;    1       GetY()
  451. ;    10      U_Stat()
  452. ;    26      PPEName()
  453. ;    2       Modem()
  454. ;    1       Alias()
  455. ;
  456. ;------------------------------------------------------------------------------
  457. ;
  458. ; Analysis flags : No flag
  459. ;
  460. ;
  461. ;------------------------------------------------------------------------------
  462. ;
  463. ;     One or more PPLC bugs were found, this is not a PPLX error, but PPLX is  
  464. ;     reporting the error ;)  Some statements  like VAR = !!!!10, VAR = !0*!0  
  465. ;     or similar things are not handled  correctly by PPLC, some may use this  
  466. ;     to  avoid a  correct decompilation...  This doesn't mean that there  is  
  467. ;     actually an error, but the probability of error is high...               
  468. ;     ■ Search for : PPLC BUG
  469. ;
  470. ;------------------------------------------------------------------------------
  471. ;
  472. ; Postprocessing report
  473. ;
  474. ;    1       For/Next
  475. ;    0       While/EndWhile
  476. ;    22      If/Then or If/Then/Else
  477. ;    0       Select Case
  478. ;
  479. ;------------------------------------------------------------------------------
  480. ;                 AEGiS Corp - Break the routines, code against the machines!
  481. ;------------------------------------------------------------------------------
  482.