formliu.frm

教你如何实现键盘开机

VERSION 5.00
Begin VB.Form FormLiu 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "浏览"
   ClientHeight    =   5025
   ClientLeft      =   45
   ClientTop       =   270
   ClientWidth     =   4710
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5025
   ScaleWidth      =   4710
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   975
      Left            =   0
      TabIndex        =   5
      Top             =   3240
      Width           =   1575
      Begin VB.OptionButton Option1 
         Caption         =   "所有文件"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   7
         Top             =   600
         Width           =   1335
      End
      Begin VB.OptionButton Option1 
         Caption         =   "程序"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   6
         Top             =   240
         Value           =   -1  'True
         Width           =   855
      End
   End
   Begin VB.CommandButton Command1 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   495
      Index           =   1
      Left            =   3480
      TabIndex        =   4
      Top             =   4440
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   495
      Index           =   0
      Left            =   0
      TabIndex        =   3
      Top             =   4440
      Width           =   1215
   End
   Begin VB.FileListBox File1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4080
      Hidden          =   -1  'True
      Left            =   2160
      Pattern         =   "*.exe;*.bat;*.com;*.lnk;*.pif"
      System          =   -1  'True
      TabIndex        =   2
      Top             =   0
      Width           =   2535
   End
   Begin VB.DirListBox Dir1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2610
      Left            =   0
      TabIndex        =   1
      Top             =   480
      Width           =   2055
   End
   Begin VB.DriveListBox Drive1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2055
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Height          =   375
      Left            =   3120
      TabIndex        =   10
      Top             =   3600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "剩余容量："
      Height          =   240
      Index           =   1
      Left            =   1320
      TabIndex        =   9
      Top             =   4680
      Width           =   1200
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "总容量："
      Height          =   240
      Index           =   0
      Left            =   1320
      TabIndex        =   8
      Top             =   4320
      Width           =   960
   End
   Begin VB.Menu KongDir 
      Caption         =   ""
      Visible         =   0   'False
      Begin VB.Menu OPEN 
         Caption         =   "打开"
      End
      Begin VB.Menu SHELLNEW 
         Caption         =   "新建"
         Begin VB.Menu NEWFOLDER 
            Caption         =   "新建子文件夹"
         End
      End
      Begin VB.Menu SEND 
         Caption         =   "发送到"
         Begin VB.Menu SENDTO 
            Caption         =   ""
            Index           =   0
         End
      End
      Begin VB.Menu COPYTO 
         Caption         =   "复制到"
      End
      Begin VB.Menu CUTTO 
         Caption         =   "解切到"
      End
      Begin VB.Menu DEL 
         Caption         =   "删除"
      End
      Begin VB.Menu RENAME 
         Caption         =   "重命名"
      End
      Begin VB.Menu PROP 
         Caption         =   "属性"
      End
   End
End
Attribute VB_Name = "FormLiu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Sub Command1_Click(Index As Integer)
Dim Fpath$
If Index Then
Else
    Fpath = GetDirPath
    FormPei.Text1(CInt(Label2)) = Fpath & File1.filename
End If
Unload Me
End Sub

'Private Sub Command2_Click()
'Dim FileAtt&, FilePath$
'On Error GoTo erh
'With File1
'If .ListIndex = -1 Then Exit Sub
'FilePath = IIf(Right(.Path, 1) = "\", .Path, .Path & "\")
'If Check1(0).Value Then FileAtt = (FileAtt Or vbReadOnly)
'If Check1(1).Value Then FileAtt = (FileAtt Or vbArchive)
'If Check1(2).Value Then FileAtt = (FileAtt Or vbHidden)
'If Check1(3).Value Then FileAtt = (FileAtt Or vbSystem)
'SetAttr FilePath & .List(.ListIndex), FileAtt
'End With
'Exit Sub
'erh:
'MsgBox "无法为该文件设置属性", , ""
'End Sub

'Private Sub COPYTO_Click()
'On Error Resume Next
'Dim RootDir$, DCount&, Dc&
'RootDir = GetDirPath
'If MsgBox("将目录" & RootDir & "下的所有文件拷贝到，要执行吗？", vbYesNo + vbQuestion, "") = vbYes Then
'    Dim Fop As SHFILEOPSTRUCT
'    Fop.hwnd = hwnd
'    Fop.wFunc = FO_COPY
'    Fop.pFrom = RootDir & "*.*"
'    SHFileOperation Fop
'    RmDir RootDir
'End If
'Dir1.Refresh
'File1.Refresh
'End Sub
'
'Private Sub DEL_Click()
'On Error Resume Next
'Dim RootDir$, DCount&, Dc&
'RootDir = GetDirPath
'If MsgBox("这将删除目录" & RootDir & "下的所有文件，要执行吗？", vbYesNo + vbQuestion, "") = vbYes Then
'    Dim Fop As SHFILEOPSTRUCT
'    Fop.hwnd = hwnd
'    Fop.wFunc = FO_DELETE
'    Fop.pFrom = RootDir & "*.*"
'    SHFileOperation Fop
'    RmDir RootDir
'End If
'Dir1.Refresh
'File1.Refresh
'End Sub

