Fu$$ing Dialup! :-(((

[Scuder]

Блин, весь инет облазил, не могу вообще ничего полезного найти..
Кто-нибудь знает, как программно соединиться с провайдером, зная всё: телефон, логин, пароль.. Насколько я понимаю, есть 2 пути:
1. Использовать существующее соединение. Но надо, чтобы стандартное окно не показывалось..
2.Общаться напрямую с COM-портом.. Но не понятно как ввести логин и пароль..
Короче, НИ ФИГА не получается..
Хелп, плз, кто чем может.. %-)

[Cyrax]

http://www.vbip.com/wininet/wininet_dialup.asp
а еще в MSDN поищи примеры "Dialer.vbp" и "VBTerm.vbp"

[_Мика_]

Вот вроди бы!
Из API-Guide



'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 Byte
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
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 (daniel@i.com.uy)
'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

[Scuder]

2Cyrax: Пример по ссылке всё равно показывает окно соединения.. А MSDN у меня нет..

2_Мика_: Всё было бы хорошо (как видно из кода), но ничего не происходит.. То есть соединение он в листбоксе показывает, но при вызове функции, resp = 621, и Dial, соответственно, False..

[Cyrax]

врешь, однако... есть - http://msdn.microsoft.com
http://search.microsoft.com/search/resu ... bp&c=0&s=1
http://search.microsoft.com/search/resu ... bp&c=0&s=1
ну блин собака... чуть запустил этот пример... они его, гады, оказывается еще на пятом басике писали...

[Scuder]

2Cyrax: Вру. Есть. Но я его органически не перевариваю.. Несколько раз ткнулся, но так и не смог разобраться в логике майкрософтовских программеров..

VBTerm - это обычная терминалка (звонилка).. Номер я и сам могу набрать.. А как мне логин и пароль передать туда? Из порта после коннекта "льётся" просто мусор типа "~я}#А!}!}#} }9}"}&} }*} } }'}"}(}"}%}&k‡hx}#}%В#}%µ¬~".. Я это не понимаю. Тупо mscomm.output = "login" слать, конечно, можно.. Только результата никакого..

Cyrax, поскольку ты один участвуешь в этом топике, на тебя все надежды.. Я уже просто отчаялся что-нибудь найти, а надо позарез.. Ты мне можешь сказать почему пример Мики не работает? Это как раз то, что нужно..

[Cyrax]

ok. попробую разобраться

[Scuder]

Имхо, там проблемы начинаются ещё с определения параметров соединения.. В List1.click. Он моё соединение видит, показывает его, но логин и пароль, а соответственно и телефон (скорее всего) оттуда не берёт. А должен.. Пихаю ему номер телефона вручную. Не помогает.. Странно ещё то, что при при вызове RasGetEntryDialParams(List1.Text, rdp, 0) в List1.click, переменной t присваивается значение 621. Такое же значение у переменной resp при вызове RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h) в функции Dial.. Хотя в обоих случаях правильный возврат - 0. Бред какой-то.. Может код для 9x? У меня w2k стоит..

[Texel]

Если в вызове RasDial и RasGetEntryDialParams поменять 0 на vbNullString, то все должно заработать. По крайней мере под ХР
...
t = RasGetEntryDialParams(vbNullString, rdp, 0)
...
resp = RasDial(ByVal 0, ByVal vbNullString, rp, 0, ByVal 0, h)
....

[Mizin Alex]

У меня есть рабочая звонилка на RASAPI (Когда-то сам также мучился , так, что твои мучения шибко знакомы .Работает в асинхронном режиме) ! Могу также выслать архивчик буржуйский с пояснениями и примерами использования этих функций .
Нуна ? Мыло давай !

С ув. Alex

[Str]

есть такая-же проблема ,
хотелось бы посмотреть пример
petrjob@mail.ru

[Scuder]

Э! А на форуме не судьба выложить?

[Mizin Alex]

Scuder - "Э! А на форуме не судьба выложить?"
ИМХО могу ли я предположить , что 'Э!' это я ?
Или ники уже отменили ?:mad:

[kif]

Ты работаешь по протоколу HTTP, вот и ищи его описалово (комманды и ответы сервера)

что еще можно сказать.

[tyomitch]

Чё? Он прову дозванивается по HTTP?

[Mizin Alex]

Вчерась отправил в раздел 'ИСХОДНИКИ' пример звонилки на RASDial
Ожидаем появления ...

С ув. Alex

[Texel]

Вчерась отправил в раздел 'ИСХОДНИКИ' пример звонилки на RASDial
Ожидаем появления ...

Как бы это ожидание не затянулось надолго
А на форуме не хотите выложить?

[Mizin Alex]

