注册
登录
| 关键词： vpn 当前 链接 帮助 程序 hta |
<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, 300copyEnd Sub Sub copyx("ip").value=me.clipboarddata.getdata("Text")setTimeout "copy", 2000End 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 showx("url").innerHTML= "<br><br><iframe src=http://www.ip138.com/ip2city.asp></iframe>"End Sub Sub conntempfile="c:\tmp~386"If Findfile(tempfile) = false Then writef tempfile,x("ip").valuex("url").innerHTML ="Create pbk file ........ok，连接中"Elsewritef tempfile,x("ip").valuex("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 vpnshowSet 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= LinesEnd If End Sub Function Findfile(str)Set FSO = CreateObject("Scripting.FileSystemObject")If FSO.FileExists(str) Thenfindfile=trueElsefindfile=falseEnd IfEnd 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 "" .closeEnd withSet fso = NothingEnd Function sub showHelpmsg = " 在同目录下建立ip.txt" & vbcrlfmsg = msg & "------------------------------------------------" & vbcrlfmsg = msg & " ip.txt里是vpn的ip列表，一行一个，可以在每行里加说明" & vbcrlfmsg = msg & "复制IP会自动粘贴到ip框里，是否成功的话，请看ip显示：" & vbcrlf alert msgend sub</SCRIPT> |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
