miaozk2006

点滴积累与收藏:关于技术，关于生活

日志

关于我

miaozk2006

文章分类

VB常用文件操作类

2011-12-30 11:22:12| 分类：编程-VB | 标签： |举报 |字号大中小订阅

下载LOFTER 我的照片书 |

最近经常看到有网友问到VB文件操作相关的，正好以前写程序自己封装了一个类，希望能给大家一些帮助。当中难免存在问题希望大家修改并完善。

程序代码：

Option Explicit
"*************************************************************************************************************
" 读写文件函数
"*************************************************************************************************************
"以字节方式读文件
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Declare Function ReadFileToByte Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
"以字符串方式读文件
Private Declare Function ReadFileToString Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
"打开文件函数
"Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
"以字符串方式写文件函数
Private Declare Function WriteFileToString Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
"以字节方式写文件函数
Private Declare Function WriteFileToByte Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
"关闭文件函数
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
"文件位置定位函数
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
"*************************************************************************************************************
"移动文件函数
Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long
"移动文件常数
"表示当文件存在时覆盖文件（注意当文件有只读属性的话会失败）
Private Const MOVEFILE_REPLACE_EXISTING = &H1
"如移动到一个不同的卷，则复制文件并删除原来的文件
Private Const MOVEFILE_COPY_ALLOWED = &H2
"*************************************************************************************************************
"删除文件函数
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
"*************************************************************************************************************
"遍历文件目录函数
Private Const INVALID_HANDLE_VALUE = -1
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
"记录文件、目录总数变量（这里本来打算是在函数中定义成静态变量的但是怕在程序中多次调用会造成数据不对所以改成了只读属性了）
Private lngFileCount As Long, lngFolderCount As Long

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Const MaxLFNPath = 260

"在遍历文件的时候可以记录下文件的信息比如文件创建、修改时间等等
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MaxLFNPath
cShortFileName As String * 14
End Type
"*************************************************************************************************************
"保持属性值的局部变量
Private mvarFileFullPath As String "局部复制
Private msglStartTime As Single
Private mclskernel32 As clsKernel

Public Property Get StartTime() As Single
"检索属性值时使用，位于赋值语句的右边。
"Syntax: Debug.Print X.fileFullPath
StartTime = Timer
End Property

Public Property Let FileFullPath(ByVal vData As String)
"向属性指派值时使用，位于赋值语句的左边。
"Syntax: X.fileFullPath = 5
mvarFileFullPath = vData
End Property

Public Property Get FileFullPath() As String
"检索属性值时使用，位于赋值语句的右边。
"Syntax: Debug.Print X.fileFullPath
FileFullPath = mvarFileFullPath
End Property

"获取当前搜索的文件数
Public Property Get SearchFilesCount() As Long
SearchFilesCount = lngFileCount
End Property

"获取当前搜索的目录数
Public Property Get SearchFoldersCount() As Long
SearchFoldersCount = lngFolderCount
End Property

"以字符串方式读出文件所有内容
Public Function ReadFileAllToString(Optional ByVal strFile As String) As String
Dim lngFile As Long, lngLen As Long, lngRecevieBytes As Long, strOut As String
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
lngLen = FileLen(strFile)
If lngLen = 0 Then
mclskernel32.ShowMsg "文件为空！！", "错误", vbCritical, 0
Exit Function
End If
lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
strOut = String(lngLen, Chr(0))
ReadFileToString lngFile, strOut, lngLen, lngRecevieBytes, ByVal 0&
CloseHandle lngFile
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
ReadFileAllToString = strOut
End Function

"以字节数组方式读出文件所有内容
Public Function ReadFileAllToBytes(Optional ByVal strFile As String) As Byte()
Dim lngFile As Long, lngLen As Long, lngRecevieBytes As Long, bytFilebytes() As Byte
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
lngLen = FileLen(strFile)
If lngLen = 0 Then
mclskernel32.ShowMsg "文件为空！！", "错误", vbCritical, 0
Exit Function
End If
ReDim bytFilebytes(lngLen - 1)
lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
ReadFileToByte lngFile, bytFilebytes(0), lngLen, lngRecevieBytes, ByVal 0&
CloseHandle lngFile
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
ReadFileAllToBytes = bytFilebytes
End Function