Да я бы с удовольствием прицепулил бы архивчики , да как-то пробовал ...
присоединил ... отправил ... , а на форуме сообщение без файла !
Или форум глючит или я ... . Или чегой-то я не так делаю чтоль ?

С ув. Alex

[Mizin Alex]

Ау ! Админы ! Не будет ли любезен уважаемый джин ... примерчик ...
Народ ропщет ... однако .

С ув. Alex.

[ASD]

Это в модуль

Public Type RASIPADDR
a As Byte
b As Byte
c As Byte
d As Byte
End Type

Public Enum RasEntryOptions
RASEO_UseCountryAndAreaCodes = &H1
RASEO_SpecificIpAddr = &H2
RASEO_SpecificNameServers = &H4
RASEO_IpHeaderCompression = &H8
RASEO_RemoteDefaultGateway = &H10
RASEO_DisableLcpExtensions = &H20
RASEO_TerminalBeforeDial = &H40
RASEO_TerminalAfterDial = &H80
RASEO_ModemLights = &H100
RASEO_SwCompression = &H200
RASEO_RequireEncryptedPw = &H400
RASEO_RequireMsEncryptedPw = &H800
RASEO_RequireDataEncryption = &H1000
RASEO_NetworkLogon = &H2000
RASEO_UseLogonCredentials = &H4000
RASEO_PromoteAlternates = &H8000
RASEO_SecureLocalFiles = &H10000
RASEO_RequireEAP = &H20000
RASEO_RequirePAP = &H40000
RASEO_RequireSPAP = &H80000
RASEO_Custom = &H100000
RASEO_PreviewPhoneNumber = &H200000
RASEO_SharedPhoneNumbers = &H800000
RASEO_PreviewUserPw = &H1000000
RASEO_PreviewDomain = &H2000000
RASEO_ShowDialingProgress = &H4000000
RASEO_RequireCHAP = &H8000000
RASEO_RequireMsCHAP = &H10000000
RASEO_RequireMsCHAP2 = &H20000000
RASEO_RequireW95MSCHAP = &H40000000
RASEO_CustomScript = &H80000000
End Enum

Public Enum RASNetProtocols
RASNP_NetBEUI = &H1
RASNP_Ipx = &H2
RASNP_Ip = &H4
End Enum

Public Enum RasFramingProtocols
RASFP_Ppp = &H1
RASFP_Slip = &H2
RASFP_Ras = &H4
End Enum


Public Type VBRasEntry
options As RasEntryOptions
CountryID As Long
CountryCode As Long
AreaCode As String
LocalPhoneNumber As String
AlternateNumbers As String
ipAddr As RASIPADDR
ipAddrDns As RASIPADDR
ipAddrDnsAlt As RASIPADDR
ipAddrWins As RASIPADDR
ipAddrWinsAlt As RASIPADDR
FrameSize As Long
fNetProtocols As RASNetProtocols
FramingProtocol As RasFramingProtocols
ScriptName As String
AutodialDll As String
AutodialFunc As String
DeviceType As String
DeviceName As String
X25PadType As String
X25Address As String
X25Facilities As String
X25UserData As String
Channels As Long
NT4En_SubEntries As Long
NT4En_DialMode As Long
NT4En_DialExtraPercent As Long
NT4En_DialExtraSampleSeconds As Long
NT4En_HangUpExtraPercent As Long
NT4En_HangUpExtraSampleSeconds As Long
NT4En_IdleDisconnectSeconds As Long
Win2000_Type As Long
Win2000_EncryptionType As Long
Win2000_CustomAuthKey As Long
Win2000_guidId(0 To 15) As Byte
Win2000_CustomDialDll As String
Win2000_VpnStrategy As Long
End Type



'Make a combo box for the modem devices and use the GetDevices command.
'in the form Dim clsVbRasEntry As VbRasEntry
'make calls as clsVbRasEntry.options = selected options
'clsVbRasEntry.LocalPhoneNumber = "555-5555" and so forth

Public Declare Function RasSetEntryProperties _
Lib "rasapi32.dll" Alias "RasSetEntryPropertiesA" _
(ByVal lpszPhonebook As String, _
ByVal lpszEntry As String, _
lpRasEntry As Any, _
ByVal dwEntryInfoSize As Long, _
lpbDeviceInfo As Any, _
ByVal dwDeviceInfoSize As Long) _
As Long

Public Declare Function RasGetErrorString _
Lib "rasapi32.dll" Alias "RasGetErrorStringA" _
(ByVal uErrorValue As Long, ByVal lpszErrorString As String, _
cBufSize As Long) As Long

Public Declare Function FormatMessage _
Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, _
ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, _
Arguments As Long) As Long

