在同目录下建立ip.txt
ip.txt里是vpn的ip列表，一行一个，可以在每行里加说明
复制IP会自动粘贴到ip框里，是否成功的话，请看ip显示
作者：lcx
<HTA:APPLICATION ID="MySampleHTA" Caption="yes" SCROLL="auto" border="none" borderStyle="static" SINGLEINSTANCE="yes" maximizebutton="no" BORDER="no" icon="dxdiag.exe"> <title>vpn 连接程序 hta版</title> <style> body { font-size:12; BACKGROUND: #DADADA; margin-left:5; } input { width:50; overflow:visible; border:1px solid lightblue; background-color:#cccccc; cursor:text; } button { border:1px solid gray; width:70; margin-left:2; cursor:hand; font-size:12; filter:progid:DXImageTransform.Microsoft.Gradient(startColorStr='#eaeaff', endColorStr='#618fff', gradientType='0'); } </style> <body> <input id="id" size="30" value="mjj"></input><br> <input id="pass" size="30" value="mjj"></input><br> <input id="ip" size="50" value="vpn的ip" ></input><br> <button id="ok" onclick=vbs:conn>链接</button> <button id="nok" onclick=vbs:dconn>断开</button> <button id="ipshow" onclick=vbs:show>当前ip显示</button> <button id="vpnshow" onclick=vbs:vpnshow>vpn列表</button> <button id="vpnhelp" onclick=vbs:showHelp>帮助</button><br> <div id="url"></div> </body> <SCRIPT LANGUAGE="VBScript"> Set oShell = CreateObject("WScript.Shell") Sub Window_onLoad window.resizeTo 450,380 window.moveTo 300, 300 copy End Sub Sub copy x("ip").value=me.clipboarddata.getdata("Text") setTimeout "copy", 2000 End Sub Function x(obj) Set x=document.getElementById(obj) End function Sub dconn cmd=oShell.exec("rasdial /d").StdOut.ReadAll() x("url").innerHTML=cmd End Sub Sub show x("url").innerHTML= "<br><br><iframe src=http://www.ip138.com/ip2city.asp></iframe>" End Sub Sub conn tempfile="c:/tmp~386" If Findfile(tempfile) = false Then writef tempfile,x("ip").value x("url").innerHTML ="Create pbk file ........ok，连接中" Else writef tempfile,x("ip").value x("url").innerHTML ="pbk file 存在........ok，连接中" End If x("url").innerHTML= oShell.exec("rasdial pvpn "&x("id").value&" "&x("pass").value&" /PHONEBOOK:"&tempfile).StdOut.ReadAll() End Sub Sub vpnshow Set FSO = CreateObject("Scripting.FileSystemObject") File = "ip.txt" Set txt = fso.OpenTextFile(File) If Not txt.atEndOfStream Then '先确定还没有到达结尾的位置 Content = txt.ReadAll '读取整个文件的数据 Lines = Replace(Content, vbCrlf, "<br>") '将文本内分行字符vbCrlf换成HTML换行标记"<br>" x("url").innerHTML= Lines End If End Sub Function Findfile(str) Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.FileExists(str) Then findfile=true Else findfile=false End If End Function Function writef(pbk_file,ip) Set FSO = CreateObject("Scripting.FileSystemObject") with fso.opentextfile(pbk_file,2,true) .writeline "[pvpn]" .writeline "Encoding=1" .writeline "Type=2" .writeline "AutoLogon=0" .writeline "UseRasCredentials=1" .writeline "DialParamsUID=546750" .writeline "Guid=76C5D8FF120C6A4F8E63F0B1E5D74AD4" .writeline "BaseProtocol=1" .writeline "VpnStrategy=2" .writeline "ExcludedProtocols=0" .writeline "LcpExtensions=1" .writeline "DataEncryption=8" .writeline "SwCompression=1" .writeline "NegotiateMultilinkAlways=0" .writeline "SkipNwcWarning=0" .writeline "SkipDownLevelDialog=0" .writeline "SkipDoubleDialDialog=0" .writeline "DialMode=1" .writeline "DialPercent=75" .writeline "DialSeconds=120" .writeline "HangUpPercent=10" .writeline "HangUpSeconds=120" .writeline "OverridePref=15" .writeline "RedialAttempts=3" .writeline "RedialSeconds=60" .writeline "IdleDisconnectSeconds=0" .writeline "RedialOnLinkFailure=0" .writeline "CallbackMode=0" .writeline "CustomDialDll=" .writeline "CustomDialFunc=" .writeline "CustomRasDialDll=" .writeline "AuthenticateServer=0" .writeline "ShareMsFilePrint=1" .writeline "BindMsNetClient=1" .writeline "SharedPhoneNumbers=0" .writeline "GlobalDeviceSettings=0" .writeline "PrerequisiteEntry=" .writeline "PrerequisitePbk=" .writeline "PreferredPort=VPN4-0" .writeline "PreferredDevice=WAN Miniport (L2TP)" .writeline "PreferredBps=0" .writeline "PreferredHwFlow=1" .writeline "PreferredProtocol=1" .writeline "PreferredCompression=1" .writeline "PreferredSpeaker=1" .writeline "PreferredMdmProtocol=0" .writeline "PreviewUserPw=1" .writeline "PreviewDomain=0" .writeline "PreviewPhoneNumber=0" .writeline "ShowDialingProgress=1" .writeline "ShowMonitorIconInTaskBar=1" .writeline "CustomAuthKey=-1" .writeline "AuthRestrictions=608" .writeline "TypicalAuth=2" .writeline "IpPrioritizeRemote=1" .writeline "IpHeaderCompression=0" .writeline "IpAddress=0.0.0.0" .writeline "IpDnsAddress=0.0.0.0" .writeline "IpDns2Address=0.0.0.0" .writeline "IpWinsAddress=0.0.0.0" .writeline "IpWins2Address=0.0.0.0" .writeline "IpAssign=1" .writeline "IpNameAssign=1" .writeline "IpFrameSize=1006" .writeline "IpDnsFlags=0" .writeline "IpNBTFlags=1" .writeline "TcpWindowSize=0" .writeline "UseFlags=0" .writeline "IpSecFlags=0" .writeline "IpDnsSuffix=" .writeline "" .writeline "NETCOMPONENTS=" .writeline "ms_server=1" .writeline "ms_msclient=1" .writeline "ms_psched=1" .writeline "" .writeline "MEDIA=rastapi" .writeline "Port=VPN4-0" .writeline "Device=WAN Miniport (L2TP)" .writeline "" .writeline "DEVICE=vpn" .writeline "PhoneNumber="&x("ip").value .writeline "AreaCode=" .writeline "CountryCode=1" .writeline "CountryID=1" .writeline "UseDialingRules=0" .writeline "Comment=" .writeline "LastSelectedPhone=0" .writeline "PromoteAlternates=0" .writeline "TryNextAlternateOnFail=1" .writeline "" .close End with Set fso = Nothing End Function sub showHelp msg = " 在同目录下建立ip.txt" & vbcrlf msg = msg & "------------------------------------------------" & vbcrlf msg = msg & " ip.txt里是vpn的ip列表，一行一个，可以在每行里加说明" & vbcrlf msg = msg & "复制IP会自动粘贴到ip框里，是否成功的话，请看ip显示：" & vbcrlf alert msg end sub </SCRIPT>- 左青龙
- 微信扫一扫
-
- 右白虎
- 微信扫一扫
-
评论