'Script To Get Mailbox INFO(Size,TItems,...) from email list, querys AD then EX
'Author: Felipe Ferreira
'Date: 16/10/07 updated 16/06/08
'Version:1.0r
'Requires: A log folder, emails.txt (with emails to get info from), !OU string! (Get the OU from ADSIEdit.msc

Dim MbxGuid, username, HomeDb,HomeSG,HomeServer,MbxDispName,MbxSize,MbxTotalItems,MbxDelItems
Dim FolderLog,FileLog,blnGetLog
Dim iFSO : Set iFSO = CreateObject("Scripting.FilesyStemObject")
Dim oFSO : Set oFSO = CreateObject("Scripting.FilesyStemObject")
DIM inputfile,outputfile
Dim strScriptPath, strScriptFile
strScriptFile = WScript.ScriptFullname
strScriptPath = Left(strScriptFile, Len(strScriptFile) - Len(WScript.Scriptname)) 'used to define the path from where the script file is located
FolderLog = strScriptPath & "log\"
MbxGuid = "0"
blnGetLog = 1

'On Error Resume Next
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EDIT, MUST CREATE FOLDER \LOG
Dim strOU : strOU = "OU=EX,OU=SERVIDOR_XXX,OU=COR"
outputfile = strScriptPath & "MBXGUID_OK.txt"
inputfile = strScriptPath & "emailst.txt"			 ' Mail fomrat usually is username@domain.local
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EDIT
Set ofile = oFSo.OpenTextFile(Outputfile,8, TRUE)
Set ifile = iFSO.OpenTextFile(inputfile)  

rootd =  GetObject("LDAP://RootDSE").Get("DefaultNamingContext")
location = strOU &","& rootd

ofile.writeline "username  ;  HomeServer   ;  HomeSG  ;  HomeDb ;  MbxDispName ; MbxSize ; MbxTotalItems  ;  MbxDelItems "
Do until ifile.AtEndOfLine
	username = iFile.Readline
	call fGetADField(username,location,"msExchMailboxGuid","mail")	
	call fGetADField(username,location,"homeMDB","mail")	
	call MbxInfo(MbxGuid,HomeServer,HomeSG,HomeDb)
	'wscript.echo  username & " ; " & HomeServer  & " ; " &  HomeSG & " ; " &  HomeDb & " ; " &  MbxDispName  & " ; " & MbxSize  & " ; " & MbxTotalItems & " ; " & MbxDelItems
	'call MbxInfo(MbxGuidP,HomeServer,HomeSG,HomeDb)
	ofile.writeline username & " ; " & HomeServer  & " ; " &  HomeSG & " ; " &  HomeDb & " ; " &  MbxDispName  & " ; " & MbxSize  & " ; " & MbxTotalItems & " ; " & MbxDelItems
	HomeServer ="X"
	HomeSG = "X"
    HomeDb = "X"
	MbxDispName = "X"
	MbxSize = "X"
	MbxTotalItems = "X"
	MbxDelItems = "X"
	blnGetLog = 1
	
loop



Function fGetADField(sKeyData,locationP,sReturnField,sKeyField)
'Returns the data requested, or nothing if no data found
'sKeyData:  the information that is being used as a unique value to query on.  Some value that is unique to the particular record you are looking For
'sReturnField : is the name of the field which contains the data that you are trying to pull out of active directory
'sKeyField:  is the field that contains the unique data from sKeyData   
	
	'These two lines create the objects used for interfacing with ADO
    Set oConnection = CreateObject("ADODB.Connection")
    Set oCommand =   CreateObject("ADODB.Command")
    'This sets the Provider parameter for the initial connection to ADO
    oConnection.Provider = "ADsDSOObject"
    oConnection.Open "Active Directory Provider"
    'This sets which connection to use when running your ADO query, as you
    'can have more than one ADO connection object
    Set oCommand.ActiveConnection = oConnection
    'This line builds the query command that will be passed to ADO.
    'Notice that it is very close to SQL.
	'wscript.echo "Select " & sReturnField & " from 'LDAP://" & locationP & "' WHERE " & sKeyField & "='" & sKeyData & "'"
    oCommand.CommandText = "Select " & sReturnField & " from 'LDAP://" & locationP & "' WHERE " & sKeyField & "='" & sKeyData & "'"
    'Page size parameter.  Determines the max # of records to return at one time.
    oCommand.Properties("Page Size") = 1000
    'SearchScope parameter.  0 = this exact key, 1 = one level down, 2 = entire subtree.
    oCommand.Properties("Searchscope") = 2
    'Turning on error checking, in case no records were returned.
    On Error Resume Next 
          'Actually runs the query
          Set oRecordSet = oCommand.Execute
          'selects the first record that was returned by the query
          oRecordSet.MoveFirst
          'Captures the Err.Number value for use in error checking
          iErr = Err.Number
    'Turns off error checking
    On Error GoTo 0
          'If the query works, iErr will have the value of zero.  If it is anything else, then
          'an error happened and we exit the function
          If iErr <> 0 Then 
			  wscript.echo "ERROR in LDAP Querying  " & err.description & " " & err.number
			  Exit Function 
		  end if