Public Declare Function RasGetEntryProperties _
Lib "rasapi32.dll" Alias "RasGetEntryPropertiesA" _
(ByVal lpszPhonebook As String, _
ByVal lpszEntry As String, _
lpRasEntry As Any, _
lpdwEntryInfoSize As Long, _
lpbDeviceInfo As Any, _
lpdwDeviceInfoSize As Long) As Long
Public Type VBRASDEVINFO
DeviceType As String
DeviceName As String
End Type

Public Declare Function RasEnumDevices _
Lib "rasapi32.dll" Alias "RasEnumDevicesA" ( _
lpRasDevInfo As Any, _
lpcb As Long, _
lpcDevices As Long _
) As Long
'--------------------------------------------
Public Type VBRasDialParams
EntryName As String
PhoneNumber As String
CallbackNumber As String
UserName As String
Password As String
Domain As String
SubEntryIndex As Long
RasDialFunc2CallbackId As Long
End Type

Public Declare Function RasSetEntryDialParams _
Lib "rasapi32.dll" Alias "RasSetEntryDialParamsA" _
(ByVal lpszPhonebook As String, _
lpRasDialParams As Any, _
ByVal blnRemovePassword As Long) As Long

Public Declare Function RasGetEntryDialParams _
Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" _
(ByVal lpszPhonebook As String, _
lpRasDialParams As Any, _
blnPasswordRetrieved As Long) As Long

Private Declare Function RasValidateEntryName _
Lib "rasapi32.dll" Alias "RasValidateEntryNameA" _
(ByVal lpszPhonebook As String, _
ByVal lpszEntry As String) As Long
'----------------------------------------------
'----------------------------------------------
' Operating system enumerations
Public Enum OSTypes
OS_Unknown = 0 ' "Unknown"
OS_Win32 = 32 ' "Win 32"
OS_Win95 = 95 ' "Windows 95"
OS_Win98 = 98 ' "Windows 98"
OS_WinNT_351 = 351 ' "Windows NT 3.51"
OS_WinNT_40 = 40 ' "Windows NT 4.0"
OS_Win2000 = 2000 ' "Windows 2000"
End Enum

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

' Constants - RasGetEntryProperties Errors
Public Const RASBASE = 600 ' RAS base error number
Public Const ERROR_INVALID_PARAMETER = 87 ' Invalid parameter passed to function
Public Const ERROR_INVALID_SIZE = (RASBASE + 32) ' The structure size is incorrect.
Public Const ERROR_BUFFER_INVALID = (RASBASE + 10) ' The buffer is invalid.
Public Const ERROR_BUFFER_TOO_SMALL = (RASBASE + 3) ' Caller's buffer is too small.
Public Const ERROR_CANNOT_OPEN_PHONEBOOK = (RASBASE + 21) ' Cannot open the phone book file.
Public Const ERROR_CANNOT_FIND_PHONEBOOK_ENTRY = (RASBASE + 23) ' Cannot find the phone book entry.


' Constants - Operating systems
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Public Type RASDIALDIALOG ' [ Windows NT Only ]
dwSize As Long ' IN - Specifies the size of this structure, in bytes. Before calling RasDialDlg, set this member to sizeof(RASDIALDIALOG) to indicate the version of the structure. If dwSize is not a valid size, RasDialDlg fails and sets the dwError member to ERROR_INVALID_SIZE.
hwndOwner As Long ' IN - Specifies the window that owns the modal RasDialDlg dialog boxes. This member can be any valid window handle, or it can be NULL if the dialog box has no owner.
dwFlags As Long ' IN - A bit flag that indicates the options that are enabled for the dialog box. You can specify the following value : RASDDFLAG_PositionDlg
xDlg As Long ' IN - Specifies the horizontal screen coordinate of the upper-left corner of the dialog box. This value is used only if the RASDDFLAG_PositionDlg flag is set.
yDlg As Long ' IN - Specifies the vertical screen coordinate of the upper-left corner of the dialog box. This value is used only if the RASDDFLAG_PositionDlg flag is set.
dwSubEntry As Long ' IN - Specifies the subentry or subentries to dial. If dwSubEntry is zero, RasDialDlg dials all subentries associated with the specified phone-book entry. Otherwise, to indicate the index of the individual subentry to dial, dwSubEntry must be a number from one to the number of subentries.
dwError As Long ' OUT - The RasDialDlg function sets this member to a system error code or RAS error code if an error occurs. If no error occurs, the function sets dwError to zero. This value is ignored on input.
Reserved As Long ' IN - Reserved; must be zero.
Reserved2 As Long ' IN - Reserved; must be zero.
End Type
Private Declare Function RasDialDlg Lib "RASDLG.DLL" Alias "RasDialDlgA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, ByVal lpszPhoneNumber As String, ByRef lpInfo As RASDIALDIALOG) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long

'---------------------------------------------
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)

Global Const RAS_MaxDeviceType = 16
Global Const RAS_MaxDeviceName = 128

