You are not logged in. [Log In] KiXtart.org website » Forums » KiXtart » Advanced Scripting » Convert Exchange out of office vbs to kix
Register User       Forum List       Calendar       FAQ
Page 1 of 1 1
Topic Options
#199060 - 2010-07-21 03:30 PM Convert Exchange out of office vbs to kix
foxy75 Offline
Just in Town

Registered: 2010-06-26
Posts: 2
Loc: Germany
Hello,

who can help me to convert the following script to kix? I'm new on kix. This script open every Mailbox on the Exchange and looks if the oof is enabled or not. If true, export the mailboxname, forwarding address and the creator of the rule to a file (in kix an .ini file to import in listview in kixforms). So we can see if there are more than one rules are enabled.

 Code:
On Error Resume Next
servername = WScript.arguments(0)
PR_HAS_RULES = &H663A000B
PR_URL_NAME = &H6707001E
PR_CREATOR = &H3FF8001E
Set fso = CreateObject("Scripting.FileSystemObject")
Set wfile = fso.opentextfile("c:\forwardingRules.ini",2,True)
'wfile.writeline("Mailbox,FolderPath,Creator,AdressObject,SMTPForwdingAddress")
Set conn = CreateObject("ADODB.Connection")
Set com = CreateObject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
svcQuery = "<LDAP://" & strNameingContext & ">;(&(objectCategory=msExchExchangeServer)(cn=" & Servername & "));cn,name,legacyExchangeDN;subtree"
Com.ActiveConnection = Conn
Com.CommandText = svcQuery
Set Rs = Com.Execute
While Not rs.eof	
	GALQueryFilter =  "(&(&(&(& (mailnickname=*)(!msExchHideFromAddressLists=TRUE)(| (&(objectCategory=person)(objectClass=user)(msExchHomeServerName=" & rs.fields("legacyExchangeDN") & ")) )))))"
	strQuery = "<LDAP://"  & strDefaultNamingContext & ">;" & GALQueryFilter & ";distinguishedName,mailnickname;subtree"
	com.Properties("Page Size") = 100
	Com.CommandText = strQuery
	Set Rs1 = Com.Execute
	While Not Rs1.eof
		Call procmailboxes(servername,rs1.fields("mailnickname"))
		WScript.echo rs1.fields("mailnickname")
		rs1.movenext
	Wend
	rs.movenext
Wend
rs.close
wfile.close
Set fso = Nothing
Set conn = Nothing
Set com = Nothing
WScript.echo "Done"

Sub procmailboxes(servername,mailboxname)

Set objSession = CreateObject("MAPI.Session") 

	objSession.Logon "","",False,True,True,True,servername & vbLF & mailboxname
	Set objInfoStores = objSession.InfoStores 
	Set objInfoStore = objSession.GetInfoStore 
If objSession.outofoffice = True Then
	
	Set Inbox = objSession.Inbox
	If inbox.fields.item(PR_HAS_RULES) = True Then
		Set objMessages = inbox.HiddenMessages
		For Each objMessage In objMessages 
			If objMessage.type = "IPM.Rule.Message" Then
 				Call procrule(objMessage,mailboxname,inbox.fields.item(PR_URL_NAME).value)
			End If
		Next
	End If 
End If
End Sub

Sub procrule(objmessage,MailboxName,folderpath)
frule = False
splitarry = Split(hextotext(objmessage.fields.item(&H65EF0102)),Chr(132),-1,1)
If UBound(splitarry) <> 0 Then
	WScript.echo 
    	WScript.echo "Mailbox Name :" & MailboxName
	WScript.echo "Folder Path :" & folderpath
	WScript.echo "Rule Created By : " & objmessage.fields.item(PR_CREATOR).value
	mbname = MailboxName
	fpath = folderpath
	creator = objmessage.fields.item(PR_CREATOR).value
	frule = True