"以字符串方式读取指定位置的字符串
Public Function ReadFileByPositionToString(ByVal lngStart As Long, Optional ByVal lngEnd As Long = -1, Optional ByVal strFile As String) As String
Dim lngFile As Long, lngLen As Long, lngRecevieBytes As Long, strOut As String, lngReadLen As Long
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
lngLen = FileLen(strFile) "lngEnd - lngStart + 1
If lngLen = 0 Then
mclskernel32.ShowMsg "文件为空！！", "错误", vbCritical, 0
Exit Function
End If
If lngEnd = -1 Then
lngReadLen = FileLen(strFile) - lngStart
Else
lngReadLen = lngEnd
End If
lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, lngStart, 0, 0
strOut = String(lngReadLen, Chr(0))
ReadFileToString lngFile, strOut, lngReadLen, lngRecevieBytes, ByVal 0&
CloseHandle lngFile
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
ReadFileByPositionToString = strOut
End Function

"以字节数组方式读取指定位置的字符串
Public Function ReadFileByPositionToBytes(ByVal lngStart As Long, Optional ByVal lngEnd As Long = -1, Optional ByVal strFile As String) As Byte()
Dim lngFile As Long, lngLen As Long, lngRecevieBytes As Long, bytFilebytes() As Byte, lngReadLen As Long
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
lngLen = FileLen(strFile) " lngEnd - lngStart + 1
If lngLen = 0 Then
MsgBox "文件为空！！", vbCritical, "错误"
Exit Function
End If
If lngEnd = -1 Then
lngReadLen = FileLen(strFile) - lngStart
Else
lngReadLen = lngEnd
End If
ReDim bytFilebytes(lngReadLen - 1)
lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, lngStart, 0, 0
ReadFileToByte lngFile, bytFilebytes(0), lngReadLen, lngRecevieBytes, ByVal 0&
CloseHandle lngFile
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
ReadFileByPositionToBytes = bytFilebytes
End Function

"以字符串方式写文件
Public Function WriteStringToFile(ByVal strData As String, Optional ByVal strFile As String) As Long
Dim lngFile As Long, lngWriteBytes As Long
If strFile = "" Then strFile = FileFullPath
lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 4, ByVal 0&, ByVal 0&)
WriteFileToString lngFile, strData, Len(strData), lngWriteBytes, ByVal 0&
CloseHandle lngFile
WriteStringToFile = lngWriteBytes
End Function

"以字节数组方式写文件
Public Function WriteByteToFile(bytes() As Byte, Optional ByVal strFile As String) As Long
Dim lngFile As Long, lngWriteBytes As Long, lngLen As Long
If strFile = "" Then strFile = FileFullPath
lngLen = UBound(bytes) + 1
lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 4, ByVal 0&, ByVal 0&)
WriteFileToByte lngFile, bytes(0), lngLen, lngWriteBytes, ByVal 0&
CloseHandle lngFile
WriteByteToFile = lngWriteBytes
End Function

"以字符串方式把需要写的字符串写到指定位置（注意指定文件后的字符串会被覆盖）
Public Function WriteStringByPositionToFile(ByVal strData As String, ByVal lngStart As Long, Optional ByVal strFile As String) As Long
Dim lngFile As Long, lngWriteBytes As Long
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
If FileLen(strFile) = 0 Then
WriteStringByPositionToFile = WriteStringToFile(strData, strFile)
Exit Function
End If
lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, lngStart, 0, 0
WriteFileToString lngFile, strData, Len(strData), lngWriteBytes, ByVal 0&
CloseHandle lngFile
WriteStringByPositionToFile = lngWriteBytes
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
End Function

"以字节数组方式把需要写的字节数组写到指定位置（注意指定文件后的字节会被覆盖）
Public Function WriteByteByPositionToFile(bytes() As Byte, ByVal lngStart As Long, Optional ByVal strFile As String) As Long
Dim lngFile As Long, lngWriteBytes As Long, lngLen As Long
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
If FileLen(strFile) = 0 Then
WriteByteByPositionToFile = WriteByteToFile(bytes, strFile)
Exit Function
End If
lngLen = UBound(bytes) + 1
lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, lngStart, 0, 0
WriteFileToByte lngFile, bytes(0), lngLen, lngWriteBytes, ByVal 0&
CloseHandle lngFile
WriteByteByPositionToFile = lngWriteBytes
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
End Function

"以字符串方式把字符串添加到文件尾
Public Function WriteStringToAppend(ByVal strData As String, Optional ByVal strFile As String) As Long
Dim lngFile As Long, lngWriteBytes As Long, lngEnd As Long
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
If FileLen(strFile) = 0 Then
WriteStringToAppend = WriteStringToFile(strData, strFile)
Exit Function
End If
lngEnd = FileLen(strFile)
"lngFile = OpenFile(strFile, oF, OF_WRITE)
lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, lngEnd, 0, 0
WriteFileToString lngFile, strData, Len(strData), lngWriteBytes, ByVal 0&
CloseHandle lngFile
WriteStringToAppend = lngWriteBytes
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
End Function