Global Const GMEM_FIXED = &H0
Global Const GMEM_ZEROINIT = &H40
Global Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Global Const ApINULL = 0&

Type RASDEVINFO
dwSize As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type

Declare Function iRasEnumDevices Lib "rasapi32.dll" Alias "RasEnumDevicesA" ( _
lpRasDevInfo As Any, _
lpcb As Long, _
lpcDevices As Long) As Long

Declare Sub iCopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Sub GetDevices(lst As ComboBox)
Dim lpRasDevInfo As RASDEVINFO
Dim lpcb As Long
Dim cDevices As Long
Dim t_Buff As Long
Dim nRet As Long
Dim t_ptr As Long
Dim i As Long

lpcb = 0

lpRasDevInfo.dwSize = LenB(lpRasDevInfo) + (LenB(lpRasDevInfo) Mod 4)

nRet = iRasEnumDevices(ByVal 0, lpcb, cDevices)

t_Buff = GlobalAlloc(GPTR, lpcb)

iCopyMemory ByVal t_Buff, lpRasDevInfo, LenB(lpRasDevInfo)

nRet = iRasEnumDevices(ByVal t_Buff, lpcb, lpcb)

If nRet = 0 Then
t_ptr = t_Buff

For i = 0 To cDevices - 1
iCopyMemory lpRasDevInfo, ByVal t_ptr, LenB(lpRasDevInfo)

'Modifed By ASD
'If block Remove WAN interfaces
If InStr(1, Command$, "nomodem") Then
lst.AddItem (ByteToString(lpRasDevInfo.szDeviceName))
Else
If ByteToString(lpRasDevInfo.szDeviceType) = "modem" Then
lst.AddItem (ByteToString(lpRasDevInfo.szDeviceName))
End If
End If
'END IF
t_ptr = t_ptr + LenB(lpRasDevInfo) + (LenB(lpRasDevInfo) Mod 4)
Next i
Else
MsgBox nRet
End If

If t_Buff <> 0 Then GlobalFree (t_Buff)

End Sub

Function ByteToString(bytearray() As Byte) As String
Dim i As Integer, t As String
i = 0
t = ""
While i < UBound(bytearray) And bytearray(i) <> 0
t = t & Chr$(bytearray(i))
i = i + 1
Wend
ByteToString = t
End Function


Function VBRasSetEntryProperties(strEntryName As String, _
typRasEntry As VBRasEntry, _
Optional strPhonebook As String) As Long

Dim rtn As Long, lngCb As Long, lngBuffLen As Long
Dim b() As Byte
Dim lngPos As Long, lngStrLen As Long

rtn = RasGetEntryProperties(vbNullString, vbNullString, _
ByVal 0&, lngCb, ByVal 0&, ByVal 0&)

If rtn <> 603 Then VBRasSetEntryProperties = rtn: Exit Function

lngStrLen = Len(typRasEntry.AlternateNumbers)
lngBuffLen = lngCb + lngStrLen + 1
ReDim b(lngBuffLen)

CopyMemory b(0), lngCb, 4
CopyMemory b(4), typRasEntry.options, 4
CopyMemory b(8), typRasEntry.CountryID, 4
CopyMemory b(12), typRasEntry.CountryCode, 4
CopyStringToByte b(16), typRasEntry.AreaCode, 11
CopyStringToByte b(27), typRasEntry.LocalPhoneNumber, 129

If lngStrLen > 0 Then
CopyMemory b(lngCb), _
ByVal typRasEntry.AlternateNumbers, lngStrLen
CopyMemory b(156), lngCb, 4
End If

CopyMemory b(160), typRasEntry.ipAddr, 4
CopyMemory b(164), typRasEntry.ipAddrDns, 4
CopyMemory b(168), typRasEntry.ipAddrDnsAlt, 4
CopyMemory b(172), typRasEntry.ipAddrWins, 4
CopyMemory b(176), typRasEntry.ipAddrWinsAlt, 4
CopyMemory b(180), typRasEntry.FrameSize, 4
CopyMemory b(184), typRasEntry.fNetProtocols, 4
CopyMemory b(188), typRasEntry.FramingProtocol, 4
CopyStringToByte b(192), typRasEntry.ScriptName, 260
CopyStringToByte b(452), typRasEntry.AutodialDll, 260
CopyStringToByte b(712), typRasEntry.AutodialFunc, 260
CopyStringToByte b(972), typRasEntry.DeviceType, 17
If lngCb = 1672& Then lngStrLen = 33 Else lngStrLen = 129
CopyStringToByte b(989), typRasEntry.DeviceName, lngStrLen
lngPos = 989 + lngStrLen
CopyStringToByte b(lngPos), typRasEntry.X25PadType, 33
lngPos = lngPos + 33
CopyStringToByte b(lngPos), typRasEntry.X25Address, 201
lngPos = lngPos + 201
CopyStringToByte b(lngPos), typRasEntry.X25Facilities, 201
lngPos = lngPos + 201
CopyStringToByte b(lngPos), typRasEntry.X25UserData, 201
lngPos = lngPos + 203
CopyMemory b(lngPos), typRasEntry.Channels, 4

