如何用VB6 检测文件是否存在

  • 内容
  • 评论
  • 相关

本来很简单,一般人baidu过都会,基本用的都是Dir这个命令,我原来也是。

但后面实际运行出现了点问题,偶尔会出现错误,查了一下人家解释为“DIR 函数在调用无权限的目录以及文件时会产生错误”。

发现原来有缺陷,想用On Error这样来屏蔽又有点不甘心,然后google了一下,发现又是英文网站解决了,请到下面原文去看:

http://www.vbforums.com/showthread.php?349990-Classic-VB-How-can-I-check-if-a-file-exists

人家那叫头脑风暴,一个人提出,n个人提出不同的实现方法。

最后我选择了一种变成模块的方式,支持“*”通配符,以下是代码,也是抄的:

模块代码:

'In a standard Module
Option Explicit
 
Public Const MAX_PATH                   As Long = 260
Private Const ERROR_NO_MORE_FILES       As Long = 18&
Private Const FILE_ATTRIBUTE_NORMAL     As Long = &H80
 
Private Type FILETIME
    dwLowDateTime   As Long
    dwHighDateTime  As Long
End Type
 
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 * MAX_PATH
    cAlternate          As String * 14
End Type
 
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
                ByVal lpFileName As String, _
                lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" ( _
                ByVal hFindFile As Long) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
                ByVal hFindFile As Long, _
                lpFindFileData As WIN32_FIND_DATA) As Long
 
Public Function FileExists(ByVal sFile As String) As Boolean
    Dim lpFindFileData  As WIN32_FIND_DATA
    Dim lFileHandle     As Long
    Dim lRet            As Long
    Dim sTemp           As String
    Dim sFileExtension  As String
    Dim sFileName       As String
    Dim sFileData()     As String
    Dim sFileToCompare  As String
    
    If IsDirectory(sFile) = True Then
        sFile = AddSlash(sFile) & "*.*"
    End If
    
    If InStr(sFile, ".") > 0 Then
        sFileToCompare = GetFileTitle(sFile)
        sFileData = Split(sFileToCompare, ".")
        sFileName = sFileData(0)
        sFileExtension = sFileData(1)
    Else
        Exit Function
    End If
    
    ' get a file handle
    lFileHandle = FindFirstFile(sFile, lpFindFileData)
    If lFileHandle <> -1 Then
        If sFileName = "*" Or sFileExtension = "*" Then
            FileExists = True
        Else
            Do Until lRet = ERROR_NO_MORE_FILES
                ' if it is a file
                If (lpFindFileData.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = vbNormal Then
                    sTemp = StrConv(RemoveNull(lpFindFileData.cFileName), vbProperCase)
                    
                    'remove LCase$ if you want the search to be case sensitive
                    If LCase$(sTemp) = LCase$(sFileToCompare) Then
                        FileExists = True ' file found
                        Exit Do
                    End If
                End If
                'based on the file handle iterate through all files and dirs
                lRet = FindNextFile(lFileHandle, lpFindFileData)
                If lRet = 0 Then Exit Do
            Loop
        End If
    End If
    
    ' close the file handle
    lRet = FindClose(lFileHandle)
End Function
 
Private Function IsDirectory(ByVal sFile As String) As Boolean
    On Error Resume Next
    IsDirectory = ((GetAttr(sFile) And vbDirectory) = vbDirectory)
End Function
 
Private Function RemoveNull(ByVal strString As String) As String
    Dim intZeroPos As Integer
 
    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        RemoveNull = Left$(strString, intZeroPos - 1)
    Else
        RemoveNull = strString
    End If
End Function
 
Public Function GetFileTitle(ByVal sFileName As String) As String
    GetFileTitle = Right$(sFileName, Len(sFileName) - InStrRev(sFileName, "\"))
End Function
 
Public Function AddSlash(ByVal strDirectory As String) As String
    If InStrRev(strDirectory, "\") <> Len(strDirectory) Then
        strDirectory = strDirectory + "\"
    End If
    AddSlash = strDirectory
End Function

然后使用的时候像这样使用:

'specific file
If FileExists("C:\WINDOWS\system32\progman.exe") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If
 
'check existence of folder
If FileExists("C:\Program Files") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If
 
'wildcard search1
If FileExists("C:\WINDOWS\system32\pschdprf.*") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If
 
'wildcard search2
If FileExists("C:\WINDOWS\system32\*.dll") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If
 
'wildcard search3
If FileExists("C:\WINDOWS\*.*") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If

挺好用的,无权限的目录或文件不会报错,大家试试看吧。

评论

1条评论
  1. Gravatar 头像

    hikaruya 回复

    差,什么都找不到。。。

发表评论

邮箱地址不会被公开。 必填项已用*标注

此站点使用Akismet来减少垃圾评论。了解我们如何处理您的评论数据