Microsoft Bob

Just a short, simple blog for Bob to share some tips and tricks.

Be sure to check out my non-technical blog at www.geekybob.com.

Month List

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="http://learn.iis.net/page.aspx/386/using-the-webdav-redirector/">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>&nbsp;<b>Security Settings</b>&nbsp;</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>&nbsp;<b>Time-outs and Maximum Sizes</b>&nbsp;</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? ;-]

Note: This blog was originally posted at http://blogs.msdn.com/robert_mcmurray/
Posted: Oct 07 2011, 09:00 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: IIS | Scripting | WebDAV
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

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="http://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>&nbsp;<b>Security Settings</b>&nbsp;</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>&nbsp;<b>Time-outs and Maximum Sizes</b>&nbsp;</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? ;-]

Note: This blog was originally posted at http://blogs.msdn.com/robert_mcmurray/
Posted: Oct 07 2011, 09:00 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: IIS | Scripting | WebDAV
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

Sometimes I Make My Day…

This past weekend I was writing a quick piece of Windows Script Host (WSH) code to clean up some files on one of my servers, and I had populated a Scripting.Dictionary object with a bunch of string data that I was going to write to a log file. Obviously it’s much easier to read through the log file if the data is sorted, but the Scripting.Dictionary object does not have a built-in Sort() method.

With this in mind, I set out to write a sorting function for my script, when I decided that it would might be more efficient to see if someone out in the community had already written such a function. I quickly discovered that someone had – and it turns out, that particular someone was me!

Way back in 1999 I published Microsoft Knowledge Base (KB) article 246067, which was titled "Sorting a Scripting Dictionary Populated with String Data." This KB article contained the following code, which took care of everything for me:

Const dictKey  = 1
Const dictItem = 2

Function SortDictionary(objDict,intSort)
  ' declare our variables
  Dim strDict()
  Dim objKey
  Dim strKey,strItem
  Dim X,Y,Z

  ' get the dictionary count
  Z = objDict.Count

  ' we need more than one item to warrant sorting
  If Z > 1 Then
    ' create an array to store dictionary information
    ReDim strDict(Z,2)
    X = 0
    ' populate the string array
    For Each objKey In objDict
        strDict(X,dictKey)  = CStr(objKey)
        strDict(X,dictItem) = CStr(objDict(objKey))
        X = X + 1
    Next

    ' perform a a shell sort of the string array
    For X = 0 to (Z - 2)
      For Y = X to (Z - 1)
        If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
            strKey  = strDict(X,dictKey)
            strItem = strDict(X,dictItem)
            strDict(X,dictKey)  = strDict(Y,dictKey)
            strDict(X,dictItem) = strDict(Y,dictItem)
            strDict(Y,dictKey)  = strKey
            strDict(Y,dictItem) = strItem
        End If
      Next
    Next

    ' erase the contents of the dictionary object
    objDict.RemoveAll

    ' repopulate the dictionary with the sorted information
    For X = 0 to (Z - 1)
      objDict.Add strDict(X,dictKey), strDict(X,dictItem)
    Next

  End If

End Function

Sometimes I make my day. ;-]

Posted: Sep 07 2011, 18:12 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: Scripting
Tags: ,
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

How to add <clear/> or <remove/> Elements through Scripting

I had a question recently where someone was trying to add <clear /> or <remove /> elements to a collection in their IIS 7 configuration settings. With that in mind, for today's blog I thought that I would discuss a couple of ways to add <clear /> and <remove /> elements by using two specific scripting methods: AppCmd and VBScript.

It should be noted that you can also use JavaScript or PowerShell, but I'm not covering those because the syntax for those is available elsewhere. (JavaScript syntax is available in the Configuration Editor in IIS Manager, and the PowerShell syntax is available through the Web Server (IIS) Administration Cmdlet Reference.) You can also use Managed-Code, and the syntax for that is also available in the Configuration Editor in IIS Manager; but compiled code isn't scripting, is it? :-)

Here's the scenario, IIS makes it possible to modify the contents of an inherited collection in two ways:

  • You can clear the contents of an inherited configuration section, as illustrated by the following configuration excerpt:
    <configuration>
       <system.webServer>
          <defaultDocument enabled="true">
             <files>
                <clear />
             </files>
          </defaultDocument>
       </system.webServer>
    </configuration>
  • You can remove an item from an inherited collection, as illustrated by the following configuration excerpt:
    <configuration>
       <system.webServer>
          <defaultDocument enabled="true">
             <files>
                <remove value="index.html" />
             </files>
          </defaultDocument>
       </system.webServer>
    </configuration>

