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