Csütörtökön Bende Imre kolléga feldobott egy magas labdát. Volt egy telefonbeszélgetésünk is ezügyben. A feladat a következő:
Van egy Exchange 2000 szerver ahol tömegesen kellene felvenni domaineket a tiltott domainek listájára.
Csak, hogy pontosan jelezzem miről is van szó, ide:
Exchange System Manager/Administrative Groups/First Administrative Group/Servers/<szerver neve>/Protocols/SMTP/Default Virtual Server, Properties, Access fül, Connection…, Add…, Domain
Ezt már megkeresni se egyszerű, hátmég tömegben felvenni ide valamit. Elkezdtem keresgélni, hogy honnan veszi a beállításokat. Végigtúrtam a metabase-t (adsutil.vbs-el), a registry-t, az AD-t és nem találtam semmit.  Azután hosszas keresgélés után rájöttem, hogy csak a metabase-ben tárolja a dolgokat, bináris formában egy IPSec tipusú (semmi köze az IPSEC protokolhoz) propertyben. Ezt a tipust a fent említett adsutil.vbs nem kezeli és miután az IPSec tipusnév nem kicsit félreérthető, elsiklottam felette. Végül némi küzdés árán megszültem a dolgot. VBScript (broáf) azért lett belőle mert a JScript a VBScript tipusú tömböt (azt hiszem SafeArray-nak hívják hivatalból) csak olvasni hajlandó és írni nem. Miután az adsutilban ignorálták az IPSec típus kezelését, ezért azt vettem a fejembe, hogy írok egy olyan scriptet ami teljeskörüen kezeli. A legszebb az lenne, ha beleraknám az adsutilba, de nem tudom, hogy ezzel milyen jogi macerákat vennék magamra, amihez semmi kedvem.
Option Explicit 

'Constants
Const ForReading = 1 

'Initial parameters
Dim FileName,IsOverWrite,SmtpVsAdsi
IsOverWrite = True
FileName = "c:\work\metabase\test.txt"
SmtpVsAdsi = "IIS://LocalHost/SMTPSVC/1" 

'Variables
Dim DomainName
Dim i
Dim FSO, f
Dim DomainList 

'Code
If IsOverWrite Then
    DomainList = Array("")
    DomainList(0) = ""
Else
    DomainList = GetDomainList(SmtpVsAdsi)
End If 

Set FSO = CreateObject("Scripting.FileSystemObject")
Set f = FSO.OpenTextFile(FileName, ForReading, True) 

Do While f.AtEndOfStream <> True
    DomainName = Trim(f.ReadLine)
    If DomainName <> "" Then
        AddDomain DomainList, DomainName
    End If
Loop 

f.Close 

SetDomainList SmtpVsAdsi, DomainList 

'Functions 

Function GetDomainList(Path)
    Dim SmtpVS
    Set SmtpVS = GetObject(Path)
    GetDomainList = SmtpVS.IPSecurity.DomainDeny
End Function 

Sub SetDomainList(Path,DomainArr)
    Dim SecObj
    Dim SmtpVS
    Set SmtpVS = GetObject(Path)
    Set SecObj = SmtpVS.IPSecurity
    SecObj.DomainDeny = DomainArr
    SmtpVS.IPSecurity = SecObj
    SmtpVS.SetInfo
End Sub 

Sub AddDomain(DomainArr,DomainName)
    If Not ((UBound(DomainArr) = 0) and (DomainArr(0) = "")) Then
        ReDim Preserve DomainArr(UBound(DomainArr)+1)
    End If
    DomainArr(UBound(DomainArr)) = DomainName
End Sub