With that in mind, let's look at scripting those settings.

Using AppCmd

AppCmd.exe is a great utility that ships with IIS 7, which allows editing the configuration settings for IIS from a command line. This also allows you to create batch scripts that automate large numbers of configuration changes. For example, the following batch file enables ASP session state, sets the maximum number of ASP sessions to 1000, and then sets the session time-out to 10 minutes for the Default Web Site:

appcmd.exe set config "Default Web Site" -section:system.webServer/asp /session.allowSessionState:"True" /commit:apphost

appcmd.exe set config "Default Web Site" -section:system.webServer/asp /session.max:"1000" /commit:apphost

appcmd.exe set config "Default Web Site" -section:system.webServer/asp

I'm a big fan of IIS 7's AppCmd.exe, but unfortunately it has two rather large limitations:

  • AppCmd.exe does not directly support clearing the contents of a configuration section. (But there's a workaround that I list below.)
  • AppCmd.exe does not support removing an item from a collection.

These limitations have caused me some grief from time to time, because I often want to script the modification of collections, and I would love to remove items or clear a collection.

How to add a <clear /> element using AppCmd:

Although it's kind of a hack, there is a way to force AppCmd.exe to add a <clear /> element.

Here's what you need to do in order to clear the list of default documents for the Default Web Site:

  1. Create an XML file like the following and save it as "CLEAR.XML":
    <?xml version="1.0" encoding="UTF-8"?>
    <appcmd>
        <CONFIG CONFIG.SECTION="system.webServer/defaultDocument" path="MACHINE/WEBROOT/APPHOST" overrideMode="Allow" locked="false">
            <system.webServer-defaultDocument  enabled="true">
                <files>
                    <clear />
                </files>
            </system.webServer-defaultDocument>
        </CONFIG>
    </appcmd>
  2. Run the following command:
    appcmd.exe set config /in "Default Web Site" < CLEAR.xml

Unfortunately this technique does not work for <remove /> elements. :-( But that being said, you can add a <remove /> element through VBScript; for more information, see the Using VBScript section.

Using VBScript

Fortunately, VBScript doesn't have AppCmd.exe's limitations, so you can add both <clear /> and <remove /> elements.

How to add a <clear /> element in VBScript:

The following steps will clear the list of default documents for the Default Web Site:

  1. Save the following VBScript code as "clear.vbs":
    Set adminManager = WScript.CreateObject("Microsoft.ApplicationHost.WritableAdminManager")
    adminManager.CommitPath = "MACHINE/WEBROOT/APPHOST/Default Web Site"
    Set defaultDocumentSection = adminManager.GetAdminSection("system.webServer/defaultDocument", _
      "MACHINE/WEBROOT/APPHOST/Default Web Site")
    Set filesCollection = defaultDocumentSection.ChildElements.Item("files").Collection
    filesCollection.Clear
    adminManager.CommitChanges
  2. Run the VBscript code by double-clicking the "clear.vbs" file.

How to add a <remove /> element in VBScript:

The following steps will remove a single item from the list of default documents for the Default Web Site:

  1. Save the following VBScript code as "remove.vbs":
    Set adminManager = WScript.CreateObject("Microsoft.ApplicationHost.WritableAdminManager")
    adminManager.CommitPath = "MACHINE/WEBROOT/APPHOST/Default Web Site"
    Set defaultDocumentSection = adminManager.GetAdminSection("system.webServer/defaultDocument", _
      "MACHINE/WEBROOT/APPHOST/Default Web Site")
    Set filesCollection = defaultDocumentSection.ChildElements.Item("files").Collection
    addElementPos = FindElement(filesCollection, "add", Array("value", "index.html"))
    If (addElementPos = -1) Then
       WScript.Echo "Element not found!"
       WScript.Quit
    End If
    filesCollection.DeleteElement(addElementPos)
    adminManager.CommitChanges
    
    Function FindElement(collection, elementTagName, valuesToMatch)
       For i = 0 To CInt(collection.Count) - 1
          Set element = collection.Item(i)
          If element.Name = elementTagName Then
             matches = True
             For iVal = 0 To UBound(valuesToMatch) Step 2
                Set property = element.GetPropertyByName(valuesToMatch(iVal))
                value = property.Value
                If Not IsNull(value) Then
                   value = CStr(value)
                End If
                If Not value = CStr(valuesToMatch(iVal + 1)) Then
                   matches = False
                   Exit For
                End If
             Next
             If matches Then
                Exit For
             End If
          End If
       Next
       If matches Then
          FindElement = i
       Else
          FindElement = -1
       End If
    End Function
  2. Run the VBscript code by double-clicking the "remove.vbs" file.

More Information

For more information about scripting and IIS configuration settings, see the following:

Note: This blog was originally posted at http://blogs.msdn.com/robert_mcmurray/

Posted: Jun 01 2011, 11:19 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: IIS | Scripting
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

Cascading Style Sheet (CSS) Color Negatizing Script

The Customer Scenario

I ran into an interesting situation recently - I host a website for a friend of mine, and he was shopping around for a new website template. He found one that he liked, but he didn't like the colors. In fact, he wanted the exact opposite of the colors in the website template, so he asked what I could do about it.

I looked at the website template, and thankfully it was using linked Cascading Style Sheets (CSS) files for all of the color definitions, so I told him that changing the colors would probably be a pretty easy thing to do. However, once I cracked open the CSS files from the website template, I found that they had hundreds of color definitions. Changing every color definition by hand would have taken hours, so I decided to write some Windows Script Host (WSH) code to do the work for me. ;-]

Negatizing a CSS File

With the above scenario in mind, here's the script that I wrote to negatize every color in a CSS file - all that you need to do is replace the paths to the input and output files and run the script to create the negatized version of the input CSS file.

Option Explicit

Const strInputFile = "c:\inetpub\wwwroot\style-dark.css"
Const strOutputFile = "c:\inetpub\wwwroot\style-light.css"

' ------------------------------------------------------------

Dim objFSO
Dim objInputFile
Dim objOutputFile
Dim strInputLine
Dim strLeft, strMid, strRight, strArray
Dim blnFound

' ------------------------------------------------------------

Const strTempRGB = "[|[TMPRGBSTR1NG]|]"
Const strTempHEX = "[|[TMPHEXSTR1NG]|]"

' ------------------------------------------------------------

Set objFSO = CreateObject("scripting.filesystemobject")
Set objInputFile = objFSO.OpenTextFile(strInputFile)
Set objOutputFile = objFSO.CreateTextFile(strOutputFile)

Do While Not objInputFile.AtEndOfStream
    strInputLine = objInputFile.ReadLine
    blnFound = True
    
    Do While blnFound
        If InStr(1,strInputLine,"rgb(",vbTextCompare) Then
            strLeft = Left(strInputLine,InStr(1,strInputLine,"rgb(",vbTextCompare)-1)
            strMid = Mid(strInputLine,InStr(1,strInputLine,"rgb(",vbTextCompare)+4)
            strRight = Mid(strMid,InStr(strMid,")")+1)
            strMid = Left(strMid,InStr(strMid,")")-1)
            strArray  = Split(strMid,",")
            strMid = InvertOctet(CInt(strArray(0))) & _
                "," & InvertOctet(CInt(strArray(1))) & _
                "," & InvertOctet(CInt(strArray(2)))
            strInputLine = strLeft & strTempRGB & "(" & strMid & ")" & strRight
        Else
            blnFound = False
        End If
    Loop
    
    strInputLine = Replace(strInputLine,strTempRGB,"rgb")
    
    blnFound = True

    Do While blnFound
        If InStr(strInputLine,"#") Then
            strLeft = Left(strInputLine,InStr(strInputLine,"#")-1)
            strMid = Mid(strInputLine,InStr(strInputLine,"#")+1)
            If Len(strMid)>6 Then
                strRight = Mid(strMid,7)
                strMid = Left(strMid,6)
            ElseIf Len(strMid)>3 Then
                strRight = Mid(strMid,4)
                strMid = Left(strMid,3)
            Else
                strRight = ""
            End If
            
            If IsHexString(strMid) Then            
                If Len(strMid) = 6 Then
                    strMid = Right("0" & Hex(InvertOctet(CInt("&h" & Left(strMid,2)))),2) & _
                        Right("0" & Hex(InvertOctet(CInt("&h" & Mid(strMid,3,2)))),2) & _
                        Right("0" & Hex(InvertOctet(CInt("&h" & Right(strMid,2)))),2)
                Else
                    strMid = Hex(InvertByte(CInt("&h" & Left(strMid,2)))) & _
                        Hex(InvertByte(CInt("&h" & Mid(strMid,3,2)))) & _
                        Hex(InvertByte(CInt("&h" & Right(strMid,2))))
                End If
            End If

            strInputLine = strLeft & strTempHEX & strMid & strRight
        Else
            blnFound = False
        End If
    Loop
    
    strInputLine = Replace(strInputLine,strTempHEX,"#")
    
    objOutputFile.WriteLine strInputLine
Loop


' ------------------------------------------------------------

Function IsHexString(ByVal tmpString)
    Dim blnHexString, intHexCount, intHexByte
    blnHexString = True
    If Len(tmpString)<>3 and Len(tmpString)<>6 Then
        blnHexString = False
    Else
        tmpString = UCase(tmpString)
        For intHexCount = 1 To Len(tmpString)
            intHexByte = Asc(Mid(tmpString,intHexCount,1))
            If (intHexByte < 48 Or intHexByte > 57) And (intHexByte < 65 Or intHexByte > 70) Then
                blnHexString = False
            End If
        Next
    End If
    IsHexString = blnHexString
End Function

' ------------------------------------------------------------

Function InvertByte(ByVal tmpByte)
    tmpByte = tmpByte And 15
    tmpByte = 15 - tmpByte
    InvertByte = tmpByte
End Function

' ------------------------------------------------------------

Function InvertOctet(ByVal tmpOctet)
    tmpOctet = tmpOctet And 255
    tmpOctet = 255 - tmpOctet
    InvertOctet = tmpOctet
End Function

' ------------------------------------------------------------

Negatizing a SharePoint 2007 Theme

After I wrote the above script, I found myself using it for a bunch of different websites that I manage for other people. One of the websites that I host is based on SharePoint 2007, so I wondered how difficult it would be negatize a SharePoint 2007 theme. As it turns out, it's pretty easy. The following steps will walk you through the steps that are required to create a negatized version of the built-in "Classic" SharePoint 2007 theme.

(NOTE: The steps in this section do not work with SharePoint 2010 or office 14; SharePoint 2010 and Office 14 store their themes in a different format, so these steps will not work.)

  1. Copy the folder:
    "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSIC"
    To the following folder:
    "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSICNEGATIVE"
  2. Rename the file:
    "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSICNEGATIVE\CLASSIC.INF"
    To the following:
    "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSICNEGATIVE\CLASSICNEGATIVE.INF"
  3. Open the following file:
    "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSIC\CLASSICNEGATIVE.INF"
    • Replace all instances of "Classic" with "Classic Negative".
    • Save and close the INF file.
  4. Open the following file:
    "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\LAYOUTS\1033\SPTHEMES.XML"
    • Add the following entry to the <SPThemes> collection:
      <Templates>
      <TemplateID>classicnegative</TemplateID>
      <DisplayName>Classic Negative</DisplayName>
      <Description>Classic Negative</Description>
      <Thumbnail>images/thclassic.gif</Thumbnail>
      <Preview>images/thclassic.gif</Preview>
      </Templates>
    • Save and close the XML file.
  5. Edit the color negatizing WSH script from earlier in this blog for each of the following files and run it:
    • theme.css
      • Input File:
        "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSIC\theme.css"
      • Output File:
        "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSICNEGATIVE\theme.css"
    • mossExtension.css
      • Input File:
        "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSIC\mossExtension.css"
      • Output File:
        "%CommonProgramFiles%\Microsoft Shared\Web Server Extensions\12\TEMPLATE\THEMES\CLASSICNEGATIVE\mossExtension.css"

That's all it takes to negate the colors that are defined in the CSS files for a SharePoint 2007 theme. (NOTE: This does not modify the colors of the images in the SharePoint theme; you will need a graphics program to update the colors in the images.)

Closing Thought

Before I receive any comments, I am perfectly aware that "negatize" is not an actual word in the English language, but it seemed appropriate, and new words have to start somewhere. ;-]