End If
tfirst = 0
addcount = 1
For i = 0 To UBound(splitarry)
	addrrsplit = Split(splitarry(i),Chr(176),-1,1)
	For j = 0 To UBound(addrrsplit)
		addrcontsep = Chr(3) & "0"
		If InStr(addrrsplit(j),addrcontsep) Then 
			If tfirst = 1 Then addcount = addcount + 1
			WScript.echo 
			WScript.echo "Address Object :" & addcount
			ReDim Preserve resarray(1,1,1,1,1,addcount)
			resarray(1,0,0,0,0,addcount) = mbname
			resarray(1,1,0,0,0,addcount) = fpath
			resarray(1,1,1,0,0,addcount) = creator		
			If InStr(addrrsplit(j),"0/o=") Then 
				resarray(1,1,1,1,0,addcount) = Mid(addrrsplit(j),(InStr(addrrsplit(j),"0/o=")+1),Len(addrrsplit(j)))
				WScript.echo "ExchangeDN :" & Mid(addrrsplit(j),(InStr(addrrsplit(j),"0/o=")+1),Len(addrrsplit(j)))
			Else 
				WScript.echo "Address :" & Mid(addrrsplit(j),3,Len(addrrsplit(j)))
				resarray(1,1,1,1,0,addcount) = Mid(addrrsplit(j),3,Len(addrrsplit(j)))
			End If 
			tfirst = 1		
		End If
		smtpsep = Chr(254) & "9"
		If InStr(addrrsplit(j),smtpsep) Then 
			slen = InStr(addrrsplit(j),smtpsep) + 2
			elen = InStr(addrrsplit(j),Chr(3))
			WScript.echo "SMTP Forwarding Address : " & Mid(addrrsplit(j),slen,(elen-slen))
			resarray(1,1,1,1,1,addcount) = Mid(addrrsplit(j),slen,(elen-slen))
		End If
	Next
Next
If frule = True Then
	For r = 1 To UBound(resarray,6)
		wfile.writeline("[" & resarray(1,0,0,0,0,r) & "]" & vbnewline & "Name=" & resarray(1,1,1,0,0,r) & vbnewline & "forwardto=" & resarray(1,1,1,1,1,r) & vbnewline & "creator=" & resarray(1,1,1,0,0,r))
	Next
End If

End Sub


Function hextotext(binprop)
arrnum = Len(binprop)/2
ReDim aout(arrnum)
slen = 1
For i = 1 To arrnum
	If CLng("&H" & Mid(binprop,slen,2)) <> 0 Then
		aOut(i) = Chr(CLng("&H" & Mid(binprop,slen,2)))
		rem wscript.echo CLng("&H" & mid(binprop,slen,2)) & "," & chr(CLng("&H" & mid(binprop,slen,2)))
	End If
	slen = slen+2
Next
hextotext = Join(aOUt,"")
End Function

Top
#199061 - 2010-07-21 05:30 PM Re: Convert Exchange out of office vbs to kix [Re: foxy75]
Richard H. Administrator Offline
Administrator
*****

Registered: 2000-01-24
Posts: 4946
Loc: Leatherhead, Surrey, UK
Unfortunately I don't have the tools (CDO?) installed to get very far, but the following should get you started so that you can see how VBS converts to KiXtart:
 Code:
Break ON
$=SetOption("WrapAtEOL","ON")

$TRUE=Not 0
$FALSE=Not $TRUE

If Not IsDeclared($SERVER)
	"You must supply a server name on the command line"+@CRLF
	"    kix32.exe script.kix $$SERVER=server"+@CRLF
	Exit 1
EndIf

$PR_HAS_RULES = &663A000B
$PR_URL_NAME = &6707001E
$PR_CREATOR = &3FF8001E

$sIni="c:\forwardingRules.ini"

;wfile.writeline("Mailbox,FolderPath,Creator,AdressObject,SMTPForwdingAddress")
$conn=CreateObject("ADODB.Connection")
$com=CreateObject("ADODB.Command")
$iAdRootDSE=GetObject("LDAP://RootDSE")
$strNamingContext=$iAdRootDSE.Get("configurationNamingContext")
$strDefaultNamingContext=$iAdRootDSE.Get("defaultNamingContext")
$Conn.Provider="ADsDSOObject"
$Conn.Open("ADs Provider")
$svcQuery="<LDAP://"+$strNamingContext+">;(&(objectCategory=msExchExchangeServer)(cn="+$SERVER+"));cn,name,legacyExchangeDN;subtree"
$Com.ActiveConnection=$Conn
$Com.CommandText=$svcQuery
$Rs=$Com.Execute
While Not $Rs.eof	
	$GALQueryFilter="(&(&(&(& (mailnickname=*)(!msExchHideFromAddressLists=TRUE)(| (&(objectCategory=person)(objectClass=user)(msExchHomeServerName="+$rs.fields("legacyExchangeDN")+")) )))))"
	$strQuery="<LDAP://"+$strDefaultNamingContext+">;"+$GALQueryFilter+";distinguishedName,mailnickname;subtree"
	$com.Properties("Page Size").Value = 100
	$Com.CommandText=$strQuery
	$Rs1 = $Com.Execute
	While Not $Rs1.eof
		"Processing: "+$rs1.fields("mailnickname")+@CRLF
		procmailboxes($SERVER,$rs1.fields("mailnickname"))
		$rs1.movenext
	Loop
	$rs.movenext
