home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / BASIC / QBS_0103 / QBS103-2.DOC < prev    next >
Text File  |  1993-04-30  |  56KB  |  1,531 lines
  1. ════════════════════════════════════════════════════════════════════════════════
  2.  Area:    QuickBasic
  3.   Msg:    #11181
  4.  Date:    02-24-93 22:45 (Public)
  5.  From:    EARL MONTGOMERY
  6.  To:      ALL
  7.  Subject: Fancy Fonts
  8. ────────────────────────────────────────────────────────────────────────────────
  9. 'The following are the fancy fonts that can be used with FONTGEN.BAS
  10. 'which I posted a week or so ago. To use them just select L from the
  11. 'menu and when prompted for the file name enter DEFAULT
  12. 'Permission given by echo coordinator to use POSTIT to post this
  13. 'BSAVED Binary File. The file is in two parts.
  14. 'Part one of two
  15. CLS:?STRING$(50,178):'This file created by PostIt! v4.0
  16. DEFINT A-Z:FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "B",1,"default.dat"
  17. T$="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789()"
  18. G"9B)JaaaaoaaaaaaaaaaaaaaaaaaaaaGFbwAGb2BMb6haaaaaa43)B)))dF()(baaaaaaaW
  19. G"M)(7V)8HdeaaaaaaaaqGdF(ZhoqaaaaaaaaGbp8C(5NJbg8aaaaaaayWJF))VFyGbpaaaa
  20. G"aaaaaaag8WdgaaaaaaW))))))F(WdF())))))daaaaapMjKqMXdaaaaa)))))pCM92BMd)
  21. G"))))paa4HdAidEmZmZ4baaaaaa8yMzMXdg(HbgaaaaaaWpZ8dmWadCWdoaaaaaa83y)n2y
  22. G"JD25MdmaaaaayGX28CopBJbgaaaaaaaGado((Jp4adiaaaaaaiGbo4J)(4GbcaaaaaaayW
  23. G"JFyGbg(XdgaaaaaaGzMzMzMzgaMzgaaaaaa832BV9EBSXgBaaaaaaFgdgoSzSXSHddgZha
  24. G"aaaaaaaaaaG)(7paaaaaaGbp(Hbgy4hpy4haaaaayWJFyGbgyGbgaaaaaaagyGbgyGHF8G
  25. G"baaaaaaaaayWG)mGbaaaaaaaaaaaamG5pyWaaaaaaaaaaaaaaWadS)aaaaaaaaaaaaOWM)
  26. G"SHcaaaaaaaaaaabo4WhF(7paaaaaaaaa(7pF8HdoqaaaaaaaaaaaaaaaaaaaaaaaaaaayW
  27. G"dp8GbgaGbgaaaaayMzMrcaaaaaaaaaaaaaaWgB(ZgBS5pBSbaaaGbg8zSWaZNbgAmFyGba
  28. G"aaaaaiSXmGbmMzmaaaaaaGdBSHJDCZmZ2baaaaamWadyaaaaaaaaaaaaaaadyadmWadmyW
  29. G"aaaaaaaadgmWadmWagWaaaaaaaaaGz88ppMbaaaaaaaaaaaGbg(Hbgaaaaaaaaaaaaaaaa
  30. G"aGbgyadaaaaaaaaaa4paaaaaaaaaaaaaaaaaaaaayGbaaaaaaiGbmGbmGbmGaaaaaaaa8z
  31. G"SXg7S32BUXgBmFaaag4GhgyGbgyGbgy4haaWNXgyGdCGdCGdSX(daa8zSbgyGp(yGbgymF
  32. G"aaadCWdBm7V)mWadm4baa4pWadm)gyGbgySX8baa4agWaZV)gBSXg7pFaaG)gBadyadmWa
  33. G"dmWadaaWNXgBS785UXgBSX8baa8zSXg7VFgyGboWd(aaaayGbaaaagyaaaaaaaaaagyaaa
  34. G"aGbgWaaaaaaagWagWagmyWGbaaaaaaaaaaGFaaGFaaaaaaaaaagmyWGbmGbmGbaaaaaa8z
  35. G"SXmGbgyGbgaGbgaaaFgBS3E7n3aZhaaaaaaaboSXgB8XgBSXM7gdaa8BMzMzgFMzMzMzg)
  36. G"aaapMjmWadmWadSWMZhaaGpBMzMzMzMzMzMB8daa(BMyGbgA4HgyIzM)aaG)MjgyGHgEOb
  37. G"gyGbpaaWJzcdmWoBSWclS5(baagBSXgBSX(BSXgBSXaaapyGbgyGbgyGbgyWdaa4bdmWad
  38. G"mWaJmYi)8baaMBgBSHhE4XgBMzM5aaa8GbgyGbgyGjMyM5paayS7(7V1gBSXgBSXgdaagB
  39. G"S527V3oBSXgBSXaaaoSzSXgBSXgBS7SHdaaWVzMzMzMXhyGbgyWdaa8zSXgBS1E7pFm4Gd
  40. G"aaa)MzMz8XMzMzMzMzoaaWNXgdgomyGbgBS)8baa(5NwyGbgyGbgyGbpaaGXgBSXgBSXgB
  41. G"SXgZhaaySXgBSXg7oBSHdoqaaagBSXgBT1(ZhBSXgBaaGXgZgk4Gdo4GcBgBmaayMzMzgp
  42. G"yGbgyGbg8aaa(BmJyadyadmWclS)aaapWadmWadmWWdaaaaaaaiWGdhoC4Gbcaaaaaaa8W
  43. G"admWadmWapaaaaqGdBgdaaaaaaaaaaaaaaaaaaaaaaaaaaaaW)aadmyaaaaaaaaaaaaaaa
  44. G"aaaaaaaEmWhZmZmZm7haaaoyGHhBMzMzMzMz8baaaaaa8zmWadmWaBmFaaahmWad8XmZmZ
  45. G"mZ8ZhaaaaaaWNXg7pWalSX(daa4WgzGbg8GbgyGbg8aaaaaaGDmZmZ8Xad8JhaaaoyGXMD
  46. G"MzMzMzMzMdaayGba4GbgyGbgyGbpaaGbgaGdgyGbgyMz(XdaaiUzMzgB4XMzMzMzMdaa4G
  47. G"bgyGbgyGbgyGbpaaaaaaa7(BT1wBSXgBmaaaaaaWTzMzMzMzMzMbaaaaaa8zSXgBSXgBmF
  48. G"aaaaaaa3MzMz8bgyGbpaaaaaayhZmZmFmWGhEaaaaaaaCBNzGbgyGbg8aaaaaaaFgdpEC4
  49. G"GbgZhaaabmWWpmWadmWaJnCaaaaaaamZmZmZmZmZSDaaaaaaGzMzMzMzgp8GbaaaaaaySX
  50. G"wBT)SXgBSbaaaaaagZgk4GdoOWMXaaaaaaGXgBSX(zGd(Zpaaaaaa4pZyaJz(daaaaaaoG
  51. G"bgyahgyGHdaaaaaaagyGbgaGbgyGbaaaaaaahgyGHdyGbgWbaaaaaa2Xnaaaaaaaaaaaaa
  52. G"aaaaaaboSzSX(daaaaaaaWJzcdmWcBgpmyaFaaaamZmamZmZmZSDaaaaaWagWaaFg7pWgZ
  53. G"haaaaaqGdBaGhd8XmZ2baaaaaamZma4XaFmZSDaaaaaagmyaaEmWhZmBhaaaaa4WgoaGhd
  54. G"8XmZ2baaaaaaaaapMbMz8WGb8aaaaaboSbaFg7pWgZhaaaaaaWmZaWNX(dSX8baaaaayWG
  55. G"ba8zS)aBmFaaaaaaGzMbaoyGbgyWdaaaaayWJzaGdgyGbg8aaaaaayWGba4GbgyGbpaaaa
  56. G"aySXqGdBgBS)gBmaaaaoSHda4WMXg7VXgdaaaGbmGbG)MbgFGzM)aaaaaaaaaWSD24h2y7
  57. G"gaaaaaa4dBmZS)mZmZodaaaaae4Wga8zSXgBmFaaaaaaGXgdaFgBSXgZhaaaaaGbdgaWNX
  58. G"gBSX8baaaaam4XmamZmZmZSDaaaaaagmyaaZmZmZmBhaaaaaaySXaySXgBSFgWaEaaGXgJ
  59. G"dBgBSXgZgoaaaaaySXaySXgBSXgZhaaaaayGbpMbgyMXdgyaaaaaaoSrgyWdgyGzo)aaaa
  60. G"aaGzMXdg(HHFyGbaaaaa4ZmZ4tmZEZmZgdaaaaGdBGbgy4hgyGbgydhaaGbmGbaEmWhZmB
  61. G"haaaaamGbmaGdgyGbg8aaaaaagWaga8zSXgBmFaaaaaGbmGbaZmZmZmBhaaaaaayh3aWTz
  62.  
  63. G"MzMzMbaaayh3ayS527V3oBSXaaaaaWdBS5da(baaaaaaaaaa4WgB4aaFaaaaaaaaaaaaWa
  64. G"daWadygBmFaaaaaaaaaaaa(dmWadaaaaaaaaaaaaG)gyGbaaaaaaaWaBmZyddyCBidy4da
  65. G"aamWgZm2WyMZE6JbgaaaaGbgaGbg8WdpyaaaaaaaaaGnSHnB2aaaaaaaaaaaaGnB2Wg2aa
  66. G"aaaaqeefbrrqueefbrrqueevLQvPAvQwLQvPAvQwLQDFx3319DDFx3319DDFhgyGbgyGbg
  67. G"yGbgyGbgyGbgyGbgyGb(yGbgyGbgyGbgyGb(yGpgyGbgyGHn2yJn2yJn2BJn2yJn2aaaaa
  68. G"aaaaG)2yJn2yJnaaaaaaa(yGpgyGbgyGHn2yJn2yVb2BJn2yJn2yJn2yJn2yJn2yJn2yJn
  69. G"aaaaaaG)gyVn2yJn2yJn2yJn2yVb(daaaaaaayJn2yJn2yJ)aaaaaaaayGbgyGb(yGpaaa
  70. G"aaaaaaaaaaaaaa4JbgyGbgyGbgyGbgyGXhaaaaaaaayGbgyGbgy8paaaaaaaaaaaaaaaaa
  71. G")JbgyGbgyGbgyGbgyGXhyGbgyGbgaaaaaaaaa8paaaaaaaagyGbgyGbg)JbgyGbgyGbgyG
  72. G"bgFGXhyGbgyGbg2yJn2yJn2CJn2yJn2yJn2yJn2Cdm)aaaaaaaaaaaaaaa)aZn2yJn2yJn
  73. G"2yJn2yZ9a8paaaaaaaaaaaaaa8pa3BJn2yJn2yJn2yJn3aZn2yJn2yJnaaaaaaW)a8paaa
  74. G"aaaaGn2yJn2Cpa3BJn2yJn2GbgyGbg)dW)aaaaaaaa2yJn2yJn28paaaaaaaaaaaaaa8pa
  75. G")JbgyGbgyaaaaaaaaaW)2yJn2yJn2yJn2yJn28daaaaaaaagyGbgy8bgFaaaaaaaaaaaaa
  76. G"aaFGXhyGbgyGbgaaaaaaaaa8Jn2yJn2yJn2yJn2yJn)BJn2yJn2GbgyGbg)JX)yGbgyGbg
  77. G"yGbgyGbgyGpaaaaaaaaaaaaaaaaaFGbgyGbgy8))))))))))))))))))aaaaaaaaa8))))
  78. G"))))p8Wdp8Wdp8Wdp8Wdp8W)Wdp8Wdp8Wdp8Wdp8Wd)))))))))daaaaaaaaaaaaaaayh3
  79. G"yJn32baaaaaaaaaFgZVXgZpWadeaaaG)gBmWadmWadmaaaaaaaaa(ZgBSXgBSbaaaaaa(B
  80. G"myWGbmGzS)aaaaaaaaaaGFyJn2ydhaaaaaaaaaMzMzMXhyGbmaaaaaaaGDCJbgyGbgaaaa
  81. G"aaGFyWJzMzgpy4haaaaaaGdBgBS)gBmB4aaaaaaa4WMXgBmBSXM7aaaaaaGhWGbd(yMzMX
  82. '>>> Continued on Page 2
  83.  
  84. --- Maximus 2.01wb
  85.  * Origin: The MOCHINE BBS * Irving, TX * 214/399-8414 * HST DS *
  86. (1:124/1301)
  87.  
  88.  
  89.  
  90. ════════════════════════════════════════════════════════════════════════════════
  91.  Area:    QuickBasic
  92.   Msg:    #11182
  93.  Date:    02-24-93 22:52 (Public)
  94.  From:    EARL MONTGOMERY
  95.  To:      ALL
  96.  Subject: Fancy Fonts Part two
  97. ────────────────────────────────────────────────────────────────────────────────
  98. ' Part two of two. Fancy fonts for Fontgen.Bas. See header part one.
  99. '>>> Start of Page 2.
  100. G"daaaaaaaaaa432B7haaaaaaaaadyGFBV98(bgWaaaaaaahWagy8bgyWWbaaaaaaaaFgBSX
  101. G"gBSXgdaaaaaaa4paa4paa4paaaaaaaaayGHFyGbaa8paaaaaaadgmyadyada(baaaaaamG
  102. G"bmGbdgmaGFaaaaaaGdBSbgyGbgyGbgyGbgyGbgyGbgyGn2WbaaaaaaaGbga4hayGbaaaaa
  103. G"aaaaayh3ayh3aaaaaaaa4WgB4aaaaaaaaaaaaaaaaaaaaGbgaaaaaaaaaaaaaaaaaGbaaa
  104. G"aaaaaapWadmWadSZgpCaaaaaa2SXgBSXgaaaaaaaaaaah2WagY4daaaaaaaaaaaaaa8XhF
  105. G"8XhFaaaaaaaaaaaaaaaaaaaaaaaa"
  106. N=3591:K=255:IF LEN(C$)<>4788 THEN ?"Incomplete script file!":BEEP:END
  107. FOR A=1 TO N:LOCATE 1:?STRING$(50*(A/N),177):IF L=0 THEN GOSUB G:L=6
  108. W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND K):PUT 1,,B$:NEXT
  109. ?:IF C<>34 THEN ?"Bad checksum!":BEEP:END ELSE ?"Success!":END
  110. G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C\256+(C AND 255):RETURN
  111. SUB G(A$):SHARED C$:C$=C$+LEFT$(A$,70):END SUB
  112. 'end of part two of two
  113.  
  114. --- Maximus 2.01wb
  115.  * Origin: The MOCHINE BBS * Irving, TX * 214/399-8414 * HST DS *
  116. (1:124/1301)
  117.  
  118.  
  119.  
  120. ════════════════════════════════════════════════════════════════════════════════
  121.  Area:    QuickBasic
  122.   Msg:    #11855
  123.  Date:    02-24-93 16:26 (Public)
  124.  From:    CHRIS TRACY
  125.  To:      ALL
  126.  Subject: Scroll v1.0 - 1/1
  127. ────────────────────────────────────────────────────────────────────────────────
  128. Well... This is a little routine i wrote to scroll an array on the screen...
  129. It's quite fast, even though it uses PRINT and locate and all that fun
  130. stuff... The original version used PrtScrn, an ASM routine from the Q4T
  131. library, but i adapted it to use PRINT... Basically, you set the screen
  132. location (you just define a box) and colors and the array and the ending key,
  133. and it will scroll very nicely for just about any number of elements (up to
  134. 32766, which is BASIC's limitations anywaz, well... depening on a few
  135. things...)... It is very handy for scrolling like an ASCII chart for
  136. instance... Note, I wrote this TO scroll an ascii chart, and of course, print
  137. messed up the control characters... So, if you use an optional PRINT
  138. statement, it will print the REAL ASCII code (like PDQPrint, PrintQ, or
  139. PrtScrn)... Oh well, here it is! Enjoy!
  140.  
  141.  Part one of SCROLL.BAS...
  142. ________O_/________________________| SNIP |______________________\_O_______
  143.         O \                        | HERE |                      / O
  144.  
  145. DECLARE SUB Scroll (Arry$(), Elements%, UpR%, Brw%, LfC%, Rgc%, Fore%,_
  146.  Back%, EndCode$)
  147.  
  148. SUB Scroll (Arry$(), Elements%, UpR%, Brw%, LfC%, Rgc%, Fore%, Back%,
  149. EndCode$)
  150. DEFINT A-Z
  151. '
  152. ' Scroll v1.0 - By Chris Tracy
  153. ' QBS Publishing - SURE!!! Yes!!!
  154. '
  155. ' Arry$()        - This is the array (of type STRING) to be scrolled.
  156. '                  NOTE: The first element MUST be 0.
  157. ' Elements%      - The number of elements to use.
  158. ' Upr%           - The upper row (1-25) to scroll on.
  159. ' Brw%           - The bottom row (1-25) to scroll on.
  160. ' Lfc%           - The left column (1-80) to scroll on.
  161. ' Rgc%           - The right column (1-80) to scroll on.
  162. ' Fore%          - The foreground color of the text to be scrolled.
  163. ' Back%          - The background color of the text to be scrolled.
  164. ' EndCode$       - This is the ending code's code to use. Use it like this:
  165. '                  Scroll Arry$(), 130, 1,25,1,79,7,0,CHR$(27)
  166. '                  The CHR$(27) would make ESCape the ending code. To use
  167. '                  another character, for instance, the F1 key is
  168. '                  CHR$(0) + ";" so just use that instead of CHR$(27).
  169. '
  170. ' This source code is released into the public domain. You can use it in
  171. ' any of your programs for free, I don't care...
  172. '
  173. LOCATE , , 0                                      ' Turn the cursor OFF!
  174. GOSUB Update:                                     ' This updates the list...
  175. DO
  176.         WHILE LEN(I$) = 0: I$ = INKEY$: WEND      ' Wait for a key
  177.         SELECT CASE I$                            ' What was it?
  178.         CASE CHR$(0) + "G"                        ' Must be HOME ...
  179.                 ElementToStart% = 0                    ' Reset starting
  180.                 Num = 0                                ' points and update
  181.  
  182.                 GOSUB Update:                          ' the scroll
  183.         CASE CHR$(0) + "O"                        ' Or maybe END ...
  184.                 ElementToStart% = Elements% - (Brw% - UpR%) ' set the start
  185.                 Num = Elements%                             ' point to the
  186.                 GOSUB Update:                         ' last ones & update
  187.         CASE CHR$(0) + "Q"                        ' PGDN ...
  188.                 ElementToStart% = ElementToStart% + (Brw% - UpR%)
  189.                 IF ElementToStart% + (Brw% - UpR%) > Elements% THEN
  190.                         Num = Elements% - (Brw% - UpR%)
  191.                         ElementToStart% = Elements% - (Brw% - UpR%)
  192.                 END IF
  193.                 GOSUB Update:
  194.                 IF ElementToStart% <> 0 THEN
  195.                         Num = Num + (Brw% - UpR%)
  196.                 END IF
  197.         CASE CHR$(0) + "I"                        ' PGUP ...
  198.                 ElementToStart% = ElementToStart% - (Brw% - UpR%)
  199.                 IF ElementToStart% < 0 THEN
  200.                         Num = 0
  201.                         ElementToStart% = 0
  202.                 END IF
  203.                 GOSUB Update:
  204.                 IF ElementToStart% <> 0 THEN
  205.                         Num = Num - (Brw% - UpR%)
  206.                 END IF
  207.         CASE CHR$(0) + "P"                         ' Down arrow key
  208.                 ElementToStart% = ElementToStart% + 1
  209.                 IF ElementToStart% + (Brw% - UpR%) > Elements% THEN
  210.                         ElementToStart% = ElementToStart% - 1
  211.                         GOTO Repeat:
  212.                 END IF
  213.                 GOSUB Update:
  214.  
  215. Continued on next message...
  216.  
  217. --- T.A.G. 2.6d Standard
  218.  * Origin: DangerBase ][ Programming Staff 412-438-4101 (1:2615/4@FIDONET.ORG)
  219.  
  220.  
  221.  
  222. ════════════════════════════════════════════════════════════════════════════════
  223.  Area:    QuickBasic
  224.   Msg:    #11856
  225.  Date:    02-24-93 16:40 (Public)
  226.  From:    CHRIS TRACY
  227.  To:      ALL
  228.  Subject: Scroll v1.0 - 2/2
  229. ────────────────────────────────────────────────────────────────────────────────
  230. ' Heres the second part of Scroll v1.0 - note... On the first one, i put
  231. ' 1/1 as the subejct... Sorry! I thought it was less than 90 lines! ;)
  232.  
  233. Part 2 of SCROLL.BAS - continued from last message...
  234.  
  235.                 Num = Num + 1
  236.         CASE CHR$(0) + "H"                         ' Up arrow key
  237.                 ElementToStart% = ElementToStart% - 1
  238.                 IF ElementToStart% < 0 THEN
  239.                         ElementToStart% = ElementToStart% + 1
  240.                         GOTO Repeat:
  241.                 END IF
  242.                 GOSUB Update:
  243.                 Num = Num - 1
  244.         CASE EndCode$                              ' The ender key!
  245.                 GOTO Ender:
  246.         END SELECT
  247. Repeat:
  248.         I$ = ""      ' This resets I$, which is what the WHILE..WEND uses.
  249.         LOOP
  250.         GOTO Ender:  ' Something else must've happened...
  251. Update:
  252.         ' This is the updater for the scroller.
  253.         ' It redisplays the current elements.
  254.         FOR Show = 0 TO Brw% - UpR%
  255.                 LOCATE UpR% + Show, LfC%
  256.                 COLOR Fore%, Back%
  257.                 PRINT MID$(Arry$(ElementToStart% + Show), 1, Rgc% - LfC%)_
  258.  + STRING$((Rgc% - LfC%) - LEN(MID$(Arry$(ElementToStart% + Show), 1, Rgc%_
  259.  - LfC%)), " ")
  260.                 'Uncomment the following line an comment the above 3 if
  261.                 'you want to use Q4t's PrtScrn (much faster).
  262.                 'PrtScrn MID$(Arry$(ElementToStart% + Show), 1, Rgc% -_
  263.  LfC%) + STRING$((Rgc% - LfC%) - LEN(MID$(Arry$(ElementToStart% + Show),_
  264.  1, Rgc% - LfC%)), " "), UpR% + Show, LfC%, Fore% + 16 * Back%
  265.  ' Combine the above 2 lines (yes, its a REM statement, but...)
  266.         NEXT Show
  267.         RETURN  ' Give control to the other part of the SUB...
  268. Ender:
  269.         END SUB
  270.  
  271.  
  272. ________O_/________________________| SNIP |______________________\_O_______
  273.         O \                        | HERE |                      / O
  274.   Line wrapping and message splitted accomplished by MsgSplit 2.00,
  275. a Victor Yiu and Scott Wunsch creation.
  276.  
  277. --- T.A.G. 2.6d Standard
  278.  * Origin: DangerBase ][ Programming Staff 412-438-4101 (1:2615/4@FIDONET.ORG)
  279.  
  280.  
  281.  
  282. ════════════════════════════════════════════════════════════════════════════════
  283.  Area:    QuickBasic
  284.   Msg:    #12565
  285.  Date:    02-25-93 10:07 (Public)
  286.  From:    CHARLES GRAHAM
  287.  To:      ALL
  288.  Subject: A puzzle for you
  289. ────────────────────────────────────────────────────────────────────────────────
  290. 'PUZZLE.BAS - EGA or better required
  291. '
  292. 'Assume the Earth's circumference at the Equator is 25,000
  293. 'miles. You run a piece of string around the Equator so the
  294. 'ends of the string meet exactly. The string is 25,000 miles
  295. 'long.
  296. '
  297. 'You add 1 foot to the length of the string. If the now
  298. '25,000-mile-plus-1-foot long string could be suspended evenly
  299. 'above the Equator, how far off the ground would the string
  300. 'be?
  301. '
  302. 'No tricks. Just math and logic.
  303. '
  304. SCREEN 9
  305. CIRCLE (320, 175), 200, 2, 0, 6.28
  306. CIRCLE (320, 175), 225, 15, 0, 6.28
  307. PAINT (320, 175), 2, 2
  308. LOCATE 13, 31
  309. COLOR 12
  310. PRINT "Polar view of Earth";
  311. LOCATE 1, 1
  312. PRINT "String =========================>";
  313. LOCATE 2, 1: PRINT "is"; : LOCATE 3, 1: PRINT "suspended";
  314. LOCATE 4, 1: PRINT "evenly"; : LOCATE 5, 1: PRINT "above";
  315. LOCATE 6, 1: PRINT "the"; : LOCATE 7, 1: PRINT "Equator.";
  316. LOCATE 13, 13: PRINT "<->"; : LOCATE 11, 1: PRINT "How";
  317. LOCATE 12, 1: PRINT "far"; : LOCATE 13, 1: PRINT "is";
  318. LOCATE 14, 1: PRINT "this"; : LOCATE 15, 1: PRINT "distance";
  319. LOCATE 16, 1: PRINT "if"; : LOCATE 17, 1: PRINT "string";
  320. LOCATE 18, 1: PRINT "is"; : LOCATE 19, 1: PRINT "a";
  321. LOCATE 20, 1: PRINT "foot"; : LOCATE 21, 1: PRINT "longer";
  322. LOCATE 22, 1: PRINT "than"; : LOCATE 23, 1: PRINT "Earth's";
  323. LOCATE 24, 1: PRINT "circumference?";
  324. DO
  325.     a$ = INKEY$
  326. LOOP UNTIL LEN(a$)
  327. SCREEN 0
  328. END
  329.  
  330.  
  331. --- QM v1.30
  332.  * Origin: QwikCom * St Charles MO * 16.8K HST/V32b (1:100/602.0)
  333.  
  334.  
  335.  
  336. ════════════════════════════════════════════════════════════════════════════════
  337.  Area:    QuickBasic
  338.   Msg:    #12658
  339.  Date:    02-25-93 22:30 (Public)
  340.  From:    CASEY PEARSON
  341.  To:      ALL
  342.  Subject: SUPERDIR.BAS
  343. ────────────────────────────────────────────────────────────────────────────────
  344. Someone asked if there was a Directory program in BASIC, well here is
  345. one that was developed a while back, but still works wonders!
  346. WARNING: this is a program that was released by IBM for demonstration
  347.          purpose and is shown here for the same reason, to use it for
  348.          profit or other means, you BETTER contact IBM first!!!
  349.  
  350. 100 'Super Directory for the IBM Personal Computer
  351. 110 'for monochrome or color adaptor,80 columns
  352. 120 SCREEN 0,0,0:WIDTH 80:COLOR 0,4,8:CLS:DEFINT A-Z:KEY OFF:FOR I=1 TO 10:KEY
  353. 130 CR$=CHR$(17)+CHR$(196)+CHR$(217)
  354. 140 PRINT "Welcome to ";:COLOR 15:PRINT "Super Directory":COLOR 0
  355. 150 'Remove the word REM from following line for automatic use with drive A
  356. 160 REM DRIVE$="A:":FSPEC$="A:*.*":GOTO 200
  357. 170 PRINT:PRINT "Select Drive: (";:COLOR 16,15:PRINT"A B";:COLOR 7,0:PRINT
  358. CHR$
  359. 180 DRIVE$=INKEY$+":":A=ASC(DRIVE$):IF (A OR 32)<97 OR (A OR 32)>98 THEN 180
  360. 190 DRIVE$=CHR$(A AND 223)+":":FSPEC$=DRIVE$+"*.*"
  361. 200 GOSUB 5000:CLS:COLOR 16:PRINT"Reading description file"
  362. 210 DIM D$(ENTRIES):FOR I=0 TO ENTRIES:D$(I)=CHR$(9)+"--" :NEXT
  363. 220 ON ERROR GOTO 310
  364. 230 OPEN DRIVE$+"DESCR.DIR" FOR INPUT AS #1
  365. 240 LINE INPUT #1,DISKNAME$:LINE INPUT#1,A$:NUMREC=VAL(A$)
  366. 250 FOR ITEMS=0 TO NUMREC
  367. 260   LINE INPUT #1,F$:LINE INPUT#1,D$
  368. 270   FOR I=0 TO ENTRIES
  369. 280     IF F$=F$(I) THEN D$(I)=D$
  370. 290      NEXT:NEXT
  371. 300 GOTO 320
  372. 310 RESUME 320
  373. 320 CLOSE#1:ON ERROR GOTO 0
  374. 330 PAGES=INT(ENTRIES/10)
  375. 340 CURR=0
  376. 350 START=CURR*10:FINISH=START+9:IF FINISH>ENTRIES THEN FINISH=ENTRIES
  377. 360 CLS:COLOR 0,4,8:PRINT STRING$(80,32):LOCATE 1,2:PRINT"Super
  378. Directory";TAB(
  379. 370 FOR I=START TO FINISH
  380. 380 COLOR 0,15:PRINT "F";LEFT$(MID$(STR$(1+I-START),2)+" ",2);:COLOR
  381. 15,4:PRINT
  382. 390 NEXT
  383. 400 LOCATE 25,1:COLOR 15,4:PRINT"Press ";:COLOR 0,15:PRINT"F1";:COLOR
  384. 15,4:PRIN
  385. 410 LOCATE 23,32:PRINT"Page #";CURR+1;"of ";PAGES+1
  386. 420 A$=INKEY$:IF A$="" THEN 420
  387. 430 IF A$<>CHR$(27) THEN 540
  388. 440 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:PRINT"  1.Exit to BASIC  2. Exit
  389. 450 A$=INKEY$:IF A$<"1" OR A$>"5" THEN 450
  390. 460 ON VAL(A$) GOTO 470,480,490,500:GOTO 350
  391. 470 COLOR 0:CLS:END
  392. 480 SYSTEM
  393. 490 RUN
  394. 500 ON ERROR GOTO 510:GOSUB 1000:GOTO 350
  395. 510 BEEP:LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:COLOR 31:PRINT"Can't save
  396. de
  397.  
  398. 520 IF INKEY$<>CHR$(13) THEN 520
  399. 530 RESUME 350
  400. 540 IF A$=CHR$(0)+CHR$(81) THEN CURR=-(CURR+1)*(CURR<PAGES):GOTO 350
  401. 550 IF A$=CHR$(0)+CHR$(73) THEN CURR=CURR-1:CURR=CURR-(PAGES+1)*(CURR<0):GOTO
  402. 3
  403. 560 A=ASC(MID$(A$+"0",2))-59:IF A<0 OR A>FINISH-START THEN BEEP:GOTO 420
  404. 570 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:PRINT"Press ";CR$;" to run
  405. progra
  406. 580 LOCATE 3+A*2,5:COLOR 31:PRINT F$(START+A);:COLOR 15
  407. 590 A$=INKEY$:IF A$<>CHR$(13) AND A$<>CHR$(27) AND A$<>CHR$(32) THEN 590
  408. 600 IF A$=CHR$(27) THEN LOCATE 3+A*2,5:PRINT F$(START+A);:GOTO 400
  409. 610 IF A$<>CHR$(32) THEN 670
  410. 620 IF DISKNAME$="" THEN LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:LINE
  411. INPUT;"
  412. 630 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:Z=START+A:PRINT "Description
  413. :";D
  414. 640 LOCATE 25,1:PRINT SPACE$(79);:BEEP:COLOR 31:LOCATE 25,1:PRINT"Cannot save
  415. d
  416. 650 A$=INKEY$:IF A$<>"y" AND A$<>"Y" AND A$<>"n" AND A$<>"N" THEN 650
  417. 660 IF A$="y" OR A$="Y" THEN RESUME 680 ELSE RESUME 350
  418. 670 ON ERROR GOTO 640:GOSUB 1000
  419. 680 ON ERROR GOTO 690:COLOR 0:CLS:RUN DRIVE$+F$(START+A)
  420. 690 LOCATE 25,1:PRINT SPACE$(79):COLOR 16:BEEP:PRINT"Cannot run ";F$(A);".
  421. ";:
  422. 700 IF INKEY$<>CHR$(13) THEN 700
  423. 710 RESUME 350
  424. 720 END
  425. 1000 'Save descriptions to disk
  426. 1010 OPEN DRIVE$+"DESCR.DIR" FOR OUTPUT AS #1
  427. 1020 PRINT#1,DISKNAME$;CHR$(13);ENTRIES;CHR$(13);
  428. 1030 FOR I=0 TO ENTRIES:PRINT#1,F$(I);CHR$(13);D$(I);CHR$(13);:NEXT
  429. 1040 CLOSE #1:ON ERROR GOTO 0:RETURN
  430. 1050 '
  431. 5000 'This subroutine reads disk directory into a string array
  432. 5010 'Enter with FSPEC$, the file spec for the FILES command
  433. 5020 'Exits with array F$, and NUMFILES, the number of files
  434. 5030 'uses a temporary array,TT$, which is ERASEd after use
  435. 5040 '
  436. 5050 DEF SEG=0:WIDTH 80
  437. 5060 HEAD=1050:TAIL=1052:BUFFER=1054
  438. 5070 CLS:COLOR 16,4,4:PRINT"Reading disk directory"
  439. 5080 COLOR 4:ON ERROR GOTO 5100
  440. 5090 FILES FSPEC$:ON ERROR GOTO 0:GOTO 5110
  441. 5100 BEEP:COLOR 31:CLS:PRINT"Cannot read directory":COLOR 4:ON ERROR GOTO
  442. 0:END
  443. 5110 DIM TT$(24):LOCATE 3,1:COLOR 4:ROWS=0
  444. 5120 'Put code for End, Enter into keyboard buffer:
  445. 5130 POKE HEAD,30:POKE TAIL,34:POKE BUFFER,0:POKE BUFFER+1,79:POKE
  446. BUFFER+2,13:
  447. 5140 LINE INPUT TT$(ROWS)
  448. 5150 IF TT$(ROWS)<>"" THEN ROWS=ROWS+1:GOTO 5130
  449. 5160 IF NOT DIMMED THEN DIM F$(ROWS*4-1):DIMMED=1
  450. 5170 ROWS=ROWS-1
  451.  
  452. 5180 FOR I=0 TO ROWS
  453. 5190  FOR J=0 TO 3
  454. 5200    T$=MID$(TT$(I),J*18+1,12)
  455. 5210    IF T$<>"" THEN F$(ENTRIES)=T$:ENTRIES=ENTRIES+1
  456. 5220 NEXT J
  457. 5230 NEXT I
  458. 5240 ERASE TT$:ENTRIES=ENTRIES-1
  459. 5250 DEF SEG:RETURN
  460.  
  461. ... ■ SLMR 2.1a ■ Nothing is so smiple that it can't get screwed up.
  462.  
  463.  
  464. --- DCQwk/T.A.G.  1.5a
  465.  * Origin: The Abacus * HST/DS * Potterville MI (1:159/100)
  466.  
  467.  
  468.  
  469. ════════════════════════════════════════════════════════════════════════════════
  470.  Area:    QuickBasic
  471.   Msg:    #3685
  472.  Date:    02-25-93 22:31 (Public)
  473.  From:    ROB MCKEE
  474.  To:      ZACK JONES
  475.  Subject: RE-BOOT
  476. ────────────────────────────────────────────────────────────────────────────────
  477. --> Note:
  478. Moved (from: NETMAIL) by Rob McKee using timEd.
  479.  
  480. Hello Zack!
  481.    You wrote to Rob Mckee:
  482.  
  483.  RM> ' Warm Reboot
  484.  
  485.  ZJ> Neat little routine.  Here's an idea for a program I've
  486.  ZJ> thought about writing Using a routine like yours to reboot
  487.  ZJ> the machine - but also have it check to see how many times
  488.  ZJ> it's rebooted.  I used to have Front Door exit with an
  489.  ZJ> errorlevel that called BOOT.COM if it couldn't initialize
  490.  ZJ> the modem - well that normally worked until one day when it
  491.  ZJ> got hung really bad - FD sat in a Boot...Can't initialize
  492.  ZJ> modem....Boot loop for about 2 hours - lots of unwanted wear
  493.  ZJ> and tear on the ole 'puter.  Anyway - it'd be nice to have a
  494.  ZJ> program that can reboot the system a set number of times.
  495.  ZJ> Interested in working on one?  Here's a very rough flow
  496.  ZJ> chart:
  497.  
  498.  ZJ> 1 -Open a file and write the number of times the system has
  499.  ZJ> been booted    (eg 1)
  500.  ZJ> 2 - reboot
  501.  ZJ> 3 - modem hung still - FD exits calling reboot
  502.  ZJ> 4 - check file to get number of times rebooted if greater
  503.  ZJ> than 3 don't     reboot the machine - blank the screen so we
  504.  ZJ> don't burn anyhing in     to the monitor.
  505.  
  506.  ZJ> Whatta ya say - wanna write one?
  507.  
  508.  |---------| Slash Here |-------------8<------------>8-----------------|
  509.  
  510.  DECLARE SUB Boot (ColdBoot%)
  511.  
  512.  DEFINT A-Z
  513.  BBSDir$ = ENVIRON$(UCASE$(RTRIM$(COMMAND$)))
  514.  ' Uses any Enviroment Variable that points to a Directory
  515.  ' I use my %BINK% variable
  516.  IF RIGHT$(BBSDir$, 1) <> "\" THEN BBSDir$ = BBSDir$ + "\"
  517.  CountFile$ = BBSDir$ + "Booted.cnt"
  518.  OPEN CountFile$ FOR BINARY AS 1
  519.  DO
  520.  LOOP UNTIL INKEY$ = ""
  521.  CurrentTime$ = TIME$      ' Get alittle fancy
  522.      La = LOF(1)
  523.      IF LOF(1) THEN
  524.          a$ = SPACE$(La)
  525.          Nu$ = ""
  526.          GET #1, , a$
  527.          FOR t = 1 TO La       ' Keep it compatible with QB And PDS
  528.   pa = ASC(MID$(a$, t, 1))
  529.             SELECT CASE pa
  530.  
  531.                 CASE 48 TO 57
  532.                     Nu$ = Nu$ + CHR$(pa)
  533.             END SELECT
  534.          NEXT
  535.          booted = VAL(Nu$)
  536.      ELSE
  537.          Booted = 0
  538.      END IF
  539.      IF booted > 3 THEN
  540.         CLS
  541.         CLOSE
  542.         KILL CountFile$     ' This Makes Booted = 0
  543.         RANDOMIZE TIMER   ' Brain dead routine to have the Message Hop
  544.  DO
  545.             r! = RND(TIMER) * 25! + 1   ' around the screen
  546.             c% = FIX(RND(TIMER) * 50! + 1)
  547.             IF FIX(RND(8) * 25) = 20 THEN
  548.                 LOCATE r2 + 1, c2 + 1, 0
  549.                 PRINT SPACE$(29);
  550.                 LOCATE FIX(r!), c%, 0
  551.                 PRINT "Boot Failed At " + CurrentTime$;
  552.                 r2 = FIX(r!) - 1
  553.                 c2 = c% - 1
  554.             END IF
  555.          LOOP WHILE INKEY$ = ""
  556.      ELSE
  557.          a$ = "Booted " + STR$(Booted + 1) + " Times" + CHR$(13) + CHR$(10)
  558.        PUT #1, 1, a$
  559.          CLOSE
  560.          Boot 0
  561.      END IF
  562.  END
  563.  
  564.  SUB Boot (ColdBoot)
  565.      DEF SEG = 0
  566.      IF NOT ColdBoot THEN
  567.          POKE &H473, &H12
  568.          POKE &H472, &H34
  569.      END IF
  570.      DEF SEG = &HFFFF
  571.      CALL Absolute(0)
  572.  END SUB
  573.  
  574.  
  575.  |---------| Slash Here |-------------8<------------>8-----------------|
  576.  
  577.  Kludgy but it works...  Didn't feel like writing the boot into a Function.
  578.  
  579.      SysOp 1:125/411 PVT - Rob
  580.  
  581. --- timEd/B6
  582.  
  583.  
  584.  
  585. --- Squish v1.01
  586.  * Origin: Flyer_Proof_Computer_Svs,Richmond_CA,MO,V32B (1:125/411)
  587.  
  588.  
  589.  
  590. ════════════════════════════════════════════════════════════════════════════════
  591.  Area:    QuickBasic
  592.   Msg:    #3687
  593.  Date:    02-25-93 23:55 (Public)
  594.  From:    ROB MCKEE
  595.  To:      OWEN GIBBINS
  596.  Subject: DIRECTORIES 1/3
  597. ────────────────────────────────────────────────────────────────────────────────
  598. Hello Owen!
  599.    You wrote to All:
  600.  
  601.  OG> In BASIC, how do you get a list all the files and
  602.  OG> subdirectories in the current directory. I know there's the
  603.  OG> FILES command, but how do you store every
  604.  OG> filename/subdirectory name in a variable. Also, I don't want
  605.  OG> to have to shell to DOS.
  606.  
  607. In QB45 or PDS:
  608.  
  609.     ' $DYNAMIC
  610.     TYPE RegTypeX
  611.         ax       AS INTEGER
  612.         bx       AS INTEGER
  613.         cx       AS INTEGER
  614.         dx       AS INTEGER
  615.         bp       AS INTEGER
  616.         si       AS INTEGER
  617.         di       AS INTEGER
  618.         flag     AS INTEGER
  619.         ds       AS INTEGER
  620.         es       AS INTEGER
  621.     END TYPE
  622.     TYPE DFileType
  623.         Fname       AS STRING * 12
  624.         FDate       AS STRING * 8
  625.         FTime       AS STRING * 8
  626.         cattr       AS STRING * 7
  627.         DSize       AS STRING * 10
  628.         DSlack      AS INTEGER
  629.         attribute   AS INTEGER
  630.     END TYPE
  631.     TYPE FileType
  632.         Fname    AS STRING * 12
  633.         year        AS INTEGER
  634.         month       AS INTEGER
  635.         day         AS INTEGER
  636.         FDate       AS STRING * 10
  637.         hour        AS INTEGER
  638.         minute      AS INTEGER
  639.         second      AS INTEGER
  640.         FTime       AS STRING * 8
  641.         attribute   AS INTEGER
  642.         Size        AS LONG
  643.     END TYPE
  644.     TYPE DiskSizeType
  645.         Drive   AS INTEGER
  646.         TotCl   AS LONG
  647.         AvaCl   AS LONG
  648.         SecCl   AS LONG
  649.         SecSz   AS LONG
  650.         CluSz   AS LONG
  651.  
  652.         free    AS LONG
  653.         Total   AS LONG
  654.         Used    AS LONG
  655.     END TYPE
  656.     DECLARE FUNCTION GoodFileName$ (FilName$)
  657.     DECLARE SUB GetDiskSize (DkSz AS DiskSizeType, UsPath$)
  658.     DECLARE SUB GetFileData (dta$, File AS FileType)
  659.     DECLARE SUB KillFile (FilName$, FilAttribute%, Result%)
  660.     DECLARE SUB findfirstfile (Path$, dta$, Result%)
  661.     DECLARE SUB FindNextFile (dta$, Result%)
  662.     DECLARE SUB SetFileAttribute (UsPath$, FilName$, FilAttribute%, Result%)
  663.  
  664.     CONST false = 0, true = NOT false, Move = 1, Normal = 2,_
  665.     ReadOnly = 4,_
  666.     Hidden = 8, Archive = 16, EveryThing = 30, DelFileInt21h = &H4100,_
  667.     MoveFilePointerInt21h = &H4200,_
  668.     SetDTAInt21h = &H1A00,_
  669.     GetDTAInt21h = &H2F00, GetDiskFreeSpaceInt21h = &H3600
  670.  
  671.     DIM RegX AS RegTypeX, File AS FileType, DkSz AS DiskSizeType, _
  672. kf$(200), ka%(1 TO 200)
  673.     Get2Parm InFile$, OutFile$, UsPath$, Parm%
  674.     DIM att(5) AS STRING * 1
  675.     att(0) = "R": att(1) = "H": att(2) = "S": att(3) = "L": _
  676.     att(4) = "D": _
  677.     att(5) = "A"
  678.     findfirstfile FileSpec$, dta$, Result%
  679.  
  680.  '>>> Continued Next Message
  681.  
  682. --- timEd/B6
  683.  * Origin: Flyer_Proof_Computer_Svs,Richmond_CA,MO,V32B (1:125/411)
  684.  
  685.  
  686.  
  687. ════════════════════════════════════════════════════════════════════════════════
  688.  Area:    QuickBasic
  689.   Msg:    #3688
  690.  Date:    02-26-93 00:11 (Public)
  691.  From:    ROB MCKEE
  692.  To:      OWEN GIBBINS
  693.  Subject: DIRECTORIES 2/3
  694. ────────────────────────────────────────────────────────────────────────────────
  695. Hello Owen!
  696.    You wrote to All:
  697.  
  698. '>>> Continued from Previous
  699.  
  700.  SUB findfirstfile (Path$, dta$, Result%)
  701.     DIM reg AS RegTypeX
  702.     thePATH$ = Path$ + CHR$(0)
  703.     reg.ax = &H2F00
  704.     CALL INTERRUPTX(&H21, reg, reg)
  705.     segm% = reg.es
  706.     ofst% = reg.bx
  707.     dta$ = SPACE$(43)
  708.     reg.ax = SetDTAInt21h '&H1A00
  709.     reg.ds = VARSEG(dta$)
  710.     reg.dx = SADD(dta$)
  711.     CALL INTERRUPTX(&H21, reg, reg)
  712.     reg.ax = &H4E00
  713.     reg.cx = 255
  714.     reg.ds = VARSEG(thePATH$)
  715.     reg.dx = SADD(thePATH$)
  716.     CALL INTERRUPTX(&H21, reg, reg)
  717.     Result% = reg.flag AND 1
  718.     reg.ax = SetDTAInt21h '&H1A00
  719.     reg.ds = segm%
  720.     reg.dx = ofst%
  721.     CALL INTERRUPTX(&H21, reg, reg)
  722.  END SUB
  723.  
  724.  SUB FindNextFile (dta$, Result%) STATIC
  725.     DIM reg AS RegTypeX
  726.     SHARED thePATH$
  727.     IF LEN(dta$) <> 43 THEN Result% = 2: EXIT SUB
  728.     reg.ax = &H2F00
  729.     CALL INTERRUPTX(&H21, reg, reg):
  730.     segm% = reg.es:
  731.     ofst% = reg.bx
  732.     reg.ax = SetDTAInt21h '&H1A00
  733.     reg.ds = VARSEG(dta$): reg.dx = SADD(dta$):
  734.     CALL INTERRUPTX(&H21, reg, reg)
  735.     reg.ax = &H4F00:
  736.     reg.cx = 251:
  737.     reg.ds = VARSEG(thePATH$):
  738.     reg.dx = SADD(thePATH$)
  739.     CALL INTERRUPTX(&H21, reg, reg)
  740.     Result% = reg.flag AND 1
  741.     reg.ax = SetDTAInt21h '&H1A00
  742.     reg.ds = segm%: reg.dx = ofst%
  743.     CALL INTERRUPTX(&H21, reg, reg)
  744.  END SUB
  745.  
  746.  SUB GetDiskSize (DkSz AS DiskSizeType, UsPath$)
  747.     DIM reg AS RegTypeX
  748.  
  749.     reg.ax = &H3600
  750.     i% = INSTR(UsPath$, ":")
  751.     IF i% > 0 THEN
  752.         D$ = MID$(UsPath$, i% - 1, 1)
  753.         IF D$ < "A" OR D$ > "Z" THEN
  754.             DkSz.Drive = false
  755.         ELSE
  756.             DkSz.Drive = ASC(D$) - 64
  757.         END IF
  758.     ELSE
  759.         DkSz.Drive = false
  760.     END IF
  761.     reg.dx = DkSz.Drive
  762.     CALL INTERRUPTX(&H21, reg, reg)
  763.     IF reg.ax < 0 THEN DkSz.SecCl = reg.ax + 65536 ELSE DkSz.SecCl = reg.ax
  764.     IF reg.bx < 0 THEN DkSz.AvaCl = reg.bx + 65536 ELSE DkSz.AvaCl = reg.bx
  765.     IF reg.cx < 0 THEN DkSz.SecSz = reg.cx + 65536 ELSE DkSz.SecSz = reg.cx
  766.     IF reg.dx < 0 THEN DkSz.TotCl = reg.dx + 65536 ELSE DkSz.TotCl = reg.dx
  767.     DkSz.CluSz = DkSz.SecCl * DkSz.SecSz
  768.     DkSz.free = DkSz.AvaCl * DkSz.CluSz
  769.     DkSz.Total = DkSz.TotCl * DkSz.CluSz
  770.     DkSz.Used = DkSz.Total - DkSz.free
  771.  END SUB
  772.  
  773.  SUB GetFileData (dta$, File AS FileType) STATIC
  774.     File.attribute = ASC(MID$(dta$, 22, 1))
  775.     File.Size = CVL(MID$(dta$, 27, 4))
  776.     tim& = CVL(MID$(dta$, 23, 2) + STRING$(2, 0))
  777.     File.second = tim& AND &H1F
  778.     File.minute = (tim& \ 32) AND &H3F
  779.     File.hour = (tim& \ 2048) AND &H1F
  780.     File.FTime = RIGHT$(STR$(File.hour), 2) + ":" + RIGHT$("00" +_
  781.  LTRIM$(STR$(File.minute)), 2) + ":" +_
  782.  RIGHT$("00" + LTRIM$(STR$(File.second)),2)
  783.     tim& = CVL(MID$(dta$, 25, 2) + STRING$(2, 0))
  784.     File.day = tim& AND &H1F
  785.     File.month = (tim& \ 32) AND &HF
  786.     File.year = ((tim& \ 512) AND &H1F) + 1980
  787.     File.FDate = RIGHT$(STR$(File.month), 2) + "-" + RIGHT$("00" + _
  788.  LTRIM$(STR$(File.day)), 2) + "-" + RIGHT$("0000" +_
  789.  LTRIM$(STR$(File.year - 1900)), 2)
  790.     f$ = MID$(dta$, 31) + CHR$(0)
  791.     File.Fname = LEFT$(f$, INSTR(f$, CHR$(0)) - 1)
  792.  END SUB
  793.  
  794.  '<<< Continued in Next Message
  795.  
  796.      SysOp 1:125/411 PVT - Rob
  797.  
  798. --- timEd/B6
  799.  * Origin: Flyer_Proof_Computer_Svs,Richmond_CA,MO,V32B (1:125/411)
  800.  
  801.  
  802.  
  803. ════════════════════════════════════════════════════════════════════════════════
  804.  Area:    QuickBasic
  805.   Msg:    #3689
  806.  Date:    02-26-93 00:13 (Public)
  807.  From:    ROB MCKEE
  808.  To:      OWEN GIBBINS
  809.  Subject: DIRECTORIES 3/3
  810. ────────────────────────────────────────────────────────────────────────────────
  811. Hello Owen!
  812.    You wrote to All:
  813.  
  814.  '<<< Continued from Previous Message
  815.  
  816.  FUNCTION GoodFileName$ (FilName$)
  817.     FiName$ = LTRIM$(RTRIM$(FilName$))
  818.     j% = INSTR(FiName$, " "): g% = j%
  819.     DO WHILE INSTR(FiName$, " ")
  820.         MID$(FiName$, j%, 1) = "."
  821.         DO
  822.             i% = INSTR(g% + 1, FiName$, " ")
  823.             IF i% <> 0 THEN
  824.                 IF i% - 1 > g% THEN EXIT DO ELSE g% = i%
  825.             ELSE
  826.                 EXIT DO
  827.             END IF
  828.         LOOP
  829.         FiName$ = MID$(FiName$, 1, j%) + MID$(FiName$, g% + 1)
  830.         j% = INSTR(FiName$, " "): g% = j%
  831.     LOOP
  832.     GoodFileName$ = UCASE$(FiName$)
  833.  END FUNCTION
  834.  
  835.  SUB KillFile (FilName$, FilAttribute%, Result%)
  836.     DIM reg AS RegTypeX
  837.     IF FilAttribute% AND 16 THEN Result% = 2: EXIT SUB
  838.     IF FilAttribute% AND 1 THEN Result% = 3: EXIT SUB
  839.     FiName$ = GoodFileName$(FilName$) + CHR$(0)
  840.     reg.ds = VARSEG(FiName$):
  841.     reg.ds = VARSEG(FiName$):
  842.     reg.dx = SADD(FiName$):
  843.     reg.ax = DelFileInt21h
  844.     CALL INTERRUPTX(&H21, reg, reg)
  845.     Result% = reg.flag AND 1
  846.  END SUB
  847.  
  848.  SUB SetFileAttribute (UsPath$, FilName$, FilAttribute%, Result%) STATIC
  849.     DIM reg AS RegTypeX
  850.     IF FilAttribute% AND 16 THEN Result% = 2: EXIT SUB
  851.     reg.ax = &H4301:
  852.     reg.cx = FilAttribute%
  853.     FiName$ = GoodFileName$(UsPath$ + FilName$) + CHR$(0)
  854.     reg.ds = VARSEG(FiName$):
  855.     reg.ds = VARSEG(FiName$):
  856.     reg.dx = SADD(FiName$):
  857.     CALL INTERRUPTX(&H21, reg, reg)
  858.     Result% = reg.flag AND 1
  859.  END SUB
  860.  
  861.  '||| That's All folks!!!
  862.  
  863.      SysOp 1:125/411 PVT - Rob
  864.  
  865.  
  866. --- timEd/B6
  867.  * Origin: Flyer_Proof_Computer_Svs,Richmond_CA,MO,V32B (1:125/411)
  868.  
  869.  
  870.  
  871. ════════════════════════════════════════════════════════════════════════════════
  872.  Area:    QuickBasic
  873.   Msg:    #7616
  874.  Date:    03-15-93 16:27 (Public)
  875.  From:    BOB PERKINS
  876.  To:      EARL MONTGOMERY
  877.  Subject: Change Directory
  878. ────────────────────────────────────────────────────────────────────────────────
  879.  EM> I am writing a little program for my own use and I need to know
  880.  EM> how to change directories using interrupts. I tried INT 21
  881.  EM> function 3B but I guess I don't know enough about interrupts as
  882.  
  883.   Here you go Earl:
  884.  
  885.  '$INCLUDE: 'qb.bi'
  886.  'Set Current Directory  Interrupt 21h, Function 3Bh
  887.  '
  888.  DIM regsx AS regtypex
  889.  'if you include a drive letter, the current directory is switched for that
  890.  'drive but the default drive remains unchanged.
  891.  newdir$ = "\squish" + CHR$(0)   'ASCIZ pathname
  892.  regsx.ax = &H3B00
  893.  regsx.ds = VARSEG(newdir$)
  894.  regsx.dx = SADD(newdir$)
  895.  interruptx &H21, regsx, regsx
  896.  IF regsx.flags AND 1 THEN PRINT "Error!"
  897.  
  898.  
  899.  
  900. --- Msg V4.5
  901.  * Origin: Reciprocity Failure  (1:124/4115.236)
  902.  
  903.  
  904.  
  905. ════════════════════════════════════════════════════════════════════════════════
  906.  Area:    QuickBasic
  907.   Msg:    #7797
  908.  Date:    03-13-93 22:59 (Public)
  909.  From:    JOHN GALLAS
  910.  To:      CALVIN FRENCH
  911.  Subject: Badly Needed! Bin2string
  912. ────────────────────────────────────────────────────────────────────────────────
  913. CF>relatively FAST decimal 2 binary function, as well as a binary 2
  914. CF>decimal function to go with it. The binary function needs to be
  915. CF>put in a string ($), so that I can deal with it. I'm not just
  916. CF>'too lazy' to write it, the fact is that I don't think I could
  917.  
  918. A while ago someone posted a program to do all kinds of convertions,
  919. bin2int, bin2hex, int2bin, etc.  Unfortunatly, I don't have the authors
  920. name who wrote this little beauty -- (If you're reading this Mr Author,
  921. can you please reply so I can put your name with the file?) -- I hope it
  922. helps!
  923.  
  924.  
  925. DEFINT A-Z
  926.  
  927. DECLARE FUNCTION Bin2Hex$ (Bin$)
  928. DECLARE FUNCTION Bin2Int% (Bin$)
  929. DECLARE FUNCTION Hex2Bin$ (Hcs$)
  930. DECLARE FUNCTION Hex2Int% (Hcs$)
  931. DECLARE FUNCTION Int2Bin$ (Dec%)
  932. DECLARE FUNCTION Int2Hex$ (Dec%)
  933.  
  934. DEFSNG A-Z
  935. FUNCTION Bin2Hex$ (Bin$)
  936.  
  937.    Bin2Hex$ = Int2Hex$(Bin2Int%(Bin$))
  938.  
  939. END FUNCTION
  940.  
  941. FUNCTION Bin2Int% (Bin$)
  942.    FOR y = LEN(Bin$) TO 1 STEP -1
  943.       IF MID$(Bin$, y, 1) = "1" THEN ax% = ax% + (2 ^ z)
  944.       z = z + 1
  945.    NEXT
  946.    Bin2Int% = ax%
  947. END FUNCTION
  948.  
  949. FUNCTION Hex2Bin$ (Hcs$)
  950.    Hcs$ = UCASE$(Hcs$)
  951.    lc = LEN(Hcs$)
  952.    FOR x = 1 TO lc
  953.       SELECT CASE MID$(Hcs$, x, 1)
  954.          CASE "0"
  955.             Out$ = Out$ + "0000"
  956.          CASE "1"
  957.             Out$ = Out$ + "0001"
  958.          CASE "2"
  959.             Out$ = Out$ + "0010"
  960.          CASE "3"
  961.             Out$ = Out$ + "0011"
  962.          CASE "4"
  963.             Out$ = Out$ + "0100"
  964.          CASE "5"
  965.             Out$ = Out$ + "0101"
  966.  
  967.          CASE "6"
  968.             Out$ = Out$ + "0110"
  969.          CASE "7"
  970.             Out$ = Out$ + "0111"
  971.          CASE "8"
  972.             Out$ = Out$ + "1000"
  973.          CASE "9"
  974.             Out$ = Out$ + "1001"
  975.          CASE "A"
  976.             Out$ = Out$ + "1010"
  977.          CASE "B"
  978.             Out$ = Out$ + "1011"
  979.          CASE "C"
  980.             Out$ = Out$ + "1100"
  981.          CASE "D"
  982.             Out$ = Out$ + "1101"
  983.          CASE "E"
  984.             Out$ = Out$ + "1110"
  985.          CASE "F"
  986.             Out$ = Out$ + "1111"
  987.       END SELECT
  988.    NEXT
  989.    Hex2Bin$ = Out$
  990. END FUNCTION
  991.  
  992. FUNCTION Hex2Int% (Hcs$)
  993.  
  994.    Hcs$ = UCASE$(Hcs$)
  995.    Hex2Int% = Bin2Int%(Hex2Bin$(Hcs$))
  996.  
  997. END FUNCTION
  998.  
  999. FUNCTION Int2Bin$ (Dec%)
  1000.    tdec% = Dec%
  1001.    DO WHILE tdec% > 0
  1002.       IF tdec% / 2 = tdec% \ 2 THEN
  1003.          Bin$ = "0" + Bin$
  1004.       ELSEIF tdec% / 2 <> tdec% \ 2 THEN
  1005.          Bin$ = "1" + Bin$
  1006.       END IF
  1007.       tdec% = tdec% \ 2
  1008.    LOOP
  1009.    Int2Bin$ = Bin$
  1010. END FUNCTION
  1011.  
  1012. FUNCTION Int2Hex$ (Dec%)
  1013.    Int2Hex$ = HEX$(Dec%)
  1014. END FUNCTION
  1015.  
  1016.  * OLX 2.1 TD * *'M ST*P*D - I'd like to buy a vowel Pat, an 'O'
  1017.  
  1018. --- Maximus 2.01wb
  1019.  * Origin: Command Line BBS =Mpls. MN= V.32bis [612-788-6685] (1:282/2007)
  1020.  
  1021.  
  1022.  
  1023.  
  1024. ════════════════════════════════════════════════════════════════════════════════
  1025.  Area:    QuickBasic
  1026.   Msg:    #9490
  1027.  Date:    03-16-93 21:35 (Public)
  1028.  From:    EARL MONTGOMERY
  1029.  To:      ALL
  1030.  Subject: VGACLIP (TSR)
  1031. ────────────────────────────────────────────────────────────────────────────────
  1032. Permission granted to post this. It contains a TSR to capture any 320
  1033. *200*256 graphics screen in BSAVE format along with the original
  1034. palettes. No seperate palette data files! The saved screens can then
  1035. be BLOADED back into your own QB programs. See the following two
  1036. messages: Basic loader and small doc file.
  1037. CLS:?STRING$(50,178):DEFINT A-Z 'Created by PostIt! v5.1
  1038. Y$="*+,-./":FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "B",1,"VGACLIP.EXE
  1039. T$="abcdefghijklmnopqrstuvwxyz":T$=T$+UCASE$(T$)+"0123456789()
  1040. G"nPfIbK*zbaiaGga))pib*bqdm*icaE,e*caq9aSd,r,Cb+ug
  1041. G",D,6b+qi,M,Xc+yl+GW,hd+mn,2,Hd+O
  1042. G"o+W8-e+Kq+qfb+Ke+0s+Gob+cf+8u+qvb+Ff+
  1043. G"Ww+WEb+bg+Sy,Mb+Ig+WA+qTb+Kh+yF+W(b,i*
  1044. G"auG+Gcc+ti+GH+q*icaAaGiamcaI*maCca4aWjaieaNaGyaCcaGaG
  1045. G"laihaUaGFa4caLaGn*ca5aqmaKdabcqoaKia5aGtaieaQbGqa4baGcaC*ka4b
  1046. G"aOambaOcWiaKkaBdGqaeCacbG4bieaVhGqaySacbWIdieaw*Ra8baScqnaWkaG
  1047. G"baRamhaScqlaml*bWSaqba3caCaClakaqWaubacdqnaimaL*ZaycaodGd*na
  1048. G"x*0aWbavd///////,
  1049. G"/////////
  1050. G"///////+GySz1rbnetj
  1051. G"bfi*GKb+M///d//8))acbUW*u4A*
  1052. G"qPjdaCca4A*qPjWeieaJQ*HQ*JY*hBGda8cc4YfaqPjdaWka4A*qPjdaWk
  1053. G"aHY*JaCDdKEAaOP*ydaqPjcaimaqHly*LMo*OamcW1nq6)*Um*u4A*qP
  1054. G"PdcieaJcbaHcbaJkbaJaCDdKEeaGRz*LMm*RaOzvaicaP7*46haqPjdaWkaA
  1055. G"wfaIaq6o*UqcauAY*ScGMvbGiaGRT*LMm*RaGR4*LMm*RaGlebaLMm*R
  1056. G"aGRpbafUu*uAY*N*Uu*uAQ*PcWOy*Uu*uAY*(cqOyaWiax3aP7*Aka
  1057. G"aU*UofauAY*ScaUo*u4A*qPjWaieaP3maAk*cbW)gOba)BJgaOjcaClaqP
  1058. G"PcamlaqHlh*LMmaWjaGlEbafUC*uAs*OcqUcaWkihfUW*uAc*bdauAI*5
  1059. G"*u4ccaqPjdaCca4ccaqHlh*LMiaqo*fUcgauAI*5*u4ccaqPjdaCca4c6R
  1060. G"qPzea8ja6E8aZaS7Pxba6M8aSdd5l6bja4ObQgGjiEqOK*qJsca98Va(noU*k
  1061. G"uAgbaFcaUG*uZamu4Yq)ZinuAQ*UaGMmaWNaOP*4caAUcacbGMPhGqaGRb*
  1062. G"LMEbGqaOzvaic/*4UnaoInJgWAa67i08cfc7tlmnhYOUgaJaVlybSc20
  1063. G"QuZHSB9a44WMSOhcaGJdBYIoicadgSclY(kHNOjXgGhhWOhQgWVSpqUOaWmaZ)8
  1064. G"RovUWaquldkSbqltnhsvlYUvxTOFgKOpypWI2HWImmop7Y(a7mVCwm4WmTZ839G
  1065. G"MgaW0a8VDiOjda4laR)YvbfKMkaq1aG1G5lGDHS6I2HWI0jqkoyAab4aPbKus)B
  1066. G"d2dOjda4laj(qI)jW8K(LxDPmb*qv4EGdndrxlx1ISpi7bD1XgGC+WIgPqJw
  1067. G"9RMeaq2aqlpYKCZHSl*iNtlI9V4gWIxFuOQgWQlAecRUOrgSku5E*0cuZHKLC
  1068. G"V4HJEOAalAfc0cuZH8HCGStWZvGXgGCa9SW20raT(0Ci)BNcAQ*mdWxlwExkBa
  1069. G"aA6*ldW6IB1vE4ObSgGjk6aGait7(giaMOib8acDeWtc1nGrIlVbAQ*qdWbJJ
  1070. G"GbmITJa)X8KU4WF8Lxlx1ISB1vlAhclsWI(zWIvymb)BCb)RPda4maiwbIeSiYd
  1071. G"O84nfuqAQ*vdWvlAhclsNal6Nbl2Naj6J2d81G5lGCVKyhP4GPbeGdKgqsjD0r
  1072. G"j(qI)jqu7eSDcSyWlI88KM1kiVt02jWIrVOYlAJ2dmpPlo8)2HGMk*Za8VDgOP
  1073. G"caWmaF5vxkt+mdW5yG0buhiocSjHcjaMSOhscWOshqIEqDa6BYXgajalbGjm6
  1074. G"GKaS)YZaCogiDa0DHJaVi2hAG0bCOhuhG(MmkKaysIEija7VmuEG72a4i2hBaYb
  1075. G"CeaFGLma)mavTi7lANblsNa3tHUGfqOSgWkqFSbZgW))tBmGcBanhY)))))))))
  1076. G")))))))))))))))))))))))))))))))))))))))))))))))))d/.
  1077. G"//aqvlYUvx5YG(Wja)thchBaYbahaRlX)2zGMatGqaCSbihWBaS
  1078. G"aW0zWxE1LYe*JoWdbl6fcl(Hli6rVa4cI(4lalAebUmkSaSOrcuW*4YOUcGdF
  1079. G"qlnnhsIEOkamAaRa4WbWIWV(bGUyma6NgaSq8RHaOBLdGoNba7e)Qia6U6aOhza
  1080. G"WsXVocGUbpa6ggaSw8RKaO71dG(Eba7f)Aja6kbbOdxaWgYVAcGUOqa6LfaSL8R
  1081. G"NaOlweGUwbaRj)kka6IhbO)uaWIYVMcGUysa6efaSj8RGaORAdGEobyXhhBaYba
  1082. G"*Pl0)UySb7cW)7ZjutfLuvz1vEyGlmAHSa4sIMqla4UnaoI9G(mB*qxm67i0l
  1083. G"AsSbSFVqHaTr1Cij6XSbOjNfieaU8VlUcWGetGMaxGqaOVloAHSa4YIMqla7FWh
  1084. G"F5vxAL1wy1PlgBWU*WWvTi7w5XIEHWIFSW20jGJB7Oh8qWma7iWZMGVccGUQna
  1085.  
  1086. G"6YcGCbnlc(6ha6IXaOxkaYrZSq4RHaOBLdGoMai3jZoHVkcGURoa6lcGCAmlf(6
  1087. G"ia6g8aO7haY1WSw4RKaO71dGECam3b4c*FSovqo7f(Aja6kbbO3faYX(SH4RMa
  1088. G"OlkeGouai33ZwIVEcGUyra6dbGCspRj(kka6IhbOBdaYv8SO4RPaOlMeGEkaihU
  1089. G"F8VDi8VDgOPbfiea9+0Dk(E1LYe*u0wtZHKyhmwKayrBjnhYWdYZ)1ja(dlZ
  1090. G")rpE0JBYoxq3a5VE8mITj7CKa1v)IeSitcOVjjEGjj(Ka7J7))NibjsKaRd9(Ua
  1091. G"Op)c*0nKla6ZUa8FDi4IXg8l*S(mUaOp6c*1TIht5sXEOk*(daB9bDi4cG(
  1092. G"Wla)xheUySb)c*C6Y)E4haOFK)p7I)o8la67Y)U4ha7df5G5Iog0la11aTc0Sf
  1093. G"K8Gl6yGVaqNby5Y)UiiaAAybcbGlgBWVaibwpZPl(BGUa4Y)EyiaC6I)oOlaDUV
  1094. G"Yc*NU4Vb6cGl)7HIaWPl(7GUa05(kl*C6I)gOlaU8VhocaNU4Vd6cqN7RS*W
  1095. G"jG8daDeWde1TX(nJcu(tSl(BGUaWPl)7HKaWPl(7GUa0jw0vU(U4Vb6cGl)7HKa
  1096. G"WPl(7GUa05(kl*C6I)gOlaU8VhwcaNU4Vd6cqN7RS*WjG8dqDoqltUySb8c*
  1097. G"D6Y)UOj*Ypd39UlgBaVa8FN7ZPl)7HMa4IXgWl*OS*WPl(BGUa4Y)E4jaC6Y
  1098. G"JgyladsSaU4Vd6cGl)BJTa05YC6I)gOlaU8VhIcaNU8Ob4cWGelGl(7GUa4Y)2G
  1099. '>> Continued on pg. 2
  1100.  
  1101. --- Maximus 2.01wb
  1102.  * Origin: Rabbit and Snake's BBS - Richardson, Texas (1:124/6108)
  1103.  
  1104.  
  1105.  
  1106. ════════════════════════════════════════════════════════════════════════════════
  1107.  Area:    QuickBasic
  1108.   Msg:    #9491
  1109.  Date:    03-16-93 21:40 (Public)
  1110.  From:    EARL MONTGOMERY
  1111.  To:      ALL
  1112.  Subject: Part two VGACLIP.EXE (TSR
  1113. ────────────────────────────────────────────────────────────────────────────────
  1114. ' See header part one:
  1115. '>> Start: pg. 2
  1116. G"laDU8(UaOp)c*1zG(U8VlMcGla6ZUa8pDY7IXg8l*WPl)7HPaG(58)mavTi7w
  1117. G"D1IEzWI3jWG(mB*uNa3tb6dcWIqZi2c5OW7iCDumdWlENad6ZSbaqDcCpfF5vx
  1118. G"kl*lENal6)IpmVP1P9IcV(3au1IStBunhYul6fclEXcsxNamQTJcBYIEWAa0cv
  1119. G"ZHKl*Goma4iWMSJhbaqDjaKJatBsnhICtG(kamx6ok8IEzGjl(LaMC)f3h9w0c
  1120. G"vZHSyWDPmbamLb0kvZHyYIh5)O(qWbBnShH6dboInG(+Av3a5)XWdyW+KnJ
  1121. G"6db4VU8KhMIGZaGMhMIeVoaMhM(WcI5GS)YamOpwh*1HdTV0Cij6bqeWObcraT
  1122. G"r1Cij6H1bSOhSgaTq1CilpOpwh*0rHhZS9HEyDa0cvZHuSfaraTA0CiFSmJEOA
  1123. G"alx1ISVOrgmQQb0LYcaqvlYoUb*u)Bhc)BNbAscaGcqxkt*vTi7wDf)ECWIgP
  1124. G"WI2zWIuSiDcOeEWSOFiSydl2Nal(ns4LZa4VcY2ndRY7ADUSJYYPYcsthdwDvul
  1125. G"Q88MM1xEvh6RS)Ih)VDiOPcaWma)BNbAQ*mdWxE1LYgaWmaVU5vTi7tTOxgS4b
  1126. G")BNbAQ*mdWwDPS*u1ISpi7Vnvus1OvrsRgnhYIgzqJw5RMeaq2amZ25Eca06u
  1127. G"ZHixalT4WAL1wlwExkl*vTi7lAKbqPPqaWka4cCaqPPqaWkahBa0be*DPS*u
  1128. G"1ISVOrgaLMcbaRa0LYcaWXgaDabaWYvTi7hBaYb+l6Lbl(WIxjWIEaDa0cuZH
  1129. G"m3bA6*ldW6jStWZvGXgGCa98VDgOPcaWmaDPS+qvlYUvxTODgSidJtr)lsNa
  1130. G"deVtSQaW0zalGqNaRlG4ZRPc*nalANblsNaZt6IdZ))2zGMk*Za8LxDPS*u1
  1131. G"ISVOrgKPuqPPgaClaDPS*u1ISB1vl6LblAecgBW6daWcaNhdZi99BVb0lkS)oS
  1132. G"(a(U(a5Q*Z8VthnJ03h)IOV4W3h)IyVyXakmmisXcax35lSDDJdOpRpW)1vGth
  1133. G"zmbTS4ZAQ*qdW8KU4WF5vxkt*vTi7wzSbghW)l6LblEWcatxd5hn0lENajsK)
  1134. G"hF+4vxkl*vTi7xTOtiOPc*nalAKbZR6Id)vxkt*vTi7wD1I2zWImOPc*n
  1135. G"aJtXI2zWI0jaR8eMCgWJE3jajFPQ4YV4W)BNbAQ*mdWxE1LYc+qnvusz1vvX
  1136. G"VhhaOpgh*0zKVyhWIwpGfKgWoYpxoTIAa1zWIypWnRhVtoTO)Z0(oYphjlYH9d
  1137. G"haDse96dn0aZpW6b4HPbKIhKgW6JV4dbf08KMYBcSo2D9LxAL1wyTm*6dYbaqD
  1138. G"dmkYbSmavTi7qn1USpqoEzGCqm4WmLJxgChc)BNbAY*(cWwy1LYc+rLlfaSl
  1139. G"7dm4paqNddombIB)USpWuAY*(cqwldLMoaGZamUibfKMkaq1amy(cmhbRKmwlV
  1140. G"4WRMIdMgqaoqAajLuIpK4FcG1YtTibhwqIeSixcCyxcKixcSaW0nqI35)G9*Dg
  1141. G"SyxcK4F(V1Y87XbhBaYb+74GPbyNiA6*fdWooyAa2DXkoyAa74aQbyhbj6aQ
  1142. G"bSOdMgGXgGCao8l2bmGpKgWYaeLvxXVhhSO(lc)ImSiDcmpPi2WxEL1Y/
  1143. G"/////////
  1144. G"akaqdawDuqdXusqbIDX4cmWac8GGYqPasm5KdmGuuyYXgin9MB0D2BTvMC5b*G
  1145. G"bG*qgaVu1eaOgatv3yJv2CMvhBSLhiYvwBVzxzKbGdaiiadfMBU9gDGixzT9MD
  1146. G"LfsiaqjabXMCLfgz5bsAUnhDHXgBLrwiG0ciVufi09gi15gBVfgzaGca6cGvhfe
  1147. G"iZnMCLvMBGmwyWrxDYvgiVzgiZidm4jdmWGNm1ydiJ9gBVj3CPaG5aq1usbcAH5
  1148. G"gzSvMCGKMBJ9MCW9MCHrxzKbIy5bstPngAHvgBGCvzSngAWOcaueGvhf0qmLeuG
  1149. G"8svGq3BGixzT9MDLXciVjhibXevTyfi09giHngDPzxy0v2caiuawDuqtnKuQ4Yq
  1150. G"bbf9MaGubCvyY5wAUDwiGy1rbn1qsPIldfeuGugEPnhDZbYBUbczPn3AHesig*
  1151. G"Fby1rbn1qsr*ggGldfeu/a))F///.G+
  1152. G"//-0p/*c*Xb0Gc-ytnmn0s0e/+"
  1153. N=4488:K=255:IF LEN(C$)<>5984 THEN ?"Incomplete script!":END
  1154. FOR A=1 TO N:LOCATE 1:?STRING$(50/N*A,177):IF L=0 THEN GOSUB G:L=6
  1155. W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND K):PUT 1,,B$:NEXT
  1156. ?:IF C=95 THEN ?"Ok":END ELSE ?"Bad checksum!":END
  1157. G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C\256+(C AND 255):RETURN
  1158. SUB G(A$):SHARED C$,Y$:FOR Q=1 TO 6:DO:S=INSTR(A$,CHR$(Q+41))
  1159. IF S THEN A$=LEFT$(A$,S-1)+STRING$(Q+1,97)+MID$(A$,S+1)
  1160. LOOP WHILE S:NEXT:C$=C$+A$:END SUB
  1161. 'That it folks!
  1162.  
  1163. --- Maximus 2.01wb
  1164.  * Origin: Rabbit and Snake's BBS - Richardson, Texas (1:124/6108)
  1165.  
  1166.  
  1167.  
  1168. ════════════════════════════════════════════════════════════════════════════════
  1169.  Area:    QuickBasic
  1170.   Msg:    #9492
  1171.  Date:    03-16-93 22:05 (Public)
  1172.  From:    EARL MONTGOMERY
  1173.  To:      ALL
  1174.  Subject: Loader program for the VG
  1175. ────────────────────────────────────────────────────────────────────────────────
  1176. SCREEN 0: CLS
  1177. DEFINT A-Z
  1178. INPUT "File Name to load "; N$
  1179. SCREEN 13
  1180. OUT &H3C8, 0
  1181. FOR X = 0 TO 767
  1182. OUT &H3C9, 0
  1183. NEXT
  1184. DEF SEG = &HA000
  1185. BLOAD N$, 0
  1186. DEF SEG = &HA000 + 4000
  1187. OUT &H3C8, 0
  1188. FOR X = 0 TO 767
  1189. P = PEEK(X)
  1190. OUT &H3C9, P
  1191. NEXT
  1192. 999 GOTO 999
  1193.  
  1194.  
  1195. --- Maximus 2.01wb
  1196.  * Origin: Rabbit and Snake's BBS - Richardson, Texas (1:124/6108)
  1197.  
  1198.  
  1199.  
  1200. ════════════════════════════════════════════════════════════════════════════════
  1201.  Area:    QuickBasic
  1202.   Msg:    #10531
  1203.  Date:    03-17-93 16:38 (Public)
  1204.  From:    EARL MONTGOMERY
  1205.  To:      ALL
  1206.  Subject: ELIMDUPE part 1 of 4 part
  1207. ────────────────────────────────────────────────────────────────────────────────
  1208. 'This program finds duplicates in the selected directories and
  1209. 'gives you the oppurtunity to delete. It can also work on just
  1210. 'one directory and allow you to delete files within that
  1211. 'directory. I think it is pretty neat. Try it out.
  1212.  
  1213. '$INCLUDE: 'qb.bi'
  1214. DEFINT A-Z
  1215. DIM f1.nam$(500) 'Make as large as you need
  1216. DIM f2.nam$(500)
  1217. DIM f1.name$(500)
  1218. DIM f2.name$(500)
  1219. drive$ = "C:\"
  1220. ON ERROR GOTO fatalerror
  1221. KEY(10) ON
  1222. ON KEY(10) GOSUB exitroutine
  1223. DIM inregs AS regtypex, outregs AS regtypex
  1224. REM Saving the current directory
  1225. tempdir$ = STRING$(64, " ")
  1226. inregs.es = -1
  1227. inregs.ax = &H4700
  1228. inregs.dx = 0
  1229. inregs.ds = VARSEG(tempdir$)
  1230. inregs.si = SADD(tempdir$)
  1231. CALL interruptx(&H21, inregs, outregs)
  1232. tempdir$ = LEFT$(tempdir$, INSTR(tempdir$, CHR$(0)) - 1)
  1233. restart:
  1234. CLS
  1235. DEF SEG = &HB800
  1236. COLOR 14
  1237. POKE 0, 201
  1238. FOR x = 2 TO 158 STEP 2: POKE x, 205: NEXT
  1239. POKE 158, 187
  1240. FOR x = 160 TO 3880 STEP 160: POKE x, 186: NEXT
  1241. POKE 3840, 200
  1242. FOR x = 3842 TO 4000 STEP 2: POKE x, 205: NEXT
  1243. FOR x = 3998 TO 160 STEP -160: POKE x, 186: NEXT
  1244. POKE 3998, 188
  1245. DEF SEG
  1246. firstinput:
  1247. LOCATE 2, 30: PRINT "Eliminate Dupes"
  1248. LOCATE 3, 28: PRINT "By Earl Montgomery"
  1249. LOCATE 4, 20: PRINT "Written entirely in Quick Basic 4.5"
  1250. LOCATE 6, 15: PRINT "Press <ENTER> at any directory prompt for C:\"
  1251. LOCATE 10, 4: PRINT STRING$(40, " ")
  1252. LOCATE 11, 4: PRINT STRING$(40, " ")
  1253. LOCATE 10, 4: INPUT "Name of first directory"; n1$
  1254. n1$ = UCASE$(n1$)
  1255. path$ = drive$ + n1$ + CHR$(0)
  1256. REM changing directories
  1257. inregs.es = -1
  1258. inregs.ax = &H3B00
  1259. inregs.ds = VARSEG(path$)
  1260. inregs.dx = SADD(path$)
  1261.  
  1262. CALL interruptx(&H21, inregs, outregs)
  1263. IF outregs.ax = 3 THEN GOSUB invaliddirectory1: GOTO firstinput
  1264. GOSUB begin
  1265. secondinput:
  1266. LOCATE 10, 4: PRINT STRING$(40, " ")
  1267. LOCATE 11, 4: PRINT STRING$(40, " ")
  1268. LOCATE 10, 4: INPUT "Name of second directory"; n2$
  1269. n2$ = UCASE$(n2$)
  1270. ' >>>>>>> Continued on next message >>>>>>>
  1271.  
  1272. --- Maximus 2.01wb
  1273.  * Origin: Rabbit and Snake's BBS - Richardson, Texas (1:124/6108)
  1274.  
  1275.  
  1276.  
  1277. ════════════════════════════════════════════════════════════════════════════════
  1278.  Area:    QuickBasic
  1279.   Msg:    #10532
  1280.  Date:    03-17-93 16:41 (Public)
  1281.  From:    EARL MONTGOMERY
  1282.  To:      ALL
  1283.  Subject: ELIMDUPE part 2 of 4 part
  1284. ────────────────────────────────────────────────────────────────────────────────
  1285. Msg#: 2 >>>>>> Continued from last message: ELIMDUPE.BAS >>>>>>>
  1286. path$ = drive$ + n2$ + CHR$(0)
  1287. inregs.es = -1
  1288. inregs.ax = &H3B00
  1289. inregs.ds = VARSEG(path$)
  1290. inregs.dx = SADD(path$)
  1291. CALL interruptx(&H21, inregs, outregs)
  1292. IF outregs.ax = 3 THEN GOSUB invaliddirectory2: GOTO secondinput
  1293. GOSUB lookfordupes
  1294. begin:
  1295.      de1 = 0
  1296.      filespec$ = "*.*" + CHR$(0)
  1297.      inregs.ax = &H2F00
  1298.      CALL interruptx(&H21, inregs, outregs)
  1299.      data.seg = outregs.es
  1300.      data.off = outregs.bx
  1301.      inregs.ax = &H4E00
  1302.      inregs.dx = SADD(filespec$)
  1303.      inregs.ds = -1
  1304.      CALL interruptx(&H21, inregs, outregs)
  1305.      cy = outregs.flags AND 1
  1306.      IF cy = 0 THEN
  1307.      END IF
  1308.      WHILE cy = 0
  1309.      DEF SEG = data.seg
  1310.      f1.name$ = ""
  1311.      i = data.off + 30
  1312.      WHILE PEEK(i) <> 0
  1313.      f1.name$ = f1.name$ + CHR$(PEEK(i))
  1314.      i = i + 1
  1315.      WEND
  1316.      DEF SEG
  1317.      de1 = de1 + 1
  1318.      f1.nam$(de1) = f1.name$
  1319.      inregs.ax = &H4F00
  1320.      CALL interruptx(&H21, inregs, outregs)
  1321.      cy = outregs.flags AND 1
  1322.      WEND
  1323.      IF i = 0 THEN
  1324.      END IF
  1325.      RETURN
  1326. lookfordupes:
  1327. de2 = 0
  1328. filespec$ = "*.*" + CHR$(0)
  1329.      inregs.ax = &H2F00
  1330.      CALL interruptx(&H21, inregs, outregs)
  1331.      data.seg = outregs.es
  1332.      data.off = outregs.bx
  1333.      inregs.ax = &H4E00
  1334.      inregs.dx = SADD(filespec$)
  1335.      inregs.ds = -1
  1336.      CALL interruptx(&H21, inregs, outregs)
  1337.      cy = outregs.flags AND 1
  1338.  
  1339.      IF cy = 0 THEN
  1340.      END IF
  1341.      WHILE cy = 0
  1342.      DEF SEG = data.seg
  1343.      f2.name$ = ""
  1344.      i = data.off + 30
  1345.      WHILE PEEK(i) <> 0
  1346.      f2.name$ = f2.name$ + CHR$(PEEK(i))
  1347.      i = i + 1
  1348. ' >>>>>>> Continued on next message >>>>>>>
  1349.  
  1350. --- Maximus 2.01wb
  1351.  * Origin: Rabbit and Snake's BBS - Richardson, Texas (1:124/6108)
  1352.  
  1353.  
  1354.  
  1355. ════════════════════════════════════════════════════════════════════════════════
  1356.  Area:    QuickBasic
  1357.   Msg:    #10533
  1358.  Date:    03-17-93 16:43 (Public)
  1359.  From:    EARL MONTGOMERY
  1360.  To:      ALL
  1361.  Subject: ELIMDUPE part 3 of 4
  1362. ────────────────────────────────────────────────────────────────────────────────
  1363. 'Msg#: 3 >>>>>> Continued from last message: ELIMDUPE.BAS >>>>>>>
  1364.      WEND
  1365.      DEF SEG
  1366.      de2 = de2 + 1
  1367.      f2.nam$(de2) = f2.name$
  1368.      inregs.ax = &H4F00
  1369.      CALL interruptx(&H21, inregs, outregs)
  1370.      cy = outregs.flags AND 1
  1371.      WEND
  1372.      IF i = 0 THEN
  1373.      END IF
  1374.      IF de1 > de2 THEN endofloop = de1:  ELSE endofloop = de2
  1375.      FOR x = 1 TO endofloop
  1376.      FOR Y = 1 TO endofloop
  1377.      IF f1.nam$(x) = f2.nam$(Y) THEN GOSUB duplicatefound
  1378.      NEXT: NEXT
  1379.      GOTO exitorcontinue
  1380. delete:
  1381. tryagain:
  1382. LOCATE 10, 4: PRINT STRING$(40, " ")
  1383. LOCATE 11, 4: PRINT STRING$(40, " ")
  1384. LOCATE 12, 4: PRINT STRING$(40, " ")
  1385. LOCATE 10, 4: PRINT "(1) "; n1$; : PRINT "          (2) " + n2$
  1386. LOCATE 11, 4: PRINT "Duplicate File Name "; : PRINT f1.nam$(x)
  1387. LOCATE 12, 4: INPUT "From which directory (1 or 2)"; dn
  1388. IF dn = 1 THEN path$ = drive$ + n1$ + CHR$(0)
  1389. IF dn = 2 THEN path$ = drive$ + n2$ + CHR$(0)
  1390. IF dn <> 1 AND dn <> 2 THEN BEEP: GOTO tryagain
  1391. inregs.es = -1
  1392. inregs.ax = &H3B00
  1393. inregs.ds = VARSEG(path$)
  1394. inregs.dx = SADD(path$)
  1395. CALL interruptx(&H21, inregs, outregs)
  1396. KILL temp$
  1397. RETURN
  1398. fatalerror:
  1399. BEEP: CLS
  1400. PRINT "Error is code "; : PRINT ERR
  1401. PRINT "Fatal error returning to DOS"
  1402. SLEEP (2)
  1403. path$ = drive$ + tempdir$ + CHR$(0)
  1404. inregs.es = -1
  1405. inregs.ax = &H3B00
  1406. inregs.ds = VARSEG(path$)
  1407. inregs.dx = SADD(path$)
  1408. CALL interruptx(&H21, inregs, outregs)
  1409. CLS : SCREEN 0: SYSTEM
  1410. duplicatefound:
  1411. LOCATE 10, 4: PRINT STRING$(40, " ")
  1412. LOCATE 11, 4: PRINT STRING$(40, " ")
  1413. LOCATE 12, 4: PRINT STRING$(40, " ")
  1414. IF n1$ = "" THEN LOCATE 10, 4: PRINT "C:\" ELSE LOCATE 10, 4: PRINT n1$;
  1415. IF n2$ = "" THEN LOCATE 10, 20: PRINT "C:\" ELSE LOCATE 10, 20: PRINT n2$
  1416.  
  1417. LOCATE 11, 4: PRINT f1.nam$(x); : LOCATE 11, 20: PRINT f2.nam$(Y)
  1418. temp$ = f1.nam$(x)
  1419. LOCATE 12, 4: INPUT "Delete one of these files"; q$
  1420. q$ = UCASE$(q$): IF q$ = "Y" THEN GOTO delete:  ELSE RETURN
  1421. exitorcontinue:
  1422. CLS
  1423. PRINT "No duplicates found or all duplicates have been processed."
  1424. INPUT "Do you wish to check other directories"; q$
  1425. q$ = UCASE$(q$)
  1426. ' >>>>>>> Continued on next message >>>>>>>
  1427.  
  1428. --- Maximus 2.01wb
  1429.  * Origin: Rabbit and Snake's BBS - Richardson, Texas (1:124/6108)
  1430.  
  1431.  
  1432.  
  1433. ════════════════════════════════════════════════════════════════════════════════
  1434.  Area:    QuickBasic
  1435.   Msg:    #10534
  1436.  Date:    03-17-93 16:45 (Public)
  1437.  From:    EARL MONTGOMERY
  1438.  To:      ALL
  1439.  Subject: ELIMDUPE final part of 4
  1440. ────────────────────────────────────────────────────────────────────────────────
  1441. ' Part 4 of 4 parts: ELIMDUPE.BAS >>>>>>>
  1442. IF q$ = "Y" THEN CLS : GOTO prepareforrestart
  1443. IF q$ = "N" THEN GOTO exitroutine
  1444. GOTO exitorcontinue
  1445. exitroutine:
  1446. path$ = drive$ + tempdir$ + CHR$(0)
  1447. inregs.es = -1
  1448. inregs.ax = &H3B00
  1449. inregs.ds = VARSEG(path$)
  1450. inregs.dx = SADD(path$)
  1451. CALL interruptx(&H21, inregs, outregs)
  1452. CLS : SCREEN 0: SYSTEM
  1453. prepareforrestart:
  1454. FOR x = 0 TO 500
  1455. f1.nam$(x) = ""
  1456. f2.nam$(x) = ""
  1457. f1.name$(x) = ""
  1458. f2.name$(x) = ""
  1459. NEXT
  1460. n1$ = ""
  1461. m2$ = ""
  1462. de1 = 0: de2 = 0
  1463. path$ = ""
  1464. temp$ = ""
  1465. GOTO restart
  1466. invaliddirectory1:
  1467. LOCATE 11, 4
  1468. PRINT "Invalid Directory"
  1469. SLEEP (1)
  1470. RETURN
  1471. invaliddirectory2:
  1472. LOCATE 11, 4
  1473. PRINT "Invalid Directory"
  1474. SLEEP (1)
  1475. RETURN
  1476. ' Msg polishing/splitting was done by MSGSPLIT 1.0, a Victor Yiu creation.
  1477.  
  1478. --- Maximus 2.01wb
  1479.  * Origin: Rabbit and Snake's BBS - Richardson, Texas (1:124/6108)
  1480.  
  1481.  
  1482.  
  1483. ════════════════════════════════════════════════════════════════════════════════
  1484.  Area:    QuickBasic
  1485.   Msg:    #10535
  1486.  Date:    03-17-93 16:47 (Public)
  1487.  From:    EARL MONTGOMERY
  1488.  To:      ALL
  1489.  Subject: Docs for ELIMDUPE.BAS
  1490. ────────────────────────────────────────────────────────────────────────────────
  1491. If you program alot as I do, at the end of the day you have probably
  1492. created quite a few duplicate files. And after several days you
  1493. really have a mess on your hands. For example I have a seperate
  1494. QB source file directory (QBSOURCE). And I am constantly moving
  1495. files back and forth between QBSOURCE and QB45. Well this is where
  1496. ELIMDUPE comes in handy. It will delete these files in a hurry!
  1497. I prefer to use utility programs written in a language I understand,
  1498. provided I have the source code - which you do! I prefer this
  1499. because if I locate a bug I can fix it. And if I decide to add a
  1500. few new features I can do that too.
  1501.  
  1502. Comments: The program is so easy to use this DOC file really isn't
  1503. necessary. However there are a couple of things you need to know.
  1504.  
  1505. #1. You can select the root directory from your hard drive by
  1506.     pressing <ENTER> at any directory prompt.
  1507.  
  1508. #2. When prompted to decide whether or not to delete a file
  1509.     pressing <ENTER> is the same as "N" and takes you to the
  1510.     next duplicate.
  1511.  
  1512. #3. You can also use this program to delete files in only one
  1513.     directory. To do this just enter the same directory name
  1514.     for both selections (directory #1 and directory #2).
  1515.  
  1516. If you find any bugs please let me know! Especially if you have
  1517. fixed them! <smile>.
  1518.  
  1519. Credits: Thanks to Tim Fitzgerald, Dick Dennison and Mike Herbert
  1520.          for their help with the interrupts.
  1521.          Special thanks to Tim Berneman as I hacked some of his
  1522.          interrupt code from BDIR.BAS
  1523.  
  1524. Enjoy Earl
  1525.  
  1526. --- Maximus 2.01wb
  1527.  * Origin: Rabbit and Snake's BBS - Richardson, Texas (1:124/6108)
  1528.  
  1529.  
  1530.  
  1531.