Note: This blog was originally posted at http://blogs.msdn.com/robert_mcmurray/
Posted: May 31 2011, 11:26 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: IIS | Scripting | SharePoint
Tags:
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

Creating XML Reports for FSRM Quota Usage

I had a great question in follow up to the "Secure, Simplified Web Publishing using Microsoft Internet Information Services 7.0" webcast that I delivered the other day, "How you can you programmatically access the quota usage information from the File Server Resource Manager (FSRM)?"

First of all, there is a native API for writing code to access FSRM data detailed at the following URL:

http://msdn2.microsoft.com/en-us/library/bb625489.aspx

That's a bit of overkill if you're just looking to script something.

There is a WMI interface as well, but it’s only for FSRM events.

So that leaves you with a pair of command-line tools that you can script in order to list your quota usage information:

  • storrept.exe - Used to manage storage reports
  • dirquota.exe - Used to manage quota usage

Right out of the box the first command-line tool, storrept.exe, can generate a detailed XML report using a user-definable scope. To see this in action, take the following example syntax and modify the scope parameter to your desired paths:

storrept.exe reports generate /Report:QuotaUsage /Format:XML /Scope:"C:\"

 You can also specify multiple paths in your scope using a pipe-delimited format like:

/Scope:"C:\Inetpub|D:\Inetpub"

When the command has finished, it will tell you the path to your report like the following example:

Storage reports generated successfully in "C:\StorageReports\Interactive".

The XML-based information in the report can then be consumed with whatever method you usually use to parse XML. It should be noted that storrept.exe also supports the following formats: CSV, DHTML, HTML, and TXT.

This XML might be okay for most applications, but for some reason I wanted to customize the information that I received, so I experimented with the second command-line tool, dirquota.exe, to get the result that I was looking for.

First of all, using dirquota.exe quota list returns information in the following format:

Quotas on machine SERVER: Quota Path: C:\inetpub\ftproot Source Template: 100 MB Limit (Matches template) Quota Status: Enabled Limit: 100.00 MB (Hard) Used: 1.00 KB (0%) Available: 100.00 MB Peak Usage: 1.00 KB (10/25/2007 2:15 PM) Thresholds: Warning ( 85%): E-mail Warning ( 95%): E-mail, Event Log Limit (100%): E-mail, Event Log

This information is formatted nicely and is therefore easily parsed, so I wrote the following batch file called "dirquota.cmd" to start things off:

@echo off echo Processing the report... dirquota.exe quota list > dirquota.txt cscript.exe //nologo dirquota.vbs

Next, I wrote the following vbscript application called "dirquota.vbs" to parse the output into some easily-usable XML code:

Option Explicit

Dim objFSO, objFile1, objFile2
Dim strLine, strArray(2)
Dim blnQuota,blnThreshold

' create objects
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objFile1 = objFSO.OpenTextFile("dirquota.txt")
Set objFile2 = objFSO.CreateTextFile("dirquota.xml")

' start the XML output file
objFile2.WriteLine "<?xml version=""1.0""?>"
objFile2.WriteLine "<Quotas>"

' set the runtime statuses to off
blnQuota = False
blnThreshold = False

' loop through the text file
Do While Not objFile1.AtEndOfStream

  ' get a line from the file
  strLine = objFile1.ReadLine

  ' only process lines with a colon character
  If InStr(strLine,":") Then
    ' split the string manually at the colon character
    strArray(1) = Trim(Left(strLine,InStr(strLine,":")-1))
    strArray(2) = Trim(Mid(strLine,InStr(strLine,":")+1))

    ' filter on strings with parentheses
    strLine = strArray(1)
    If InStr(strLine,"(") Then
      strLine = Trim(Left(strLine,InStr(strLine,"(")-1)) & "*"
    End If

    ' process the inidivdual entries
    Select Case UCase(strLine)

      ' a quota path signifies a new record
      Case UCase("Quota Path")

        ' close any open threshold collections
        If blnThreshold = True Then
          objFile2.WriteLine "</Thresholds>"
        End If

        ' close an open quota element
        If blnQuota= True Then
          objFile2.WriteLine "</Quota>"
        End If

        ' signify a new quota element
        objFile2.WriteLine "<Quota>"

        ' output the relelvant information
        objFile2.WriteLine FormatElement(strArray(1),strArray(2))

        ' set the runtime statuses
        blnQuota= True
        blnThreshold = False

      ' these bits of informaiton are parts of a quota
      Case UCase("Source Template"), UCase("Quota Status"), _
          UCase("Limit"), UCase("Used"), _
          UCase("Available"), UCase("Peak Usage")

        ' close any open threshold collections
        If blnThreshold = True Then
          objFile2.WriteLine "</Thresholds>"
        End If

        ' set the runtime status
        blnThreshold = False

        ' output the relelvant information
        objFile2.WriteLine FormatElement(strArray(1),strArray(2))

      ' these bits of informaiton are thresholds
      Case UCase("Warning*"), UCase("Limit*")

        ' open a threshold collection if not already open
        If blnThreshold = False Then
          objFile2.WriteLine "<Thresholds>"
        End If

        ' output the relelvant information
        objFile2.WriteLine FormatElement( _
          Left(strLine,Len(strLine)-1), _
          Replace(Mid(strArray(1), _
          Len(strLine))," ","") & " " & strArray(2))

        ' set the runtime status
        blnThreshold = True

    End Select
  End If
