ساخت کانکش اینترنت

[rezayavari]

دوست عزیز اگر یک بار به برنامه نگاه بندازید متوجه می شین چی می گم

[lord_viper]

I have this code in a module: (Module1)

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

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

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length 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


'BytesToVBRasDialParams

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


'VBRasDialParamsToBytes

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

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

[lord_viper]

کد:

*Ras Dial API Call*
<DllImport("RasApi32.dll", CharSet:=CharSet.Auto)> _
Public Function RasDial( _
ByRef lprasDialExtensions As RASDIALEXTENSIONS, _
ByVal lpszPhoneBook As String, _
ByRef lpRasDialParams As RASDIALPARAMS, _
ByVal dwNotifierType As Int32, _
ByVal hwndNotifier As System.Delegate, _
ByRef lphRasConn As IntPtr) As Int32
End Function

The threeStructures are Below:

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Public Structure RASDIALPARAMS
Public dwSize As Integer
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=CInt(RASFieldSizeConstants.RAS_MaxEntry Name + 1))> _
Public szEntryName As String
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=CInt(RASFieldSizeConstants.RAS_MaxPhone Number + 1))> _
Public szPhoneNumber As String
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=CInt(RASFieldSizeConstants.RAS_MaxCallb ackNumber + 1))> _
Public szCallBackNumber As String
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=CInt(RASFieldSizeConstants.UNLEN + 1))> _
Public szUsername As String
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=CInt(RASFieldSizeConstants.PWLEN + 1))> _
Public szPassword As String
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=CInt(RASFieldSizeConstants.DNLEN + 1))> _
Public szDomain As String
#If OSVER > 4 Then
Public dwSubEntry As Integer
Public dwCallBackID As Integer
#End If

'RASDIALEXTENSIONS
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Public Structure RASDIALEXTENSIONS
Public dwSize As Integer
Public dwfOptions As Integer
Public hwndParent As Integer
Public Reserved As Integer
Public Reserved1 As Integer
Public RasEapINfo As RasEapINfo
End Structure

'RASEAPINFO
<StructLayout(LayoutKind.Sequential, charset:=CharSet.Auto)> _
Public Structure RASEAPINFO
Public dwSizeofEAPInfo As Int32
Public pbEapInfo As Int32
End Structure

Here is the Code so far >

Public Function Connect() As Boolean
Dim x As Integer 'Return from API Calls
Dim hconn As IntPtr 'Connection Handle
Dim bln As Boolean 'Password Stored

mParams = New RASDIALPARAMS
With mParams
.dwSize = Marshal.SizeOf(GetType(RASDIALPARAMS))
.szEntryName = mEntryName
End With

x = RasGetEntryDialParams(mPhonebook, mParams, bln)
hconn = Nothing

x = RasDial(Nothing, Nothing, mParams, Nothing, Nothing, hconn)
End Function

[lord_viper]

کد:

RAS API上的其他Function

來源:cww

取得目前連線資訊
    Function GetAllConnects(ConnEntry() as RASCONN) As Long
       傳回值：總共連線數
       使用方式 ：
       Dim Conn() AS RASCONN
       Dim icnt as Long
       icnt = GetAllConnects(Conn())


取得所有撥號網路Entry的資訊(不管有沒有連線)
    Function GetRasNameEntries(Entry() As RASENTRYNAME, _
                               Optional PhonePath As String) As Long
傳回值：總共Entry數
       使用方式 ：
       Dim Conn() AS RASENTRYNAME
       Dim icnt as Long
       icnt = GetRasNameEntries(Conn())

呼叫修改某一個連線Entry 的Window
    Sub EditEntry(ByVal EntryName As String, _
                  Optional ByVal PhonePath As String)
於撥號網路中新增一個Entry
    Sub CreateEntry(Optional ByVal PhonePath As String)
自動撥接
    Function DialUp(ByVal EntryName As String, ByVal UserN As String, _
          ByVal Pwd As String, Optional ByVal PhonePath As String) As Long
取消撥接
     Function HangUp(ByVal hconn As Long) As Boolean
       hconn的值來自於
       1.DialUp()的傳回值
       2.GetAllConnects() RASCONN結構參數中的hRasConn值

