Option Explicit

' Wiki page with script info: http://info.izzy.org/Wiki/EXCollect.aspx
' Most recent "released version": http://info.izzy.org/Technical/Scripting/Documents/Forms/DispForm.aspx?ID=42
'
' Draft\beta versions and To-Dos posted here: http://info.izzy.org/Technical/Scripting/EXCollect/
'
Const DebugLevel = 1 '4 = Max
Const RegPath = "SOFTWARE\Izzy.Org\EXCollect"
Const SGInfoFile = "EXCollect-SGData.txt"
Const StoreInfoFile = "EXCollect-StoreData.txt"
Const MBInfoFile = "EXCollect-MBData.txt"
Const HKLM = &H80000002
Const HandleErrors = True
      UpdateStoreData = False ' If store\DB data should be saved on each run
Const GetMBData = True ' Option to get MB count, # of items in mailboxes, and size of mailboxes - Only works with Exchange 2000/2003 currently
Const WriteMBData = False ' Option to save indvidual mailbox data to MBInfoFile - Only works with Exchange 2000/2003 currently
Const LimitToServers = "" 'Enter NetBIOS name of the only Exchange servers you want to collect data from, comma seperated.
Const DoPing = True ' Should systems be pinged 1st

Const PowerShellPath = "C:\Windows\system32\WindowsPowerShell\v1.0\powershell.exe"
Const E2k7PSPath = "C:\Program Files\Microsoft\Exchange Server\bin\exshell.psc1"

Dim objCom ' the global ADO command object
Dim objConn ' the global ADO connection object
Dim objFSO, objShell, objRootDSE
Dim strMsg, UpdateStoreData


If InStr(1,wscript.fullname,"cscript.exe",1) = 0 then
  strMsg = "This script should be run using the following syntax:" & VbCrLf & _
           "CSCRIPT EXCollect.vbs"
  WScript.Echo strMsg
	WScript.quit
Else
  Main
End if