Loop

' close any open threshold collections
If blnThreshold = True Then
  objFile2.WriteLine "</Thresholds>"
End If

' close an open quota element
If blnQuota= True Then
  objFile2.WriteLine "</Quota>"
End If

' end the XML output file
objFile2.WriteLine "</Quotas>"

objFile1.Close
objFile2.Close
Set objFSO = Nothing

' format data into an XML element
Function FormatElement(tmpName,tmpValue)
  FormatElement = "<" & Replace(tmpName," ","") & _
  ">" & tmpValue & "</" & Replace(tmpName,Chr(32),"") & ">"
End Function

When the batch file and vbscript are run, they will create a file named "dirquota.xml" which will resemble the following example XML:

<?xml version="1.0"?>
<Quotas>
  <Quota>
    <QuotaPath>C:\inetpub\ftproot</QuotaPath>
    <SourceTemplate>100 MB Limit (Matches template)</SourceTemplate>
    <QuotaStatus>Enabled</QuotaStatus>
    <Limit>100.00 MB (Hard)</Limit>
    <Used>1.00 KB (0%)</Used>
    <Available>100.00 MB</Available>
    <PeakUsage>1.00 KB (10/25/2007 2:15 PM)</PeakUsage>
    <Thresholds>
      <Warning>(85%) E-mail</Warning>
      <Warning>(95%) E-mail, Event Log</Warning>
      <Limit>(100%) E-mail, Event Log</Limit>
    </Thresholds>
  </Quota>
</Quotas>

I found the above XML much easier to use than the XML that came from the storrept.exe report, but I'm probably comparing apples to oranges. In any event, I hope this helps someone with questions about FSRM reporting.

Have fun!

Note: This blog was originally posted at http://blogs.msdn.com/robert_mcmurray/
Posted: Oct 25 2007, 10:27 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: Scripting
Tags: , ,
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

Viewing current FTP7 sessions using C#

A few weeks ago my friend Jaroslav posted a blog entry about viewing the current FTP7 sessions using Javascript, and I followed that up with a blog post about viewing the current FTP7 sessions using VBScript.

This blog entry follows up on those postings by showing you how to view the current FTP7 sessions using C#. To do so, start a new Windows Console Application project using C# in Visual Studio 2005 on a computer running Windows Server 2008 with the new FTP7 server installed. You will need to add a reference to the AppHostAdminLibrary by manually browsing to the nativerd.dll file that's located in the %WinDir%\System32\InetSrv folder. After you've added the reference, replace all of the C# code from the project template with the following C# code:

using System;
using System.Collections.Generic;
using System.Text;
using AppHostAdminLibrary;

namespace FtpDumpSessions
{
  class FtpDumpSessions
  {
    static void Main(string[] args)
    {
      AppHostWritableAdminManager objAdminManager =
        new AppHostWritableAdminManager();

      // get the collection of sites
      IAppHostElement objSitesElement =
        objAdminManager.GetAdminSection(
        "system.applicationHost/sites",
        "MACHINE/WEBROOT/APPHOST");
      uint intSiteCount =
        objSitesElement.Collection.Count;
      Console.WriteLine(
        "Site count: {0}",
        intSiteCount);

      try
      {
        // loop through the sites collection
        for (int intSite = 0;
          intSite < intSiteCount;
          ++intSite)
        {
          // get a site
          IAppHostElement objFtpSite =
            objSitesElement.Collection[intSite];

          // get the FTP section
          IAppHostElement objFtpSiteElement =
            objFtpSite.ChildElements["ftpServer"];

          // get the sessions collection
          IAppHostElement objFtpSessions =
            objFtpSiteElement.ChildElements["sessions"];
          uint intSessionCount =
            objFtpSessions.Collection.Count;
          Console.WriteLine(
            "\tFTP sessions for {0}: {1}",
            objFtpSite.Properties["name"].Value, intSessionCount);

          // loop through the sessions
          for (int intSession = 0;
            intSession < intSessionCount;
            ++intSession)
          {
            IAppHostElement objFtpSession =
              objFtpSessions.Collection[intSession];
            // loop through each session's properties
            for (int intProperty = 0;
              intProperty < objFtpSession.Properties.Count;
              ++intProperty)
            {
              Console.WriteLine(
                "\t\t{0}: {1}",
                objFtpSession.Properties[intProperty].Name,
                objFtpSession.Properties[intProperty].Value);
            }
          }
        }
      }
      catch (System.Exception ex)
      {
        Console.WriteLine(
          "\r\nError: {0}",
          ex.Message);
      }
    }
  }
}