'GET DATA 
	if sReturnField = "msExchMailboxGuid" then
	 s = myADsEncodeBinaryData(oRecordSet.Fields(sReturnField).Value)	 
	end if	
	if sReturnField = "homeMDB" then
		HomeInfo = oRecordSet.Fields(sReturnField).Value		
		'CN=Mailbox Store VIP,CN=Storage Group Name,CN=InformationStore,CN=EXCHANGE,CN=Se...
		aHomeInfo = split(HomeInfo,",")
		HomeDb = replace(ahomeInfo(0),"CN=","")
		HomeSG =  replace(ahomeInfo(1),"CN=","")
		HomeServer =replace(ahomeInfo(3),"CN=","")	 
		'wscript.echo "HOMEDB = " & HomeDb & " HOMESG = " & HomeSG & " HOMESRV = " & HomeServer
	end if 
	oConnection.close
end Function 


Function myADsEncodeBinaryData (arrByte)
 Dim str, s, i
 str = OctetToHexStr (arrByte)
 MbxGuid = str
  'WScript.Echo "MbxGuid = "& "'" & str & "'"
  'WScript.Echo "Length = " & len(str) & " '" & str & "'"
 s = ""
 For i = 1 to Len (str) Step 2
  s = s & "\" & Mid (str, i, 2)
 Next
 'WScript.Echo s
 myADsEncodeBinaryData = s
End Function


Function OctetToHexStr (arrbytOctet)
 ' Function to convert OctetString (byte array) to Hex string.
 ' Code from Richard Mueller, a MS MVP in Scripting and ADSI
 Dim k
 OctetToHexStr = ""
 For k = 1 To Lenb (arrbytOctet)
  OctetToHexStr = OctetToHexStr _
        & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
 Next
End Function


Function MbxInfo(MbxGuidP,strComputer,SGp,DBp)
'Prob, differente ID formats
'AD (FFC85AEC7D73E  64A A63D-C193C6F5615B
'EX{EC5AC8FF-737D-4AE6-A63D-C193C6F5615B}
'Could work with last 12 digits, but would have to do a complete dump of each DB? or where can take argument in query?
'Where Like not working... will dump enitre DB and then parse txt to get info (SLOW) but should work
	Dim fileLogOnly
	'First  Check in Log folder if dump was already done!
	FileLogOnly = strComputer & "_" & SGp & "_" & DBp & ".txt"
	FileLog = FolderLog & strComputer & "_" & SGp & "_" & DBp & ".txt"
		
	call CheckLog(FileLogOnly)
	if blnGetLog = 0 then 
		'wscript.echo "FileLog already present,not getting again."
		'call function to search inside file
		'wscript.echo "GetInfo Call: " & MbxGuidP & "   " & FileLogOnly & " From : " & strComputer
		call GetInfo(MbxGuidP,FileLogOnly)
		'blnGetLog = true
		exit function 	
	end if
	if blnGetLog = 1 then 
		Dim objWMIService, colItems, objItem
		'wscript.echo "Creating: " & FileLog	
		Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
		Dim objTextFile : Set objTextFile = objFSO.CreateTextFile(FileLog, True)
		objTextFile.WriteLine "MaibloxGUID; MailboxName; Size; Total Emails ; DeletedMessageSizeExtended" 
		Set objWMIService = GetObject("winmgmts:" _
		 & "{impersonationLevel=impersonate}!\\" & strComputer & _
		 "\ROOT\MicrosoftExchangeV2")
		'FORMAT DB AND SG NAMES
		SGp = "'" & SGp & "'"
		DBp = "'" & DBp & "'"		
		'wscript.echo MbxGuidP
		'QUERY SERVER JUST EACH SG DBs	
	
		Set colItems = objWMIService.ExecQuery _
			("Select * from Exchange_Mailbox WHERE ((StoreName="& DBp &") And (StorageGroupName="& SGp &"))")
		wscript.echo strComputer & " " & SGp & " " & DBp & " Please wait..."

		'PULL INFO
		For Each objItem in colItems
			'Should Cut GUID to last 12 digits {0712F9FF-D250-4FC4-BCF6-D8C019E8E237}			
			objTextFile.WriteLine(right(objItem.MailboxGUID,13) & " ; " &  objItem.MailboxDisplayName & " ; " & objItem.Size & " ; " & objItem.TotalItems & " ; " & objItem.DeletedMessageSizeExtended)    
			Wscript.StdOut.Write(".")
		Next	
 		