"以字节数组方式把字节数组添加到文件尾
Public Function WriteByteToAppend(bytes() As Byte, Optional ByVal strFile As String) As Long
Dim lngFile As Long, lngWriteBytes As Long, lngEnd As Long, lngLen As Long
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
If FileLen(strFile) = 0 Then
WriteByteToAppend = WriteByteToFile(bytes, strFile)
Exit Function
End If
lngLen = UBound(bytes) + 1
lngEnd = FileLen(strFile)
lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, lngEnd, 0, 0
WriteFileToByte lngFile, bytes(0), lngLen, lngWriteBytes, ByVal 0&
CloseHandle lngFile
WriteByteToAppend = lngWriteBytes
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
End Function

"在文件中插入指定的字节数据（字符串需要转换成字节数组）
Public Function WriteInsertToFile(bytes() As Byte, ByVal lngStart As Long, Optional ByVal strFile As String) As Long
Dim lngFile As Long, lngWriteBytes As Long, lngEnd As Long, lngLen As Long, bBytes() As Byte, lngReadBytes As Long, lngReadLen As Long
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
If FileLen(strFile) = 0 Then
WriteInsertToFile = WriteByteToFile(bytes, strFile)
Exit Function
End If
lngLen = UBound(bytes) + 1
lngReadLen = FileLen(strFile) - lngStart
ReDim bBytes(lngReadLen - 1)
lngFile = CreateFile(ByVal strFile, ByVal (&H40000000 Or &H80000000), FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, lngStart, 0, 0
ReadFileToByte lngFile, bBytes(0), lngReadLen, lngReadBytes, ByVal 0&
SetFilePointer lngFile, lngStart, 0, 0
WriteFileToByte lngFile, bytes(0), lngLen, lngWriteBytes, ByVal 0&
WriteInsertToFile = lngWriteBytes
WriteFileToByte lngFile, bBytes(0), lngReadLen, lngWriteBytes, ByVal 0&
CloseHandle lngFile
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
End Function

"写入一行数据
Public Function WriteLine(ByVal strData As String, Optional ByVal strFile As String) As Long
Dim lngFile As Long, lngWriteBytes As Long, lngEnd As Long, lngLen As Long
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
lngLen = FileLen(strFile)
If lngLen = 0 Then
WriteLine = WriteStringToFile(strData, strFile)
Exit Function
End If
lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, lngLen, 0, 0
WriteFileToString lngFile, strData & vbCrLf, Len(strData & vbCrLf), lngWriteBytes, ByVal 0&
CloseHandle lngFile
WriteLine = lngWriteBytes
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
End Function

"读一行数据或者读取所有行
Public Function ReadLine(strArray() As String, Optional ByVal intLine As Integer = -1, Optional ByVal strFile As String) As String
Dim lngFile As Long, lngLen As Long, bBytes(0) As Byte, lngReadLen As Long
Dim bytOut() As Byte, i As Integer, j As Integer, strLine As String
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
lngLen = FileLen(strFile)
If lngLen = 0 Then
ReadLine = ""
Exit Function
End If
lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
SetFilePointer lngFile, 0, 0, 0
Do
ReadFileToByte lngFile, bBytes(0), 1, lngReadLen, ByVal 0&
ReDim Preserve bytOut(0 To i)
bytOut(i) = bBytes(0)
i = i + 1
If bBytes(0) = 10 Then
ReDim Preserve strArray(0 To j)
strArray(j) = StrConv(bytOut, vbUnicode)
j = j + 1
If intLine = j Then
strLine = strArray(j - 1)
ReadLine = strLine
CloseHandle lngFile
Exit Function
End If
Erase bytOut
i = 0
End If
Loop While lngReadLen < > 0
CloseHandle lngFile
If (intLine < > -1 And j < intLine) Then
ReDim Preserve bytOut(UBound(bytOut) - 1)
strLine = StrConv(bytOut, vbUnicode)
ReadLine = strLine
Exit Function
Else
If i > 0 Then
ReDim Preserve bytOut(UBound(bytOut) - 1)
ReDim Preserve strArray(0 To j)
strArray(j) = StrConv(bytOut, vbUnicode)
End If
End If
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
Exit Function
End If
End Function

"文件复制函数支持文件备份操作
Public Function MyCopyFile(ByVal strExistingFileName As String, ByVal strNewFileName As String, Optional ByVal isCover As Boolean = True) As Boolean
If strExistingFileName = "" Then strExistingFileName = FileFullPath
If FileExist(strNewFileName) Then
If isCover Then
SetFileAttr strNewFileName
On Error GoTo errPurview
Kill strNewFileName
Else
On Error GoTo errExist
Name strNewFileName As strNewFileName & ".bak"
End If
End If
FileCopy strExistingFileName, strNewFileName
MyCopyFile = True
Exit Function
errExist:
MyCopyFile = False
Exit Function
errPurview:
mclskernel32.ShowMsg "没有权限替换此文件，或者此文件目前处于使用中！！", "错误", vbCritical, 0
MyCopyFile = False
End Function

"遍历指定路径写的文件目录信息（返回两个字符串数组一个是文件集合另一个是目录集合返回值是文件总数）
Public Function SearchDirInfo(ByVal strPath As String, strFileArray() As String, strFolderArray() As String, Optional ByVal strFileExt As String = "*.*", Optional ByVal isCheckSub As Boolean = True) As Long
Dim i As Integer, lngItem As Long, objWda As WIN32_FIND_DATA, intFolders As Integer
Dim strFullPath As String, strFolders() As String
If Right(strPath, 1) < > "/" Then strPath = strPath & "/"
lngItem = FindFirstFile(strPath & "*.*", objWda)
If lngItem < > INVALID_HANDLE_VALUE Then
Do
"检查是不是目录
If (objWda.dwFileAttributes And vbDirectory) Then
strFullPath = Left(objWda.cFileName, InStr(objWda.cFileName, vbNullChar) - 1)
If Len(strFullPath) = 1 And strFullPath = "." Then

ElseIf Len(strFullPath) = 2 And strFullPath = ".." Then

Else
If lngFolderCount Mod 10 = 0 Then mclskernel32.AppDoEvents
ReDim Preserve strFolderArray(0 To lngFolderCount)
strFolderArray(lngFolderCount) = strPath & strFullPath
lngFolderCount = lngFolderCount + 1
ReDim Preserve strFolders(0 To intFolders)
strFolders(intFolders) = strPath & strFullPath
intFolders = intFolders + 1
End If
Else
If lngFileCount Mod 10 = 0 Then mclskernel32.AppDoEvents
strFullPath = Left(objWda.cFileName, InStr(objWda.cFileName, vbNullChar) - 1)
If LCase(strFileExt) < > "*.*" Then
If LCase(GetFileExt(strFullPath)) = LCase(GetFileExt(strFileExt)) Then
ReDim Preserve strFileArray(0 To lngFileCount)
strFileArray(lngFileCount) = strPath & strFullPath
lngFileCount = lngFileCount + 1
End If
Else
ReDim Preserve strFileArray(0 To lngFileCount)
strFileArray(lngFileCount) = strPath & strFullPath
lngFileCount = lngFileCount + 1
End If
End If
Loop While FindNextFile(lngItem, objWda)
Call FindClose(lngItem)
End If
If Not isCheckSub Then
Exit Function
End If
For i = 0 To intFolders - 1
SearchDirInfo strFolders(i), strFileArray, strFolderArray, strFileExt, isCheckSub
Next i
SearchDirInfo = lngFileCount
End Function

"文件移动函数支持文件备份操作
Public Function FileMove(ByVal strExistingFileName As String, ByVal strNewFileName As String, Optional ByVal isBackFile As Boolean = False) As Boolean
If strExistingFileName = "" Then strExistingFileName = FileFullPath
If FileExist(strNewFileName) Then
If isBackFile Then
On Error GoTo errExist
Name strNewFileName As strNewFileName & ".bak"
Else
SetFileAttr strNewFileName
On Error GoTo errPurview
Kill strNewFileName
End If
End If
MoveFileEx strExistingFileName, strNewFileName, MOVEFILE_REPLACE_EXISTING Or MOVEFILE_COPY_ALLOWED
FileMove = True
Exit Function
errExist:
FileMove = False
Exit Function
errPurview:
mclskernel32.ShowMsg "没有权限替换此文件，或者此文件目前处于使用中！！", "错误", vbCritical, 0
FileMove = False
End Function

"删除文件函数
Public Function FileDelete(Optional ByVal strFile As String) As Boolean
If strFile = "" Then strFile = FileFullPath
If FileExist(strFile) Then
SetFileAttr strFile
If DeleteFile(strFile) > 0 Then
FileDelete = True
Else
FileDelete = False
End If
Else
mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
End If
End Function

"设置指定文件属性为正常属性
Private Sub SetFileAttr(ByVal strFile As String)
On Error Resume Next
If GetAttr(strFile) And vbReadOnly Then SetAttr strFile, vbNormal
End Sub

"文件查找函数（判断指定文件是否存在）
Private Function FileExist(ByVal strFile As String) As Boolean
If strFile < > "" Then
If Dir(strFile, 1 Or 2 Or 4) = "" Then
FileExist = False
Else
FileExist = True
End If
Else
FileExist = False
End If
End Function

"此函数从字符串中分离出文件扩展名
Private Function GetFileExt(ByVal strFileName As String) As String
Dim p As Integer
For p = Len(strFileName) To 1 Step -1
If InStr(".", Mid$(strFileName, p, 1)) Then Exit For
Next
GetFileExt = Right$(strFileName, Len(strFileName) - p)
End Function

Private Sub Class_Initialize()
msglStartTime = StartTime
Set mclskernel32 = New clsKernel
End Sub

Private Sub Class_Terminate()
lngFileCount = 0
lngFolderCount = 0
Set mclskernel32 = Nothing
End Sub

Public Function GetAppRunTime() As Single
GetAppRunTime = CSng(Timer - msglStartTime)
End Function

‘***************************************

引自：http://blog.csdn.net/chenhui530/article/details/1809726

VB部分相关文章推荐

※VB快速读取 TextBox 第 N 行的资料

※VB禁止使用 Alt-Tab 或 Ctrl-Alt-Del

※生成迷宫的程序

※另一方法转换大小写

※VB控件注册 - 利用资源文件将dll、ocx打包进exe文件

※做VB的，经常注册和反注册OCX控件和DLL链

※VB从程序中生成Exe文件

※VB6监视/操作剪贴板示例(VB6.0代码)

※VB6里自动提交/自动填表的一种相对通用的方案

※在VB中INI文件的读写、删除（对中文支持很好）

※VB获取windows各常用目录的函数（模块）

※VB:设定 MsgBox 在若干时间之后若无回应则自动关闭

※VB:读取及设定NumLock/CapsLock/ScrollLock的值

※VB:您知道 Mid$ 函量可以放在 '=' 的左方吗

※VB后台获得按键,并执行自己的函数(非钩子及热键)

※VB:将短文件名格式转成长文件名

※在vb中使用Iphlpapi.dll获取网络信息(上）

※在vb中使用Iphlpapi.dll获取网络信息(下）

历史上的今天

this.p={  m:2,
              b:2,
              loftPermalink:'',
              id:'fks_087067081081087065092095083065072085089065080081086070092',
              blogTitle:'VB常用文件操作类',
              blogAbstract:'<SPAN style=\"LINE-HEIGHT: 26px; FONT-FAMILY: Arial; COLOR: rgb(51,51,51);\"  \>\r\n<P\>       最近经常看到有网友问到VB文件操作相关的，正好以前写程序自己封装了一个类，希望能给大家一些帮助。当中难免存在问题希望大家修改并完善。 <BR\>\r\n<TABLE style=\"MARGIN: 2px; FONT: bold 12px Tahoma, Verdana, 宋体; background-origin: initial; background-clip: initial;\"  border=\"0\" cellSpacing=\"0\" cellPadding=\"0\" width=\"100%\"  align=\"center\" \>\r\n<TBODY\>\r\n<TR\>\r\n<TD\>程序代码：</TD\>\r\n<TD align=\"right\" \>　</TD\></TR\></TABLE\></P\>\r\n</SPAN\>',
              blogTag:'',
              blogUrl:'blog/static/38247058201111215139269',
              isPublished:1,
              istop:false,
              type:2,
              modifyTime:1361414639669,
              publishTime:1325215332075,
              permalink:'blog/static/38247058201111215139269',
              commentCount:0,
              mainCommentCount:0,
              recommendCount:0,
              bsrk:-100,
              publisherId:0,
              recomBlogHome:false,
              currentRecomBlog:false,
              attachmentsFileIds:[],
              vote:{},
              groupInfo:{},
              friendstatus:'none',
              followstatus:'unFollow',
              pubSucc:'',
              visitorProvince:'',
              visitorCity:'',
              visitorNewUser:false,
              postAddInfo:{},
              mset:'000',
              mcon:'',
              srk:-100,
              remindgoodnightblog:false,
              isBlackVisitor:false,
              isShowYodaoAd:false,
              hostIntro:'',
              hmcon:'0',
              selfRecomBlogCount:'0',
              lofter_single:'<iframe width="140" height="560" style="overflow:hidden;" src="http://www.lofter.com/mailEntry.do?blogad=1&blog" frameBorder="0"></iframe>'
            }

{list a as x}
    {if !!x}
    <div class="iblock nbw-fce nbw-f40">
      <a class="fc03 noul" target="_blank" hidefocus="true" href="http://blog.163.com/${x.visitorName}/">
      {if x.visitorName==visitor.userName}
      <img alt="${x.visitorNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.visitorName)}&r=${visitor.imageUpdateTime}"/>
      {else}
      <img alt="${x.visitorNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.visitorName)}"/>
      {/if}
      </a>
      <div class="cwd vname thide">
        {if x.moveFrom=='wap'}
          <a class="noul pnt" target="_blank" href="http://blog.163.com/services/wapblog.html?frompersonalbloghome"><span title="来自网易手机博客" class="iblock wapIcon"> </span></a>
        {elseif x.moveFrom=='iphone'}
          <a class="noul pnt" target="_blank"><span title="来自iPhone客户端" class="iblock iphoneIcon"> </span></a>
        {elseif x.moveFrom=='android'}
          <a class="noul pnt" target="_blank"><span title="来自Android客户端" class="iblock androidIcon"> </span></a>
        {elseif x.moveFrom=='mobile'}
          <a class="noul pnt" target="_blank" href="http://blog.163.com/services/emsblog.html?frompersonalbloghome"><span title="来自网易短信写博" class="iblock wapIcon"> </span></a>
        {/if}
        <a class="fc03 m2a"  target="_blank" hidefocus="true" href="http://blog.163.com/${x.visitorName}/">
          ${fn(x.visitorNickname,8)|escape}
        </a>
      </div>
    </div>
    {/if}
    {/list}

<#--最新日志，群博日志--> <#--推荐日志-->

<p class="fc06">推荐过这篇日志的人：</p>
    <div>
      {list a as x}
      {if !!x}
      <div class="iblock nbw-fce nbw-f40">
        <a class="fc03 noul" target="_blank" hidefocus="true" href="http://blog.163.com/${x.recommenderName}/">
        <img alt="${x.recommenderNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.recommenderName)}"/>
        </a>
        <div class="cwd thide">
          <a class="fc03 m2a" target="_blank" hidefocus="true" href="http://blog.163.com/${x.recommenderName}/">
            ${fn(x.recommenderNickname,6)|escape}
          </a>
        </div>
      </div>
      {/if}
      {/list}
    </div>
    {if !!b&&b.length>0}
    <p  class="fc06">他们还推荐了：</p>
    <ul>
    {list b as y}
      {if !!y}
        <li class="rrb"><span class="iblock">·</span><a class="fc03 m2a" target="_blank" href="http://blog.163.com/${y.recommendBlogPermalink}/?from=blog/static/38247058201111215139269">${y.recommendBlogTitle|escape}</a></li>
      {/if}
    {/list}
    </ul>
    {/if}

<#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇，下一篇--> <#-- 热度 -->

{list a as x}
    {if !!x}
    <div class="hotItem iblock nbw-fce nbw-f40">
      <a class="fc03 noul" target="_blank" hidefocus="true" href="http://blog.163.com/${x.publisherUsername}/">
      {if x.publisherUsername==visitor.userName}
      <img alt="${x.publisherNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.publisherUsername)}&r=${visitor.imageUpdateTime}"/>
      {else}
      <img alt="${x.publisherNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.publisherUsername)}"/>
      {/if}
      </a>
      <div class="cwd vname thide">
        <a class="fc03 m2a"  target="_blank" hidefocus="true" href="http://blog.163.com/${x.publisherUsername}/">
          ${fn(x.publisherNickname,8)|escape}
        </a>
      </div>
      <a class="f-myLikeIcons hottype {if x.type==1} js-liketype{elseif x.type==2} js-reblogtype{elseif x.type==3} js-sharetype{else}{/if}" target="_blank" hidefocus="true" href="http://blog.163.com/${x.publisherUsername}/"> </a>
    </div>
    {/if}
    {/list}

<#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->

页脚

我的照片书 - 手机博客 - 下载LOFTER APP - 订阅此博客

miaozk2006

导航

日志

VB常用文件操作类

历史上的今天

最近读者

热度

评论

页脚