If lngCb > 1768 Then
CopyMemory b(1768), typRasEntry.NT4En_SubEntries, 4
CopyMemory b(1772), typRasEntry.NT4En_DialMode, 4
CopyMemory b(1776), typRasEntry.NT4En_DialExtraPercent, 4
CopyMemory b(1780), typRasEntry.NT4En_DialExtraSampleSeconds, 4
CopyMemory b(1784), typRasEntry.NT4En_HangUpExtraPercent, 4
CopyMemory b(1788), typRasEntry.NT4En_HangUpExtraSampleSeconds, 4
CopyMemory b(1792), typRasEntry.NT4En_IdleDisconnectSeconds, 4

If lngCb > 1796 Then
CopyMemory b(1796), typRasEntry.Win2000_Type, 4
CopyMemory b(1800), typRasEntry.Win2000_EncryptionType, 4
CopyMemory b(1804), typRasEntry.Win2000_CustomAuthKey, 4
CopyMemory b(1808), typRasEntry.Win2000_guidId(0), 16
CopyStringToByte b(1824), typRasEntry.Win2000_CustomDialDll, 260
CopyMemory b(2084), typRasEntry.Win2000_VpnStrategy, 4
End If

End If

rtn = RasSetEntryProperties(strPhonebook, strEntryName, _
b(0), lngCb + lngStrLen, ByVal 0&, ByVal 0&)

VBRasSetEntryProperties = rtn

End Function


Function VBRASErrorHandler(rtn As Long) As String
Dim strError As String, i As Long
strError = String(512, 0)
If rtn > 600 Then
RasGetErrorString rtn, strError, 512&
Else
FormatMessage &H1000, ByVal 0&, rtn, 0&, strError, 512, ByVal 0&
End If
i = InStr(strError, Chr$(0))
If i > 1 Then VBRASErrorHandler = Left$(strError, i - 1)
End Function

Function VBRasGetEntryProperties(strEntryName As String, _
typRasEntry As VBRasEntry, _
Optional strPhonebook As String) As Long

Dim rtn As Long, lngCb As Long, lngBuffLen As Long
Dim b() As Byte
Dim lngPos As Long, lngStrLen As Long

rtn = RasGetEntryProperties(vbNullString, vbNullString, _
ByVal 0&, lngCb, ByVal 0&, ByVal 0&)

rtn = RasGetEntryProperties(strPhonebook, strEntryName, _
ByVal 0&, lngBuffLen, ByVal 0&, ByVal 0&)

If rtn <> 603 Then VBRasGetEntryProperties = rtn: Exit Function

ReDim b(lngBuffLen - 1)
CopyMemory b(0), lngCb, 4

rtn = RasGetEntryProperties(strPhonebook, strEntryName, _
b(0), lngBuffLen, ByVal 0&, ByVal 0&)

VBRasGetEntryProperties = rtn
If rtn <> 0 Then Exit Function

CopyMemory typRasEntry.options, b(4), 4
CopyMemory typRasEntry.CountryID, b(8), 4
CopyMemory typRasEntry.CountryCode, b(12), 4
CopyByteToTrimmedString typRasEntry.AreaCode, b(16), 11
CopyByteToTrimmedString typRasEntry.LocalPhoneNumber, b(27), 129

CopyMemory lngPos, b(156), 4
If lngPos <> 0 Then
lngStrLen = lngBuffLen - lngPos
typRasEntry.AlternateNumbers = String(lngStrLen, 0)
CopyMemory ByVal typRasEntry.AlternateNumbers, _
b(lngPos), lngStrLen
End If

CopyMemory typRasEntry.ipAddr, b(160), 4
CopyMemory typRasEntry.ipAddrDns, b(164), 4
CopyMemory typRasEntry.ipAddrDnsAlt, b(168), 4
CopyMemory typRasEntry.ipAddrWins, b(172), 4
CopyMemory typRasEntry.ipAddrWinsAlt, b(176), 4
CopyMemory typRasEntry.FrameSize, b(180), 4
CopyMemory typRasEntry.fNetProtocols, b(184), 4
CopyMemory typRasEntry.FramingProtocol, b(188), 4
CopyByteToTrimmedString typRasEntry.ScriptName, b(192), 260
CopyByteToTrimmedString typRasEntry.AutodialDll, b(452), 260
CopyByteToTrimmedString typRasEntry.AutodialFunc, b(712), 260
CopyByteToTrimmedString typRasEntry.DeviceType, b(972), 17
If lngCb = 1672& Then lngStrLen = 33 Else lngStrLen = 129
CopyByteToTrimmedString typRasEntry.DeviceName, b(989), lngStrLen
lngPos = 989 + lngStrLen
CopyByteToTrimmedString typRasEntry.X25PadType, b(lngPos), 33
lngPos = lngPos + 33
CopyByteToTrimmedString typRasEntry.X25Address, b(lngPos), 201
lngPos = lngPos + 201
CopyByteToTrimmedString typRasEntry.X25Facilities, b(lngPos), 201
lngPos = lngPos + 201
CopyByteToTrimmedString typRasEntry.X25UserData, b(lngPos), 201
lngPos = lngPos + 203
CopyMemory typRasEntry.Channels, b(lngPos), 4

If lngCb > 1768 Then
CopyMemory typRasEntry.NT4En_SubEntries, b(1768), 4
CopyMemory typRasEntry.NT4En_DialMode, b(1772), 4
CopyMemory typRasEntry.NT4En_DialExtraPercent, b(1776), 4
CopyMemory typRasEntry.NT4En_DialExtraSampleSeconds, b(1780), 4
CopyMemory typRasEntry.NT4En_HangUpExtraPercent, b(1784), 4
CopyMemory typRasEntry.NT4En_HangUpExtraSampleSeconds, b(1788), 4
CopyMemory typRasEntry.NT4En_IdleDisconnectSeconds, b(1792), 4

If lngCb > 1796 Then
CopyMemory typRasEntry.Win2000_Type, b(1796), 4
CopyMemory typRasEntry.Win2000_EncryptionType, b(1800), 4
CopyMemory typRasEntry.Win2000_CustomAuthKey, b(1804), 4
CopyMemory typRasEntry.Win2000_guidId(0), b(1808), 16
CopyByteToTrimmedString _
typRasEntry.Win2000_CustomDialDll, b(1824), 260
CopyMemory typRasEntry.Win2000_VpnStrategy, b(2084), 4
End If

End If

End Function


Function VBRasEnumDevices(clsVBRasDevInfo() As VBRASDEVINFO) As Long
Dim rtn As Long, i As Long
Dim lpcb As Long, lpcDevices As Long
Dim b() As Byte
Dim dwSize As Long

rtn = RasEnumDevices(ByVal 0&, lpcb, lpcDevices)

If lpcDevices = 0 Then Exit Function

dwSize = lpcb \ lpcDevices

ReDim b(lpcb - 1)

CopyMemory b(0), dwSize, 4

rtn = RasEnumDevices(b(0), lpcb, lpcDevices)

If lpcDevices = 0 Then Exit Function

ReDim clsVBRasDevInfo(lpcDevices - 1)

For i = 0 To lpcDevices - 1
CopyByteToTrimmedString clsVBRasDevInfo(i).DeviceType, _
b((i * dwSize) + 4), 17
CopyByteToTrimmedString clsVBRasDevInfo(i).DeviceName, _
b((i * dwSize) + 21), dwSize - 21
Next i

VBRasEnumDevices = lpcDevices

End Function

Sub CopyByteToTrimmedString(strToCopyTo As String, _
bPos As Byte, lngMaxLen As Long)
Dim strTemp As String, lngLen As Long
strTemp = String(lngMaxLen + 1, 0)
CopyMemory ByVal strTemp, bPos, lngMaxLen
lngLen = InStr(strTemp, Chr$(0)) - 1
strToCopyTo = Left$(strTemp, lngLen)
End Sub


Sub CopyStringToByte(bPos As Byte, _
strToCopy As String, lngMaxLen As Long)
Dim lngLen As Long
lngLen = Len(strToCopy)
If lngLen = 0 Then
Exit Sub
ElseIf lngLen > lngMaxLen Then
lngLen = lngMaxLen
End If
CopyMemory bPos, ByVal strToCopy, lngLen
End Sub

Function BytesToVBRasDialParams(bytesIn() As Byte, _
udtVBRasDialParamsOUT As VBRasDialParams) As Boolean

Dim iPos As Long, lngLen As Long
Dim dwSize As Long
On Error GoTo badBytes

CopyMemory dwSize, bytesIn(0), 4

If dwSize = 816& Then
lngLen = 21&
ElseIf dwSize = 1060& Or dwSize = 1052& Then
lngLen = 257&
Else
'unkown size
Exit Function
End If
iPos = 4
With udtVBRasDialParamsOUT
CopyByteToTrimmedString .EntryName, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 129
CopyByteToTrimmedString .PhoneNumber, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 129
CopyByteToTrimmedString .CallbackNumber, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 257
CopyByteToTrimmedString .UserName, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 257
CopyByteToTrimmedString .Password, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 16
CopyByteToTrimmedString .Domain, bytesIn(iPos), lngLen

