home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / BBS / POBNLS03.ZIP / POBNLS.PPE (.txt) < prev   
PCBoard Programming Language Executable  |  1995-01-14  |  4KB  |  294 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.O1 (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Real     REAL001
  20.     String   STRING001
  21.     String   STRING002
  22.     String   STRING003
  23.     String   STRING004
  24.     String   STRING005
  25.     String   STRING006
  26.     String   STRING007
  27.     String   STRING008
  28.     String   STRING009
  29.     String   STRING010
  30.     String   STRING011
  31.     String   STRING012
  32.     String   STRING013
  33.     String   STRING014
  34.     String   STRING015
  35.     String   STRING016
  36.     String   STRING017
  37.     BigStr   BIGSTR001
  38.  
  39. ;------------------------------------------------------------------------------
  40.  
  41.     Goto LABEL002
  42.     End
  43.     If (0 == 0) PROCEDURE001 = "DUMMY"
  44.  
  45.     EndProc
  46.  
  47.     :LABEL001
  48.     DCloseAll
  49.     :LABEL002
  50.     STRING010 = PPEPath() + PPEName() + ".CFG"
  51.     STRING011 = ReadLine(STRING010, 1)
  52.     STRING012 = ReadLine(STRING010, 1) + "SYSOP.NDX"
  53.     STRING013 = ReadLine(STRING010, 1) + "BBS.NDX"
  54.     DOpen 1, STRING011 + "NODELIST.DBF", 0
  55.     If (Exist(STRING012)) Goto LABEL003
  56.     Cls
  57.     Newline
  58.     Newline
  59.     PrintLn "@X0FPlease wait .... creating SYSOP.NDX file!"
  60.     PrintLn "                              @X8FWAIT!"
  61.     PrintLn "@X0F"
  62.     DnCreate 1, String(STRING011) + "SYSOP.NDX", "Sysop_name"
  63.     :LABEL003
  64.     If (Exist(STRING013)) Goto LABEL004
  65.     Newline
  66.     Newline
  67.     PrintLn "Please wait .... creating BBS.NDX file!"
  68.     PrintLn "                              @X8FWAIT!"
  69.     PrintLn "@X0F"
  70.     DnCreate 1, String(STRING011) + "BBS.NDX", "Bbs_name"
  71.     :LABEL004
  72.     Cls
  73.     DispFile PPEPath() + "INPUT", 1 + 2 + 4
  74.     AnsiPos 66, 13
  75.     While (STRING017 <> Chr(27)) Do
  76.         STRING017 = Inkey()
  77.         If (STRING017 == 1) Goto LABEL005
  78.         If (STRING017 == 2) Goto LABEL006
  79.     EndWhile
  80.     Cls
  81.     Goto LABEL012
  82.     :LABEL005
  83.     AnsiPos 39, 17
  84.     InputStr "@X0F", BIGSTR001, 14, 40, Mask_Ascii(), 4
  85.     DnOpen 1, STRING011 + "SYSOP.NDX"
  86.     Goto LABEL007
  87.     :LABEL006
  88.     AnsiPos 39, 19
  89.     InputStr "@X0F", BIGSTR001, 14, 40, Mask_Ascii(), 4
  90.     DnOpen 1, STRING011 + "BBS.NDX"
  91.     :LABEL007
  92.     DTop 1
  93.     STRING008 = 1
  94.     DSeek 1, BIGSTR001
  95.     If (DChkStat(1) == 2) Then
  96.         Select Case (LangExt())
  97.             Case ""
  98.                 STRING015 = "@X0CRecord not found - current record is the closest match"
  99.                 STRING016 = " ATTENTION!:  write entry in upper and / or lowercase "
  100.             Case ".GER"
  101.                 STRING015 = "@X0CEintrag nicht gefunden - dieser Eintrag ist aehnlich! "
  102.                 STRING016 = "   Achtung!: Gross und Kleinschreibung beachten!  "
  103.         End Select
  104.     Else
  105.         STRING015 = "                                                      "
  106.         STRING016 = STRING015
  107.     Endif
  108.     Cls
  109.     DispFile PPEPath() + PPEName(), 2 + 1 + 4
  110.     AnsiPos 45, 1
  111.     Print "@X08POBNLS [PPE3] v.0.02ß POB(@X0Ac@X08)1995"
  112.     :LABEL008
  113.     Print ReadLine(STRING010, 2)
  114.     AnsiPos 63, 3
  115.     Print DRecCount(1)
  116.     AnsiPos 30, 3
  117.     Print "        "
  118.     AnsiPos 30, 3
  119.     Print DRecNo(1)
  120.     AnsiPos 13, 4
  121.     Print STRING015
  122.     AnsiPos 13, 5
  123.     Print STRING016
  124.     Print ReadLine(STRING010, 2)
  125.     DGet 1, "Zone", STRING001
  126.     DGet 1, "NET", STRING002
  127.     DGet 1, "Node", STRING003
  128.     DGet 1, "Location", STRING006
  129.     DGet 1, "Bbs_phone", STRING009
  130.     DGet 1, "Bbs_name", STRING004
  131.     DGet 1, "Sysop_name", STRING005
  132.     DGet 1, "Maxbaud", STRING014
  133.     AnsiPos 35, 7
  134.     Print STRING001 + ":" + STRING002 + "/" + STRING003
  135.     AnsiPos 35, 9
  136.     Print STRING004
  137.     AnsiPos 35, 11
  138.     Print STRING005
  139.     AnsiPos 35, 13
  140.     Print STRING006
  141.     AnsiPos 35, 15
  142.     Print STRING009
  143.     AnsiPos 65, 15
  144.     Print STRING014
  145.     AnsiPos 1, 22
  146.     While (STRING007 <> Chr(27)) Do
  147.         STRING007 = Inkey()
  148.         If (STRING007 == Chr(13)) Goto LABEL001
  149.         Select Case (STRING007)
  150.             Case "HOME"
  151.                 Goto LABEL009
  152.             Case "END"
  153.                 Goto LABEL010
  154.         End Select
  155.         If (STRING007 == "$") Then
  156.             REAL001 = 10000
  157.             Goto LABEL011
  158.             Continue
  159.         Endif
  160.         If (STRING007 == "%") Then
  161.             REAL001 = -10000
  162.             Goto LABEL011
  163.             Continue
  164.         Endif
  165.         If (STRING007 == "*") Then
  166.             REAL001 = 1000
  167.             Goto LABEL011
  168.             Continue
  169.         Endif
  170.         If (STRING007 == "/") Then
  171.             REAL001 = -1000
  172.             Goto LABEL011
  173.             Continue
  174.         Endif
  175.         If (STRING007 == "+") Then
  176.             REAL001 = 100
  177.             Goto LABEL011
  178.             Continue
  179.         Endif
  180.         If (STRING007 == "-") Then
  181.             REAL001 = -100
  182.             Goto LABEL011
  183.             Continue
  184.         Endif
  185.         If (STRING007 == "RIGHT") Then
  186.             REAL001 = 10
  187.             Goto LABEL011
  188.             Continue
  189.         Endif
  190.         If (STRING007 == "LEFT") Then
  191.             REAL001 = -10
  192.             Goto LABEL011
  193.             Continue
  194.         Endif
  195.         If (STRING007 == "DOWN") Then
  196.             REAL001 = 1
  197.             Goto LABEL011
  198.             Continue
  199.         Endif
  200.         If (STRING007 == "UP") Then
  201.             REAL001 = -1
  202.             Goto LABEL011
  203.         Endif
  204.     EndWhile
  205.     Goto LABEL012
  206.     :LABEL009
  207.     STRING008 = 1
  208.     DGo 1, STRING008
  209.     STRING015 = "                                                      "
  210.     STRING016 = STRING015
  211.     Goto LABEL008
  212.     :LABEL010
  213.     DGo 1, DRecCount(1)
  214.     STRING015 = "                                                      "
  215.     STRING016 = STRING015
  216.     Goto LABEL008
  217.     :LABEL011
  218.     STRING008 = DRecNo(1) + REAL001
  219.     If (STRING008 < 0) Goto LABEL009
  220.     If (STRING008 > DRecCount(1)) Goto LABEL010
  221.     DGo 1, STRING008
  222.     STRING015 = "                                                      "
  223.     STRING016 = STRING015
  224.     Goto LABEL008
  225.     :LABEL012
  226.     End
  227.  
  228. ;------------------------------------------------------------------------------
  229. ;
  230. ; Usage report (before postprocessing)
  231. ;
  232. ; ■ Statements used :
  233. ;
  234. ;    2       End
  235. ;    4       Cls
  236. ;    57      Goto 
  237. ;    32      Let 
  238. ;    14      Print 
  239. ;    6       PrintLn 
  240. ;    25      If 
  241. ;    2       DispFile 
  242. ;    2       InputStr 
  243. ;    4       Newline
  244. ;    16      AnsiPos 
  245. ;    1       EndProc
  246. ;    1       DOpen 
  247. ;    1       DCloseAll
  248. ;    2       DnCreate 
  249. ;    2       DnOpen 
  250. ;    1       DTop 
  251. ;    3       DGo 
  252. ;    1       DSeek 
  253. ;    8       DGet 
  254. ;
  255. ;
  256. ; ■ Functions used :
  257. ;
  258. ;    5       -
  259. ;    20      +
  260. ;    19      ==
  261. ;    2       <>
  262. ;    1       <
  263. ;    1       >
  264. ;    17      !
  265. ;    3       Chr()
  266. ;    2       Inkey()
  267. ;    2       String()
  268. ;    2       Mask_Ascii()
  269. ;    3       PPEPath()
  270. ;    5       ReadLine()
  271. ;    2       Exist()
  272. ;    2       LangExt()
  273. ;    2       PPEName()
  274. ;    3       DRecCount()
  275. ;    2       DRecNo()
  276. ;    1       DChkStat()
  277. ;
  278. ;------------------------------------------------------------------------------
  279. ;
  280. ; Analysis flags : No flag
  281. ;
  282. ;------------------------------------------------------------------------------
  283. ;
  284. ; Postprocessing report
  285. ;
  286. ;    0       For/Next
  287. ;    2       While/EndWhile
  288. ;    11      If/Then or If/Then/Else
  289. ;    2       Select Case
  290. ;
  291. ;------------------------------------------------------------------------------
  292. ;                 AEGiS Corp - Break the routines, code against the machines!
  293. ;------------------------------------------------------------------------------
  294.