vpn连接程序hta版实现代码(修改)

页面导航:首页 > 脚本专栏 > hta > vpn连接程序hta版实现代码(修改)

vpn连接程序hta版实现代码(修改)

来源:互联网 作者:脚本宝典 时间:2015-07-20 18:44 【

代码如下: HTA:APPLICATION ID=MySampleHTA Caption=yes SCROLL=auto border=none borderStyle=static SINGLEINSTANCE=yes maximizebutton=no BORDER=no icon=dxdiag.exe titlevpn 连接程序 hta版/title style body { font-size:12; BACKGROUND: #DA

代码如下:


<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> 


Tags:

文章评论

最 近 更 新
热 点 排 行
Js与CSS工具
代码转换工具

<