Loop
$rs.close
$fso = 0
$conn = 0
$com = 0
"Done"+@CRLF

Exit 0

Function procmailboxes($sServer,$sMailName)
	"In ProcMailBoxes"+@CRLF
EndFunction
Top
#199258 - 2010-08-03 05:00 PM Re: Convert Exchange out of office vbs to kix [Re: Richard H.]
foxy75 Offline
Just in Town

Registered: 2010-06-26
Posts: 2
Loc: Germany
Hy,

thx, the first part works.
Because its very hard for me to translate the rest of vbs.
This is the secon part i translated, because i get now results.
 Code:
Function procmailboxes($Server, $mailboxname)
$objSession = CreateObject("MAPI.Session") 
$objSession.Logon(,, 0, 1, 1, 1, $Server+@CRLF+$mailboxname)
$objInfoStores = $objSession.InfoStores
$objInfoStore = $objSession.GetInfoStore 

If $objSession.outofoffice.value
$Inbox = $objSession.Inbox
 If $inbox.fields.item(&663A000B).value
  $objMessages = $inbox.HiddenMessages
  For Each $objMessage in $objMessages 
   If $objMessage.type = "IPM.Rule.Message" 
    ;procrule($objMessage, $mailboxname,inbox.fields.item(&6707001E).value)
   EndIf
  Next
 EndIf 
EndIf
				
EndFunction

Top
#199275 - 2010-08-04 09:53 AM Re: Convert Exchange out of office vbs to kix [Re: foxy75]
Arend_ Moderator Offline
MM club member
*****

Registered: 2005-01-17
Posts: 1896
Loc: Hilversum, The Netherlands
Like Richard, I don't have Outlook or CDO to test, but I did a literal translation of your script. Since we are dealing with a COM object, the Boolean values might not always work out.

 Code:
$servername = "MYSERVERNAME"

$PR_HAS_RULES = &663A000B
$PR_URL_NAME = &6707001E
$PR_CREATOR = &3FF8001E
$fso = CreateObject("Scripting.FileSystemObject")
$wfile = $fso.opentextfile("c:\forwardingRules.ini",2,1)
;$wfile.writeline("Mailbox,FolderPath,Creator,AdressObject,SMTPForwdingAddress")
$conn = CreateObject("ADODB.Connection")
$com = CreateObject("ADODB.Command")
$iAdRootDSE = GetObject("LDAP://RootDSE")
$strNameingContext = $iAdRootDSE.Get("configurationNamingContext")
$strDefaultNamingContext = $iAdRootDSE.Get("defaultNamingContext")
$Conn.Provider = "ADsDSOObject"
$Conn.Open("ADs Provider")
$svcQuery = "<LDAP://" + $strNameingContext + ">;(&(objectCategory=msExchExchangeServer)(cn=" + $Servername + "));cn,name,legacyExchangeDN;subtree"
$Com.ActiveConnection = $Conn
$Com.CommandText = $svcQuery
$Rs = $Com.Execute
While Not $rs.eof	
  $GALQueryFilter = "(&(&(&(& (mailnickname=*)(!msExchHideFromAddressLists=TRUE)(| (&(objectCategory=person)(objectClass=user)(msExchHomeServerName=" + $rs.fields("legacyExchangeDN") + ")) )))))"
  $strQuery = "<LDAP://" + $strDefaultNamingContext + ">;" + $GALQueryFilter + ";distinguishedName,mailnickname;subtree"
  $com.Properties("Page Size").Value = 100
  $Com.CommandText = $strQuery
  $Rs1 = $Com.Execute
  While Not $Rs1.eof
    procmailboxes($servername,$rs1.fields("mailnickname"))
    ? $rs1.fields("mailnickname")
    $rs1.movenext
  Loop
  $rs.movenext
Loop
$rs.close
$wfile.close
$fso = ""
$conn = ""
$com = ""
? "Done"

