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。 |