How to create an HTML Application to configure your WebDAV Redirector settings
I've mentioned in previous blog posts that I use the Windows WebDAV Redirector a lot. (And believe me, I use it a lot.) Having said that, there are a lot of registry settings that control how the Windows WebDAV Redirector operates, and I tend to tweak those settings fairly often.
I documented all of those registry settings in my Using the WebDAV Redirector walkthrough, but unfortunately there isn't a built-in interface for managing the settings. With that in mind, I decided to write my own user interface.
I knew that it would be pretty simple to create a basic Windows Form application that does everything, but my trouble is that I would want to share the code in a blog, and the steps create a Windows application are probably more than I would want to write in such a short space. So I decided to reach into my scripting past and create an HTML Application for Windows that configures all of the Windows WebDAV Redirector settings.
It should be noted, like everything else these days, that this code is provided as-is. ;-]
Using the HTML Application
When you run the application, it will present you with the following user interface, which allows you to configure most of the useful Windows WebDAV Redirector settings:
Creating the HTML Application
To create this HTML Application, save the following HTMLA code as "WebDAV Redirector Settings.hta" to your computer, and then double-click its icon to run the application.
<html>
<head>
<title>WebDAV Redirector Settings</title>
<HTA:APPLICATION
APPLICATIONNAME="WebDAV Redirector Settings"
ID="WebDAV Redirector Settings"
VERSION="1.0"
BORDER="dialog"
BORDERSTYLE="static"
INNERBORDER="no"
SYSMENU="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
SCROLL="no"
SCROLLFLAT="yes"
SINGLEINSTANCE="yes"
CONTEXTMENU="no"
SELECTION="no"/>
<script language="vbscript">
' ----------------------------------------
' Start of main code section.
' ----------------------------------------
Option Explicit
Const intDialogWidth = 700
Const intDialogHeight = 620
Const HKEY_LOCAL_MACHINE = &H80000002
Const strWebClientKeyPath = "SYSTEM\CurrentControlSet\Services\WebClient\Parameters"
Const strLuaKeyPath = "Software\Microsoft\Windows\CurrentVersion\Policies\System"
Dim objRegistry
Dim blnHasChanges
' ----------------------------------------
' Start the application.
' ----------------------------------------
Sub Window_OnLoad
On Error Resume Next
' Set up the UI dimensions.
Self.resizeTo intDialogWidth,intDialogHeight
Self.moveTo (Screen.AvailWidth - intDialogWidth) / 2, _
(Screen.AvailHeight - intDialogHeight) / 2
' Retrieve the current settings.
Document.all.TheBody.ClassName = "hide"
Set objRegistry = GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Call CheckForLUA()
Call GetValues()
Document.All.TheBody.ClassName = "show"
End Sub
' ----------------------------------------
' Check for User Access Control
' ----------------------------------------
Sub CheckForLUA()
If GetRegistryDWORD(strLuaKeyPath,"EnableLUA",1)<> 0 Then
MsgBox "User Access Control (UAC) is enabled on this computer." & _
vbCrLf & vbCrLf & "UAC must be disabled in order to edit " & _
"the registry and restart the service for the WebDAV Redirector. " & _
"Please disable UAC before running this application again. " & _
"This application will now exit.", _
vbCritical, "User Access Control"
Self.close
End If
End Sub
' ----------------------------------------
' Exit the application.
' ----------------------------------------
Sub ExitApplication()
If blnHasChanges = False Then
If MsgBox("Are you sure you want to exit?", _
vbQuestion Or vbYesNo Or vbDefaultButton2, _
"Exit Application") = vbNo Then
Exit Sub
End If
Else
Dim intRetVal
intRetVal = MsgBox("You have unsaved changes. " & _
"Do you want to save them before you exit?", _
vbQuestion Or vbYesNoCancel Or vbDefaultButton1, _
"Exit Application")
If intRetVal = vbYes Then
Call SetValues()
ElseIf intRetVal = vbCancel Then
Exit Sub
End If
End If
Self.close
End Sub
' ----------------------------------------
' Flag the application as having changes.
' ----------------------------------------
Sub FlagChanges()
blnHasChanges = True
End Sub
' ----------------------------------------
' Retrieve the settings from the registry.
' ----------------------------------------
Sub GetValues()
On Error Resume Next
Dim tmpCount,tmpArray,tmpString
' Get the radio button values
Call SetRadioValue(Document.all.BasicAuthLevel, _
GetRegistryDWORD(strWebClientKeyPath, _
"BasicAuthLevel",1))
Call SetRadioValue(Document.all.SupportLocking, _
GetRegistryDWORD(strWebClientKeyPath, _
"SupportLocking",1))
' Get the text box values
Document.all.InternetServerTimeoutInSec.Value = _
GetRegistryDWORD(strWebClientKeyPath, _
"InternetServerTimeoutInSec",30)
Document.all.FileAttributesLimitInBytes.Value = _
GetRegistryDWORD(strWebClientKeyPath, _
"FileAttributesLimitInBytes",1000000)
Document.all.FileSizeLimitInBytes.Value = _
GetRegistryDWORD(strWebClientKeyPath, _
"FileSizeLimitInBytes",50000000)
Document.all.LocalServerTimeoutInSec.Value = _
GetRegistryDWORD(strWebClientKeyPath, _
"LocalServerTimeoutInSec",15)
Document.all.SendReceiveTimeoutInSec.Value = _
GetRegistryDWORD(strWebClientKeyPath, _
"SendReceiveTimeoutInSec",60)
Document.all.ServerNotFoundCacheLifeTimeInSec.Value = _
GetRegistryDWORD(strWebClientKeyPath, _
"ServerNotFoundCacheLifeTimeInSec",60)
' Get the text area values
tmpArray = GetRegistryMULTISZ( _
strWebClientKeyPath,"AuthForwardServerList")
For tmpCount = 0 To UBound(tmpArray)
tmpString = tmpString & tmpArray(tmpCount) & vbTab
Next
If Len(tmpString)>0 Then
Document.all.AuthForwardServerList.Value = _
Replace(Left(tmpString,Len(tmpString)-1),vbTab,vbCrLf)
End If
blnHasChanges = False
End Sub
' ----------------------------------------
' Save the settings in the registry.
' ----------------------------------------
Sub SetValues()
On Error Resume Next
' Set the radio button values
Call SetRegistryDWORD( _
strWebClientKeyPath, _
"BasicAuthLevel", _
GetRadioValue(Document.all.BasicAuthLevel))
Call SetRegistryDWORD( _
strWebClientKeyPath, _
"SupportLocking", _
GetRadioValue(Document.all.SupportLocking))
' Set the text box values
Call SetRegistryDWORD( _
strWebClientKeyPath, _
"InternetServerTimeoutInSec", _
Document.all.InternetServerTimeoutInSec.Value)
Call SetRegistryDWORD( _
strWebClientKeyPath, _
"FileAttributesLimitInBytes", _
Document.all.FileAttributesLimitInBytes.Value)
Call SetRegistryDWORD( _
strWebClientKeyPath, _
"FileSizeLimitInBytes", _
Document.all.FileSizeLimitInBytes.Value)
Call SetRegistryDWORD( _
strWebClientKeyPath, _
"LocalServerTimeoutInSec", _
Document.all.LocalServerTimeoutInSec.Value)
Call SetRegistryDWORD( _
strWebClientKeyPath, _
"SendReceiveTimeoutInSec", _
Document.all.SendReceiveTimeoutInSec.Value)
Call SetRegistryDWORD( _
strWebClientKeyPath, _
"ServerNotFoundCacheLifeTimeInSec", _
Document.all.ServerNotFoundCacheLifeTimeInSec.Value)
' Set the text area values
Call SetRegistryMULTISZ( _
strWebClientKeyPath, _
"AuthForwardServerList", _
Split(Document.all.AuthForwardServerList.Value,vbCrLf))
' Prompt to restart the WebClient service
If MsgBox("Do you want to restart the WebDAV Redirector " & _
"service so your settings will take effect?", _
vbQuestion Or vbYesNo Or vbDefaultButton2, _
"Restart WebDAV Redirector") = vbYes Then
' Restart the WebClient service.
Call RestartWebClient()
End If
Call GetValues()
End Sub
' ----------------------------------------
' Start the WebClient service.
' ----------------------------------------
Sub RestartWebClient()
On Error Resume Next
Dim objWMIService,colServices,objService
Document.All.TheBody.ClassName = "hide"
Set objWMIService = GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colServices = objWMIService.ExecQuery( _
"Select * from Win32_Service Where Name='WebClient'")
For Each objService in colServices
objService.StopService()
objService.StartService()
Next
Document.All.TheBody.ClassName = "show"
End Sub
' ----------------------------------------
' Retrieve a DWORD value from the registry.
' ----------------------------------------
Function GetRegistryDWORD( _
ByVal tmpKeyPath, _
ByVal tmpValueName, _
ByVal tmpDefaultValue)
On Error Resume Next
Dim tmpDwordValue
If objRegistry.GetDWORDValue( _
HKEY_LOCAL_MACHINE, _
tmpKeyPath, _
tmpValueName, _
tmpDwordValue)=0 Then
GetRegistryDWORD = CLng(tmpDwordValue)
Else
GetRegistryDWORD = CLng(tmpDefaultValue)
End If
End Function
' ----------------------------------------
' Set a DWORD value in the registry.
' ----------------------------------------
Sub SetRegistryDWORD( _
ByVal tmpKeyPath, _
ByVal tmpValueName, _
ByVal tmpDwordValue)
On Error Resume Next
Call objRegistry.SetDWORDValue( _
HKEY_LOCAL_MACHINE, _
tmpKeyPath, _
tmpValueName, _
CLng(tmpDwordValue))
End Sub
' ----------------------------------------
' Retrieve a MULTISZ value from the registry.
' ----------------------------------------
Function GetRegistryMULTISZ( _
ByVal tmpKeyPath, _
ByVal tmpValueName)
On Error Resume Next
Dim tmpMultiSzValue
If objRegistry.GetMultiStringValue( _
HKEY_LOCAL_MACHINE, _
tmpKeyPath, _
tmpValueName, _
tmpMultiSzValue)=0 Then
GetRegistryMULTISZ = tmpMultiSzValue
Else
GetRegistryMULTISZ = Array()
End If
End Function
' ----------------------------------------
' Set a MULTISZ value in the registry.
' ----------------------------------------
Sub SetRegistryMULTISZ( _
ByVal tmpKeyPath, _
ByVal tmpValueName, _
ByVal tmpMultiSzValue)
On Error Resume Next
Call objRegistry.SetMultiStringValue( _
HKEY_LOCAL_MACHINE, _
tmpKeyPath, _
tmpValueName, _
tmpMultiSzValue)
End Sub
' ----------------------------------------
' Retrieve the value of a radio button group.
' ----------------------------------------
Function GetRadioValue(ByVal tmpRadio)
On Error Resume Next
Dim tmpCount
For tmpCount = 0 To (tmpRadio.Length-1)
If tmpRadio(tmpCount).Checked Then
GetRadioValue = CLng(tmpRadio(tmpCount).Value)
Exit For
End If
Next
End Function
' ----------------------------------------
' Set the value for a radio button group.
' ----------------------------------------
Sub SetRadioValue(ByVal tmpRadio, ByVal tmpValue)
On Error Resume Next
Dim tmpCount
For tmpCount = 0 To (tmpRadio.Length-1)
If CLng(tmpRadio(tmpCount).Value) = CLng(tmpValue) Then
tmpRadio(tmpCount).Checked = True
Exit For
End If
Next
End Sub
' ----------------------------------------
'
' ----------------------------------------
Sub Validate(tmpField)
Dim tmpRegEx, tmpMatches
Set tmpRegEx = New RegExp
tmpRegEx.Pattern = "[0-9]"
tmpRegEx.IgnoreCase = True
tmpRegEx.Global = True
Set tmpMatches = tmpRegEx.Execute(tmpField.Value)
If tmpMatches.Count = Len(CStr(tmpField.Value)) Then
If CDbl(tmpField.Value) => 0 And _
CDbl(tmpField.Value) =< 4294967295 Then
Exit Sub
End If
End If
MsgBox "Please enter a whole number between 0 and 4294967295.", _
vbCritical, "Validation Error"
tmpField.Focus
End Sub
' ----------------------------------------
'
' ----------------------------------------
Sub BasicAuthWarning()
MsgBox "WARNING:" & vbCrLf & vbCrLf & _
"Using Basic Authentication over non-SSL connections can cause " & _
"serious security issues. Usernames and passwords are transmitted " & _
"in clear text, therefore the use of Basic Authentication with " & _
"WebDAV is disabled by default for non-SSL connections. That " & _
"being said, this setting can override the default behavior for " & _
"Basic Authentication, but it is strongly discouraged.", _
vbCritical, "Basic Authentication Warning"
End Sub
' ----------------------------------------
' End of main code section.
' ----------------------------------------
</script>
<style>
body { color:#000000; background-color:#cccccc;
font-family:'Segoe UI',Tahoma,Verdana,Arial; font-size:9pt; }
fieldset { padding:10px; width:640px; }
.button { width:150px; }
.textbox { width:200px; height:22px; text-align:right; }
.textarea { width:300px; height:50px; text-align:left; }
.radio { margin-left:-5px; margin-top: -2px; }
.hide { display:none; }
.show { display:block; }
select { width:300px; text-align:left; }
table { border-collapse:collapse; empty-cells:hide; }
h1 { font-size:14pt; }
th { font-size:9pt; text-align:left; vertical-align:top; padding:2px; }
td { font-size:9pt; text-align:left; vertical-align:top; padding:2px; }
big { font-size:11pt; }
small { font-size:8pt; }
</style>
</head>
<body id="TheBody" class="hide">
<h1 align="center" id="TheTitle" style="margin-bottom:-20px;">WebDAV Redirector Settings</h1>
<div align="center">
<p style="margin-bottom:-20px;"><i><small><b>Note</b>: See <a target="_blank" href="https://go.microsoft.com/fwlink/?LinkId=324291">Using the WebDAV Redirector</a> for additional details.</small></i></p>
<form>
<center>
<table border="0" cellpadding="2" cellspacing="2" style="width:600px;">
<tr>
<td style="width:600px;text-align:left"><fieldset title="Security Settings">
<legend> <b>Security Settings</b> </legend>
These values affect the security behavior for the WebDAV Redirector.<br>
<table style="width:600px;">
<tr title="Specifies whether the WebDAV Redirector can use Basic Authentication to communicate with a server.">
<td style="width:300px">
<table border="0">
<tr>
<td style="width:300px"><b>Basic Authentication Level</b></td>
</tr>
<tr>
<td style="width:300px;"><span style="width:280px;padding-left:20px;"><small><i><b>Note</b>: Using basic authentication can cause <u>serious security issues</u> as the username and password are transmitted in clear text, therefore the use of basic authentication over WebDAV is disabled by default unless the connection is using SSL.</i></small></span></td>
</tr>
</table>
</td>
<td style="width:300px">
<table style="width:300px">
<tr>
<td style="width:020px"><input class="radio" type="radio" value="0" name="BasicAuthLevel" onchange="VBScript:FlagChanges()" id="BasicAuthLevel0"></td>
<td style="width:280px"><label for="BasicAuthLevel0">Basic Authentication is disabled</label></td>
</tr>
<tr>
<td style="width:020px"><input class="radio" type="radio" value="1" checked name="BasicAuthLevel" onchange="VBScript:FlagChanges()" id="BasicAuthLevel1"></td>
<td style="width:280px"><label for="BasicAuthLevel1">Basic Authentication is enabled for SSL web sites only</label></td>
</tr>
<tr>
<td style="width:020px"><input class="radio" type="radio" value="2" name="BasicAuthLevel" onchange="VBScript:FlagChanges()" id="BasicAuthLevel2" onClick="VBScript:BasicAuthWarning()"></td>
<td style="width:280px"><label for="BasicAuthLevel2">Basic Authentication is enabled for SSL and non-SSL web sites</label></td>
</tr>
</table>
</td>
</tr>
<tr title="Specifies a list of local URLs for forwarding credentials that bypasses any proxy settings. (Note: This requires Windows Vista SP1 or later.)">
<td style="width:300px">
<table border="0">
<tr>
<td style="width:300px"><b>Authentication Forwarding Server List</b></td>
</tr>
<tr>
<td style="width:300px;"><span style="width:280px;padding-left:20px;"><small><i><b>Note</b>: Include one server name per line.</i></small></span></td>
</tr>
</table>
</td>
<td style="width:300px"><textarea class="textarea" name="AuthForwardServerList" onchange="VBScript:FlagChanges()"></textarea></td>
</tr>
<tr title="Specifies whether the WebDAV Redirector supports locking.">
<td style="width:300px"><b>Support for WebDAV Locking</b></td>
<td style="width:300px">
<table style="width:300px">
<tr>
<td style="width:020px"><input class="radio" type="radio" value="1" checked name="SupportLocking" onchange="VBScript:FlagChanges()" id="SupportLocking1"></td>
<td style="width:280px"><label for="SupportLocking1">Enable Lock Support</label></td>
</tr>
<tr>
<td style="width:020px"><input class="radio" type="radio" value="0" name="SupportLocking" onchange="VBScript:FlagChanges()" id="SupportLocking0"></td>
<td style="width:280px"><label for="SupportLocking0">Disable Lock Support</label></td>
</tr>
</table>
</td>
</tr>
</table>
</fieldset> </td>
</tr>
<tr>
<td style="width:600px;text-align:left"><fieldset title="Time-outs">
<legend> <b>Time-outs and Maximum Sizes</b> </legend>
These values affect the behavior for WebDAV Client/Server operations.<br>
<table border="0" style="width:600px;">
<tr title="Specifies the connection time-out for the WebDAV Redirector uses when communicating with non-local WebDAV servers.">
<td style="width:300px"><b>Internet Server Time-out</b> <small>(In Seconds)</small></td>
<td style="width:300px"><input class="textbox" type="text" name="InternetServerTimeoutInSec" onchange="VBScript:FlagChanges()" onblur="VBScript:Validate(Me)" value="30"></td>
</tr>
<tr title="Specifies the connection time-out for the WebDAV Redirector uses when communicating with a local WebDAV server.">
<td style="width:300px"><b>Local Server Time-out</b> <small>(In Seconds)</small></td>
<td style="width:300px"><input class="textbox" type="text" name="LocalServerTimeoutInSec" onchange="VBScript:FlagChanges()" onblur="VBScript:Validate(Me)" value="15"></td>
</tr>
<tr title="Specifies the time-out in seconds that the WebDAV Redirector uses after issuing a request.">
<td style="width:300px"><b>Send/Receive Time-out</b> <small>(In Seconds)</small></td>
<td style="width:300px"><input class="textbox" type="text" name="SendReceiveTimeoutInSec" onchange="VBScript:FlagChanges()" onblur="VBScript:Validate(Me)" value="60"></td>
</tr>
<tr title="Specifies the period of time that a server is cached as non-WebDAV by the WebDAV Redirector. If a server is found in this list, a fail is returned immediately without attempting to contact the server.">
<td style="width:300px"><b>Server Not Found Cache Time-out</b> <small>(In Seconds)</small></td>
<td style="width:300px"><input class="textbox" type="text" name="ServerNotFoundCacheLifeTimeInSec" onchange="VBScript:FlagChanges()" onblur="VBScript:Validate(Me)" value="60"></td>
</tr>
<tr title="Specifies the maximum size in bytes that the WebDAV Redirector allows for file transfers.">
<td style="width:300px"><b>Maximum File Size</b> <small>(In Bytes)</small></td>
<td style="width:300px"><input class="textbox" type="text" name="FileSizeLimitInBytes" onchange="VBScript:FlagChanges()" onblur="VBScript:Validate(Me)" value="50000000"></td>
</tr>
<tr title="Specifies the maximum size that is allowed by the WebDAV Redirector for all properties on a specific collection.">
<td style="width:300px"><b>Maximum Attributes Size</b> <small>(In Bytes)</small></td>
<td style="width:300px"><input class="textbox" type="text" name="FileAttributesLimitInBytes" onchange="VBScript:FlagChanges()" onblur="VBScript:Validate(Me)" value="1000000"></td>
</tr>
</table>
</fieldset> </td>
</tr>
<tr>
<td style="text-align:center">
<table border="0">
<tr>
<td style="text-align:center"><input class="button" type="button" value="Apply Settings" onclick="VBScript:SetValues()">
<td style="text-align:center"><input class="button" type="button" value="Exit Application" onclick="VBScript:ExitApplication()">
</tr>
</table>
</td>
</tr>
</table>
</center>
</form>
</div>
</body>
</html>
Additional Notes
You will need to run this HTML Application as an administrator in order to save the settings and restart the Windows WebDAV Redirector. (Which is listed as the "WebClient" service in your Administrative Tools.)
This HTML Application performs basic validation for the numeric fields, and it prevents you from exiting the application when you have unsaved changes, but apart from that there's not much functionality other than setting and retrieving the registry values. How else can you get away with posting an application in a blog with only 500 lines of code and no compilation required? ;-]
Comments
- Anonymous
October 05, 2014
good job thanks for sharing.