Цитата:
А расфон редактировать... Вы хоть пробовали такое сами реализовать?
Я расфон стараюсь не трогать, но вот так можно, работает
реализация на vbs:Код:
Set WSS_ = CreateObject("WScript.Shell")
Set FSO_ = CreateObject("Scripting.FileSystemObject")
VPNprofile = WSS_.ExpandEnvironmentStrings("C:\Documents and Settings\All Users\Application Data\Microsoft\Network\Connections\Pbk\name.pbk")
Set flW = FSO_.OpenTextFile(VPNprofile, 8, True)
flW.WriteLine "[Название подключения]"
flW.WriteLine "Encoding=1"
flW.WriteLine "Type=2"
flW.WriteLine "AutoLogon=0"
flW.WriteLine "UseRasCredentials=1"
flW.WriteLine "DialParamsUID=Boroda Prodaction"
flW.WriteLine "Guid=044E7B18647D5649AE37C9A544038D28"
flW.WriteLine "BaseProtocol=1"
flW.WriteLine "VpnStrategy=1"
flW.WriteLine "ExcludedProtocols=0"
flW.WriteLine "LcpExtensions=1"
flW.WriteLine "DataEncryption=8"
flW.WriteLine "SwCompression=1"
flW.WriteLine "NegotiateMultilinkAlways=0"
flW.WriteLine "SkipNwcWarning=0"
flW.WriteLine "SkipDownLevelDialog=0"
flW.WriteLine "SkipDoubleDialDialog=0"
flW.WriteLine "DialMode=1"
flW.WriteLine "DialPercent=75"
flW.WriteLine "DialSeconds=120"
flW.WriteLine "HangUpPercent=10"
flW.WriteLine "HangUpSeconds=120"
flW.WriteLine "OverridePref=15"
flW.WriteLine "RedialAttempts=1000"
flW.WriteLine "RedialSeconds=5"
flW.WriteLine "IdleDisconnectSeconds=0"
flW.WriteLine "RedialOnLinkFailure=1"
flW.WriteLine "CallbackMode=0"
flW.WriteLine "CustomDialDll="
flW.WriteLine "CustomDialFunc="
flW.WriteLine "CustomRasDialDll="
flW.WriteLine "AuthenticateServer=0"
flW.WriteLine "ShareMsFilePrint=0"
flW.WriteLine "BindMsNetClient=0"
flW.WriteLine "SharedPhoneNumbers=0"
flW.WriteLine "GlobalDeviceSettings=0"
flW.WriteLine "PrerequisiteEntry="
flW.WriteLine "PrerequisitePbk="
flW.WriteLine "PreferredPort=VPN4-0"
flW.WriteLine "PreferredDevice=Минипорт WAN (L2TP)"
flW.WriteLine "PreferredBps=0"
flW.WriteLine "PreferredHwFlow=1"
flW.WriteLine "PreferredProtocol=1"
flW.WriteLine "PreferredCompression=1"
flW.WriteLine "PreferredSpeaker=1"
flW.WriteLine "PreferredMdmProtocol=0"
flW.WriteLine "PreviewUserPw=1"
flW.WriteLine "PreviewDomain=0"
flW.WriteLine "PreviewPhoneNumber=0"
flW.WriteLine "ShowDialingProgress=0"
flW.WriteLine "ShowMonitorIconInTaskBar=1"
flW.WriteLine "CustomAuthKey=-1"
flW.WriteLine "AuthRestrictions=288"
flW.WriteLine "TypicalAuth=2"
flW.WriteLine "IpPrioritizeRemote=1"
flW.WriteLine "IpHeaderCompression=0"
flW.WriteLine "IpAddress=0.0.0.0"
flW.WriteLine "IpDnsAddress=0.0.0.0"
flW.WriteLine "IpDns2Address=0.0.0.0"
flW.WriteLine "IpWinsAddress=0.0.0.0"
flW.WriteLine "IpWins2Address=0.0.0.0"
flW.WriteLine "IpAssign=1"
flW.WriteLine "IpNameAssign=1"
flW.WriteLine "IpFrameSize=1006"
flW.WriteLine "IpDnsFlags=0"
flW.WriteLine "IpNBTFlags=1"
flW.WriteLine "TcpWindowSize=0"
flW.WriteLine "UseFlags=0"
flW.WriteLine "IpSecFlags=0"
flW.WriteLine "IpDnsSuffix="
flW.WriteLine ""
flW.WriteLine "NETCOMPONENTS="
flW.WriteLine "ms_server=0"
flW.WriteLine "ms_msclient=0"
flW.WriteLine "ms_psched=1"
flW.WriteLine "vmware_bridge=0"
flW.WriteLine ""
flW.WriteLine "MEDIA=rastapi"
flW.WriteLine "Port=VPN4-0"
flW.WriteLine "Device=Минипорт WAN (L2TP)"
flW.WriteLine ""
flW.WriteLine "DEVICE=vpn"
flW.WriteLine "PhoneNumber=vpn.<name>.ru"
flW.WriteLine "AreaCode="
flW.WriteLine "CountryCode=1"
flW.WriteLine "CountryID=1"
flW.WriteLine "UseDialingRules=0"
flW.WriteLine "Comment="
flW.WriteLine "LastSelectedPhone=0"
flW.WriteLine "PromoteAlternates=0"
flW.WriteLine "TryNextAlternateOnFail=1"
flW.Close
Сохранить в UTF-8 кодировке, иначе русское название не отобразится.
Ну это конкретно для меня случай. А так один раз создаем, смотрим расфон и подпровляем под себя скрипт.
Ярлык на подключение, то же vbs:Код:
Option Explicit
Const ssfCONNECTIONS = &H0031
Const ssfDESKTOP = &H0000
'Const ssfCOMMON_DESKTOPDIRECTORY = &H0019
Dim objShell
Dim objFolderConnections
Dim objFolderDesktop
'Dim objFolderAllUsersDesktop
Dim objSubFolder
Set objShell = WScript.CreateObject("Shell.Application")
Set objFolderConnections = objShell.NameSpace(ssfCONNECTIONS)
If (Not objFolderConnections Is Nothing) Then
For Each objSubFolder In objFolderConnections.Items
If objSubFolder.Name = "Название подключение" Then
Set objFolderDesktop = objShell.NameSpace(ssfDESKTOP) 'objFolderAllUsersDesktop
If (Not objFolderDesktop Is Nothing) Then
objFolderDesktop.CopyHere objSubFolder
End If
End If
Next
End If
Set objFolderDesktop = Nothing ' objFolderAllUsersDesktop
Set objFolderConnections = Nothing
Set objShell = Nothing
WScript.Quit 0
Цитата:
Если прога нравится, могу поделиться исходниками, добавите функционал, поделитесь тоже)
С удовольствием, жду...