wscript.echo "done"
			objTextFile.Close
			Set objTextFile= Nothing
		'Should call Get Info
		call GetInfo(MbxGuidP,FileLogOnly)
	end if
end function

sub GetInfo(mbxId,FileLogP)
'Id should be last 12 digits
'FileLogP: filename where function parses data, ex: MST01V01_SG_DB1.txt
'open File and Parse it
	Dim fs,f,f1,fc,inputfile,strtext,ifile
	Set i2FSO = CreateObject("Scripting.FilesyStemObject") 
	Set fs = CreateObject("Scripting.FileSystemObject")
	'wscript.echo "Parsing Log: " & FileLogP & " in " & FolderLog
	Set f = fs.GetFolder(FolderLog)
	Set fc = f.Files
	'Goes thru each File in the folder
	For Each f1 in fc
	'wscript.echo f1.name & " " & FileLogP
		if f1.name = fileLogP then
		'wscript.echo "Found Match"
			inputfile= FolderLog & f1.name
			Set ifile = i2FSO.OpenTextFile(inputfile)  
		'Goes thru each line 
		Do until ifile.AtEndOfLine 
			strText = ifile.ReadLine 
'wscript.echo "Searching Inside File"	
			mbxIdp = right(mbxId,12)
'wscript.echo mbxidp			
			If Instr(strText, mbxIdp) > 0 Then   ' Found Correct String
				'write to global variable to latter write to a output txt
				wscript.echo "!!!FOUND USER INFO!!!"
				'wscript.echo strText
				arrText = split(strText, ";")
				MbxDispName =  arrText(1) 'MailboxDisplayName
				MbxSize = arrText(2) 'MailboxSize
				MbxTotalItems = arrText(3) 'TotalItems			
				MbxDelItems = arrText(4) 'MailboxDeleteItems	
			end if
		loop 'next line
			ifile.close
		end if		
	
	next ' goes thru each log file
end sub


Function CheckLog(filenameP)
  Dim oFSO, oFolder, oFileCollection, oFile
  Dim oFolderCollection, oSubFolder, intFileSize, strFileName
  Set oFSO = CreateObject("Scripting.FileSystemObject")  
  Set fs = CreateObject("Scripting.FileSystemObject")
'wscript.echo "CheckLog..."
'CHECK IF FODLERS DO   EXISTS
   If (fs.FolderExists(FolderLog))=false Then
     wscript.echo "folder " & FolderLog & " NOT FOUND"
	 wscript.quit
   end if      
'gets all files of current folder
   Set oFolder = oFSO.GetFolder(FolderLog)
   Set oFileCollection = oFolder.Files           
'Walk through each file in this folder collection. 
 For each oFile in oFileCollection   
 on error resume next
 'wscript.echo oFile.Name & " " & filenamep
		If (oFile.Name = filenamep) Then
       	  filename = FolderLog & oFile.Name
	      'wscript.echo "Log already Present" & FolderLog & oFile.Name & " , " & oFile.Size & " , "  & oFile.DateLastModified 
		  blnGetLog = 0		'Set boolean so it will not retrive log again!
		End If 
  Next  
  'Clean up
  Set oFSO = Nothing
  Set oFolder = Nothing
  Set oFileCollection = Nothing
  Set oFile = Nothing
End Function