Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Dial up connection
Message
From
30/07/2008 08:23:42
 
 
To
09/06/2008 13:18:11
General information
Forum:
Visual FoxPro
Category:
Other
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Windows XP SP2
Miscellaneous
Thread ID:
01300147
Message ID:
01335210
Views:
25
Actually i'm doing like this :
I create as many ISP as i need on my system then launch them programmatically till i get a connection.
It works good but i'm going to improve that creating ISP programmatically.
I found a free code on the internet "Connectoid" it is written in visual basic so i need to translate it but it seems to be what i really needed.
I send you the code or part of it ... but if you want i can send you the whole project or give you the link from where i got it
Attribute VB_Name = "modMain"
Option Explicit
Public Const MAXIMUM_COMMAND_ARGUMENTS = 20
Public Const MARKER_TEXTFILE_NAME = "Connectoid03.txt"
'-----------------------------------------------------
' Version history for the marker file
'
' Begin with - "Connectoid.txt" = Only created the 4 Secure VPN connections
' 2004 07 20 - "Connectoid01.txt" = Added 3 Secure RAS connections (AH,SD,SR)
' 2004 08 05 - "Connectoid02.txt" = added 1 new secure RAS connection (UK)
' 2004 08 20 - "Connectoid03.txt" = added the DNS suffix "xyz.xyz.com" to all the connectoids
'

Sub Main()
   Dim cmdArgCount As Integer
   Dim cmdArgs() As String
   Dim strVPNDevice As String
   Dim strModemDevice As String
   Dim i As Integer
   Dim fStop As Boolean
   Dim fOptionIgnoreOS As Boolean
   Dim fOptionDeleteOldVPN As Boolean
   Dim fOptionLeaveOldRAS As Boolean
   Dim fUseDefaultGateway As Boolean
   Dim fUserInterfaceVisible As Boolean
   Dim sRASConnectionName() As String
   Dim iRASEntriesCount As Integer
   Dim ans As Long
   Dim sTempServerName As String
   Dim tmpVBRasEntry As VBRasEntry
   Dim fDeleteOK As Boolean


   fStop = False
   fOptionIgnoreOS = False
   fOptionDeleteOldVPN = False
   fOptionLeaveOldRAS = False
   fUseDefaultGateway = True
   fUserInterfaceVisible = False


   cmdArgs = GetCommandLine(MAXIMUM_COMMAND_ARGUMENTS)
   cmdArgCount = UBound(cmdArgs)

   Debug.Assert MsgBox("Upper bounds for command line is " & cmdArgCount)

   If cmdArgCount > 0 Then

      For i = 1 To cmdArgCount
         Select Case LCase(Right(cmdArgs(i), Len(cmdArgs(i)) - 1))

            Case "?", "help"

               frmHelp.Show vbModal
               fStop = True

            Case "diag"
               fStop = True
               Form1.Show

            Case "nodefaultgateway"
               fUseDefaultGateway = False

            Case "ignoreos"
               fOptionIgnoreOS = True


            Case "deleteoldvpn"
               fOptionDeleteOldVPN = True
               Debug.Assert MsgBox("Delete old VPN?")
            Case "leaveoldras"
               fOptionLeaveOldRAS = True

            Case "force"
               Debug.Assert MsgBox("Force Create VPN?")

               ' Case "ui"
               ' fUserInterfaceVisible = True
               ' fStop = True
               ' frmUI.Show

            Case Else
               MsgBox "What is (" & cmdArgs(i) & ")?"
               fStop = True
         End Select

      Next i

   End If
   If fStop = False Then

      strVPNDevice = FindDevice("PPTP", FindbyName)
      CreateVPNEntry "Secure VPN - S R", "secure-sr.xyz.com", strVPNDevice, fUseDefaultGateway
      CreateVPNEntry "Secure VPN - A H", "secure-ah.xyz.com", strVPNDevice, fUseDefaultGateway
      CreateVPNEntry "Secure VPN - S D", "secure-sd.xyz.com", strVPNDevice, fUseDefaultGateway
      CreateVPNEntry "Secure VPN - UK", "secure-uk.xyz.com", strVPNDevice, fUseDefaultGateway
      Debug.Assert MsgBox(GetWindowsDirectory)

      '**************-------------
      '*
      '* Options
      '*
      '**************-------------

      'Delete old VPN's Option

      If fOptionDeleteOldVPN = True Then
         iRASEntriesCount = GetEntries(sRASConnectionName)
         If iRASEntriesCount < 1 Then
            'we got problems because there should be some connections... particularly the secures vpn above
         Else
            For i = 1 To iRASEntriesCount
               'TODO: Look for old vpn connections
               Debug.Assert MsgBox(sRASConnectionName(i))
               If VBRasGetEntryProperties(sRASConnectionName(i), tmpVBRasEntry) = 0 Then
                  Debug.Assert MsgBox(tmpVBRasEntry.LocalPhoneNumber)
                  sTempServerName = Trim(LCase(tmpVBRasEntry.LocalPhoneNumber))
                  fDeleteOK = False
                  If sTempServerName = "sr.xyz.com" Then fDeleteOK = True
                  If sTempServerName = "ah.xyz.com" Then fDeleteOK = True
                  If sTempServerName = "sd.xyz.com" Then fDeleteOK = True
                  If sTempServerName = "uk.xyz.com" Then fDeleteOK = True
                  If sTempServerName = "sr1.xyz.com" Then fDeleteOK = True
                  If sTempServerName = "ah1.xyz.com" Then fDeleteOK = True
                  If sTempServerName = "sd1.xyz.com" Then fDeleteOK = True
                  If sTempServerName = "uk1.xyz.com" Then fDeleteOK = True
                  If sTempServerName = "0.99.34.2" Then fDeleteOK = True
                  If sTempServerName = "0.99.223.2" Then fDeleteOK = True
                  If sTempServerName = "0.99.159.2" Then fDeleteOK = True
                  If sTempServerName = "0.99.50.2" Then fDeleteOK = True


                  If fDeleteOK = True Then

                     ans = RasDeleteEntry(vbNullString, sRASConnectionName(i))
                     If ans = 0 Then
                        App.LogEvent "Removed old connection '" & sRASConnectionName(i)
                     Else
                        'didn't delete it
                        Debug.Assert MsgBox("RASDELETEENTRY Returns " & ans)
                        App.LogEvent "Couldn't remove old connection '" & sRASConnectionName(i)
                     End If
                  End If
               End If
            Next i

         End If
         Debug.Assert MsgBox("Connection Count is " & iRASEntriesCount)


      End If ' option for delete old vpn


      'Create Secure RAS Connections
      strModemDevice = FindDevice("modem", FindbyType)
      If strModemDevice = "" Then
         App.LogEvent "Secure VPN did not make any RAS connectoids because no modem was found", _
            vbLogEventTypeInformation
         Debug.Assert MsgBox("No modem")
      Else
         Debug.Assert MsgBox(strModemDevice)
         CreateRASEntry "Secure RAS - S R", "1", "415", "555-1212", strModemDevice, NonSecure5400
         CreateRASEntry "Secure RAS - A H", "1", "651", "555-1212", strModemDevice, NonSecure5400
         CreateRASEntry "Secure RAS - S D", "1", "858", "555-1212", strModemDevice, NonSecure5400
         CreateRASEntry "Secure RAS - UK", "44", "", "0800 5555 321", strModemDevice, MSRRAS

      End If

      'This text marker is a way to see the process completed.
      'Also it is inventorable by LANDesk and I think SMS

      CreateTextMarker




      App.LogEvent "Secure VPN App is now ending", vbLogEventTypeInformation
   Else
      App.LogEvent "Secure VPN did not finish", vbLogEventTypeWarning
   End If
