启动拨号网络中的连接
由于拨号网络不是一个可执行文件, 所以要启动拨号网络,需要借助 explorer.exe 。但若是要启动拨号网络中的某一个连接,则要借助rundll.exe 和 rnaui.dll两个文件。启动方法如下(假定此连接名称为163):
Shell "rundll rnaui.dll,RnaDial 163",vbNormalFocus
上面假定了连接名称,但在实际编程中我们是不知道连接名称的。在窗体上放置一个命令按钮(cmdCallConnect),在其单击事件中进行连接处理。下面的代码介绍如何取得默认的连接名称并启动它:
Option Explicit
/*有关的API声明*/
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32"(ByVal hKey As Long) As Long
/*常数的设定*/
Const HKEY_CURRENT_USER = &H80000001
Const ERROR_SUCCESS = 0
在命令按钮(cmdCallConnect)中加入如下代码:
Private Sub cmdCallConnect_Click()
/*启动默认拨号连接*/
Shell "rundll rnaui.dll,RnaDial" + GetConnect, vbNormalFocus
End Sub
/*取得连接的函数(GetConnect)*/
Public Function GetConnect() As String
Dim hKey As Long
Dim SubKey As String
/*主键*/
hKey = HKEY_CURRENT_USER
/*子键*/
SubKey = "RemoteAccess"
/*取得默认连接名*/
GetConnect=GetRegValue(hKey,SubKey, "Default")
End Function
/*取得注册的函数(GetRegValue)*/
Public Function GetRegValue(hKey As Long,lpszSubKey As String,szKey As String) As Variant
On Error GoTo ErrorRoutineErr:
Dim phkResult As Long
Dim lResult As Long
Dim szBuffer As String
Dim lBuffSize As Long
/*创建缓冲区*/
szBuffer = Space(255)
lBuffSize = Len(szBuffer)
/*打开注册键*/
RegOpenKeyEx hKey, lpszSubKey, 0, 1,phkResult
/*取得查询结果*/
lResult = RegQueryValueEx(phkResult, szKey, 0, 0, szBuffer, lBuffSize)
/*关闭注册键*/
RegCloseKey phkResult
/*返回结果*/
If lResult = ERROR_SUCCESS Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue =""
End If
Exit Function
/*意外处理*/
ErrorRoutineErr:
GetRegValue =""
End Function
设计E-mail的接收部分 /*有关的API声明*/
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32"(ByVal hKey As Long) As Long
/*常数的设定*/
Const HKEY_CURRENT_USER = &H80000001
Const ERROR_SUCCESS = 0
在命令按钮(cmdCallConnect)中加入如下代码:
Private Sub cmdCallConnect_Click()
/*启动默认拨号连接*/
Shell "rundll rnaui.dll,RnaDial" + GetConnect, vbNormalFocus
End Sub
/*取得连接的函数(GetConnect)*/
Public Function GetConnect() As String
Dim hKey As Long
Dim SubKey As String
/*主键*/
hKey = HKEY_CURRENT_USER
/*子键*/
SubKey = "RemoteAccess"
/*取得默认连接名*/
GetConnect=GetRegValue(hKey,SubKey, "Default")
End Function
/*取得注册的函数(GetRegValue)*/
Public Function GetRegValue(hKey As Long,lpszSubKey As String,szKey As String) As Variant
On Error GoTo ErrorRoutineErr:
Dim phkResult As Long
Dim lResult As Long
Dim szBuffer As String
Dim lBuffSize As Long
/*创建缓冲区*/
szBuffer = Space(255)
lBuffSize = Len(szBuffer)
/*打开注册键*/
RegOpenKeyEx hKey, lpszSubKey, 0, 1,phkResult
/*取得查询结果*/
lResult = RegQueryValueEx(phkResult, szKey, 0, 0, szBuffer, lBuffSize)
/*关闭注册键*/
RegCloseKey phkResult
/*返回结果*/
If lResult = ERROR_SUCCESS Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue =""
End If
Exit Function
/*意外处理*/
ErrorRoutineErr:
GetRegValue =""
End Function
在VB 6菜单上点击"工程/部件...",弹出"部件"对话框,在对话框的控件卡中选中Microsoft MAPI Controls 6.0控件,点击"确定"按钮后,工具箱上增加了MAPIMessage和MAPISession两个图标。
在Form上加入一个MAPIMessage控件,取名为MAPIMessage1;再加入一个MAPISession控件,取名为MAPISession1;再加入三个TextBox控件,分别取名为Subject、Content和Indexno, 将它们的Caption分别改为邮件标题、邮件内容和邮件索引号;在TextBox前各加入一个Label控件,将Caption分别改为标题、内容和索引号。
将MAPIMessage1的各项属性设置如下:
·DownLoadMail=TRUE;
·LogonUI=TRUE;
·NewSession=FALSE;
·UserName="接收Email"。
在Form上加入一个按钮(Getmail),将其Caption改为取邮件。
在 Getmail_Click()事件中加入以下程序代码,程序的功能是使我们接收Email。
MAPIMessage1.Fetch
Form1.Caption=MAPIMessage1.MsgCount
MAPIMessage1.MsgIndex=CINT(Indexno.text)
Subject.Text = MAPIMessage1.MsgNoteText
Content.Text = MAPIMessage1.MsgSubject
其中Fetch命令用来将信件抓到系统存储器的inbuffer中。我们将信件抓回来后,可以通过MsgCount属性知道信件数量,接着可以用MsgIndex设置要看哪一封信件的内容、标题等。
Form1.Caption=MAPIMessage1.MsgCount
MAPIMessage1.MsgIndex=CINT(Indexno.text)
Subject.Text = MAPIMessage1.MsgNoteText
Content.Text = MAPIMessage1.MsgSubject
