回 帖 发 新 帖 刷新版面

主题:请问如何检测文件是否存在

附件为自动检测u盘插拔状态并给出提示的源码,我想增加一个功能,就是在U盘插入的同时,检测U盘上是否存在123.txt文件,并给出提示。
请问在哪里增加,增加什么语句?谢谢!
请注意,是不一定的盘符路径哦!

回复列表 (共3个回复)

沙发

增加一个计时器,代码如下:

Private Sub Timer1_Timer()
Dim FSO, Drv, Drvs, Drive As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Drvs = FSO.Drives
For Each Drv In Drvs
  If Drv.DriveType = 1 And Drv.IsReady Then '如果是U盘并且可用
    Drive = Drv.DriveLetter & ":\"
    If Len(Dir(Drive & "123.txt")) Then MsgBox Drv.DriveLetter & "盘上有123.txt文件": Exit For
  End If
Next
Set FSO = Nothing
End Sub

板凳

前辈,由于我是要在一台老设备的老系统上使用,这台老系统在运行我的程序同时还要运行它本身的一个大型软件,我必须尽量少用组件。不好意思。

检测文件的存在问题我已经用自己的方法大致解决,较笨,但可以提示插入的U盘是否为我认证过的U盘。

但在运行中,又发现了一个问题,就是,如果我先插入一个没有认证过的u盘,点击确定后,程序会提示“不是KEY盘”;但拔下未认证的U盘,插上认证过的U盘,程序还会提示“不是KEY盘”。我大概了解是程序没有再次检测U盘是否为KEY盘,但不知道在哪里修改和怎么修改。

下面是我的源程序:

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Const DRIVE_CDROM = 5
'返回USB路径
Private Function GetUSBPath() As String
    Dim I As Integer
    On Error Resume Next
        For I = 97 To 122 Step 1
            If GetDriveType(Chr(I) & ":\") = DRIVE_CDROM Then
                    GetUSBPath = Chr(I + 1) & ":\"
            End If
        Next I
End Function

'返回序列号
Private Function GetPathInfo(PathStr As String) As String
  Dim MySerial As Long, MyLong As Long, MyType, MyStr
  MyStr = String$(255, Chr$(0))
  MyType = String$(255, Chr$(0))
  MyLong = GetVolumeInformation(PathStr, MyStr, Len(MyStr), MySerial, 0, 0, MyType, Len(MyType))
  GetPathInfo = MySerial
End Function

Private Sub Command1_Click()

On Error GoTo zz
Dim b As Long
    For b = Asc("C") To Asc("Z")
    If GetDriveType(Chr(b) + ":") = 2 Then GoTo xx
     Next b

xx:
                Dim s1 As String
                Open Chr(b) & ":" & "\id.txt" For Binary As #1
                Line Input #1, s1
                Close #1

                If s1 = IIf(GetPathInfo(GetUSBPath) = 0, "USB没有连接磁盘", GetPathInfo(GetUSBPath)) Then
                    Unload Me
                    Load Form2
                    Form2.Show
'                    MsgBox "是key 盘"
                    Else
                    GoTo zz
                    End If
Exit Sub

zz:
MsgBox "不是key 盘"
Exit Sub

End Sub

Private Sub Form_Load()
  Form1.Move (Screen.Width - Form1.Width) / 2, (Screen.Height - Form1.Height) / 2 '窗口居中
End Sub


敬请前辈帮助我!!

3 楼

已经自我解决啦!!!

我来回复

您尚未登录,请登录后再回复。点此登录或注册