End Sub


Function GetCommandLine(Optional MaxArgs)
   'Declare variables.
   Dim C As String
   Dim CmdLine As String
   Dim CmdLnLen As Integer
   Dim InArg As Boolean
   Dim i As Integer
   Dim NumArgs As Integer
   'See if MaxArgs was provided.
   If IsMissing(MaxArgs) Then MaxArgs = 10
   'Make array of the correct size.
   ReDim ArgArray(MaxArgs) As String
   NumArgs = 0: InArg = False
   'Get command line arguments.
   CmdLine = Command()
   CmdLnLen = Len(CmdLine)
   'Go thru command line one character
   'at a time.
   For i = 1 To CmdLnLen
      C = Mid(CmdLine, i, 1)
      'Test for space or tab.
      If (C <> " " And C <> vbTab) Then
         'Neither space nor tab.
         'Test if already in argument.
         If Not InArg Then
            'New argument begins.
            'Test for too many arguments.
            If NumArgs = MaxArgs Then Exit For
            NumArgs = NumArgs + 1
            InArg = True
         End If
         'Concatenate character to current argument.
         ArgArray(NumArgs) = ArgArray(NumArgs) & C
      Else
         'Found a space or tab.
         'Set InArg flag to False.
         InArg = False
      End If
   Next i
   'Resize array just enough to hold arguments.
   ReDim Preserve ArgArray(NumArgs)
   'Return Array in Function name.
   GetCommandLine = ArgArray()
