VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - VB问题全功略(29)
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:10435, 日期:2002-01-28
VB问题全功略(29)

141、在 VB 程序中做复制磁片 (DiskCopy) 的功能
142、在 VB 程序中做制作格式 (Format) 的功能
143、简简单单做到【剪下 / 复制 / 贴上 / 复原】的功能
144、如何侦测电脑目前是否正在连线中?
145、如何在程序中启动【拨号网络连线】对话框?

141、在 VB 程序中做复制磁片 (DiskCopy) 的功能

下面这一段程序并不是实际在程序中就做复制磁片的功能,而是呼叫出 Windows 系统的复制磁片问话框!

注释:在声明区中加入以下声明

Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As Long

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

注释:在 Form 中加入一个 CommandButton 命名为 cmdDiskCopy,再加入一个 DriveListBox

Private Sub cmdDiskCopy_Click()
注释: DiskCopyRunDll takes two parameters- From and To
Dim DriveLetter$, DriveNumber&, DriveType&
Dim RetVal&, RetFromMsg&
DriveLetter = UCase(Drive1.Drive) 注释:磁盘代号 ( A / B / C / D..... )
DriveNumber = (Asc(DriveLetter) - 65) 注释:磁盘序号,从 0 开始:A=0,B=1....
DriveType = GetDriveType(DriveLetter) 注释:磁盘型态 ( 软盘 / 硬盘 / 光盘 ... )

If DriveType = 2 Then 注释:软盘
RetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll " & DriveNumber & "," & DriveNumber, 1) 注释:Notice space after
Else 注释:非软盘
RetFromMsg = MsgBox("只有磁盘片才可以复制磁片", 64, "复制磁片")
End If
End Sub

142、在 VB 程序中做制作格式 (Format) 的功能

下面这一段程序并不是实际在程序中就做制作格式的功能,而是呼叫出 Windows 系统的制作格式问话框!

这个范例程序是从网络上抓下来的,原作者特别注明,这一段程序也可以格式化硬盘,所以要小心控制,程序码中格式化硬盘的部份,我已经 Mark 起来了,若有需要,才将 Mark 拿掉吧!

软盘格式化的部份我已测试过没问题,硬盘的部份,我没有空硬盘所以没有测试,大家自己玩玩吧!若有问题再通知我!

注释:在声明区中加入以下声明

Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As Long

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

注释:在 Form 中加入一个 CommandButton 命名为 cmdFormatDrive,再加入一个 DriveListBox

Private Sub cmdFormatDrive_Click()
Dim DriveLetter$, DriveNumber&, DriveType&
Dim RetVal&, RetFromMsg%
DriveLetter = UCase(Drive1.Drive) 注释:磁盘代号 ( A / B / C / D..... )
DriveNumber = (Asc(DriveLetter) - 65) 注释:磁盘序号,从 0 开始:A=0,B=1....
DriveType = GetDriveType(DriveLetter) 注释:磁盘型态 ( 软盘 / 硬盘 / 光盘 ... )

If DriveType = 2 Then 注释:软盘
RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Else 注释:非软盘
RetFromMsg = MsgBox("这一张磁盘不是软盘,可能是硬盘!" & vbCrLf & _
"您还要继续格式 (Format) 吗?", 276, "格式化")
Select Case RetFromMsg
Case 6 注释:Yes:表示要格式化硬盘
注释: UnComment to do it...
注释:RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Case 7 注释:No:表示要取消格式化
注释: Do nothing
End Select
End If
End Sub

143、简简单单做到【剪下 / 复制 / 贴上 / 复原】的功能

在很多软件的编辑功能表中,都有提供【剪下 / 复制 / 贴上 / 复原】的功能,在 VB 中我们只要借用 Windows 的系统功能,很容易也可以有这样的功能,看看以下的程序码便能了解了!

Sub mnuEditText_Click (Index As Integer)
注释: 我们只要使用 SendKeys,其他的就让 Windows 去做吧!
Select Case Index
Case 0 注释:复原/UNDO
SendKeys "^Z" 注释:Keys Ctrl+Z
Case 1 注释:剪下/CUT
SendKeys "^X" 注释:Keys Ctrl+X
Case 2 注释:复制/COPY
SendKeys "^C" 注释:Keys Ctrl+C
Case 3 注释:贴上/PASTE
SendKeys "^V" 注释:Keys Ctrl+V
End Select
End Sub

144、如何侦测电脑目前是否正在连线中?

有些应用程序在程序中有部份功能必须和 Internet 连结沟通,这时候,侦测电脑目前是否正在连线状态就显得很重要了,每当在 Windows 中拨接上网之后,Windows 系统会自动在注册表中做上一点记号 (改变注册表中某些键值的资料),而我们在 VB 程序中就可以利用这些改变的键值来判断电脑目前是否正在连线状态!

注释:在模组的声明区中加入以下声明及模组:

Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public ReturnCode As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Public Function ActiveConnection() As Boolean
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As Long
Dim lpcbData As Long

ActiveConnection = False
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Remote Connection"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)
lpcbData = Len(lpData)
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)
If ReturnCode = ERROR_SUCCESS Then
If lpData = 0 Then
ActiveConnection = False
Else
ActiveConnection = True
End If
End If
RegCloseKey (hKey)
End If
End Function

注释:而在程序中使用实例如下:

If ActiveConnection = True then
Call MsgBox("您的电脑目前正在连线中!",vbInformation)
Else
Call MsgBox("您的电脑目前在离线状态!.", vbInformation)
End If

145、如何在程序中启动【拨号网络连线】对话框?

要直接在 VB 程序中开启【拨号网络连线】对话框,要使用 Shell 函数:

Private Sub Command1_Click()
Dim res
res = Shell("rundll32.exe rnaui.dll,RnaDial " & "拨号网络连线名称", 1)
End Sub

其中 "拨号网络连线名称" 是我们事先在 【拨号网络】中设定的【连线名称】,例如【Hinet】。

注:以上方法只适用于 Windows95/98。