Private Sub Dir1_Change()
With File1
.Path = Dir1.Path
If .ListCount > 0 Then .ListIndex = 0
End With
End Sub
Private Sub Dir1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
'    With Dir1
'        .Path = .List(.ListIndex)
'    End With
ElseIf Button = 2 Then
    PopupMenu KongDir
End If
End Sub

Private Sub Drive1_Change()
On Error GoTo erh
Dir1.Path = Drive1.Drive
GetDisk (Drive1.Drive & "\")
Exit Sub
erh:
MsgBox "设备未准备好！", , ""
End Sub

Private Sub File1_DblClick()
Command1(0) = True
End Sub

Private Sub Form_Load()
On Error GoTo errh
Drive1.Drive = GetSetting("BigChina", "Explorer", "LastLiuDrv", "C:\")
Dir1.Path = GetSetting("BigChina", "Explorer", "LastLiuDir", "c:\")
GetDisk (Drive1.Drive & "\")
Exit Sub
errh:
Drive1.Drive = "c:\"
Dir1.Path = "c:\"
Resume Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
SaveSetting "BigChina", "Explorer", "LastLiuDrv", Drive1.Drive
SaveSetting "BigChina", "Explorer", "LastLiuDir", Dir1.Path
End Sub

'Private Sub NEWFOLDER_Click()
'Dim NewF$, NewSF$
'NewF = GetDirPath
'If MsgBox("将要在" & NewF & "下新建一个文件夹，" & vbCrLf & "是这样吗？", vbYesNo + vbQuestion, "新建文件夹") = vbYes Then
'    NewSF = InputBox("请输入新文件夹的名称：", "", "NewFolder")
'    If NewSF = "" Then Exit Sub
'    NewF = NewF + NewSF
'    If CreateDirectory(NewF, 0) Then MsgBox "新文件夹建立成功！" & vbCrLf & "为:" & NewF: Dir1.Refresh Else MsgBox "无法建立新文件夹" & NewF
'End If
'End Sub

'Private Sub OPEN_Click()
'Dim ii&, Fname$
'Unload Me
'FormOpen.Hide
'Fname = Dir1.List(Dir1.ListIndex)
'ii = ShellExecute(MainHwnd, "open", Fname, vbNullString, vbNullString, SW_NORMAL)
'If ii < 32 Then ErrorMsg ii, Fname
'End Sub

Private Sub Option1_Click(Index As Integer)
If Index Then
   File1.Pattern = "*.*"
Else
   File1.Pattern = "*.exe;*.bat;*.com;*.lnk;*.pif"
End If
   File1.Refresh
End Sub
'Private Sub FileGet()
'Dim FileAtt&, FilePath$
'On Error Resume Next
'With File1
'If .ListIndex = -1 Then Exit Sub
'FilePath = IIf(Right(.Path, 1) = "\", .Path, .Path & "\")
'FileAtt = GetAttr(FilePath & .List(.ListIndex))
'End With
'Check1(0).Value = IIf((FileAtt And vbReadOnly) = vbReadOnly, 1, 0)
'Check1(1).Value = IIf((FileAtt And vbArchive) = vbArchive, 1, 0)
'Check1(2).Value = IIf((FileAtt And vbHidden) = vbHidden, 1, 0)
'Check1(3).Value = IIf((FileAtt And vbSystem) = vbSystem, 1, 0)
'End Sub
Private Sub GetDisk(ByVal Disk$)
Dim Spcu&, Bps&, Nofc&, Noc&, Zk As Double, Sk As Double
If GetDiskFreeSpace(Disk, Spcu, Bps, Nofc, Noc) Then
Zk = Format(Spcu * Bps * Noc / 2 ^ 20, "####0.##")
Sk = Format(Spcu * Bps * Nofc / 2 ^ 20, "####0.##")
Label1(0) = "总容量：" & Zk & "M"
Label1(1) = "剩余容量：" & Sk & "M"
Else
MsgBox "无法判断磁盘容量！", , ""
End If
End Sub
Private Function GetDirPath() As String
Dim DirP$
    With Dir1
        DirP = .List(.ListIndex)
    End With
GetDirPath = IIf(Right(DirP, 1) = "\", DirP, DirP & "\")
End Function


Private Sub PROP_Click()
ShowProperties GetDirPath, hwnd
End Sub