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

Share this: