⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.frm

📁 卸载USB设备的软件
💻 FRM
📖 第 1 页 / 共 2 页
字号:

'判断磁盘类型
Dim DiskKey As String
'截取磁盘列表前两个字符
DiskKey = Left(DriveList.List(i), 2)


    Select Case GetDriveBusType(DiskKey)
           Case "1394"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 6)
           Case "Ata"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 5)
           Case "Atapi"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 1)
           Case "Fibre"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 6)
           Case "RAID"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 5)
           Case "Scsi"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 1)
           Case "Ssa"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 6)
           Case "Usb"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 4)
           Case "未知"
                Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 6)
           Case Else
    End Select


End If  '结束有效性判断
Next i  '遍历下一个磁盘


End Sub


'** 无窗口拖动 **
'当鼠标在标题栏上时,实现拖动操作
Private Sub TitlePicture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim r As Long, i
  If Button = 1 Then
     i = ReleaseCapture()
     r = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  End If
End Sub

Private Sub Say_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim r As Long, i
  If Button = 1 Then
     i = ReleaseCapture()
     r = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  End If
End Sub



'/** 内存自动清理 **/
Private Sub NeiCun_Timer()
    SetProcessWorkingSetSize GetCurrentProcess, -1, -1
End Sub



'考虑到可扩展性,所以没有命名成复合词形式.例如btnUnload
'/** 鼠标在第一个按钮上点击触发的更换图片事件 **/
Private Sub Btn1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Btn1.Picture = LoadResPicture(106, 0)
End Sub

