使用vb6拨号连接
目前,我正在用经典的 vb6 开发一个实时股票市场价目表抓取器,如果没有有效的互联网连接,它将连接到互联网。对于互联网连接过程,我使用 rasapi32.dll 使用下面的代码,但不幸的是它总是返回错误代码:- 621,电话簿无法打开。
代码是
'This program let you dial to your dial-up connections using whether
'the stored user name and password or the ones you specifies
'(It use RasDial for dialing)
'You need a form with a list,2 textbox and a command button
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12
Private Type RASDIALPARAMS
dwSize As Long ' 1052
szEntryName(RAS95_MaxEntryName) As Byte
szPhoneNumber(RAS_MaxPhoneNumber) As Byte
szCallbackNumber(RAS_MaxCallbackNumber) As Byte
szUserName(UNLEN) As Byte
szPassword(PWLEN) As Byte
szDomain(DNLEN) As Bytehttp://stackoverflow.com/questions/1361069/how-can-i-access-hidden-class-variables-in-vb6
End Type
Private Type RASENTRYNAME95
'set dwsize to 264
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lprasdialextensions As Long, ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, ByRef lphrasconn As Long) As Long
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As Long
Private Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean
**Dim rp As RASDIALPARAMS, h As Long, resp As Long**
rp.dwSize = Len(rp) + 6
ChangeBytes Connection, rp.szEntryName
ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
ChangeBytes UserName, rp.szUserName
ChangeBytes Password, rp.szPassword
ChangeBytes "*", rp.szDomain 'Domain stored for the connection
'Dial
resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h) 'AddressOf RasDialFunc
MsgBox resp
Dial = (resp = 0)
End Function
Private Function ChangeToStringUni(Bytes() As Byte) As String
'Changes an byte array to a Visual Basic unicode string
Dim temp As String
temp = StrConv(Bytes, vbUnicode)
ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End Function
Private Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
'Changes a Visual Basic unicode string to an byte array
'Returns True if it truncates str
Dim lenBs As Long 'length of the byte array
Dim lenStr As Long 'length of the string
lenBs = UBound(Bytes) - LBound(Bytes)
lenStr = LenB(StrConv(str, vbFromUnicode))
If lenBs > lenStr Then
CopyMemory Bytes(0), str, lenStr
ZeroMemory Bytes(lenStr), lenBs - lenStr
ElseIf lenBs = lenStr Then
CopyMemory Bytes(0), str, lenStr
Else
CopyMemory Bytes(0), str, lenBs 'Queda truncado
ChangeBytes = True
End If
End Function
Private Sub Command1_Click()
Dial List1.Text, Text1, Text2
End Sub
Private Sub List1_Click()
Dim rdp As RASDIALPARAMS, t As Long
rdp.dwSize = Len(rdp) + 6
ChangeBytes List1.Text, rdp.szEntryName
'Get User name and password for the connection
t = RasGetEntryDialParams(List1.Text, rdp, 0)
If t = 0 Then
Text1 = ChangeToStringUni(rdp.szUserName)
Text2 = ChangeToStringUni(rdp.szPassword)
End If
End Sub
Private Sub Form_Load()
'example created by Daniel Kaufmann ([email protected])
'load the connections
Text2.PasswordChar = "*"
Command1.Caption = "Dial"
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If List1.ListCount > 0 Then
List1.ListIndex = 0
List1_Click
End If
End Sub
请帮助我
Currently I'm developing a real-time stock market price list grabber in classic vb6 which will connect to the internet if there is no active internet connection. for internet connection process I used the code below using rasapi32.dll, But unfortunately it always returns ERROR CODE :- 621, The phone-book cannot be opened.
THE CODE IS
'This program let you dial to your dial-up connections using whether
'the stored user name and password or the ones you specifies
'(It use RasDial for dialing)
'You need a form with a list,2 textbox and a command button
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12
Private Type RASDIALPARAMS
dwSize As Long ' 1052
szEntryName(RAS95_MaxEntryName) As Byte
szPhoneNumber(RAS_MaxPhoneNumber) As Byte
szCallbackNumber(RAS_MaxCallbackNumber) As Byte
szUserName(UNLEN) As Byte
szPassword(PWLEN) As Byte
szDomain(DNLEN) As Bytehttp://stackoverflow.com/questions/1361069/how-can-i-access-hidden-class-variables-in-vb6
End Type
Private Type RASENTRYNAME95
'set dwsize to 264
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lprasdialextensions As Long, ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, ByRef lphrasconn As Long) As Long
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As Long
Private Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean
**Dim rp As RASDIALPARAMS, h As Long, resp As Long**
rp.dwSize = Len(rp) + 6
ChangeBytes Connection, rp.szEntryName
ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
ChangeBytes UserName, rp.szUserName
ChangeBytes Password, rp.szPassword
ChangeBytes "*", rp.szDomain 'Domain stored for the connection
'Dial
resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h) 'AddressOf RasDialFunc
MsgBox resp
Dial = (resp = 0)
End Function
Private Function ChangeToStringUni(Bytes() As Byte) As String
'Changes an byte array to a Visual Basic unicode string
Dim temp As String
temp = StrConv(Bytes, vbUnicode)
ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End Function
Private Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
'Changes a Visual Basic unicode string to an byte array
'Returns True if it truncates str
Dim lenBs As Long 'length of the byte array
Dim lenStr As Long 'length of the string
lenBs = UBound(Bytes) - LBound(Bytes)
lenStr = LenB(StrConv(str, vbFromUnicode))
If lenBs > lenStr Then
CopyMemory Bytes(0), str, lenStr
ZeroMemory Bytes(lenStr), lenBs - lenStr
ElseIf lenBs = lenStr Then
CopyMemory Bytes(0), str, lenStr
Else
CopyMemory Bytes(0), str, lenBs 'Queda truncado
ChangeBytes = True
End If
End Function
Private Sub Command1_Click()
Dial List1.Text, Text1, Text2
End Sub
Private Sub List1_Click()
Dim rdp As RASDIALPARAMS, t As Long
rdp.dwSize = Len(rdp) + 6
ChangeBytes List1.Text, rdp.szEntryName
'Get User name and password for the connection
t = RasGetEntryDialParams(List1.Text, rdp, 0)
If t = 0 Then
Text1 = ChangeToStringUni(rdp.szUserName)
Text2 = ChangeToStringUni(rdp.szPassword)
End If
End Sub
Private Sub Form_Load()
'example created by Daniel Kaufmann ([email protected])
'load the connections
Text2.PasswordChar = "*"
Command1.Caption = "Dial"
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If List1.ListCount > 0 Then
List1.ListIndex = 0
List1_Click
End If
End Sub
Please help me
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
这可能根本没有帮助,但谷歌搜索发现了一些可能缺少组件或损坏的电话簿的建议:错误 621:无法打开电话簿
This may be no help at all, but googling turned up several suggestions that there may be missing components or a corrupt phonebook: Error 621: Cannot Open Phonebook