If dwSize > 1052& Then
CopyMemory .SubEntryIndex, bytesIn(1052), 4&
CopyMemory .RasDialFunc2CallbackId, bytesIn(1056), 4&
End If
End With
BytesToVBRasDialParams = True
Exit Function
badBytes:
'error handling goes here ??
BytesToVBRasDialParams = False
End Function
Function VBRasDialParamsToBytes( _
udtVBRasDialParamsIN As VBRasDialParams, _
bytesOut() As Byte) As Boolean

Dim rtn As Long
Dim blnPsswrd As Long
Dim b() As Byte
Dim bLens As Variant
Dim dwSize As Long, i As Long
Dim iPos As Long, lngLen As Long

bLens = Array(1060&, 1052&, 816&)
For i = 0 To 2
dwSize = bLens(i)
ReDim b(dwSize - 1)
CopyMemory b(0), dwSize, 4
rtn = RasGetEntryDialParams(vbNullString, b(0), blnPsswrd)
If rtn = 623& Then Exit For
Next i

If rtn <> 623& Then Exit Function

On Error GoTo badBytes
ReDim bytesOut(dwSize - 1)
CopyMemory bytesOut(0), dwSize, 4

If dwSize = 816& Then
lngLen = 21&
ElseIf dwSize = 1060& Or dwSize = 1052& Then
lngLen = 257&
Else
'unkown size
Exit Function
End If
iPos = 4
With udtVBRasDialParamsIN
CopyStringToByte bytesOut(iPos), .EntryName, lngLen
iPos = iPos + lngLen: lngLen = 129
CopyStringToByte bytesOut(iPos), .PhoneNumber, lngLen
iPos = iPos + lngLen: lngLen = 129
CopyStringToByte bytesOut(iPos), .CallbackNumber, lngLen
iPos = iPos + lngLen: lngLen = 257
CopyStringToByte bytesOut(iPos), .UserName, lngLen
iPos = iPos + lngLen: lngLen = 257
CopyStringToByte bytesOut(iPos), .Password, lngLen
iPos = iPos + lngLen: lngLen = 16
CopyStringToByte bytesOut(iPos), .Domain, lngLen

If dwSize > 1052& Then
CopyMemory bytesOut(1052), .SubEntryIndex, 4&
CopyMemory bytesOut(1056), .RasDialFunc2CallbackId, 4&
End If
End With
VBRasDialParamsToBytes = True
Exit Function
badBytes:
'error handling goes here ??
VBRasDialParamsToBytes = False
End Function

Function VBRasSetEntryDialParams _
(strPhonebook As String, bytesIn() As Byte, _
blnRemovePassword As Boolean) As Long

VBRasSetEntryDialParams = RasSetEntryDialParams _
(strPhonebook, bytesIn(0), blnRemovePassword)
End Function

Public Function ValidName(conName As String) As String
Dim rtn As Long
rtn = RasValidateEntryName(vbNullString, conName)
If rtn <> 0 Then
If rtn = 183 Then ValidName = "EXIST"
If rtn = 123 Then ValidName = "BAD"
Else
ValidName = "OK"
End If
End Function


' Windows NT Only : Function that displays the Phonebook dialog
Public Function RAS_DlgNT_Dial(ByRef strPhoneNumber As String, ByRef strEntryName As String, Optional ByRef strPhonebook As String = vbNullString, Optional ByVal OwnerFormHandle As Long) As Boolean

Dim DialInfo As RASDIALDIALOG
Dim ReturnValue As Long
Dim TheOS As OSTypes

' Make sure that the parameters passed are NULL terminated so they are passed to the API correctly
If strPhoneNumber <> vbNullString Then
If Right(strPhoneNumber, 1) <> Chr(0) Then
strPhoneNumber = strPhoneNumber & Chr(0)
End If
End If
If strEntryName <> vbNullString Then
If Right(strEntryName, 1) <> Chr(0) Then
strEntryName = strEntryName & Chr(0)
End If
End If
If strPhonebook <> vbNullString Then
If Right(strPhonebook, 1) <> Chr(0) Then
strPhonebook = strPhonebook & Chr(0)
End If
End If

' If the user's OS is Win9x, change the phonebook = vbNullString because entries are
' stored in the Windows Registry, not a phonebook
If strPhonebook <> vbNullString Then
If GetOS(TheOS) = False Then
strPhonebook = vbNullString
Else
If (TheOS = OS_Win95) Or (TheOS = OS_Win98) Then
strPhonebook = vbNullString
End If
End If
End If

' Initialize the structure to be passed to the API
With DialInfo
.dwSize = Len(DialInfo)
.hwndOwner = OwnerFormHandle
.dwSubEntry = 1
End With

