home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / BBS / TICKLE10.ZIP / TKLPACK.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1995-01-03  |  5KB  |  334 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.     Boolean  BOOLEAN001
  20.     Boolean  BOOLEAN002
  21.     Boolean  BOOLEAN003
  22.     Integer  INTEGER001
  23.     Integer  INTEGER002
  24.     Integer  INTEGER003
  25.     Real     REAL001
  26.     Real     REAL002
  27.     Real     REAL003
  28.     String   STRING001
  29.     String   STRING002
  30.     String   STRING003
  31.     String   STRING004
  32.     String   STRING005
  33.     String   STRING006
  34.     String   STRING007
  35.     String   STRING008
  36.     String   STRING009
  37.     Int      INT001
  38.     Int      INT002
  39.     Int      INT003
  40.     Int      INT004
  41.     Int      INT005
  42.     Int      INT006
  43.     Int      INT007
  44.     Int      INT008
  45.     Int      INT009
  46.  
  47. ;------------------------------------------------------------------------------
  48.  
  49.     STRING006 = PPEPath() + "TKLTEXT"
  50.     Newlines 3
  51.     PrintLn ReadLine(STRING006, 59)
  52.     Newlines 2
  53.     Delay 18
  54.     Print ReadLine(STRING006, 60)
  55.     Gosub LABEL008
  56.     PrintLn ReadLine(STRING006, 61)
  57.     Newline
  58.     Print ReadLine(STRING006, 62)
  59.     Gosub LABEL007
  60.     PrintLn ReadLine(STRING006, 61)
  61.     Newline
  62.     Print ReadLine(STRING006, 63)
  63.     Gosub LABEL011
  64.     If (DErr(0)) Then
  65.         SPrintLn ReadLine(STRING006, 64)
  66.         Log "Cannot open TICKLE.DBF (DataBase) in EXCLUSIVE mode - Aborting", 0
  67.     Else
  68.         Gosub LABEL012
  69.         If (DErr(0)) Then
  70.             SPrintLn ReadLine(STRING006, 4)
  71.             Log "Cannot open TICKLE.NDX (Index) - Aborting", 0
  72.         Else
  73.             PrintLn ReadLine(STRING006, 61)
  74.             Newline
  75.             PrintLn ReadLine(STRING006, 65)
  76.             Newline
  77.             Delay 36
  78.             Gosub LABEL001
  79.             If (INT007 > 0) Then
  80.                 Newlines 2
  81.                 PrintLn ReadLine(STRING006, 66)
  82.                 Newlines 2
  83.                 DTop 0
  84.                 DPack 0
  85.             Endif
  86.             FPutLn 2, "Total Number of Records in Database After Pack  : ", DRecCount(0)
  87.             FPutLn 2
  88.             FPutLn 2, "Total Users Deleted : ", INT007
  89.             FPutLn 2, "     Time Completed : ", Time()
  90.             FClose 2
  91.             Newline
  92.             PrintLn ReadLine(STRING006, 67)
  93.             Newline
  94.             Goto LABEL009
  95.             End
  96.             :LABEL001
  97.             DTop 0
  98.             PrintLn ReadLine(STRING006, 68)
  99.             Newline
  100.             FAppend 2, PPEPath() + PPEName() + ".log", 1, 0
  101.             FPutLn 2
  102.             FPutLn 2
  103.             FPutLn 2, "========================================================================"
  104.             FPutLn 2
  105.             FPutLn 2, "Tickle File Packing Program - Version 1.0"
  106.             FPutLn 2, "Written by Dan Shore - SysOp - The Shoreline BBS"
  107.             FPutLn 2
  108.             FPutLn 2, "      Date of Pack : ", Date()
  109.             FPutLn 2, "Start Time of Pack : ", Time()
  110.             FPutLn 2
  111.             For INT001 = 1 To DRecCount(0)
  112.                 StartDisp 1
  113.                 DGo 0, INT001
  114.                 STRING001 = DGet(0, DName(0, 1))
  115.                 STRING003 = Left(STRING001, 1)
  116.                 If (STRING003 < "A") STRING003 = "A"
  117.                 If (STRING003 > "Z") STRING003 = "Z"
  118.                 FPut 2, "Processing Username: ", STRING001
  119.                 If (INT008) Goto LABEL002
  120.                 Print ReadLine(STRING006, 69)
  121.                 INT008 = GetX()
  122.                 INT009 = GetY()
  123.                 :LABEL002
  124.                 AnsiPos INT008, INT009
  125.                 Print INT001
  126.                 Gosub LABEL004
  127.                 If (BOOLEAN002) Goto LABEL003
  128.                 FPutLn 2, "Not Current User - Deleted"
  129.                 DDelete 0
  130.                 Inc INT007
  131.                 Continue
  132.                 :LABEL003
  133.                 FPutLn 2, "Current User - Not Deleted"
  134.             Next
  135.             PrintLn "@X07"
  136.             FPutLn 2
  137.             FPutLn 2, "Total Number of Records in Database Before Pack : ", DRecCount(0)
  138.             StartDisp 2
  139.             Return
  140.             :LABEL004
  141.             STRING004 = STRING002 + "PCBNDX." + STRING003
  142.             INTEGER001 = FileInf(STRING004, 4)
  143.             If (INTEGER001 < 27) Then
  144.                 PrintLn ReadLine(STRING006, 70), STRING004, ReadLine(STRING006, 71)
  145.             Endif
  146.             INT004 = INTEGER001 / 27
  147.             INT005 = 0
  148.             FOpen 1, STRING004, 0, 0
  149.             BOOLEAN001 = 0
  150.             BOOLEAN002 = 0
  151.             :LABEL005
  152.             If (BOOLEAN001) Goto LABEL006
  153.             REAL001 = INT004
  154.             REAL002 = INT005
  155.             REAL001 = REAL001 / 2
  156.             REAL002 = REAL002 / 2
  157.             REAL003 = REAL001 + REAL002 + 0.5
  158.             INT003 = REAL003
  159.             INTEGER002 = (INT003 - 1) * 27
  160.             FSeek 1, INTEGER002, 0
  161.             FRead 1, INT002, 2
  162.             FRead 1, STRING005, 25
  163.             If (STRING005 == STRING001) Then
  164.                 BOOLEAN002 = 1
  165.                 BOOLEAN001 = 1
  166.             ElseIf (INT004 - INT005 < 2) Then
  167.                 BOOLEAN001 = 1
  168.             ElseIf (STRING005 < STRING001) Then
  169.                 INT005 = INT003
  170.             ElseIf (STRING005 > STRING001) Then
  171.                 INT004 = INT003
  172.             Endif
  173.             Goto LABEL005
  174.             :LABEL006
  175.             FClose 1
  176.             Return
  177.             :LABEL007
  178.             Copy PPEPath() + "TICKLE.DBF", PPEPath() + "TICKLE.DBK"
  179.             Copy PPEPath() + "TICKLE.NDX", PPEPath() + "TICKLE.NBK"
  180.             Return
  181.             :LABEL008
  182.             FOpen 1, PPEPath() + PPEName() + ".cfg", 0, 0
  183.             FGet 1, STRING002
  184.             FClose 1
  185.             STRING002 = Trim(STRING002, " ")
  186.             If (Right(STRING002, 1) <> "\") STRING002 = STRING002 + "\"
  187.             Return
  188.         Endif
  189.     Endif
  190.     :LABEL009
  191.     DnCloseAll 0
  192.     DClose 0
  193.     PrintLn ReadLine(STRING006, 72)
  194.     Newline
  195.     Gosub LABEL010
  196.     If (BOOLEAN003) Then
  197.         PrintLn "            @X0BRegistered to: @X0E", STRING007, "@X07"
  198.     Else
  199.         Newline
  200.         PrintLn "  *************************************************"
  201.         Newline
  202.         PrintLn "   [Unregistered Version] - Pausing for 5 Seconds"
  203.         Newline
  204.         PrintLn "  Support the Shareware Concept and Register Today"
  205.         Newline
  206.         PrintLn "  *************************************************"
  207.         Delay 90
  208.     Endif
  209.     End
  210.     :LABEL010
  211.     FOpen 3, PPEPath() + "TKL.KEY", 0, 0
  212.     FGet 3, STRING009
  213.     FGet 3, STRING008
  214.     STRING009 = RTrim(STRING009, " ")
  215.     STRING009 = Mid(STRING009, InStr(STRING009, ":") + 1, Len(STRING009) - InStr(STRING009, ":"))
  216.     STRING007 = Trim(STRING009, " ")
  217.     STRING009 = Mid(STRING008, 3, Len(STRING008) - 2)
  218.     STRING008 = Trim(STRING009, " ")
  219.     For INT001 = 1 To Len(STRING007)
  220.         INT006 = S2I(Mid(STRING007, INT001, 1), 36) - 9
  221.         INTEGER003 = INTEGER003 + INT006
  222.     Next
  223.     If (INTEGER003 < 0) INTEGER003 = INTEGER003 * -1
  224.     If (INTEGER003 == 0) INTEGER003 = INTEGER003 + 384
  225.     INTEGER003 = INTEGER003 * 7914
  226.     STRING009 = LTrim(String(INTEGER003), " ")
  227.     If (STRING009 == STRING008) BOOLEAN003 = 1
  228.     FClose 3
  229.     Return
  230.     :LABEL011
  231.     DOpen 0, PPEPath() + "tickle", 1
  232.     Return
  233.     :LABEL012
  234.     If (Exist(PPEPath() + "tickle.ndx")) DnOpen 0, PPEPath() + "tickle"
  235.     Return
  236.  
  237. ;------------------------------------------------------------------------------
  238. ;
  239. ; Usage report (before postprocessing)
  240. ;
  241. ; ■ Statements used :
  242. ;
  243. ;    2       End
  244. ;    25      Goto 
  245. ;    43      Let 
  246. ;    5       Print 
  247. ;    16      PrintLn 
  248. ;    21      If 
  249. ;    3       FOpen 
  250. ;    1       FAppend 
  251. ;    4       FClose 
  252. ;    3       FGet 
  253. ;    1       FPut 
  254. ;    18      FPutLn 
  255. ;    2       StartDisp 
  256. ;    2       Log 
  257. ;    7       Gosub 
  258. ;    7       Return
  259. ;    3       Delay 
  260. ;    1       Inc 
  261. ;    12      Newline
  262. ;    4       Newlines 
  263. ;    1       AnsiPos 
  264. ;    2       SPrintLn 
  265. ;    1       FSeek 
  266. ;    2       FRead 
  267. ;    2       Copy 
  268. ;    1       DOpen 
  269. ;    1       DClose 
  270. ;    1       DPack 
  271. ;    1       DnOpen 
  272. ;    1       DnCloseAll 
  273. ;    2       DTop 
  274. ;    1       DGo 
  275. ;    1       DDelete 
  276. ;
  277. ;
  278. ; ■ Functions used :
  279. ;
  280. ;    1       -
  281. ;    3       *
  282. ;    3       /
  283. ;    23      +
  284. ;    5       -
  285. ;    3       ==
  286. ;    1       <>
  287. ;    7       <
  288. ;    2       <=
  289. ;    3       >
  290. ;    4       >=
  291. ;    14      !
  292. ;    4       &&
  293. ;    2       ||
  294. ;    4       Len(
  295. ;    3       Mid()
  296. ;    1       Left()
  297. ;    1       Right()
  298. ;    2       InStr()
  299. ;    1       LTrim()
  300. ;    1       RTrim()
  301. ;    3       Trim()
  302. ;    1       Date()
  303. ;    2       Time()
  304. ;    1       String()
  305. ;    11      PPEPath()
  306. ;    17      ReadLine()
  307. ;    1       Exist()
  308. ;    1       S2I()
  309. ;    1       GetX()
  310. ;    1       GetY()
  311. ;    1       FileInf()
  312. ;    2       PPEName()
  313. ;    2       DErr()
  314. ;    1       DName()
  315. ;    4       DRecCount()
  316. ;    1       DGet()
  317. ;
  318. ;------------------------------------------------------------------------------
  319. ;
  320. ; Analysis flags : No flag
  321. ;
  322. ;------------------------------------------------------------------------------
  323. ;
  324. ; Postprocessing report
  325. ;
  326. ;    2       For/Next
  327. ;    0       While/EndWhile
  328. ;    9       If/Then or If/Then/Else
  329. ;    0       Select Case
  330. ;
  331. ;------------------------------------------------------------------------------
  332. ;                 AEGiS Corp - Break the routines, code against the machines!
  333. ;------------------------------------------------------------------------------
  334.