Sub Main
  If HandleErrors Then On Error Resume Next
  Dim objSGInfoFile, objStoreInfoFile, strServerVer, strExchangeVer, strStorageGrpName
  Dim strStorageGroupDN, strStoreDN, strServerDN
  Dim StorageGrp, Store, SGLogUNCPath, LogFileCount
  Dim strServerListDN, arrServerListDN, strServerSGDNs
  Dim EDBPath, STMPath, EDBSize, STMSize, TotalStore
  Dim arrSG, arrStore, arrTLogs
  Dim strServer, objServer
  Dim NewestFile, OldestFile, NewestDate, OldestDate, objNewestFile, objOldestFile, LastNewLog
  Dim OutputLine, Temp
  Dim i, j, k, n, o, LogDiff, EXCollectRun
  Dim iMBCount, iMBTotalSize, iItemCount, LastMBCount, LastItemCount, LastMBTotalSize, iMBCountDiff, iMBTotalSizeDiff, iItemCountDiff
  Dim bContiune

  Call InitializeADSI

  strServerListDN = GetAllServers(GetOrganizationInformation)
  
  Set objFSO = CreateObject ("Scripting.FileSystemObject")
  Set objShell = CreateObject("WScript.Shell")
  
  If Not objFSO.FileExists(StoreInfoFile) Then
	  Set objStoreInfoFile  = objFSO.OpenTextFile (StoreInfoFile, 8, True)
	  OutputLine = "Date Time,Run #,Server,Version,Storage Group,Store,EDB Path,EDB Size (MB),STM Path, STM Size (MB),Total Size (MB)"
	  OutputLine = Replace(OutputLine,",",Chr(9))
	  objStoreInfoFile.WriteLine OutputLine
	  UpdateStoreData = True
  ElseIf UpdateStoreData Then
	  Set objStoreInfoFile  = objFSO.OpenTextFile (StoreInfoFile, 8, True)
  End If

  If Not objFSO.FileExists(SGInfoFile) Then
	  Set objSGInfoFile = objFSO.OpenTextFile (SGInfoFile, 8, True)
	  OutputLine = "Date Time,Run #,Server,Version,New TLOGS,Storage Group,SG Total Size (MBs),Current TLOG,# of MBX,Total Item Count,Total MBX Size (KBs),MB Count Diff, MBX Total Size Diff (KBs), Item Count Diff"
	  OutputLine = Replace(OutputLine,",",Chr(9))
	  objSGInfoFile.WriteLine OutputLine
  Else
	  Set objSGInfoFile = objFSO.OpenTextFile (SGInfoFile, 8, True)
  End If

  EXCollectRun  = GetRegistry (RegPath,"EXCollectRun")
  If EXCollectRun = "" Then 
    EXCollectRun = 1
  Else
    EXCollectRun = Cint(EXCollectRun) + 1
  End If

  arrServerListDN = Split (strServerListDN, ";")

  For i = LBound (arrServerListDN) To UBound (arrServerListDN)
    Dim serverTotal

    bContiune = True
    strServerDN = arrServerListDN (i)
    strServer = Mid (Left (strServerDN, Instr (strServerDN, ",") - 1), 4)
    Set objServer = GetObject("LDAP://" & arrServerListDN (i))
    strServerVer = Replace(objServer.Get("serialNumber"),"Service Pack","SP") ' Get Exchange version from AD
    Set objServer = Nothing

    Temp = MID(strServerVer,InStr(1,strServerVer,"Version ",1) + 8,3)
    Select Case(Temp)
      Case "6.0"
        strExchangeVer = 2000
      Case "6.5"
        strExchangeVer = 2003
      Case "8.0", "8.1"
        strExchangeVer = 2007
    End Select

    logdata "---------------------------",0
    logdata "Server name: " & strServer & " - Exchange " & strExchangeVer & " " & strServerVer,0

    If InStr(1,LimitToServers,strServer,1) = 0 and Len(LimitToServers) > 1 Then
      WScript.Echo Space(2) & "[" & strServer & "] is not in the LimitToServers list, skipping"
      bContiune = False
    Else
      If DoPing And Not Ping(strServer) Then 
        WScript.Echo Space(2) &  "[" & strServer & "] is not pingable, skipping"
        bContiune = False
      End If
    End If    
    If bContiune = True Then
      strServerSGDNs = GetStorageGroupsForServer (arrServerListDN (i))
      arrSG = Split (strServerSGDNs, ";")
      logdata Space(2) & "# of SGs: " & UBound(arrSG) + 1,0

      For j = LBound (arrSG) To UBound (arrSG)
        Dim sgTotal, SGLogPath, objSG

        sgTotal = 0
        iMBCount = 0
        iMBTotalSize = 0
        iMBTotalSizeDiff = 0

        strStorageGroupDN = arrSG (j)
        StorageGrp = Mid (Left (strStorageGroupDN, Instr (strStorageGroupDN, ",") - 1), 4)

        Set objSG = GetObject ("LDAP://" & strStorageGroupDN)
        strStorageGrpName = objSG.Get("name")
        logdata "",0
        logdata Space(4) & "---------------------------",0
        logdata Space(4) & "Storage Group: " & strStorageGrpName,0

        SGLogPath = objSG.Get("msExchESEParamLogFilePath")
        Set objSG =  Nothing

        SGLogUNCPath = "\\" & strServer & "\" & Left(SGLogPath,1) & "$" & Right(SGLogPath,Len(SGLogPath)-2)

        arrTLogs = GetFiles (SGLogUNCPath & "\*.log")
        Logdata Space(4) & "# of current *.LOG files: " & UBound(arrTLogs),1 & " (Includes TMP & RES Logs)"
        
        n = 1
        Do While LEN(arrTLogs(n)) < 12 ' Skip temp TLOGS (EXXtmp.log & EXX.LOG)
          Logdata Space(6) & "Skipping current and temp TLOG: " & arrTLogs(n),2
          If n >= UBound(arrTLogs) Or LEN(arrTLogs(n)) > 12 Then Exit Do
          n = n + 1
        Loop

        o = UBound(arrTLogs) - 1
        Do While LEN(arrTLogs(o)) < 12 ' Skip RES TLOGS (res1.log, res2.log)
          Logdata Space(6) & "Skipping reservation TLOG: " & arrTLogs(o),2
          If o = 0 Or LEN(arrTLogs(o)) > 12 Then Exit Do
          o = o - 1
        Loop

        LogFileCount = (UBound(arrTLogs) - n) - (UBound(arrTLogs)-o)

        If AccessFile(SGLogUNCPath & "\" & arrTLogs(n),objNewestFile) And AccessFile(SGLogUNCPath & "\" & arrTLogs(o),objOldestFile) Then
          NewestFile = Replace(objNewestFile.Name,".log","")
          NewestDate = objNewestFile.DateLastModified 
          Set objNewestFile = Nothing

          OldestFile = Replace(objOldestFile.Name,".log","")
          OldestDate = objOldestFile.DateLastModified 
          Set objOldestFile = Nothing
          
          strStoreDN = GetStoresForStorageGroupLDAP (strStorageGroupDN)
          arrStore = Split (strStoreDN, ";")

          For k = LBound (arrStore) To UBound (arrStore)
		        Dim obj, objFile, strFile, storeTotal
		        storeTotal = 0

		        strStoreDN = arrStore (k)
		        Store = Mid (Left (strStoreDN, Instr (strStoreDN, ",") - 1), 4)

		        Set obj = GetObject ("LDAP://" & strStoreDN)

	          EDBSize = 0
	          STMSize = 0
	          
		        EDBPath = obj.Get ("msExchEDBFile")
		        strFile = "\\" & strServer & "\" & Left (EDBPath, 1) & "$" & Mid (EDBPath, 3) ' Convert to a UNC path
		        LogData Space(6) & "Processing EDB: " & strFile,3
		        If objFSO.FileExists(strFile) Then 
		          Set objFile = objFSO.GetFile (strFile)
		          EDBSize = FormatNumber (objFile.Size / (1024 * 1024), 0)
		          storeTotal = storeTotal + (objFile.Size / (1024 * 1024))
          	
    	        If strExchangeVer <> 2007 Then
		            STMPath = obj.Get ("msExchSLVFile")
		            strFile = "\\" & strServer & "\" & Left (STMPath, 1) & "$" & Mid (STMPath, 3)
		            Set objFile = objFSO.GetFile (strFile)
		            STMSize = FormatNumber (objFile.Size / (1024 * 1024), 0)
		            storeTotal = storeTotal + (objFile.Size / (1024 * 1024))
		          Else
		            STMPath = "N/A"
		          End If
		          Set objFile = Nothing
		        Else
		          EDBSize = "Error"
		        End If
        	
		        TotalStore = FormatNumber (storeTotal, 0)
		        sgTotal = sgTotal + storeTotal
		        OutputLine = Date & " " & FormatDateTime(Time,4) & Chr(9) & EXCollectRun & Chr(9) & strServer & Chr(9) & strExchangeVer & Chr(9) & StorageGrp & Chr(9) & Store & Chr(9) & EDBPath & Chr(9) & EDBSize & Chr(9) & STMPath & Chr(9) & STMSize & Chr(9) & TotalStore
		        If UpdateStoreData Then objStoreInfoFile.WriteLine OutputLine
          Next

	        LastNewLog = GetRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName,"Last Newest Log")
	        LastItemCount = GetRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName,"Last Item Count")
	        LastMBCount = GetRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName,"Last Mailbox Count")
	        LastMBTotalSize = GetRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName,"Last Total Mailbox Size")
	        
          Logdata Space(2) & "LogFileCount: " & LogFileCount,2

	        Logdata Space(4) & "LastNewLog: " & LastNewLog,2
          Logdata Space(4) & "NewestFile: " & NewestFile & " NewestDate: " & NewestDate,2
          Logdata Space(4) & "OldestFile: " & OldestFile & " OldestDate: " & OldestDate,2

    	    Temp = PutRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName,"Last Oldest Log",OldestFile)
    	    
          LogDiff = SubLargeHex(NewestFile,LastNewLog)
	        Temp = PutRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName,"Last Newest Log" ,NewestFile)
    	    
	        If LastNewLog <> NewestFile and LastNewLog <> "" Then 
  	        Logdata Space(4) & "# of new TLogs: " & LogDiff,1
	        Else
	          If LastNewLog = "" Then 
	            Logdata Space(4) & "No previous run data exist, current # TLOG: " & LogFileCount,1
	          End If
		        LogDiff = 0
	        End If

          LogData Space(4) & "Total SG file sizes: " & FormatNumber (sgTotal,0) & " MBs", 0
          If GetMBData Then
            GetItemCount strServer, strStorageGrpName, strExchangeVer, iMBCount, iItemCount, iMBTotalSize
          End If

	        
	        Temp = PutRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName, "Last Item Count", iItemCount)
	        Temp = PutRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName, "Last Mailbox Count", iMBCount)
	        Temp = PutRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName, "Last Total Mailbox Size", iMBTotalSize)
	        Temp = PutRegistry (RegPath & "\" & strServer & "\" & strStorageGrpName, "Last TLOG Run",Date & " " & Time)

          If LastItemCount = "" Or LastItemCount = 0 Then 
            LastItemCount = 0
            iItemCountDiff =  0
          Else
            iItemCountDiff = iItemCount - LastItemCount
          End If

          If LastMBCount = "" Or LastMBCount = 0 Then 
            LastMBCount = 0
            iMBCountDiff = 0
          Else
            iMBCountDiff = iMBCount - LastMBCount
          End If

          If LastMBTotalSize = "" Or LastMBTotalSize = 0 Then 
            LastMBTotalSize = 0
            iMBTotalSizeDiff = 0
          Else
            iMBTotalSizeDiff = iMBTotalSize - LastMBTotalSize
          End If

          If GetMBData And iMBCount > 0 Then
            Logdata "",1
            Logdata Space(6) & "Mailboxes: " & FormatNumber(iMBCount,0),1
            Logdata Space(6) & "Item Count: " & FormatNumber(iItemCount,0),1
            Logdata Space(6) & "Total MB Size: " & FormatNumber(iMBTotalSize/1024,0) & " MBs",1

            Logdata "",1
            Logdata Space(6) & "Mailboxes Diff: " & FormatNumber(iMBCountDiff,0),1
            Logdata Space(6) & "Item Count Diff: " & FormatNumber(iItemCountDiff,0),1
            Logdata Space(6) & "Total MB Size Diff: " & FormatNumber(iMBTotalSizeDiff,0) & " KBs",1
          End If
          If iMBCount = 0 Then logdata Space(6) & "No mailboxes found, possible Public Folder only storage group or off-line.",1
          
	        OutputLine = Date & " " & FormatDateTime(Time,4) & Chr(9) & EXCollectRun & Chr(9) & strServer & Chr(9) & strExchangeVer & Chr(9) & LogDiff & Chr(9) & StorageGrp & Chr(9) & FormatNumber (sgTotal, 0) & Chr(9) & LogFileCount & Chr(9) & iMBCount & Chr(9) & iItemCount & Chr(9) & iMBTotalSize & Chr(9) & iMBCountDiff & Chr(9) & iMBTotalSizeDiff & Chr(9) & iItemCountDiff
	        objSGInfoFile.WriteLine OutputLine
	      Else
	        WScript.Echo Space(4) & "Error accessing log file: " & SGLogUNCPath & "\" & arrTLogs(n)
	      End If
      Next
    End If
  Next
  
  Temp = PutRegistry (RegPath, "EXCollectRun",EXCollectRun)
  Temp = PutRegistry (RegPath, "Info","See: http://info.izzy.org/Wiki/EXCollect.aspx")

  If UpdateStoreData Then
    objStoreInfoFile.Close
    Set objStoreInfoFile = Nothing
  End If
  objSGInfoFile.Close
  Set objSGInfoFile = Nothing
  
  Set objShell = Nothing
  Set objRootDSE = Nothing
  objConn.Close

  Set objCom  = Nothing
  Set objConn = Nothing
End Sub

Function GetItemCount (strComputer,strStorageGroup, strServerVer, iMBCount, iTotalItemCount, iMBTotalSize)
  If HandleErrors Then On Error Resume Next
  Dim SWBemlocator
  Dim objWMIService, objExec
  Dim colItems
  Dim objFile, objItem
  Dim strOutputLine, strQuery, strCMD, Temp, strDisplayName, strDatabaseName
  Dim iMBSize, iMBItemCount, f
  Dim iItemCountStart, iMBSizeStart, iDBNameStart
  Dim MailboxArray

  iMBCount = 0
  iTotalItemCount = 0
  iMBTotalSize = 0
  iMBItemCount = 0
  iMBSize= 0
    
  If WriteMBData and Not objFSO.FileExists(MBInfoFile) Then
	  Set objFile  = objFSO.OpenTextFile (MBInfoFile, 8, True)
    objFile.WriteLine Replace("Date Time,Server,StorageGroup,MailStore,User,Size(KB),TotalItems",",",vbTab)
	  objFile.WriteLine strOutputLine
  ElseIf WriteMBData Then
	  Set objFile  = objFSO.OpenTextFile (MBInfoFile, 8, True)
  End If

  If strServerVer <> 2007 Then
    Logdata vbCrLf & Space(4) & "Querying WMI for mailbox info on " & strComputer & " for SG: " & strStorageGroup,1
    Set SWBemlocator = CreateObject("WbemScripting.SWbemLocator")
    If Err.number <> 0 Then
      WScript.Echo "GetItemCount (SWBemlocator): Error " & CDbl(Err.number) & vbCrlf & Err.Description
      Err.Clear
      Exit Function
    End If

    Set objWMIService = SWBemlocator.ConnectServer(strComputer,"\root\MicrosoftExchangeV2","","")
    If Err.number <> 0 Then
      WScript.Echo "GetItemCount (objWMIService): Error " & CDbl(Err.number) & vbCrlf & Err.Description
      Err.Clear
      Exit Function
    End If

    strQuery = "Select * from Exchange_Mailbox Where StorageGroupName='" & strStorageGroup & "'"
    logdata Space(6) & "GetItemCount: WMI Query: " & strQuery, 2
    Set colItems = objWMIService.ExecQuery(strQuery,,48)
    If Err.number <> 0 Then
      WScript.Echo "GetItemCount (colItems): Error " & CDbl(Err.number) & vbCrlf & Err.Description
      Err.Clear
      Exit Function
    End If

    For Each objItem in colItems
      iMBItemCount = objItem.TotalItems
      iMBSize = objItem.Size

      If IsNull(iMBItemCount) Then iMBItemCount = 0
      If IsNull(iMBSize) Then iMBSize = 0
      
      iMBCount = iMBCount + 1
      iTotalItemCount = iTotalItemCount + iMBItemCount
      
      LogData "iTotalItemCount: " & iTotalItemCount & Chr(9) & " iMBItemCount: " & iMBItemCount & vbTab & " MailboxDisplayName: " & objItem.MailboxDisplayName,4
      iMBTotalSize = iMBTotalSize + iMBSize

      strOutputLine = Date & " " & FormatDateTime(Time,4) & VbTab & objItem.ServerName & vbTab &objItem.StorageGroupName &_
	                    vbTab & objItem.StoreName & vbTab & Chr(34) & objItem.MailboxDisplayName & Chr(34) &_
	                    vbTab & iMBSize & vbTab & iMBItemCount
	    If WriteMBData Then objFile.writeline strOutputLine

      Logdata Space(6) & strOutputLine,3
    Next
    If Err.number <> 0 Then
      WScript.Echo "GetItemCount (after colItems): Error " & CDbl(Err.number) & vbCrlf & Err.Description
      Err.Clear
      Exit Function
    End If
  Else ' strServerVer <> 2007 
    
    If GetRegistry("SOFTWARE\Microsoft\PowerShell\1","Install") <> "" And GetRegistry("SOFTWARE\Microsoft\PowerShell\1\PowerShellSnapIns\Microsoft.Exchange.Management.PowerShell.Admin","PowerShellVersion") <> "" Then
      strCMD = PowerShellPath & " -PSConsoleFile """ & E2k7PSPath & """ -NoProfile -noninteractive -OutputFormat Text -command """ & _
        "Get-MailboxStatistics -server " & strComputer & " | where-object {$_.StorageGroupName -eq '" & strStorageGroup & "'} | ft DisplayName, ItemCount, @{expression={$_.TotalItemSize.Value.ToKB()};label='TotalItemSize'} , DatabaseName"
'      strCMD = PowerShellPath & " -NoProfile -noninteractive -OutputFormat Text -command dir ."
'      strCMD = "cmd /c dir . /o-d /b"
      Logdata "GetItemCount: strCMD: " & VbCrlf & strCMD,3
      Logdata "",1
      Logdata Space(4) & "Getting mailbox data via PowerShell, this may take a minute or two",1
      Set objExec = objShell.Exec(strCMD)
      objExec.StdIn.Close()
    
      f = 0
      Temp = objExec.StdOut.ReadLine() ' Skip blank line
      Temp = objExec.StdOut.ReadLine() ' Read in header to figure out column widths

      iItemCountStart = InStr(1,Temp,"ItemCount",1)
      iMBSizeStart = InStr(1,Temp,"TotalItemSize",1)
      iDBNameStart = InStr(1,Temp,"DatabaseName",1)
      
      Temp = objExec.StdOut.ReadLine() ' Skip blank line
      ReDim MailboxArray(1)
      Do While Not objExec.StdOut.AtEndOfStream
        MailboxArray(f) = objExec.StdOut.ReadLine()
        If Len (MailboxArray(f)) = 0 Then Exit Do
        LogData "Mailbox: " & MailboxArray(f),3

        ReDim Preserve MailboxArray(f+1)
        strDisplayName = Trim(Left(MailboxArray(f),iItemCountStart))
        iMBItemCount = Trim(Mid(MailboxArray(f),iItemCountStart,iMBSizeStart-iItemCountStart))
        iMBSize = Trim(Mid(MailboxArray(f),iMBSizeStart,iDBNameStart-iMBSizeStart))
        strDatabaseName = Trim(Mid(MailboxArray(f),iDBNameStart,Len(MailboxArray(f))-iDBNameStart-1))
'        WScript.Echo "Start: " & iDBNameStart & " LEN: " & Len(MailboxArray(f)) & " End: " & Len(MailboxArray(f))- iDBNameStart-1
        
        If IsNull(iMBItemCount) Then iMBItemCount = 0
        If IsNull(iMBSize) Then iMBSize = 0

        iMBCount = iMBCount + 1
        iTotalItemCount = iTotalItemCount + iMBItemCount
        
        LogData "iTotalItemCount: " & iTotalItemCount & vbTab & " iMBItemCount: " & iMBItemCount & " iMBSize: " & iMBSize & vbTab & " MailboxDisplayName: " & strDisplayName ,3
        iMBTotalSize = iMBTotalSize + iMBSize

        strOutputLine = Date & " " & FormatDateTime(Time,4) & VbTab & strComputer & vbTab & strStorageGroup &_
                        vbTab & strDatabaseName & vbTab & Chr(34) & strDisplayName  & Chr(34) &_
                        vbTab & iMBSize & vbTab & iMBItemCount
        If WriteMBData Then objFile.writeline strOutputLine
        Logdata Space(6) & strOutputLine,4
        f = f + 1
      Loop

      Set objExec = Nothing
    Else
      Logdata Space(6) & "PowerShell or Exchange 2007 Managment Shell is not installed",0
      Logdata Space(6) & "Unable to get data from Exchange 2007 servers.",0
    End If ' PowerShell and EMC installed
  End If 'strServerVer <> 2007

  If WriteMBData Then objFile.close
  Set SWBemlocator = Nothing
  Set objWMIService = Nothing
  Set objFile = Nothing
End Function

Function GetAllServers (strOrgDN)
  Dim strQuery, strDomainNC, strServerListDN
  Dim Rs
  ' Get the list of all servers within the organization

  strQuery = "<LDAP://" & "CN=Administrative Groups," & strOrgDN & ">;" & _
  "(objectCategory=msExchExchangeServer);name,cn,distinguishedName;subtree"
  strDomainNC = objRootDSE.Get ("defaultNamingContext")
  strServerListDN = ""

  Set Rs =  DoLDAPQuery (strQuery)

  Logdata VbCrLf & "All Exchange Servers in forest " & strDomainNC,1
  While Not Rs.EOF
    ' output the current server found
    Logdata "Server CN: " & Rs.Fields ("cn"),2
    Logdata  vbTab & "Server Name: " & Rs.Fields ("name"),1
    Logdata "Server DN: " & Rs.Fields ("distinguishedName"),3

    strServerListDN = strServerListDN & ";" & Rs.Fields ("distinguishedName")
    Rs.MoveNext
  Wend

  GetAllServers = Mid (strServerListDN, 2)

  rs.Close
  Set rs = Nothing

  Logdata  "strServerListDN = " & strServerListDN,3
  Logdata  " ",2
End Function 

Function GetStoresForStorageGroup (strStorageGroup)
 Dim objSG, objStore
 Dim strOC, strType, strStoreDN

 strStoreDN	= ""

 Set objSG = GetObject ("LDAP://" & strStorageGroup)

 For Each objStore in objSG
  strOC = objStore.Get ("objectCategory")
  ' turn objectCategory into objectClass
  strType = Left (strOC, Instr (strOC, ",") - 1)
  strType = Replace (Mid (strType, 4), "-", "")

  Logdata vbTab & "store: " & objStore.Name & " " & strType,2

  strStoreDN	= strStoreDN	& ";" & objStore.Get ("distinguishedName")
 Next

 GetStoresForStorageGroup	= Mid (strStoreDN, 2)

 Logdata "store DN's: " & strStoreDN,3
End Function

Function GetStoresForStorageGroupLDAP (strStorageGroup)
 Dim strQuery, strType, strStoreDN
 Dim Rs
 strStoreDN	= ""

 ' public stores first
 strType = "msExchPublicMDB"
 strQuery = "<LDAP://" & strStorageGroup & ">;" & _
  "(objectCategory=msExchPublicMDB);name,cn,distinguishedName;onelevel"

 Set Rs = DoLDAPQuery (strQuery)
 While Not Rs.EOF
  strStoreDN	= strStoreDN	& ";" & Rs.Fields ("distinguishedName")

  Logdata vbTab & "store: " & Rs.Fields ("name") & " " & strType,2
  Rs.MoveNext
 Wend

  rs.Close
  Set rs = Nothing

 ' private stores next
 strType = "msExchPrivateMDB"
 strQuery = "<LDAP://" & strStorageGroup & ">;" & _
  "(objectCategory=msExchPrivateMDB);name,cn,distinguishedName;onelevel"

 Set Rs = DoLDAPQuery (strQuery)
 While Not Rs.EOF
  strStoreDN	= strStoreDN	& ";" & Rs.Fields ("distinguishedName")

  Logdata vbTab & "store: " & Rs.Fields ("name") & " " & strType,2

  Rs.MoveNext
 Wend

  rs.Close
  Set rs = Nothing

  GetStoresForStorageGroupLDAP = Mid (strStoreDN, 2)

  Logdata "store DN's: " & strStoreDN,3
End Function 

Function GetStorageGroupsForServer (strServerDN)
  On Error Resume Next
  Dim strQuery, strServerSGDNs, strStoreDN
  Dim Rs

  strQuery = "<LDAP://" & "CN=InformationStore," & strServerDN & ">;" & _
  "(objectCategory=msExchStorageGroup);name,cn,distinguishedName;onelevel"

  strServerSGDNs = ""

  Set Rs = DoLDAPQuery (strQuery)

  Logdata "All storage groups on server " & Left (strServerDN, InStr (strServerDN, ",") - 1),2
  
  If Rs.EOF Then Exit Function
  While Not Rs.EOF
    ' output the current server found
    Logdata "Storage Group CN: " & Rs.Fields ("cn"),2
    Logdata "Storage Group Name: " & Rs.Fields ("name"),2
    Logdata "Storage Group DN: " & Rs.Fields ("distinguishedName"),3

    strServerSGDNs = strServerSGDNs & ";" & Rs.Fields ("distinguishedName")
    strStoreDN = GetStoresForStorageGroup (Rs.Fields ("distinguishedName"))

    Rs.MoveNext
  Wend
  GetStorageGroupsForServer = Mid (strServerSGDNs, 2)

  rs.Close
  Set rs = Nothing
End Function

Sub InitializeADSI
  If HandleErrors Then On Error Resume Next
  Set objCom  = CreateObject ("ADODB.Command")
  Set objConn = CreateObject ("ADODB.Connection")
  Set objRootDSE = GetObject ("LDAP://RootDSE")
  
  ' Open the connection.
  objConn.Provider = "ADsDSOObject"
  objConn.Open "ADs Provider"
End Sub

Function DoLDAPQuery (strLDAPQuery)
  On Error Resume Next
  Logdata "LDAP query: " & strLDAPQuery,3

  objCom.ActiveConnection = objConn
  objCom.Properties ("Page Size") = 1000
  objCom.CommandText = strLDAPQuery

  Set DoLDAPQuery = objCom.Execute
End Function

Function GetOrganizationInformation
  If HandleErrors Then On Error Resume Next
  Dim strQuery, strConfigNC, strOrgDN
  Dim Rs

  GetOrganizationInformation = False

  strConfigNC = objRootDSE.Get ("configurationNamingContext")

  ' Build a query to find the Exchange organization.
  strQuery =  "<LDAP://CN=Microsoft Exchange,CN=Services," & strConfigNC & ">;" & _
              "(objectCategory=msExchOrganizationContainer);name,distinguishedName;onelevel"

  strOrgDN = ""

  Set Rs = DoLDAPQuery (strQuery)

  ' If there are any results, there will only be one result. There
  ' may only be one Exchange organization per Active Directory forest.
  WScript.echo "Exchange Organization Name: " & Rs.Fields ("name")
  Logdata "Organization DN: " & Rs.Fields ("distinguishedName"),1

  strOrgDN = Rs.Fields ("distinguishedName")
 
  rs.Close
  Set rs = Nothing

  If Len (strOrgDN) = 0 Then
    wscript.echo "Cannot find Exchange organization information"
    GetOrganizationInformation = True
  Else
    GetOrganizationInformation = strOrgDN
  End If
End Function

Function PutRegistry (strPath,strValueName,strValue)
  If HandleErrors Then On Error Resume Next
  Dim Temp
  Dim strComputer, objRegistry
	strComputer = "."
	
	Set objRegistry = GetObject("winmgmts:{impersonationLevel = impersonate}!\\" & strComputer & "\root\default:StdRegProv")
	
	Temp = objRegistry.CreateKey(HKLM, strPath)
	
	If Temp <> 0 Then
	    WScript.Echo "PutRegistry: Unable to update registry, the operation failed." & Err.Number
	    WScript.Quit
	End If
	
	objRegistry.SetStringValue HKLM, strPath, strValueName,strValue
	Set ObjRegistry = Nothing
End Function

Function GetRegistry (strPath,strValueName)
  If HandleErrors Then On Error Resume Next
	Dim Temp, strValue
  Dim strComputer, objRegistry
	strComputer = "."
	
	Logdata Space(6) & "GetRegistry: Path: " & strPath & "\" & strValueName,3
	Set objRegistry = GetObject("winmgmts:{impersonationLevel = impersonate}!\\" & strComputer & "\root\default:StdRegProv")
	Temp = objRegistry.GetStringValue (HKLM, strPath, strValueName, strValue)
	If IsNull(strValue) or strValue = "" Then
	  Temp = objRegistry.GetDWORDValue (HKLM, strPath, strValueName, strValue)
	End If 
	Logdata Space(6) & "GetRegistry: strValue = [" & strValue & "]",3

	If IsNull(strValue) Then 
		GetRegistry = ""
	Else
		GetRegistry  = strValue
  End If
  Set objRegistry = Nothing
End Function

Function GetFiles(strPath)
  If HandleErrors Then On Error Resume Next
  Dim strCMD, f, i
  Dim FilesArray, objExec
  
  strCMD = "cmd /c dir """ & strPath & """ /o-d /b"
  Logdata "GetFiles: strCMD: [" & strCMD & "]",3
  Set objExec = objShell.Exec(strCMD)
  
  f = 0
  ReDim FilesArray(1)
  Do While Not objExec.StdOut.AtEndOfStream
    FilesArray(f) = objExec.StdOut.ReadLine()
    If f > 0 Then
      ReDim Preserve FilesArray(f+1)
      f = f + 1
    Else
      f = 1
    End If
  Loop
  GetFiles = FilesArray
End Function

Function SubLargeHex (strNumber1, strNumber2)
  If HandleErrors Then On Error Resume Next
  Dim N1Part2, N2Part2
  Logdata "SubLargeHex: strNumber1 [" & strNumber1 & "] strNumber2 [" & strNumber2 & "]",3

  If LEN(strNumber1) > 8 Then ' Check if E2k7 format
    N1Part2 = "&H" & Right(strNumber1,8) 'Drop the LOG prefex, i.e. "E00"
    N2Part2 = "&H" & Right(strNumber2,8)
    SubLargeHex = CDbl(N1Part2 - N2Part2)
  Else
    N1Part2 = "&H" & Right(strNumber1,5)
    N2Part2 = "&H" & Right(strNumber2,5)
    SubLargeHex = CDbl(N1Part2 - N2Part2)
  End If
End Function

Function Ping(srvHost)
  If HandleErrors Then On Error Resume Next
  Dim strPingResults, WshExec

  Set WshExec = objShell.Exec("ping -n 1 -w 1000 " & srvHost) 'send 1 echo requests, waiting 1 second each
  strPingResults = WshExec.StdOut.ReadAll
  If InStr(1,strPingResults, "reply from",1) Then
    Ping = True
  Else
    Ping = False
  End If
  Set WshExec = Nothing
End Function

Function AccessFile(strFilePath,objFile)
  On Error Resume Next
  Set objFile = objFSO.GetFile(strFilePath)
  If Err.number <> 0 Then
'    WScript.Echo CDbl(Err.number) & vbCrlf & Err.Description & VbCrLf & strFilePath
    AccessFile = False
  Else
    AccessFile = True
  End If
End Function

Sub Logdata (Data,LogLevel)
  If DebugLevel > 1 Then Data = Time & ":: " & Data
  If DebugLevel >= LogLevel Then WScript.Echo Data
End Sub

'GetField ("abc.123",".",Remainder)
Function GetField (Data,Delimiter,ExtraData)
	On Error GoTo 0
	If InStr(Data,Delimiter) = 0 Then
		GetField = Data
		ExtraData = ""
		Exit Function
	End If
	GetField = Left(Data,InStr(Data,Delimiter)-1)
	ExtraData = Right(Data,Len(Data)-InStr(Data,Delimiter)-Len(Delimiter)+1)
End Function