取得連線狀態
     Function GetConnectStatus(ByVal hocnn As Long) As Long
       hconn的值來自於
       1.DialUp()的傳回值
       2.GetAllConnects() RASCONN結構參數中的hRasConn值


'Below is in rasapi.bas
Public Const RAS_MaxEntryName = 256
Public Const RAS_MaxDeviceName = 128
Public Const RAS_MaxDeviceType = 16
Public Const RAS_MaxPhoneNumber = 128
Public Const RAS_MaxCallbackNumber = 128
Public Const UNLEN = 256
Public Const PWLEN = 256
Public Const DNLEN = 15
Public Const ERROR_INVALID_HANDLE = 6

Type RASCONN
   dwSize As Long '412
   hRasConn As Long
   szEntryName(RAS_MaxEntryName) As Byte
   szDeviceType(RAS_MaxDeviceType) As Byte
   szDeviceName(RAS_MaxDeviceName) As Byte
End Type

Type RASENTRYNAME
  dwSize As Long '264
  szEntryName(RAS_MaxEntryName) As Byte
End Type

Type RASDIALPARAMS
  dwSize As Long '1052
  szEntryName(RAS_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

Type RASCONNSTATUS
    dwSize As Long  '144
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS_MaxDeviceName) As Byte
End Type

Declare Function RasDial Lib "rasapi32" _
  Alias "RasDialA" (DialExt As Long, ByVal lpPhoneBook As String, _
  RasDialParam As RASDIALPARAMS, ByVal NotifyType As Long, _
  ByVal Notifter As Long, hRasConn As Long) As Long
Declare Function RasCreatePhonebookEntry Lib "rasapi32" _
  Alias "RasCreatePhonebookEntryA" (ByVal hWnd As Long, ByVal lpPhoneBook As String) As Long
Declare Function RasEditPhonebookEntry Lib "rasapi32" _
  Alias "RasEditPhonebookEntryA" (ByVal hWnd As Long, ByVal lpPhoneBook As String, _
  ByVal lpEntryName As String) As Long
Declare Function RasGetErrorString Lib "rasapi32" _
  Alias "RasGetErrorStringA" (ByVal ErrValue As Long, ByVal lpErrStr As String, _
  ByVal cSize As Long) As Long
Declare Function RasEnumEntries& Lib "rasapi32" _
  Alias "RasEnumEntriesA" (ByVal res As String, ByVal lpszPhonebook As String, _
  lpRasEntryBuffer As Any, lpcb As Long, lpcEntries As Long)
Declare Function RasEnumConnections Lib "rasapi32" Alias _
      "RasEnumConnectionsA" (lprasconn As Any, _
       lpcb As Long, lpConnect As Long) As Long
Declare Function RasHangUp Lib "rasapi32" Alias _
      "RasHangUpA" (ByVal hRasConn As Long) As Long
Declare Function RasGetConnectStatus Lib "rasapi32" Alias _
      "RasGetConnectStatusA" (ByVal hRasConn As Long, _
      lprasconnstatus As RASCONNSTATUS) As Long
Declare Function RasGetEntryDialParams Lib "rasapi32" _
   Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, _
   lpRasDialParams As RASDIALPARAMS, _
   lpfPassword As Byte) As Long

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Enum RasConnState
    RASCS_OpenPort = 0
    RASCS_PortOpened             '1
    RASCS_ConnectDevice          '2
    RASCS_DeviceConnected        '3
    RASCS_AllDevicesConnected    '4
    RASCS_Authenticate           '5
    RASCS_AuthNotify             '6
    RASCS_AuthRetry
    RASCS_AuthCallback
    RASCS_AuthChangePassword
    RASCS_AuthProject
    RASCS_AuthLinkSpeed
    RASCS_AuthAck
    RASCS_ReAuthenticate
    RASCS_Authenticated
    RASCS_PrepareForCallback
    RASCS_WaitForModemReset
    RASCS_WaitForCallback
    RASCS_Projected
    RASCS_StartAuthentication  '19
    RASCS_CallbackComplete
    RASCS_LogonNetwork         '21
    RASCS_Interactive = &H1000
    RASCS_RetryAuthentication
    RASCS_CallbackSetByCaller
    RASCS_PasswordExpired
    RASCS_Connected = &H2000
    RASCS_Disconnected