When you compile and run the project, you should see a listing of all users connected to your FTP7 sites.

That's about it for this post - have fun!

Posted: Jul 06 2007, 01:59 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: FTP | Scripting
Tags: , ,
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

Viewing current FTP7 sessions using VBScript

A few weeks ago my friend Jaroslav posted a blog entry about viewing the current FTP7 sessions using Javascript, and I followed that up with a blog post about viewing the current FTP7 sessions using C#.

This blog entry follows up on those postings by showing you how to view the current FTP7 sessions using VBScript. To do so, copy the following VBScript code to Windows Notepad and save the file as "ftp_sessions.vbs" on a computer running Windows Server 2008 with the new FTP7 server installed:

Option Explicit

Dim objAdminManager, objSiteCollection, objFtpSiteElement
Dim objSite, objFtpSession, objFtpSessions, objFtpProperty
Dim intSite, intFtpSession, intFtpProperty
Dim intSiteCount, intFtpSessionCount, intFtpPropertyCount

Set objAdminManager = WScript.CreateObject("Microsoft.ApplicationHost.AdminManager")

' get the collection of sites
Set objSiteCollection = objAdminManager.GetAdminSection( _
  "system.applicationHost/sites", "MACHINE/WEBROOT/APPHOST" )

intSiteCount = CInt(objSiteCollection.Collection.Count)

WScript.Echo String(40,"*")
WScript.Echo "Site count: " & intSiteCount
WScript.Echo String(40,"*")

' loop through the sites collection
For intSite = 0 To intSiteCount-1

  ' get a site
  Set objSite = objSiteCollection.Collection.Item(intSite)
  
  ' get the FTP section
  Set objFtpSiteElement = objSite.ChildElements.Item("ftpServer")
  
  ' get the sessions collection
  Set objFtpSessions = objFtpSiteElement.ChildElements.Item("sessions")
  intFtpSessionCount = CInt(objFtpSessions.Collection.Count)

  WScript.Echo String(40,"=")
  WScript.Echo "FTP sessions for " & _
    objSite.Properties.Item("name").Value & _
    ": " & intFtpSessionCount
  WScript.Echo String(40,"=")

  ' loop through the sessions
  For intFtpSession = 0 To intFtpSessionCount - 1
    Set objFtpSession = objFtpSessions.Collection.Item(intFtpSession)
    intFtpPropertyCount = CInt(objFtpSession.Properties.Count)
    ' loop through each session's properties
    For intFtpProperty = 0 To intFtpPropertyCount - 1
      Set objFtpProperty = objFtpSession.Properties.Item(intFtpProperty)
      WScript.Echo CStr(objFtpProperty.Name) & ": " & CStr(objFtpProperty.Value)
    Next
    WScript.Echo String(40,"-")
  Next
Next

To make sure that you don't see any message box pop-ups, run the script from the command-line using the following syntax:

cscript.exe ftp_sessions.vbs

That's about it for this post - have fun!

Posted: Jul 06 2007, 01:59 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: FTP | Scripting
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

Scripting MIDI Events in Sibelius

OK - I have to admit, when you realize that you are making software choices based on scripting language support you start to get the feeling that there are times when you just have to accept the fact that you are a geek.

Here's a case in point: I write music as a hobby, and when shopping for a program to write sheet music with, I chose Sibelius because I discovered that they have a really cool scripting language called "ManuScript". OK - so the name is kind of silly, but it's pretty cool to write code with.

The way it works is that you create what Sibelius calls a "plug-in", and you assign it to a category that will be used as the menu under which your plug-in will be displayed. Once you've done all that, you can start writing code.

For example, I needed to add sustain pedal MIDI events to an entire piano score, and doing so manually would have been a tedious exercise. So I made my life easier and created a quick plug-in that adds the MIDI events to apply the sustain pedal at full level to the beginning of every measure, and then adds the MIDI events to lift the sustain pedal at the end of every measure:

// Verify that a score is open.
if (Sibelius.ScoreCount=0)
{
   Sibelius.MessageBox("Please open a score.");
   return false;
}

