Id= "Mysamplehta"
caption= "Yes"
Scroll= "Auto"
Border= "None"
borderstyle= "Static"
Singleinstance= "Yes"
Maximizebutton= "No"
Border= "No"
icon= "Dxdiag.exe" >
<TITLE>VPN Connector HTA Edition </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= "value=" MJJ "></input><br>
<input id= "Pass" size= "value=" "MJJ" ></input><br>
<input id= "IP" size= "IP" value= "VPN" ></input><br>
<button id= "OK" onclick=vbs:conn> link </button>
<button id= "NOK" onclick=vbs:dconn> disconnect </button>
<button id= "ipshow" onclick=vbs:show> current IP display </button>
<button id= "vpnshow" Onclick=vbs:vpnshow>vpn list </button>
<button id= "Vpnhelp" onclick=vbs:showhelp> help </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, connect"
Else
Writef tempfile,x ("IP"). Value
X ("url"). InnerHTML = "pbk file exists ... ok, connect"
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 ' first determine where the end is not reached
Content = txt. ReadAll ' reads the entire file's data
Lines = replace (Content, VbCrlf, "<br>") ' converts text-line character VbCrlf to HTML newline tag ' <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 = "Establish ip.txt under same directory" & vbCrLf
msg = msg & "------------------------------------------------" & vbCrLf
msg = msg & "Ip.txt is a VPN IP list, one line can be added to each line in the description" & vbCrLf
msg = msg & "Copy IP will be automatically pasted into the IP box, if successful, please see IP display:" & vbCrLf
Alert msg
End Sub
</SCRIPT>