End Enum

'取得目前連線資訊
Public Function GetAllConnections(Conn() As RASCONN) As Long
    Dim dl&, size&, validConnection&, counter%
    ReDim Conn(0)
    Conn(0).dwSize = 412
    size = 412
    dl& = RasEnumConnections(Conn(0), size, validConnection)
    If validConnection > 0 Then
       ReDim Conn(validConnection - 1)
       Conn(0).dwSize = 412
       size = validConnection * 412
       dl& = RasEnumConnections(Conn(0), size, validConnection)
    End If
    If dl = 0 Then
       GetAllConnections = validConnection
    Else
       GetAllConnections = -1
    End If
End Function

'取得所有撥號網路Entry的資訊(不管有沒有連線)
Public Function GetRasNameEntries(Entry() As RASENTRYNAME, Optional PhonePath As String) As Long
Dim di As Long, lpcb As Long, lpentries As Long
Dim addit As Long
Dim i As Long

di& = RasEnumEntries(vbNullString, PhonePath, 0, 0, lpentries)
If lpentries > 0 Then
   i = lpentries - 1
   ReDim Entry(i)
   len5 = LenB(Entry(0))
   addit = (4 - (len5 Mod 4)) Mod 4
   Entry(0).dwSize = len5 + addit
   lpcb = Entry(0).dwSize * (i + 1)
   di& = RasEnumEntries(vbNullString, PhonePath, Entry(0), lpcb, lpentries)
End If
If di = 0 Then
   GetRasNameEntries = lpentries
Else
   GetRasNameEntries = -1
End If
End Function
'呼叫修改某一個連線Entry 的Window
Public Sub EditEntry(ByVal EntryName As String, Optional ByVal PhonePath As String)
Dim di As Long
di = RasEditPhonebookEntry(0, PhonePath, EntryName)
End Sub
'於撥號網路中新增一個Entry
Public Sub CreateEntry(Optional ByVal PhonePath As String)
Call RasCreatePhonebookEntry(0, PhonePath)
End Sub

'自動撥接(Win95 4, 5 個參數不傳，或為vbNullString)
Public Function DialUp(ByVal EntryName As String, ByVal UserN As String, _
    ByVal Pwd As String, Optional ByVal PhoneBook As String, Optional sDomain As String) As Long
Dim RasDialPara As RASDIALPARAMS
Dim bya() As Byte, di As Long
Dim len5 As Long, i As Long
Dim hRasConn As Long

len5 = LenB(RasDialPara)
i = (4 - (len5 Mod 4)) Mod 4
RasDialPara.dwSize = len5 + i '1052
bya = StrConv(EntryName, vbFromUnicode) + ChrB(0)
Call CopyByte(RasDialPara.szEntryName, bya)

bya = StrConv(UserN, vbFromUnicode) + ChrB(0)
Call CopyByte(RasDialPara.szUserName, bya)

bya = StrConv(Pwd, vbFromUnicode) + ChrB(0)
Call CopyByte(RasDialPara.szPassword, bya)

bya = StrConv(sDomain, vbFromUnicode) + ChrB(0)
Call CopyByte(RasDialPara.szDomain, bya)
'若使用以下CallBack function的方式，則RasDial()不等連線成功或失敗便結束。
di = RasDial(0, PhoneBook, RasDialPara, 0, AddressOf RasDialFunc, hRasConn)

'若第二、三個參數都是0則，RasDial會等連線成功或失敗後才執行下一行指令
'di = RasDial(0, PhoneBook, RasDialPara, 0, 0, hRasConn)

If di = 0 Then
   DialUp = hRasConn
Else
   DialUp = 0
   Dim str5 As String
   str5 = String(255, Chr(0))
   Call RasGetErrorString(di, str5, 256)
   MsgBox Left(str5, InStr(1, str5, Chr(0)) - 1), vbCritical
   Call HangUp(hRasConn)
End If
End Function





Public Sub RasDialFunc(ByVal unMsg As Long, _
                       ByVal ConnState As Long, _
                       ByVal dwError As Long)