' Open the dialog
ReturnValue = RasDialDlg(strPhonebook, strEntryName, strPhoneNumber, DialInfo)
If ReturnValue <> 0 Then
RAS_DlgNT_Dial = True
Else
If RAS_GetLastError(DialInfo.dwError, "RasDialDlg", True) = True Then
RAS_DlgNT_Dial = False
Else
RAS_DlgNT_Dial = True
End If
End If

End Function
Public Function GetOS(Optional ByRef Return_WinOS As OSTypes, Optional ByRef Return_WinVersion As String, Optional ByRef Return_WinBuild As String) As Boolean
On Error GoTo ErrorTrap

Dim OSinfo As OSVERSIONINFO
Dim RetValue As Long
Dim PID As String

OSinfo.dwOSVersionInfoSize = 148
OSinfo.szCSDVersion = Space(128)
RetValue = GetVersionEx(OSinfo)
If RetValue = 0 Then
MsgBox "An error occured while trying to get the OS version and information." & Chr(13) & "Click OK to continue.", vbOKOnly + vbExclamation, " Error Getting OS Information"
GetOS = False
Exit Function
End If

With OSinfo
Select Case .dwPlatformId
Case VER_PLATFORM_WIN32s
PID = "Win 32"
Return_WinOS = OS_Win32
Case VER_PLATFORM_WIN32_WINDOWS
If .dwMinorVersion = 0 Then
PID = "Windows 95"
Return_WinOS = OS_Win95
ElseIf .dwMinorVersion = 10 Then
PID = "Windows 98"
Return_WinOS = OS_Win98
End If
Case VER_PLATFORM_WIN32_NT
If .dwMajorVersion = 3 Then
PID = "Windows NT 3.51"
Return_WinOS = OS_WinNT_351
ElseIf .dwMajorVersion = 4 Then
PID = "Windows NT 4.0"
Return_WinOS = OS_WinNT_40
ElseIf .dwMajorVersion = 5 Then
PID = "Windows 2000"
Return_WinOS = OS_Win2000
End If
Case Else
PID = "Unknown"
Return_WinOS = OS_Unknown
End Select
End With

Return_WinVersion = Trim(Str(OSinfo.dwMajorVersion) & "." & LTrim(Str(OSinfo.dwMinorVersion)))
Return_WinBuild = Trim(Str(OSinfo.dwBuildNumber))

GetOS = True

Exit Function

ErrorTrap:

If Err.Number = 0 Then
Resume Next
ElseIf Err.Number = 20 Then
Resume Next
Else
MsgBox Err.Source & " caused the following error while getting the OS version:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description
Err.Clear
GetOS = False
Exit Function
End If

End Function

' Function that returns displays the RAS error message for the specified error number
Public Function RAS_GetLastError(ByVal ErrorNumber As Long, Optional ByVal LastAPICalled As String = "last", Optional ByVal DisplayErrorMsg As Boolean = True) As Boolean
On Error Resume Next

Const MAX_ERRLEN = 512
Dim ErrMsg As String
Dim ReturnValue As Long

' No Error Occured
If ErrorNumber = 0 Then
RAS_GetLastError = False
Exit Function
End If

' Allocate buffer to receive the error description
ErrMsg = String(MAX_ERRLEN, Chr(0))

If ErrorNumber <= 600 Then

' Get the error description
ReturnValue = FormatMessage(&H1000, ByVal 0&, ErrorNumber, 0&, ErrMsg, MAX_ERRLEN, ByVal 0&)

' The "FormatMessage" API Failed
If ReturnValue = 0 Then
ErrMsg = "Unknown Error (FormatMessage API Failed To Retrieve Error Information)"
Else
ErrMsg = Left(ErrMsg, InStr(ErrMsg, Chr(0)) - 1)
End If

Else

' Get the error description
ReturnValue = RasGetErrorString(ErrorNumber, ErrMsg, MAX_ERRLEN)

' The "ErrorNumber" value is not a valid RAS error number
If ReturnValue = ERROR_INVALID_PARAMETER Then
RAS_GetLastError = False
Exit Function

' The "RasGetErrorString" API Failed
ElseIf ReturnValue <> 0 Then
ErrMsg = "Unknown Error (RasGetErrorString API Failed To Retrieve Error Information)"

' Got the error description
Else
ErrMsg = Left(ErrMsg, InStr(ErrMsg, Chr(0)) - 1)
End If

End If

' If the user specified to show the error dialog, show it
If DisplayErrorMsg = True Then
MsgBox "The following error occured while calling the " & LastAPICalled & " RAS API:" & Chr(13) & Chr(13) & "Error Number = " & CStr(ErrorNumber) & Chr(13) & "Error Description = " & ErrMsg, vbOKOnly + vbExclamation, " RAS API Error"
End If

RAS_GetLastError = True

End Function

[Texel]

2 ASD:
Many thanks