home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / WINER.ZIP / DOS.BAS < prev    next >
BASIC Source File  |  1992-05-13  |  13KB  |  422 lines
  1. '*********** DOS.BAS - demonstrates manipulating files directly using DOS
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6. DECLARE FUNCTION DOSError% ()
  7. DECLARE FUNCTION ErrMessage$ (ErrNumber)
  8. DECLARE FUNCTION LocFile& (Handle)
  9. DECLARE FUNCTION LofFile& (Handle)
  10. DECLARE FUNCTION PeekWord% (BYVAL Segment, BYVAL Address)
  11.  
  12. DECLARE SUB ClipFile (Handle, NewLength&)
  13. DECLARE SUB CloseFile (Handle)
  14. DECLARE SUB FlushFile (Handle)
  15. DECLARE SUB KillFile (FileName$)
  16. DECLARE SUB LockFile (Handle, Location&, NumBytes&, Action)
  17. DECLARE SUB OpenFile (FileName$, OpenMethod, Handle)
  18. DECLARE SUB ReadFile (Handle, Segment, Address, NumBytes)
  19. DECLARE SUB SeekFile (Handle, Location&, SeekMethod)
  20. DECLARE SUB WriteFile (Handle, Segment, Address, NumBytes)
  21.  
  22.  
  23. '$INCLUDE: 'REGTYPE.BI'
  24.  
  25. DIM SHARED Registers AS RegType 'so all can access it
  26. DIM SHARED ErrCode              'ditto for the ErrCode
  27. CRLF$ = CHR$(13) + CHR$(10)     'define this once now
  28.  
  29. COLOR 15, 1                     'this makes the DOS
  30. CLS                             'messages high-intensity
  31. COLOR 7, 1
  32.  
  33.  
  34. '---- Open the test file we will use.
  35. FileName$ = "C:\MYFILE.DAT"     'specify the file name
  36. OpenMethod = 2                  'read/write non-shared
  37. CALL OpenFile(FileName$, OpenMethod, Handle)
  38. GOSUB HandleErr
  39. PRINT FileName$; " successfully opened, handle:"; Handle
  40.  
  41.  
  42. '---- Write a test message string to the file.
  43. Msg$ = "This is a test message." + CRLF$
  44. Segment = SSEG(Msg$)             'use this with BASIC PDS
  45. 'Segment = VARSEG(Msg$)          'use this with QuickBASIC
  46. Address = SADD(Msg$)
  47. NumBytes = LEN(Msg$)
  48. CALL WriteFile(Handle, Segment, Address, NumBytes)
  49. GOSUB HandleErr
  50. PRINT "The test message was successfully written."
  51.  
  52.  
  53. '---- Show how to write a numeric value.
  54. IntData = 1234
  55. Segment = VARSEG(IntData)
  56. Address = VARPTR(IntData)
  57. NumBytes = 2
  58. CALL WriteFile(Handle, Segment, Address, NumBytes)
  59. GOSUB HandleErr
  60. PRINT "The integer variable was successfully written."
  61.  
  62.  
  63. '---- See how large the file is now.
  64. Length& = LofFile&(Handle)
  65. GOSUB HandleErr
  66. PRINT "The file is now"; Length&; "bytes long."
  67.  
  68.  
  69. '---- Seek back to the beginning of the file.
  70. Location& = 1                   'specify file offset 1
  71. SeekMethod = 0                  'relative to beginning
  72. CALL SeekFile(Handle, Location&, SeekMethod)
  73. GOSUB HandleErr
  74. PRINT "We successfully seeked back to the beginning."
  75.  
  76.  
  77. '---- Ensure that the Seek worked by seeing where we are.
  78. CurSeek& = LocFile&(Handle)
  79. GOSUB HandleErr
  80. PRINT "The DOS file pointer is now at location"; CurSeek&
  81.  
  82.  
  83. '---- Read the test message back in again.
  84. Buffer$ = SPACE$(23)            'the length of Msg$
  85. Segment = SSEG(Buffer$)         'use this with BASIC PDS
  86. 'Segment = VARSEG(Buffer$)      'use this with QuickBASIC
  87. Address = SADD(Buffer$)
  88. NumBytes = LEN(Buffer$)
  89. CALL ReadFile(Handle, Segment, Address, NumBytes)
  90. GOSUB HandleErr
  91. PRINT "Here is the test message: "; Buffer$
  92.  
  93.  
  94. '---- Skip over the CRLF by reading it as an integer.
  95. Address = VARPTR(Temp)          'read the CRLF into Temp
  96. Segment = VARSEG(Temp)
  97. NumBytes = 2
  98. CALL ReadFile(Handle, Segment, Address, NumBytes)
  99. GOSUB HandleErr
  100.  
  101.  
  102. '---- Read the integer written earlier, also into Temp.
  103. Address = VARPTR(Temp)
  104. Segment = VARSEG(Temp)
  105. NumBytes = 2
  106. CALL ReadFile(Handle, Segment, Address, NumBytes)
  107. GOSUB HandleErr
  108. PRINT "The integer value just read is:"; Temp
  109.  
  110.  
  111. '---- Append a new string at the end of the file.
  112. Msg$ = "This is appended to the end of the file." + CRLF$
  113. Segment = SSEG(Msg$)            'use this with BASIC PDS
  114. 'Segment = VARSEG(Msg$)         'use this with QuickBASIC
  115. Address = SADD(Msg$)
  116. NumBytes = LEN(Msg$)
  117. CALL WriteFile(Handle, Segment, Address, NumBytes)
  118. GOSUB HandleErr
  119. PRINT "The appended message has been written, ";
  120. PRINT "but it's still in the DOS file buffer."
  121.  
  122.  
  123. '---- Flush the file's DOS buffer to disk.
  124. CALL FlushFile(Handle)
  125. GOSUB HandleErr
  126. PRINT "Now the buffer has been flushed to disk.  ";
  127. PRINT "Here's the file contents:"
  128. SHELL "TYPE " + FileName$
  129.  
  130.  
  131. '---- Display the current length of the file again.
  132. PRINT "Before calling ClipFile the file is now";
  133. Length& = LofFile&(Handle)
  134. GOSUB HandleErr
  135. PRINT Length&; "bytes long."
  136.  
  137.  
  138. '---- Clip the file to be 2 bytes shorter.
  139. NewLength& = LofFile&(Handle) - 2
  140. CALL ClipFile(Handle, NewLength&)
  141. PRINT "The file has been clipped successfully.  ";
  142.  
  143.  
  144. '---- Prove that the clipping worked successfully.
  145. Length& = LofFile&(Handle)
  146. GOSUB HandleErr
  147. PRINT "It is now"; Length&; "bytes long."
  148.  
  149.  
  150. '---- Close the file.
  151. CALL CloseFile(Handle)
  152. GOSUB HandleErr
  153. PRINT "The file was successfully closed."
  154.  
  155.  
  156. '---- Open the file again, this time for shared access.
  157. OpenMethod = 66                 'full sharing, read/write
  158. CALL OpenFile(FileName$, OpenMethod, Handle)
  159. GOSUB HandleErr
  160. PRINT FileName$; " successfully opened in shared mode";
  161. PRINT ", handle:"; Handle
  162.  
  163.  
  164. '---- Lock bytes 50 through 59.
  165. Start& = 50
  166. Length& = 10
  167. Action = 0                      'specify locking
  168. CALL LockFile(Handle, Start&, Length&, Action)
  169. GOSUB HandleErr
  170. PRINT "File bytes 50 through 59 are successfully locked."
  171.  
  172.  
  173. '---- Prove that it is locked by asking DOS to copy it.
  174. PRINT "DOS (another process) fails to access the file:"
  175. SHELL "COPY " + FileName$ + " NUL"
  176.  
  177.  
  178. '---- Unlock the same range of bytes (mandatory).
  179. Start& = 50
  180. Length& = 10
  181. Action = 1                      'specify unlocking
  182. CALL LockFile(Handle, Start&, Length&, Action)
  183. GOSUB HandleErr
  184. PRINT "File bytes 50 through 59 successfully unlocked."
  185.  
  186.  
  187. '---- Prove the unlocking worked by having DOS copy it.
  188. PRINT "Once unlocked DOS can access the file:";
  189. SHELL "COPY " + FileName$ + " NUL"
  190.  
  191.  
  192. CloseIt:
  193. '---- Close the file
  194. CALL CloseFile(Handle)
  195. GOSUB HandleErr
  196. PRINT "The file was successfully closed, ";
  197.  
  198.  
  199. '---- Kill the file to be polite
  200. CALL KillFile(FileName$)
  201. GOSUB HandleErr
  202. PRINT "and then successfully deleted."
  203.  
  204. END
  205.  
  206.  
  207. '=======================================
  208. '  Error handler
  209. '=======================================
  210.  
  211. HandleErr:
  212. TempErr = DOSError%             'call DOSError only once
  213. IF TempErr = 0 THEN RETURN      'return if no errors
  214. PRINT ErrMessage$(TempErr)      'else print the message
  215. IF TempErr = 1 THEN             'we failed trying to lock
  216.   COLOR 7 + 16
  217.   PRINT "SHARE must be installed to continue."
  218.   COLOR 7
  219.   RETURN CloseIt
  220. ELSE                            'otherwise end
  221.   END
  222. END IF
  223.  
  224. SUB ClipFile (Handle, Length&) STATIC
  225.   '-- Use SeekFile to seek there, and then call WriteFile
  226.   '   specifying zero bytes to truncate it at that point.
  227.   '   Length& + 1 is needed because we need to seek just
  228.   '   PAST the point where the file is to be truncated.
  229.   CALL SeekFile(Handle, Length& + 1, Zero)
  230.   IF ErrCode THEN EXIT SUB    'exit if an error occurred
  231.   CALL WriteFile(Handle, Dummy, Dummy, Zero)
  232. END SUB
  233.  
  234. SUB CloseFile (Handle) STATIC
  235.   ErrCode = 0                   'assume no errors
  236.   Registers.AX = &H3E00         'close file service
  237.   Registers.BX = Handle         'using this handle
  238.   CALL DOSInt(Registers)
  239.   IF Registers.Flags AND 1 THEN ErrCode = Registers.AX
  240. END SUB
  241.  
  242. FUNCTION DOSError% STATIC
  243.  
  244.   DOSError% = ErrCode
  245.  
  246. END FUNCTION
  247.  
  248. FUNCTION ErrMessage$ (ErrNumber) STATIC
  249.   SELECT CASE ErrNumber
  250.     CASE 2
  251.       ErrMessage$ = "File not found"
  252.     CASE 3
  253.       ErrMessage$ = "Path not found"
  254.     CASE 4
  255.       ErrMessage$ = "Too many files"
  256.     CASE 5
  257.       ErrMessage$ = "Access denied"
  258.     CASE 6
  259.       ErrMessage$ = "Invalid handle"
  260.     CASE 61
  261.       ErrMessage$ = "Disk full"
  262.     CASE ELSE
  263.       ErrMessage$ = "Undefined error: " + STR$(ErrNumber)
  264.   END SELECT
  265. END FUNCTION
  266.  
  267. SUB FlushFile (Handle) STATIC
  268.   ErrCode = 0                   'assume no errors
  269.   Registers.AX = &H4500         'create duplicate handle
  270.   Registers.BX = Handle         'based on this handle
  271.  
  272.   CALL DOSInt(Registers)
  273.   IF Registers.Flags AND 1 THEN 'an error, assign it
  274.     ErrCode = Registers.AX
  275.   ELSE                          'no error, so closing the
  276.     TempHandle = Registers.AX   'dupe flushes the data
  277.     CALL CloseFile(TempHandle)
  278.   END IF
  279. END SUB
  280.  
  281. SUB KillFile (FileName$) STATIC
  282.   ErrCode = 0                      'assume no errors
  283.   LocalName$ = FileName$ + CHR$(0) 'make an ASCIIZ string
  284.  
  285.   Registers.AX = &H4100            'delete file service
  286.   Registers.DX = SADD(LocalName$)  'using this handle
  287.   Registers.DS = SSEG(LocalName$)  'use this with PDS
  288.  'Registers.DS = -1                'use this with QB
  289.  
  290.   CALL DOSInt(Registers)
  291.   IF Registers.Flags AND 1 THEN ErrCode = Registers.AX
  292.  
  293. END SUB
  294.  
  295. FUNCTION LocFile& (Handle) STATIC
  296.   ErrCode = 0               'assume no errors
  297.  
  298.   Registers.AX = &H4201     'seek to where we are now
  299.   Registers.BX = Handle     'using this handle
  300.   Registers.CX = 0          'move zero bytes from here
  301.   Registers.DX = 0
  302.  
  303.   CALL DOSInt(Registers)
  304.   IF Registers.Flags AND 1 THEN    'an error occurred
  305.     ErrCode = Registers.AX
  306.   ELSE                             'adjust to one-based
  307.     LocFile& = (Registers.AX + (65536 * Registers.DX)) + 1
  308.   END IF
  309. END FUNCTION
  310.  
  311. SUB LockFile (Handle, Location&, NumBytes&, Action) STATIC
  312.   ErrCode = 0                     'assume no errors
  313.   LocalLoc& = Location& - 1       'adjust to zero-based
  314.  
  315.   Registers.AX = Action + (256 * &H5C)  'lock/unlock
  316.   Registers.BX = Handle
  317.   Registers.CX = PeekWord%(VARSEG(LocalLoc&), VARPTR(LocalLoc&) + 2)
  318.   Registers.DX = PeekWord%(VARSEG(LocalLoc&), VARPTR(LocalLoc&))
  319.   Registers.SI = PeekWord%(VARSEG(NumBytes&), VARPTR(NumBytes&) + 2)
  320.   Registers.DI = PeekWord%(VARSEG(NumBytes&), VARPTR(NumBytes&))
  321.  
  322.   CALL DOSInt(Registers)
  323.   IF Registers.Flags AND 1 THEN ErrCode = Registers.AX
  324. END SUB
  325.  
  326. FUNCTION LofFile& (Handle)
  327.   '---- first get and save the current file location
  328.   CurLoc& = LocFile&(Handle) 'LocFile also clears ErrCode
  329.   IF ErrCode THEN EXIT FUNCTION
  330.  
  331.   Registers.AX = &H4202      'seek to the end of the file
  332.   Registers.BX = Handle      'using this handle
  333.   Registers.CX = 0           'move zero bytes from there
  334.   Registers.DX = 0
  335.  
  336.   CALL DOSInt(Registers)
  337.   IF Registers.Flags AND 1 THEN  'an error occurred
  338.     ErrCode = Registers.AX
  339.     EXIT FUNCTION
  340.   ELSE                           'assign where we are
  341.     LofFile& = Registers.AX + (65536 * Registers.DX)
  342.   END IF
  343.  
  344.   Registers.AX = &H4200     'seek to where we were before
  345.   Registers.BX = Handle     'using this handle
  346.   Registers.CX = PeekWord%(VARSEG(CurLoc&), VARPTR(CurLoc&) + 2)
  347.   Registers.DX = PeekWord%(VARSEG(CurLoc&), VARPTR(CurLoc&))
  348.  
  349.   CALL DOSInt(Registers)
  350.   IF Registers.Flags AND 1 THEN ErrCode = Registers.AX
  351. END FUNCTION
  352.  
  353. SUB OpenFile (FileName$, Method, Handle) STATIC
  354.  
  355.   ErrCode = 0                      'assume no errors
  356.   Registers.AX = Method + (256 * &H3D) 'open file service
  357.   LocalName$ = FileName$ + CHR$(0) 'make an ASCIIZ string
  358.  
  359. DO
  360.   Registers.DX = SADD(LocalName$)  'point to the name
  361.   Registers.DS = SSEG(LocalName$)  'use this with PDS
  362.  'Registers.DS = -1                'use this w/QuickBASIC
  363.  
  364.   CALL DOSInt(Registers)              'call DOS
  365.   IF (Registers.Flags AND 1) = 0 THEN 'no errors
  366.     Handle = Registers.AX             'assign the handle
  367.     EXIT SUB                          'and we're all done
  368.   END IF
  369.  
  370.   IF Registers.AX = 2 THEN         'File not found error
  371.     Registers.AX = &H3C00          'so create it!
  372.   ELSE
  373.     ErrCode = Registers.AX         'read the code from AX
  374.     EXIT SUB
  375.   END IF
  376. LOOP
  377.  
  378. END SUB
  379.  
  380. SUB ReadFile (Handle, Segment, Address, NumBytes) STATIC
  381.   ErrCode = 0                   'assume no errors
  382.  
  383.   Registers.AX = &H3F00         'read from file service
  384.   Registers.BX = Handle         'using this handle
  385.   Registers.CX = NumBytes       'and this many bytes
  386.   Registers.DX = Address        'read to this address
  387.   Registers.DS = Segment        'and this segment
  388.  
  389.   CALL DOSInt(Registers)
  390.   IF Registers.Flags AND 1 THEN ErrCode = Registers.AX
  391. END SUB
  392.  
  393. SUB SeekFile (Handle, Location&, Method) STATIC
  394.   ErrCode = 0                      'assume no errors
  395.   LocalLoc& = Location& - 1        'adjust to zero-based
  396.  
  397.   Registers.AX = Method + (256 * &H42)
  398.   Registers.BX = Handle
  399.   Registers.CX = PeekWord%(VARSEG(LocalLoc&), VARPTR(LocalLoc&) + 2)
  400.   Registers.DX = PeekWord%(VARSEG(LocalLoc&), VARPTR(LocalLoc&))
  401.  
  402.   CALL DOSInt(Registers)
  403.   IF Registers.Flags AND 1 THEN ErrCode = Registers.AX
  404. END SUB
  405.  
  406. SUB WriteFile (Handle, Segment, Address, NumBytes) STATIC
  407.   ErrCode = 0                      'assume no errors
  408.  
  409.   Registers.AX = &H4000
  410.   Registers.BX = Handle
  411.   Registers.CX = NumBytes
  412.   Registers.DX = Address
  413.   Registers.DS = Segment
  414.  
  415.   CALL DOSInt(Registers)
  416.   IF Registers.Flags AND 1 THEN
  417.     ErrCode = Registers.AX
  418.   ELSEIF Registers.AX <> Registers.CX THEN
  419.     ErrCode = 61
  420.   END IF
  421. END SUB
  422.