'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn1
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            Btn1.Picture = LoadResPicture(103, 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            Btn1.Picture = LoadResPicture(102, 0)
        End If
    End If
End With
End Sub

Private Sub Btn2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Btn2.Picture = LoadResPicture(107, 0)
End Sub

'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn2
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            Btn2.Picture = LoadResPicture(103, 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            Btn2.Picture = LoadResPicture(102, 0)
        End If
    End If
End With
End Sub

Private Sub Btn3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Btn3.Picture = LoadResPicture(108, 0)
End Sub

'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn3
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            Btn3.Picture = LoadResPicture(103, 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            Btn3.Picture = LoadResPicture(102, 0)
        End If
    End If
End With
End Sub

Private Sub Btn4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Btn4.Picture = LoadResPicture(109, 0)
End Sub

'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn4
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            Btn4.Picture = LoadResPicture(103, 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            Btn4.Picture = LoadResPicture(102, 0)
        End If
    End If
End With
End Sub


Private Sub Btn5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Btn5.Picture = LoadResPicture(104, 0)
End Sub

'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn5
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            Btn5.Picture = LoadResPicture(103, 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            Btn5.Picture = LoadResPicture(102, 0)
        End If
    End If
End With
End Sub
Private Sub Btn6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Btn6.Picture = LoadResPicture(105, 0)
End Sub

'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn6
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            Btn6.Picture = LoadResPicture(103, 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            Btn6.Picture = LoadResPicture(102, 0)
        End If
    End If
End With
End Sub


Private Sub MyDriverList_ItemClick(ByVal Item As MSComctlLib.ListItem)

ChooseDriver = MyDriverList.ListItems(MyDriverList.SelectedItem.Index).Text

LblTip.Caption = "点击卸载按钮,卸载盘符为 " & ChooseDriver & " 的磁盘"




End Sub


Private Sub btn2_Click()

    '设置路径变量
    StrPath = ChooseDriver & ":\"
    

        
        '接着判断是不是USB设备
        If GetDriveBusType(Left(StrPath, 2)) <> "Usb" Then
                
                '显示错误信息
                MsgBox "驱动器类型错误,请选择一个USB设备!", vbCritical, "错误"
        
                '还原没有焦点的图片
                Btn2.Picture = LoadResPicture(103, 0)

        
                '退出子过程
                Exit Sub
        
        '判断结束
        End If
        
        '如果没有发生上面不愉快的事情,那么确定是USB设备,进行下一步操作
        blnIsUsb = True

    
    '锁定卸载按钮,防止重复卸载
    Me.Btn2.Enabled = False
    Me.Btn3.Enabled = False
    
    '对设备进行卸载
    If CloseLockFileHandle(Left(StrPath, 2), GetCurrentProcessId) Then
                
        '检查卸载完成否
        If blnIsUsb Then
            '卸载成功
            If RemoveUsbDrive("\\.\" & Left(StrPath, 2), True) Then
                MsgBox "安全卸载USB设备成功!!", , "提示"
            '卸载失败
            Else
                MsgBox "安全卸载USB设备失败!!", vbCritical, "提示"
            End If
        End If
    Else
    
    '当发现有句柄没有关闭
        MsgBox "发现有锁定文件还没解锁!!", vbCritical, "提示"
    End If
    
    '操作执行完毕,还原卸载按钮可用
    Me.Btn2.Enabled = True
    Me.Btn3.Enabled = True


'检测磁盘
Call ReLoadList



End Sub

'强力卸载
Private Sub btn3_Click()


    Dim hwndShell As Long, i As Long
    Me.Btn2.Enabled = False
    Me.Btn3.Enabled = False
    hwndShell = FindWindow("Progman", vbNullString)
    i = PostMessage(hwndShell, WM_QUIT, 0, 0)
    If i = 0 Then Exit Sub
    Do While True
        hwndShell = FindWindow("Progman", vbNullString)
        If hwndShell = 0 Then
            Exit Do
        End If
        DoEvents
    Loop
    Shell "Explorer.exe", vbNormalFocus
    Me.Btn2.Enabled = True
    Me.Btn3.Enabled = True
    
    
    '检测磁盘
Call ReLoadList

End Sub


Private Sub btn1_Click()
'检测磁盘
Call ReLoadList

LblTip.Caption = "请先选择您要卸载的磁盘"
End Sub

Private Sub Btn5_Click()
Update
End Sub




Private Sub Btn6_Click()
MsgBox "俺还没想好界面怎么画。", vbCritical, "郁闷"
Btn6.Picture = LoadResPicture(103, 0)
Exit Sub
End Sub





'/** 鼠标在最小化按钮上点击触发的更换图片事件 **/
Private Sub btnMin_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    btnMin.Picture = LoadResPicture("btnmin3", 0)
End Sub

'/** 鼠标在最小化按钮上点击触发的窗体最小化事件 **/
Private Sub btnMin_Click()
    'Call CloseWindow(Me.hwnd)  '为什么不能用....
    MainForm.Hide
    btnMin.Picture = LoadResPicture("btnmin1", 0)
End Sub

'/** 鼠标在最小化按钮上滑动触发的更换图片事件 **/
Private Sub btnMin_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With btnMin
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            btnMin.Picture = LoadResPicture("btnmin1", 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            btnMin.Picture = LoadResPicture("btnmin2", 0)
        End If
    End If
End With

End Sub



'/** 鼠标在最大化按钮上点击触发的更换图片事件 **/
Private Sub btnMax_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    btnMax.Picture = LoadResPicture("btnmax3", 0)
End Sub

'/** 鼠标在最大化按钮上点击触发的窗体最小化事件 **/
Private Sub btnMax_Click()
MainForm.Hide
Unload MainForm
MsgBox "程序已经最小化至托盘,随时听从您的差遣。", vbInformation, "后台运行提示"
End Sub


'/** 鼠标在最大化按钮上滑动触发的更换图片事件 **/
Private Sub btnMax_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With btnMax
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            btnMax.Picture = LoadResPicture("btnmax1", 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            btnMax.Picture = LoadResPicture("btnmax2", 0)
        End If
    End If
End With

End Sub



'/** 鼠标在关闭按钮上点击触发的更换图片事件 **/
Private Sub btnEnd_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    btnEnd.Picture = LoadResPicture("btnend3", 0)
End Sub

'/** 鼠标在关闭按钮上点击触发的窗体最小化事件 **/
Private Sub btnEnd_Click()
    '卸载窗体 - 擦除窗体可视部分
    LetExitMe
    '如果不关闭就还原没有焦点的图
    btnEnd.Picture = LoadResPicture("btnend1", 0)
End Sub


'/** 鼠标在关闭按钮上滑动触发的更换图片事件 **/
Private Sub btnEnd_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With btnEnd
    '当鼠标未按下任何按键的时候
    If Button = 0 Then
        '判断鼠标是否在该控件上
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            ReleaseCapture
            '载入没有焦点时候的图
            btnEnd.Picture = LoadResPicture("btnend1", 0)
        Else
             '反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
             SetCapture .hwnd
            '载入有焦点的图
            btnEnd.Picture = LoadResPicture("btnend2", 0)
        End If
    End If
End With

End Sub



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -