Use API for file read/write--createfile,readfile,writefile, etc.

Original:

Simple and Easy--api file read-write class

Http://www.vbgood.com/thread-102870-1-1.html

Read this post: Http://www.vbgood.com/thread-99249-1-1.html wrote a simple class that uses the API to read and write files, menial work. The demo code is in the attachment. ' *********************************** ' written by D.l. ' 2011/04/04 ' *********************************** Option Explicit ' Private Declare Function CreateFile Lib "kernel32" Alias "Createfilea" (ByVal lpfilename as String, ByVal Dwdesi Redaccess as Long, ByVal dwShareMode as Long, lpsecurityattributes as Security_attributes, ByVal dwcreationdisposition as Long, ByVal dwflagsandattributes as Long, ByVal hTemplateFile as Long) as Long ' Private Type security_attributes ' nlength As Long ' lpsecuritydescriptor as Long ' binherithandle as Long ' End Type Private Declare Function CreateFile Lib ' kernel "Alias" Createfilea "(ByVal lpfilename as String, ByVal dwdesiredaccess as Long, ByVal dwShareMode as Long, ByVal lpsec Urityattributes as Long, ByVal dwcreationdisposition as Long, ByVal dwflagsandattributes as Long, ByVal hTemplateFile as L ONG) as Long Private Declare Function ReadFile Lib "Kernel32.dll" (ByvAl hfile as long, ByRef lpbuffer as any, ByVal nNumberOfBytesToRead as Long, byref lpnumberofbytesread as Long, ByVal Lpov Erlapped as Long) as Long Private Declare Function writefile Lib "Kernel32.dll" (ByVal hfile as Long, ByRef lpbuffer as an Y, ByVal Nnumberofbytestowrite as Long, ByRef Lpnumberofbyteswritten as Long, ByVal lpoverlapped as Long) as Long Private Declare function FlushFileBuffers Lib "kernel32" (ByVal hfile as Long) as Long ' Private Declare Function getfilesize Lib ' Kernel32.dll "(ByVal hfile as Long, ByRef lpFileSizeHigh as Long) as Long Private Declare Function GetFileSizeEx Lib" Kern El32.dll "(ByVal hfile as Long, ByRef lpfilesize as Currency) as Long Enum desiredaccess generic_read = &h80000000 GEN Eric_write = &h40000000 Generic_execute = &h20000000 Generic_all = &h10000000 End enum enum ShareMode FILE_SHA Re_read = &h1 File_share_write = &h2 file_share_delete = &h4 End Enum ' This parameter must is one of the Follo Wing values, which Cannot be combined:enum creationdisposition truncate_existing = 5 Open_always = 4 Open_existing = 3 Create_always = 2 CREATE_N EW = 1 End enum enum flagsandattributes ' attributes file_attribute_archive = &h20 file_attribute_compressed = &h80 0 File_attribute_directory = &h10 File_attribute_hidden = &h2 file_attribute_normal = &H80 ' The FILE does not has other attributes set. This attribute are valid only if used alone. File_attribute_readonly = &h1 File_attribute_system = &h4 file_attribute_temporary = &H100 ' Flags FILE_FLAG_ Backup_semantics = &h2000000 File_flag_delete_on_close = &h4000000 file_flag_no_buffering = &H20000000 FILE _flag_overlapped = &h40000000 File_flag_posix_semantics = &h1000000 file_flag_random_access = &H10000000 File_flag_sequential_scan = &h8000000 File_flag_write_through = &h80000000 End Enum Private Const INVALID_HANDLE _value =-1 ' Private Declare Function setfilepointer Lib "Kernel32.dll" (ByVal hfile as Long, ByVal Ldistancetomove as Long, ByRef lpDistanceToMoveHigh as Long, ByVal Dwmovemethod as Long) as Long ' Private Con St Invalid_set_file_pointer =-1 ' Private Declare Function setfilepointerex Lib "kernel32" (ByVal hfile as Long, Lidistanc Etomove as Large_integer, Lpnewfilepointer as Large_integer, ByVal Dwmovemethod as Long) as Long ' Private Type Large_integ ER ' lowpart as Long ' highpart as Long ' End Type Private Declare Function setfilepointerex Lib "kernel32" (ByVal hfile as Long, ByVal lidistancetomove as Currency, Lpnewfilepointer as Currency, ByVal Dwmovemethod as Long) as Long Enum Movemeth Od file_begin = 0 file_current = 1 file_end = 2 END Enum Private Declare Function setendoffile Lib "kernel32" (ByVal hfile As long) as Long Private Declare Function closehandle Lib "kernel32" (ByVal Hobject as Long) as Long "" "" "" "" "" "" "" "" "," "" "" "" "", "" "", "" "", "" Le = Invalid_handle_valuE FileName = "" End Sub Private Sub class_terminate () call FileClose End Sub ' *******properties******* Public property Get Handle () as Long Handle = M_handle End Property Private Property Let Handle (ByVal value as long) M_handle = Value End Pro Perty Public Property Get filename () as String filename = M_filename End Property Private Property Let filename (ByVal Valu e as String) M_filename = Value End property ' *******public functions******* ' FileOpen ' open file public Function FileOpen (Byva L FileName as String, ByVal createifnotexists as Boolean) As Boolean Dim dwcreation as Long If (createifnotexists) then DW Creation = open_always Else dwcreation = open_existing End If if (CreateFile2 (FileName, Generic_read Or generic_write, FIL E_share_read Or file_share_write, 0, dwcreation, 0, 0) then FileOpen = True Else FileOpen = False End If End Function ' Fi Leseek ' Move file pointer public Function FileSeek (ByVal distancetomove as Double, ByVal Movemethod as Movemethod) as Boolean Dim lre T as Long Dim Curin as CUrrency, curout as Currency If (Handle = invalid_handle_value) then Exit Function Curin = dbl2cur (distancetomove) Lret = S Etfilepointerex (Handle, Curin, Curout, Movemethod) if (lret) then FileSeek = True Else FileSeek = False End If End Functio n ' FileWrite ' write file public Function FileWrite (Buffer () as Byte) as Boolean Dim Lret as Long Dim lbufferlength As Long Dim LB Yteswritten as Long if (Handle = Invalid_handle_value) Then Exit Function If (Isarrayinit (Buffer ()) = False) Then exit fun ction lbufferlength = UBound (buffer)-LBound (buffer) + 1 Lret = WriteFile (Handle, Buffer (0), Lbufferlength, lBytesWritten , 0) If (lret and lBytesWritten = lbufferlength) Then ' Lret = FlushFileBuffers (Handle) FileWrite = True Else FileWrite = F Alse End If End Function ' FileRead ' read file public Function FileRead (Buffer () as Byte) as Boolean Dim lret As Long Dim lbuffer Length Dim Lbytesread as Long if (Handle = invalid_handle_value) then Exit Function If (Isarrayinit (Buffer ()) = False) the n Exit Function LbufferlEngth = UBound (buffer)-LBound (buffer) + 1 Lret = ReadFile (Handle, buffer (0), Lbufferlength, Lbytesread, 0) If (Lret) the n FileRead = True Else FileRead = False End If End Function ' fileclose ' close file public Function FileClose () as Boolean Dim LR ET as Long if (Handle = invalid_handle_value) then Exit Function Lret = CloseHandle (Handle) if (lret) then Handle = Invali D_handle_value filename = "" FileClose = True End If End Function ' CreateFile2 ' creates a file with CreateFile API function, this function can not expose public Function CreateFile2 (ByVal lpfilename as String, ByVal dwdesiredaccess as desiredaccess, ByVal dwShareMode as ShareMode, B Yval lpsecurityattributes as Long, ByVal dwcreationdisposition as Creationdisposition, ByVal dwFlagsAndAttributes as Flag Sandattributes, ByVal hTemplateFile as Long) as Boolean ' The lpFileName string should is//./x:to open a floppy drive x o R a partition x on a hard disk. For example: "String meaning '//./a:obtains a handle to drive a on the user ' s computer. '//./c:obtains a handleTo drive C on the user ' s computer. M_filename = lpFileName Handle = CreateFile (lpFileName, dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, htemplatefile) CreateFile2 = IIf (Handle <> Invalid_handle_value, True, False) End function ' filegetsize ' gets the file size (bytes) public Function filegetsize (size as Double) as a Boolean Dim Lret as Long Dim Curout as Currency if (Handle = invalid_handle_value) then Exit Function Lret = GetFileSizeEx (Handle, Curout) if (lre T) then Size = Cur2dbl (curout) filegetsize = True End If End Function ' filesetsize ' Specify File size (bytes) public Function filesetsize (ByVal Size as Double) As Boolean Dim lret As Long Dim curout As Currency if (Size < 0) then Exit Function If (Handle = INVALID_HANDLE_VALUE) Then Exit Function Lret = SetFilePointerEx (Handle, Dbl2cur (Size), Curout, File_begin) If (lret) Then Lret = SetEndOfFile (H Andle) if (lret) then filesetsize = True End If End If End Function "" "" "" "" "" "" "" "" "" "" "" "" """ "" "" "Private Function Cur2dbl (cur as Currency) as Double cur2dbl = cur * 10000 End function Private function dbl2c ur (dbl as Double) as Currency dbl2cur = dbl/10000 End function Private Function isarrayinit (ByRef LPSA () as Byte) as Boo Lean Dim Lret as Long isarrayinit = True err.clear on Error Resume Next lret = LBound (LPSA ()) If (err.number) then err.cle Ar isarrayinit = False end If End Function Copy Code reference link: http://hi.baidu.com/hnxyy/blog/item/e77c3f87db17612ac65cc3b3.html

Test Engineering:

http://download.csdn.net/source/3197291