StaffWebsites_CSExtension.vb

Imports Microsoft.MetadirectoryServices
Imports System.IO
Imports System.Data.SqlClient
Imports System.DirectoryServices
' CSExtension for an MA which manages Virtual Directories in IIS.
' IIS must be installed on the ILM server as code relies on iisVDir.vbs,
' however the websites can be on a remote server.
' Written by Carol Wapshere, 17th January 2008
Public Class MACallExport_StaffWebsites
Implements IMAExtensibleFileImport
Implements IMAExtensibleCallExport
Const IIS_SERVER As String = "dc01"
Const PARENT_SHARE As String = "\\dc01\StaffWebsites\"
Const PARENT_FLDR As String = "C:\StaffWebsites\"
Dim LOGFILE_NAME As String = MAUtils.MAFolder & "\export.log"
Dim logfile As StreamWriter
Public Sub GenerateImportFile(ByVal filename As String, ByVal connectTo As String, ByVal user As String, ByVal password As String, ByVal configParameters As ConfigParameterCollection, ByVal fullImport As Boolean, ByVal types As TypeDescriptionCollection, ByRef customData As String) Implements IMAExtensibleFileImport.GenerateImportFile
  Dim iisVdirQuery As String = RunCmd("cscript iisvdir.vbs /s " & IIS_SERVER & " /query w3svc/1/ROOT/Staff")
  Dim arrVDir(,) As String
  Dim i, j As Integer
  i = -1
  Dim posEnd As Integer = iisVdirQuery.LastIndexOf("=")
  Dim posStart As Integer = iisVdirQuery.IndexOf("/", posEnd)
  While iisVdirQuery.Substring(posStart, 1) = "/"
    i = i + 1
    ReDim Preserve arrVDir(1, i)
    posEnd = iisVdirQuery.IndexOf(" ", posStart)
    arrVDir(0, i) = iisVdirQuery.Substring(posStart, posEnd - posStart).Replace("/", "")
    posStart = posStart + 35
    posEnd = iisVdirQuery.IndexOf(vbCrLf, posStart)
    arrVDir(1, i) = iisVdirQuery.Substring(posStart, posEnd - posStart)
    posStart = posEnd + 2
  End While
  Dim fw As StreamWriter
  Try
    'Open the output file specified in the run profile
    fw = New StreamWriter(filename, False)
    Catch ex As Exception
    Throw New UnauthorizedAccessException("Unable to open file: " & filename)
  End Try
  fw.WriteLine("alias,path")
  If i >= 0 Then
    For j = 0 To i
      fw.WriteLine(arrVDir(0, j) & "," & arrVDir(1, j))
    Next
  End If
  fw.Close()
End Sub
Public Sub BeginExport(ByVal connectTo As String, ByVal user As String, ByVal password As String, ByVal configParameters As ConfigParameterCollection, ByVal types As TypeDescriptionCollection) Implements IMAExtensibleCallExport.BeginExport
  logfile = New StreamWriter(LOGFILE_NAME, False)
End Sub
Public Sub ExportEntry(ByVal modificationType As ModificationType, ByVal changedAttributes As String(), ByVal csentry As CSEntry) Implements IMAExtensibleCallExport.ExportEntry
  Dim VDirAlias As String = csentry("alias").Value
  If modificationType = Microsoft.MetadirectoryServices.ModificationType.Add Then
    CreateVDir(VDirAlias)
  ElseIf modificationType = Microsoft.MetadirectoryServices.ModificationType.Delete Then
    DeleteVDir(VDirAlias)
  ElseIf modificationType = Microsoft.MetadirectoryServices.ModificationType.Replace Then
    RenameVDir(csentry)
  End If
End Sub
Public Sub EndExport() Implements IMAExtensibleCallExport.EndExport
  logfile.Close()
End Sub
Private Sub CreateVDir(ByRef VDirAlias As String)
  Dim newSharePath As String = PARENT_SHARE & VDirAlias
  Dim newDrivePath As String = PARENT_FLDR & VDirAlias
  Dim templatePath As String = PARENT_SHARE & "template"
If Not System.IO.Directory.Exists(newSharePath) Then
  RunCmd("xcopy /I " & templatePath & " " & newSharePath)
Else
  logfile.WriteLine("File " & newDrivePath & " already exists.")
End If
  RunCmd("cacls " & PARENT_SHARE & VDirAlias & " /E /G " & VDirAlias & ":C")
  RunCmd("cscript iisvdir.vbs /s " & IIS_SERVER & " /create w3svc/1/ROOT/Staff " & VDirAlias & " " & PARENT_FLDR & VDirAlias)
End Sub
Private Sub DeleteVDir(ByRef VDirAlias As String)
  'Only deletes the Virtual Directory from IIS - the folder is not touched.
  RunCmd("cscript iisvdir.vbs /s " & IIS_SERVER & " /delete w3svc/1/ROOT/Staff/" & VDirAlias)
End Sub
Private Sub RenameVDir(ByRef csentry As CSEntry)
'Renames the folder, deletes the old VDir, and creates a new one.
'In a production environment a redirect should also be created for the old address.
  Dim oldDrivePath As String = csentry("path").Value
  Dim oldAlias As String = oldDrivePath.Substring(oldDrivePath.LastIndexOf("\") + 1)
  Dim oldSharePath As String = PARENT_SHARE & "\" & oldAlias
  Dim newAlias As String = csentry("alias").Value
  Dim newSharePath As String = PARENT_SHARE & "\" & newAlias
  Dim newDrivePath As String = PARENT_FLDR & "\" & newAlias
  RunCmd("ren " & oldSharePath & " " & newSharePath)
  RunCmd("cscript iisvdir.vbs /s " & IIS_SERVER & " /delete w3svc/1/ROOT/Staff/" & oldAlias)
  RunCmd("cscript iisvdir.vbs /s " & IIS_SERVER & " /create w3svc/1/ROOT/Staff " & newAlias & " " & newDrivePath)
End Sub
Private Function RunCmd(ByRef command As String) As String
  'Run a command in a cmd process and returns the output
  logfile.Write(command)
  Dim myProcess As Process = New Process()
  Dim s As String
  myProcess.StartInfo.FileName = "cmd.exe"
  With myProcess.StartInfo
    .UseShellExecute = False
    .CreateNoWindow = True
    .RedirectStandardInput = True
    .RedirectStandardOutput = True
    .RedirectStandardError = True
  End With
  myProcess.Start()
  Dim sIn As StreamWriter = myProcess.StandardInput
  sIn.AutoFlush = True
  Dim sOut As StreamReader = myProcess.StandardOutput
  Dim sErr As StreamReader = myProcess.StandardError
  sIn.Write(command & System.Environment.NewLine)
  sIn.Write("exit" & System.Environment.NewLine)
  s = sOut.ReadToEnd()
  If Not myProcess.HasExited Then
    myProcess.Kill()
  End If
  sIn.Close()
  sOut.Close()
  sErr.Close()
  myProcess.Close()
  Return s
End Function
End Class