miaozk2006

Function GetCDROM() ' ·µ»Ø¹âÇýµÄÅÌ·û(×Öĸ)
    Dim Fso As New FileSystemObject '´´½¨ FSO ¶ÔÏóµÄÒ»¸öʵÀý
    Dim FsoDrive As Drive, FsoDrives As Drives '¶¨ÒåÇý¶¯Æ÷¡¢Çý¶¯Æ÷¼¯ºÏ¶ÔÏó
    Set FsoDrives = Fso.Drives
    For Each FsoDrive In FsoDrives '±éÀúËùÓпÉÓõÄÇý¶¯Æ÷
        If FsoDrive.DriveType = CDrom Then 'Èç¹ûÇý¶¯Æ÷µÄÀàÐÍΪ CDrom
            GetCDROM = FsoDrive.DriveLetter 'Êä³öÆäÅÌ·û
        Else
            GetCDROM = ""
        End If
    Next
    Set Fso = Nothing
    Set FsoDrive = Nothing
    Set FsoDrives = Nothing
End Function

'·µ»Ø²¼¶ûÖµ
'True ´æÔÚ£¬False ²»´æÔÚ£¬filername ÎļþÃû
Function FileExist(filename As String)
    Dim Fso As New FileSystemObject
    If Fso.FileExists(filename) = True Then
        FileExist = True
    Else
        FileExist = False
    End If
    Set Fso = Nothing
End Function
'·µ»Ø²¼¶ûÖµ
'True ´æÔÚ£¬False ²»´æÔÚ£¬foldername Îļþ¼Ð
Function FolderExist(foldername As String)
    Dim Fso As New FileSystemObject
    If Fso.FolderExists(foldername) = True Then
        FolderExist = True
    Else
        FolderExist = False
    End If
    Set Fso = Nothing
   End Function

'·µ»Ø´ÅÅÌ×Ü¿Õ¼ä´óС(µ¥Î»£ºM)£¬Drive = ÅÌ·û A ,C, D ...
Function AllSpace(Drive As String)
    Dim Fso As New FileSystemObject, Drv As Drive
    Set Drv = Fso.GetDrive(Drive) 'µÃµ½ Drv ¶ÔÏóµÄʵÀý
    If Drv.IsReady Then 'Èç¹û¸ÃÇý¶¯Æ÷´æÔÚ(ÈíÇý»ò¹âÇýÀïÓÐÅÌƬ£¬Ó²ÅÌ´æÈ¡Õý³£)
    AllSpace = Format$(Drv.TotalSize / (2 ^ 20), "0.00") '½«×Ö½Úת»»ÎªÕ×
Else
    AllSpace = 0
End If
Set Fso = Nothing
Set Drv = Nothing
End Function
'·µ»Ø´ÅÅÌ¿ÉÓÿռä´óС(µ¥Î»£ºM)£¬Drive = ÅÌ·û A ,C, D ...
Function FreeSpace(Drive)
    Dim Fso As New FileSystemObject, Drv As Drive
    Set Drv = Fso.GetDrive(Drive)
    If Drv.IsReady Then
        FreeSpace = Format$(Drv.FreeSpace / (2 ^ 20), "0.00")
    End If
    Set Fso = Nothing
    Set Drv = Nothing
End Function
'»ñÈ¡Çý¶¯Æ÷ÎļþϵͳÀàÐÍ£¬Drive = ÅÌ·û A ,C, D ...
Function FsType(Drive As String)
    Dim Fso As New FileSystemObject, Drv As Drive
    Set Drv = Fso.GetDrive(Drive)
    If Drv.IsReady Then
        FsType = Drv.FileSystem
    Else
        FsType = ""
    End If
    Set Fso = Nothing
    Set Drv = Nothing
End Function

'·µ»Ø Windows Îļþ¼Ð·¾¶
Function GetWindir()
    Dim Fso As New FileSystemObject
    GetWindir = Fso.GetSpecialFolder(WindowsFolder)
    Set Fso = Nothing
End Function
'·µ»Ø Windows\System Îļþ¼Ð·¾¶
Function GetWinSysdir()
    Dim Fso As New FileSystemObject
    GetWinSysdir = Fso.GetSpecialFolder(SystemFolder)
    Set Fso = Nothing
End Function

'Filename = ÎļþÃû£¬Drive = Çý¶¯Æ÷£¬Folder = Îļþ¼Ð(Ò»²ã)
Sub BackupFile(Filename As String, Drive As String, Folder As String)
    Dim Fso As New FileSystemObject '´´½¨ FSO ¶ÔÏóʵÀý
    Dim Dest_path As String, Counter As Long
    Counter = 0
    Do While Counter < 6 'Èç¹ûÇý¶¯Æ÷û׼±¸ºÃ£¬¼ÌÐø¼ì²â¡£¹²¼ì²â 6 Ãë
        Counter = Counter + 1
        Call Waitfor(1) '¼ä¸ô 1 Ãë
        If Fso.Drives(Drive).IsReady = True Then
            Exit Do
        End If
    Loop
    If Fso.Drives(Drive).IsReady = False Then '6 ÃëºóÄ¿±êÅÌÈÔδ׼±¸¾ÍÐ÷£¬Í˳ö
        MsgBox " Ä¿±êÇý¶¯Æ÷ " & Drive & " ûÓÐ×¼±¸ºÃ£¡ ", vbCritical
        Exit Sub
    End If
    If Fso.GetDrive(Drive).FreeSpace < Fso.GetFile(Filename).Size Then
        MsgBox "Ä¿±êÇý¶¯Æ÷¿Õ¼ä̫С£¡", vbCritical 'Ä¿±êÇý¶¯Æ÷¿Õ¼ä²»¹»£¬Í˳ö
        Exit Sub
    End If
    If Right$(Drive, 1) <> ":" Then
        Drive = Drive & ":"
    End If
    If Left$(Folder, 1) <> "\" Then
        Folder = "\" & Folder
    End If
    If Right$(Folder, 1) <> "\" Then
        Folder = Folder & "\"
    End If
    Dest_path = Drive & Folder
    If Not Fso.FolderExists(Dest_path) Then 'Èç¹ûÄ¿±êÎļþ¼Ð²»´æÔÚ£¬´´½¨Ö®
        Fso.CreateFolder Dest_path
    End If
    Fso.CopyFile Filename, Dest_path & Fso.GetFileName(Filename), True
    '¿½±´£¬Ö±½Ó¸²¸ÇͬÃûÎļþ
    MsgBox " Îļþ±¸·ÝÍê±Ï¡£", vbOKOnly
    Set Fso = Nothing
End Sub
Private Sub Waitfor(Delay As Single) 'ÑÓʱ¹ý³Ì£¬Delay µ¥Î»Ô¼Îª 1 Ãë
    Dim StartTime As Single
    StartTime = Timer
    Do Until (Timer - StartTime) > Delay
    Loop
   End Sub