End Function

Private Sub CreateVPNEntry(ByVal sConnectoidName As String, ByVal sVPNServer As String, ByVal _
     sDeviceName As String, Optional ByVal fSetDefaultGateway As Boolean)

   Dim typVBRasEntry As VBRasEntry

   If IsMissing(fSetDefaultGateway) Then
      fSetDefaultGateway = True
   End If

   'typVBRasEntry.AreaCode = ""
   'typVBRasEntry.AutodialFunc = 0
   'typVBRasEntry.CountryCode = "1"
   'typVBRasEntry.CountryID = "1"
   typVBRasEntry.DeviceName = sDeviceName
   typVBRasEntry.DeviceType = "vpn"
   typVBRasEntry.fNetProtocols = RASNP_Ip
   typVBRasEntry.FramingProtocol = RASFP_Ppp
   If fSetDefaultGateway = True Then
      typVBRasEntry.options = CLng(RASEO_IpHeaderCompression + RASEO_RemoteDefaultGateway + RASEO_ModemLights + _
         RASEO_SwCompression + RASEO_RequireDataEncryption + RASEO_NetworkLogon + RASEO_UseLogonCredentials + _
         RASEO_RequireEAP + RASEO_Custom + RASEO_PreviewUserPw + RASEO_PreviewDomain + RASEO_ShowDialingProgress)
   Else
      typVBRasEntry.options = CLng(RASEO_IpHeaderCompression + RASEO_ModemLights + RASEO_SwCompression + _
         RASEO_RequireDataEncryption + RASEO_NetworkLogon + RASEO_UseLogonCredentials + RASEO_RequireEAP + _
         RASEO_Custom + RASEO_PreviewUserPw + RASEO_PreviewDomain + RASEO_ShowDialingProgress)
   End If
   'typVBRasEntry.options = CLng(txtOptions.Text)
   typVBRasEntry.Win2000_CustomAuthKey = 15
   typVBRasEntry.Win2000_EncryptionType = 1
   typVBRasEntry.Win2000_Type = 2
   typVBRasEntry.Win2000_VpnStrategy = VS_PptpFirst

   typVBRasEntry.ipAddrDns.a = "0"
   typVBRasEntry.ipAddrDns.b = "0"
   typVBRasEntry.ipAddrDns.C = "0"
   typVBRasEntry.ipAddrDns.d = "0"
   typVBRasEntry.ipAddrDnsAlt.a = "0"
   typVBRasEntry.ipAddrDnsAlt.b = "0"
   typVBRasEntry.ipAddrDnsAlt.C = "0"
   typVBRasEntry.ipAddrDnsAlt.d = "0"
   typVBRasEntry.ipAddrWins.a = "0"
   typVBRasEntry.ipAddrWins.b = "0"
   typVBRasEntry.ipAddrWins.C = "0"
   typVBRasEntry.ipAddrWins.d = "0"
   typVBRasEntry.ipAddrWinsAlt.a = "0"
   typVBRasEntry.ipAddrWinsAlt.b = "0"
   typVBRasEntry.ipAddrWinsAlt.C = "0"
   typVBRasEntry.ipAddrWinsAlt.d = "0"
   typVBRasEntry.LocalPhoneNumber = sVPNServer
   typVBRasEntry.WinXP_DNSSuffix = "corp.xyz.com"
   Dim rtn As Long

   rtn = VBRasSetEntryProperties(sConnectoidName, typVBRasEntry)
   If rtn <> 0 Then
      App.LogEvent "Could not create VPN connectoid (" & sConnectoidName & ") to " & _
         sVPNServer & ". Error code was " & rtn

   End If



End Sub