// Retrieve a score object for the active score.
score = Sibelius.ActiveScore;
// Retrieve an object for the current selection.
selection = score.Selection;

if (selection.IsPassage)
{
   // Loop through the highlighted measures.
   for each Bar b in selection
   {
      // Add MIDI sustain pedal events.
      b.AddText(1,"~C64,127",TechniqueTextStyle);
      b.AddText(b.Length,"~C64,0",TechniqueTextStyle);
   }
   // Return a status message.    Sibelius.MessageBox("Finished."); }

I should point out, however, that this is meant to be a brief example of what you can do. Running this same plug-in on the same selection will re-add the sustain pedal events to your score; I didn't add any advanced logic to check for the existence of any prior sustain pedal events. If anyone wants to take on that challenge, have fun and don't forget to share your results!

Posted: May 11 2007, 04:45 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: Scripting | MIDI
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us

Programmatically Enumerating Installations of the FrontPage Server Extensions

I had a great question from a customer the other day: "How do you programmatically enumerate how many web sites on a server have the FrontPage Server Extensions installed?" Of course, that's one of those questions that sounds so simple at first, and then you start to think about how to actually go about it and it gets a little more complicated.

The first thought that came to mind was to just look for all the "W3SVCnnnn" subfolders that are located in the "%ALLUSERSPROFILE%\Application Data\Microsoft\Web Server Extensions\50" folder. (These folders contain the "ROLES.INI" files for each installation.) The trouble with this solution is that some folders and files do not get cleaned up when the server extensions are uninstalled, so you'd get erroneous results.

The next thought that came to mind was to check the registry, because each installation of the server extensions will create a string value and subkey named "Port /LM/W3SVC/nnnn:" under the "[HKLM\SOFTWARE\Microsoft\Shared Tools\Web Server Extensions\Ports]" key. Enumerating these keys will give you the list of web sites that have the server extensions or SharePoint installed. The string values that are located under the subkey contain some additional useful information, so I thought that as long as I was enumerating the keys, I might as well enumerate those values.

The resulting script is listed below, and when run it will create a log file that lists all of the web sites that have the server extensions or SharePoint installed on the server that is specified by the "strComputer" constant.

Option Explicit

Const strComputer = "localhost"

Dim objFSO, objFile
Dim objRegistry
Dim strRootKeyPath, strSubKeyPath, strValue
Dim arrRootValueTypes, arrRootValueNames
Dim arrSubValueTypes, arrSubValueNames
Dim intLoopA, intLoopB

Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1

strRootKeyPath = "Software\Microsoft\" & _
  "Shared Tools\Web Server Extensions\Ports"

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("ServerExtensions.Log")

objFile.WriteLine String(40,"-")
objFile.WriteLine "Report for server: " & UCase(strComputer)
objFile.WriteLine String(40,"-")

Set objRegistry = GetObject(_
  "winmgmts:{impersonationLevel=impersonate}!\\" & _
  strComputer & "\root\default:StdRegProv")
objRegistry.EnumValues HKEY_LOCAL_MACHINE, strRootKeyPath, _
  arrRootValueNames, arrRootValueTypes

For intLoopA = 0 To UBound(arrRootValueTypes)
  If arrRootValueTypes(intLoopA) = REG_SZ Then
    objFile.WriteLine arrRootValueNames(intLoopA)
    strSubKeyPath = strRootKeyPath & _
      "\" & arrRootValueNames(intLoopA)
    objRegistry.EnumValues HKEY_LOCAL_MACHINE, _
      strSubKeyPath, arrSubValueNames, arrSubValueTypes
    For intLoopB = 0 To UBound(arrSubValueTypes)
      If arrSubValueTypes(intLoopB) = REG_SZ Then
        objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
          strSubKeyPath, arrSubValueNames(intLoopB), strValue
        objFile.WriteLine vbTab & _
          arrSubValueNames(intLoopB) & "=" & strValue
      End If
    Next
    objFile.WriteLine String(40,"-")
  End If
Next

objFile.Close

The script should be fairly easy to understand, and you can customize it to suit your needs. For example, you could change the "strComputer" constant to a string array and loop through an array of servers.

Note: More information about the WMI objects used in the script can be found on the following pages:

Hope this helps!

Posted: Jul 11 2006, 21:02 by Bob | Comments (0)
  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5
Filed under: FrontPage | Scripting
Social Bookmarks: E-mail | Kick it! | DZone it! | del.icio.us