Function procmailboxes($servername,$mailboxname)
  $objSession = CreateObject("MAPI.Session") 
  $objSession.Logon("","",0,1,1,1,$servername + @CRLF + $mailboxname
  $objInfoStores = $objSession.InfoStores 
  $objInfoStore = $objSession.GetInfoStore 
  If $objSession.outofoffice = 1
    $Inbox = $objSession.Inbox
    If $inbox.fields.item($PR_HAS_RULES).value = 1
      $objMessages = $inbox.HiddenMessages
      For Each $objMessage In $objMessages 
        If $objMessage.type = "IPM.Rule.Message"
          $procrule($objMessage,$mailboxname,$inbox.fields.item(PR_URL_NAME).value)
        EndIf
      Next
    EndIf 
  EndIf
EndFunction

Function procrule($objmessage,$MailboxName,$folderpath)
  $frule = 0
  $splitarry = Split(hextotext($objmessage.fields.item(&65EF0102)),Chr(132),-1,1)
  If UBound($splitarry) <> 0
    ?
    ? "Mailbox Name :" + $MailboxName
    ? "Folder Path :" + $folderpath
    ? "Rule Created By : " + $objmessage.fields.item(PR_CREATOR).value
    $mbname = $MailboxName
    $fpath = $folderpath
    $creator = $objmessage.fields.item(PR_CREATOR).value
    $frule = 1
  EndIf
  $tfirst = 0
  $addcount = 1
  For $i=0 To UBound($splitarry)
    $addrrsplit = Split($splitarry($i),Chr(176),-1,1)
    For $j=0 To UBound($addrrsplit)
      $addrcontsep = Chr(3) + "0"
      If InStr($addrrsplit($j),$addrcontsep)
        If $tfirst = 1
          $addcount = $addcount + 1
          ?
          ? "Address Object :" + $addcount
          ReDim Preserve $resarray(1,1,1,1,1,$addcount)
          $resarray(1,0,0,0,0,$addcount) = $mbname
          $resarray(1,1,0,0,0,$addcount) = $fpath
          $resarray(1,1,1,0,0,$addcount) = $creator		
          If InStr($addrrsplit($j),"0/o=")
            $resarray(1,1,1,1,0,$addcount) = SubStr($addrrsplit($j),(InStr($addrrsplit($j),"0/o=")+1),Len($addrrsplit($j)))
            ? "ExchangeDN :" + SubStr($addrrsplit($j),(InStr($addrrsplit($j),"0/o=")+1),Len($addrrsplit($j)))
          Else 
            ? "Address :" + SubStr($addrrsplit($j),3,Len($addrrsplit($j)))
            $resarray(1,1,1,1,0,$addcount) = SubStr($addrrsplit($j),3,Len($addrrsplit($j)))
          EndIf 
          $tfirst = 1		
        EndIf
        $smtpsep = Chr(254) + "9"
        If InStr($addrrsplit($j),$smtpsep)
          $slen = InStr($addrrsplit($j),$smtpsep) + 2
          $elen = InStr($addrrsplit($j),Chr(3))
          ? "SMTP Forwarding Address : " + SubStr($addrrsplit($j),$slen,($elen-$slen))
          $resarray(1,1,1,1,1,$addcount) = SubStr($addrrsplit($j),$slen,($elen-$slen))
        EndIf
      EndIf
    Next
  Next

  If $frule = 1
    For $r=1 To UBound($resarray,6)
      $wfile.writeline("[" + $resarray(1,0,0,0,0,$r) + "]" + @CRLF + "Name=" + $resarray(1,1,1,0,0,$r) + @CRLF + "forwardto=" + $resarray(1,1,1,1,1,$r) + @CRLF + "creator=" + $resarray(1,1,1,0,0,$r))
    Next
  EndIf
EndFunction


Function hextotext($binprop)
  $arrnum = Len($binprop)/2
  ReDim $aout($arrnum)
  $slen = 1
  For $i=1 To $arrnum
    If CLng("&" + SubStr($binprop,$slen,2)) <> 0
      $aOut($i) = Chr(CLng("&" + SubStr($binprop,$slen,2)))
      ? CLng("&" + SubStr($binprop,$slen,2)) + "," + chr(CLng("&" + SubStr($binprop,$slen,2)))
    EndIf
    $slen = $slen+2
  Next
  $hextotext = Join($aOUt,"")
EndFunction

Top
Page 1 of 1 1


Moderator:  Glenn Barnas, NTDOC, Arend_, Jochen, Radimus, Allen, ShaneEP, Ruud van Velsen, Mart 
Hop to:
Shout Box

Who's Online
1 registered (Allen) and 977 anonymous users online.
details
Newest Members
batdk82, StuTheCoder, M_Moore, BeeEm, min_seow
17885 Registered Users
My Cookies · Mark all read Powered by UBB.threads™ Contact Us · KiXtart.org website · Top

Generated in 0.053 seconds in which 0.025 seconds were spent on a total of 13 queries. Zlib compression enabled.
Search the board with:
superb Board Search
or try with google:
Google
Web kixtart.org