Private Sub CreateRASEntry(ByVal sConnectoidName As String, ByVal sCountryCode As String, ByVal _
     sAreaCode As String, ByVal sLocalNumber As String, ByVal sDeviceName As String, Optional ByVal _
     ServerType As RASCreationType = NonSecure5400)

   Dim typVBRasEntry As VBRasEntry

   If IsEmpty(ServerType) Then
      ServerType = NonSecure5400
   End If

   typVBRasEntry.AreaCode = sAreaCode
   typVBRasEntry.AutodialFunc = 0
   typVBRasEntry.CountryCode = sCountryCode
   typVBRasEntry.CountryID = sCountryCode
   typVBRasEntry.DeviceName = sDeviceName
   typVBRasEntry.DeviceType = "modem"
   typVBRasEntry.fNetProtocols = RASNP_Ip
   typVBRasEntry.FramingProtocol = RASFP_Ppp
   If ServerType = NonSecure5400 Then
      typVBRasEntry.options = CLng(RASEO_UseCountryAndAreaCodes + RASEO_IpHeaderCompression + _
         RASEO_RemoteDefaultGateway + RASEO_ModemLights + RASEO_SwCompression + RASEO_RequirePAP + _
         RASEO_Custom + RASEO_PreviewPhoneNumber + RASEO_SharedPhoneNumbers + _
         RASEO_PreviewUserPw + RASEO_ShowDialingProgress)
      typVBRasEntry.Win2000_CustomAuthKey = 0
      typVBRasEntry.Win2000_EncryptionType = 0
      typVBRasEntry.Win2000_Type = 1

   Else
      typVBRasEntry.options = CLng(RASEO_UseCountryAndAreaCodes + RASEO_IpHeaderCompression + _
         RASEO_RemoteDefaultGateway + RASEO_ModemLights + RASEO_SwCompression + RASEO_RequireDataEncryption + _
         RASEO_NetworkLogon + RASEO_UseLogonCredentials + RASEO_RequireEAP + RASEO_Custom + RASEO_PreviewUserPw + _
         RASEO_PreviewDomain + RASEO_ShowDialingProgress)
      typVBRasEntry.Win2000_CustomAuthKey = 15
      typVBRasEntry.Win2000_EncryptionType = 1
      typVBRasEntry.Win2000_Type = 1

   End If

   typVBRasEntry.ipAddrDns.a = "0"
   typVBRasEntry.ipAddrDns.b = "0"
   typVBRasEntry.ipAddrDns.C = "0"
   typVBRasEntry.ipAddrDns.d = "0"
   typVBRasEntry.ipAddrDnsAlt.a = "0"
   typVBRasEntry.ipAddrDnsAlt.b = "0"
   typVBRasEntry.ipAddrDnsAlt.C = "0"
   typVBRasEntry.ipAddrDnsAlt.d = "0"
   typVBRasEntry.ipAddrWins.a = "0"
   typVBRasEntry.ipAddrWins.b = "0"
   typVBRasEntry.ipAddrWins.C = "0"
   typVBRasEntry.ipAddrWins.d = "0"
   typVBRasEntry.ipAddrWinsAlt.a = "0"
   typVBRasEntry.ipAddrWinsAlt.b = "0"
   typVBRasEntry.ipAddrWinsAlt.C = "0"
   typVBRasEntry.ipAddrWinsAlt.d = "0"
   typVBRasEntry.WinXP_DNSSuffix = "corp.xyz.com"
   typVBRasEntry.LocalPhoneNumber = sLocalNumber
   '***************************************************************************
   '****Thanks to CHOI LIM JU for helping with the following change  **
   '***************************************************************************
   'Set redial if dropped
   typVBRasEntry.WinXP_Options2 = RASEO2_ReconnectIfDropped
   '***************************************************************************


   Dim rtn As Long

   rtn = VBRasSetEntryProperties(sConnectoidName, typVBRasEntry)
   If rtn <> 0 Then
      App.LogEvent "Could not create VPN connectoid (" & sConnectoidName & ") to " & sLocalNumber & _
         ". Error code was " & rtn

   End If



End Sub
Public Function AddBackslash(s As String) As String
   If Len(s & "X") > 1 Then
      If Right$(s, 1) <> "\" Then
         AddBackslash = s + "\"
      Else
         AddBackslash = s
      End If
   Else
      AddBackslash = "\"
   End If
End Function



Public Function GetWindowsDirectory() As String
   Dim s As String
   Dim i As Integer
   i = GetWindowsDirectoryA("", 0)
   s = Space(i)
   Call GetWindowsDirectoryA(s, i)
   GetWindowsDirectory = AddBackslash(Left$(s, i - 1))
End Function

Sub CreateTextMarker()

   On Error GoTo CreateTextMark_Err
   Dim sMarkerFile As String
   Dim xFile As Integer


   xFile = FreeFile

   sMarkerFile = GetWindowsDirectory & MARKER_TEXTFILE_NAME
   Open sMarkerFile For Append As xFile
   Close xFile
   Exit Sub

CreateTextMark_Err:

   App.LogEvent "Error Creating Text Marker. Error Number: " & Err.Number & _
      " - " & Err.Description, vbLogEventTypeError
   Resume Next


End Sub

>I read your post on the UT regarding Internet Connection using dialup.
>
>How did it go?
>
>Did you use MarshallSoft DLL's or code something yourself?
Previous
Reply
Map
View

Click here to load this message in the networking platform