If ConnState = &H2000 Then
   ' Connect Complete
End If

Debug.Print unMsg, ConnState
End Sub
'取消撥接
Public Function HangUp(ByVal hconn As Long) As Boolean
Dim st As Long, len5 As Long
Dim i As Long, ConStatus  As RASCONNSTATUS
st = RasHangUp(hconn)
len5 = LenB(ConStatus)
i = (4 - (len5 Mod 4)) Mod 4
ConStatus.dwSize = len5 + i
Do While True
  Call Sleep(0)
  i = RasGetConnectStatus(hconn, ConStatus)
  If i = ERROR_INVALID_HANDLE Then
     Exit Do
  End If
Loop
If st = 0 Then
   HangUp = True
Else
   HangUp = False
End If
End Function
'取得連線狀態
Public Function GetConnectStatus(ByVal hocnn As Long) As Long
Dim i As Long, ConStatus  As RASCONNSTATUS
Dim len5 As Long
len5 = LenB(ConStatus)
i = (4 - (len5 Mod 4)) Mod 4
ConStatus.dwSize = len5 + i
i = RasGetConnectStatus(hconn, ConStatus)
If i = 0 Then
   GetConnectStatus = ConStatus.RasConnState
Else
   GetConnectStatus = -1
End If
End Function
Private Sub CopyByte(dest() As Byte, sour() As Byte)
Dim sourL As Long, sourU As Long
Dim destL As Long, destU As Long, i As Long, j As Long
sourL = LBound(sour)
sourU = UBound(sour)
destL = LBound(dest)
destU = UBound(dest)
j = 0
For i = sourL To sourU
    dest(destL + j) = sour(i)
    j = j + 1
    If j >= (destU - destL) + 1 Then
       Exit For
    End If
Next i
End Sub

این خیلی کامله کدهاش برایساخت برقراری ارتباط خروج از اینترنت و.... هست[/quote]

[rezayavari]

اگر می شد فایلش رو بزاری عالی می شد
البته خودم یک سورس پیدا کردم ماله گروه مارشال سافت است که می گه باید نسخه کامل رو بخری

[IT.M@N]

عرض سلام

اقا منم دنبال یه همچین برنامه ای هستم و حدود 1 سال پیش هم تو همین فروم هم یه تاپیک زدم ولی به نتیجه ای نرسیدم !


ببینید منظور من از این دیالر اینه که :

یه کانکشن بسازم که طرف تا رو دکمه کانکت کلیل میکنه به اینترنت وصل بشه !!


خوب با این اوصاف که : من قبلا username- password - و شماره شبکه رو هم بهش دادم !


یعنی من همه کارها رو کردم


مثلا :

من یه اینترنت رایگان دارم از یه جایی ! میخوام طرف نفهمه که داره با چه یوزر و چه شبکه ای کانکت میشه !!!



امیدوارم که منظورمو کاملا گرفته باشید


پس منتظرم

البته اگه امکان داره سورس و برنامه رو یه جا بزارید

[IT.M@N]

البته این این برنامه

http://www.parspooyesh.com/interface/dow...Dialer.exe

همون چیزی هست که من دلم میخواد همه چیزش کامل کامل هست ولی فقط سورسش در دسرس نیست که حداقل بتونم قسمت یوزر و پسورد و شماره شبکه رو مخفی کنم !

و یه چندتا بخش دیگه بهش اضافه کنم

[rezayavari]

دوست عزیز اگر به نتیجه رسیدی ما رو هم بی خبر نذار چون خیلی بهش نیاز دارم
پارس پویش سورس رو برای فورش نمی زاره و فقط می گه بگین چه طرحی می خواین پول بدین تا آماده کنیم
منم هم دارم می گردم پست شما رو هم فکر کنم دیدم تو همین انجمن

[IT.M@N]

سلام

شما هم اگه به نتیجه رسیدید منم رو هم درجریان بزارید چون منم واقعا خیلی خیلی به این روش نیاز دارم و تنها چیزی هم که نیاز جفتمون رو برطرف میکنه همین سورس پارس پویش هست چون همونی هست که میخوایم !