VB中通过WMI控制DNS服务器，可在ASP中调用

在VB中要使用Scripting API for WMI，必须引用 Microsoft WMI Scripting V1.1 Library

下面介绍Scripting API For WMI的几个对象

SWbemLocator——用于取得SWbemServices对象，他代表了本地或远程计算机上名字空间的一个连接。
SWbemService——代表名字空间的一个连接，可用于处理它的部件
SWbemObject——代表一个单独的类定义或一个对象实例
SWbemOjbectSet——包括SWbemObject的集合

下面是DNS WMI Provider的几个对象
MicrosoftDNS_Zone——用于管理DNS服务器上的区域的类
MicrosoftDNS_AType，MicrosoftDNS_CNAMEType,MicrosoftDNS_MXType等等——管理DNS Server上的各种资源记录

详细的参考请见MSDN，我用的是VS.NET2003带的MSDN
Scripting API for WMI的路径是 MSDN Library--设置和系统管理--Windows Management Instrumentation(WMI)--SDK文档--WMI Reference--Scripting API For WMI

DNS WMI Provider的路径是 MSDN Library--网络和目录服务--域名系统(DNS)--SDK文档--DNS WMI Provider--DNS WMI Provider Reference--DNS WMI Classes

下面是代码实现

需要引用Microsoft Scripting Runtime和Microsoft WMI Scripting V1.1 Library，只是示例了A、MX、和CName记录的操作，还可以扩展其他资源记录的操作，也可以加上区域的操作，参考MSDN就可以了
Class DNSController  
      
    Private objService As Object 
      
    Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long 
    Private Type OSVERSIONINFO  
           dwOSVersionInfoSize  As Long 
           dwMajorVersion  As Long 
           dwMinorVersion  As Long 
           dwBuildNumber  As Long 
           dwPlatformId  As Long 
           szCSDVersion  As String * 128  
           osName  As String 
    End Type  
      
      
    Private Function GetWindowsVersion() As OSVERSIONINFO  
        Dim ver   As OSVERSIONINFO  
        ver.dwOSVersionInfoSize = 148  
        GetVersionEx ver  
        With ver  
            Select Case .dwPlatformId  
                Case 1  
                    Select Case .dwMinorVersion  
                        Case 0  
                            .osName = "Windows 95" 
                        Case 10  
                            .osName = "Windows 98" 
                        Case 90  
                            .osName = "Windows Mellinnium" 
                    End Select 
                Case 2  
                    Select Case .dwMajorVersion  
                        Case 3  
                            .osName = "Windows NT 3.51" 
                        Case 4  
                             .osName = "Windows NT 4.0" 
                        Case 5  
                            If .dwMinorVersion = 0 Then 
                                .osName = "Windows 2000" 
                            ElseIf .dwMinorVersion = 1 Then 
                                .osName = "Windows XP" 
                            Else 
                                .osName = "Windows 2003" 
                            End If 
                    End Select 
                  Case Else 
                    .osName = "Failed" 
            End Select 
        End With 
        GetWindowsVersion = ver  
    End Function 
      
    '判断操作系统，由于WMI在2003和2000上的实现略有差异，所以需要判断操作系统  
    Private Function IsWin2k3() As Boolean 
        Dim v   As OSVERSIONINFO  
        v = GetWindowsVersion()  
        If v.osName = "Windows 2003" Then 
            IsWin2k3 = True 
        Else 
            IsWin2k3 = False 
        End If 
    End Function 
      
      
      
    '//   
    '// 连接到一个DNS服务器  
    '//   
    '// 服务器名称，可以是计算机名，也可以是IP  
    '// 连接服务器所使用的用户名，如果是连接本机，请使用""   
    '// 连接服务器所使用的密码，如果是连接本机，请使用""   
    Public Function Connect(ByVal strServer As Variant, ByVal strUserName As Variant, ByVal strPassword As Variant, ByRef errMsg As Variant) As Variant 
          
        On Error GoTo ll  
      
        Connect = True 
        Err.Clear  
          
        Dim objLocator As WbemScripting.SWbemLocator  
      
        Set objLocator = CreateObject("WbemScripting.SWbemLocator")  
          
        Set objService = objLocator.ConnectServer(strServer, "root\microsoftdns", strUserName, strPassword)  
        objService.Security_.ImpersonationLevel = 3  
        Connect = True 
        Exit Function 
          
    ll: Connect = False 
        errMsg = "错误 0x" & CStr(Hex(Err.Number)) & "，连接服务器 " & strServer & " 时出现错误，具体信息是" & vbCrLf & Err.Description  
        Set objLocator = Nothing 
        Set objService = Nothing 
        Err.Clear  
          
    End Function 
      
      
    '//   
    '// 从服务器断开连接  
    '//   
    Public Sub DisConnect()  
        Set objService = Nothing 
    End Sub 
      
      
      
    '//   
    '// 创建区域函数  
    '//   
    '// 区域名称  
    '// 区域保存的文件名称  一般是 "区域名称.dns"  
    '// 返回错误信息  
    '// 返回操作是否成功  
    Public Function CreateZone(ByVal sZoneName As Variant, ByVal sDataFileName As Variant, ByRef errMsg As Variant) As Variant 
          
        Set objInst = SelectRR("MicrosoftDNS_Zone", " ContainerName=" & Chr(34) & sZoneName & Chr(34), errMsg)  
      
        If errMsg <> "" Then 
            CreateZone = False 
            Exit Function 
        End If 
      
        If objInst.Count > 0 Then 
            errMsg = "该区域已存在" 
            CreateZone = False 
        End If 
      
        Set objInst = Nothing 
          
        Dim oParams As New Dictionary  
        oParams.Add "ZoneName", sZoneName  
      
        '这是因为win2003和win2000系统中CreateZone函数的zoneType参数不一致  PrimaryZone的值在2000中是1，在2003中是0  
        If IsWin2k3() Then 
            zoneType = 0  
        Else 
            zoneType = 1  
        End If 
        oParams.Add "ZoneType", zoneType  
      
        CreateZone = Create("MicrosoftDNS_Zone", "CreateZone", oParams, errMsg)  
          
        Set oParams = Nothing 
          
          
    End Function 
      
      
      
    '//   
    '// 删除一个区域  
    '//   
    '// 要删除区域的域名  
    Public Function DeleteZone(ByVal sContainerName As Variant, ByRef errMsg As Variant) As Variant 
        DeleteZone = Delete("MicrosoftDNS_Zone", "ContainerName", sContainerName, errMsg)  
    End Function 
      
      
      
    '//   
    '// 添加A记录  
    '//   
    '// 主机名称  
    '// 主机对应的IP  
    '// 所在区域的域名  
    Public Function CreateARecord(ByVal sHostName As Variant, ByVal sContainerName As Variant, ByVal sIPAddress As Variant, ByRef errMsg As Variant) As Variant 
          
        If sHostName = "" Then 
            sOwnerName = sContainerName  
        Else 
            sOwnerName = sHostName & "." & sContainerName  
        End If 
          
        Set objInst = SelectRR("MicrosoftDNS_AType", " ownerName=" & Chr(34) & sOwnerName & Chr(34), errMsg)  
      
        If errMsg <> "" Then 
            CreateARecord = False 
            Exit Function 
        End If 
      
        If objInst.Count > 0 Then 
            errMsg = "该记录已存在" 
            CreateARecord = False 
        End If 
      
        Set objInst = Nothing 
          
        Dim oParams As New Dictionary  
        oParams.Add "ContainerName", sContainerName  
          
        oParams.Add "OwnerName", sOwnerName  
          
        oParams.Add "IPAddress", sIPAddress  
           
        CreateARecord = Create("MicrosoftDNS_AType", "CreateInstanceFromPropertyData", oParams, errMsg)  
          
        Set oParams = Nothing 
      
    End Function 
      
    '//   
    '// 修改A记录信息  
    '//   
    '// 主机全名 比方说 www.mglz.net   
    '// 主机对应的IP  
    Public Function ModifyARecord(ByVal sOwnerName As Variant, ByVal sIPAddress As Variant, ByRef errMsg As Variant) As Variant 
          
        Dim oParams As New Dictionary  
          
        oParams.Add "IPAddress", sIPAddress  
          
        ModifyARecord = Modify("MicrosoftDNS_AType", "OwnerName", sOwnerName, "Modify", oParams, errMsg)  
          
        Set oParams = Nothing 
      
    End Function 
      
      
      
    '//   
    '// 删除A记录记录  
    '//   
    '// 主机全名 比方说 www.mglz.net  
    Public Function DeleteARecord(ByVal sOwnerName As Variant, ByRef errMsg As Variant) As Variant 
        DeleteARecord = Delete("MicrosoftDNS_AType", "OwnerName", sOwnerName, errMsg)  
    End Function 
      
      
      
    '//   
    '// 添加MX记录  
    '//   
    '// 主机名称  
    '// 所在区域的域名  
    '// 要转向到的邮件服务器  
    '// 优先级  
    Public Function CreateMXRecord(ByVal sHostName As Variant, ByVal sContainerName As Variant, ByVal sMailServer As Variant, ByVal sPreference As Variant, ByRef errMsg As Variant) As Variant 
          
        If sHostName = "" Then 
            sOwnerName = sContainerName  
        Else 
            sOwnerName = sHostName & "." & sContainerName  
        End If 
          
        Set objInst = SelectRR("MicrosoftDNS_MXType", " ownerName=" & Chr(34) & sOwnerName & Chr(34), errMsg)  
          
        If errMsg <> "" Then 
            CreateMXRecord = False 
            Exit Function 
        End If 
          
        If objInst.Count > 0 Then 
            errMsg = "该记录已存在" 
            CreateMXRecord = False 
        End If 
          
        Set objInst = Nothing 
          
        Dim oParams As New Dictionary  
        oParams.Add "ContainerName", sContainerName  
          
        If sHostName = "" Then 
            oParams.Add "OwnerName", sContainerName  
        Else 
            oParams.Add "OwnerName", sHostName & "." & sContainerName  
        End If 
          
        oParams.Add "Preference", sPreference  
        oParams.Add "MailExchange", sMailServer  
           
        CreateMXRecord = Create("MicrosoftDNS_MXType", "CreateInstanceFromPropertyData", oParams, errMsg)  
          
        Set oParams = Nothing 
      
    End Function 
      
      
    '//   
    '// 修改MX记录  
    '//   
    '// 主机全名 比方说 www.mglz.net   
    '// 要转向到的邮件服务器  
    '// 优先级  
    Public Function ModifyMXRecord(ByVal sOwnerName As Variant, ByVal sMailServer As Variant, ByVal sPreference As Variant, ByRef errMsg As Variant) As Variant 
          
        Dim oParams As New Dictionary  
          
        oParams.Add "MailExchange", sMailServer  
        oParams.Add "Preference", sPreference  
          
        ModifyMXRecord = Modify("MicrosoftDNS_MXType", "OwnerName", sOwnerName, "Modify", oParams, errMsg)  
          
        Set oParams = Nothing 
      
    End Function 
      
    '//   
    '// 删除MX记录  
    '//   
    '// 主机全名 比方说 www.mglz.net  
    Public Function DeleteMXRecord(ByVal sOwnerName As Variant, ByRef errMsg As Variant) As Variant 
        DeleteMXRecord = Delete("MicrosoftDNS_MXType", "OwnerName", sOwnerName, errMsg)  
    End Function 
      
      
    '//   
    '// 添加别名  
    '//   
    '// 别名  
    '// 所在区域的域名  
    '// 目标主机名称  
    Public Function CreateCName(ByVal sHostName As Variant, ByVal sContainerName As Variant, ByVal sPrimaryName As Variant, ByRef errMsg As Variant) As Variant 
        If sHostName = "" Then 
            sOwnerName = sContainerName  
        Else 
            sOwnerName = sHostName & "." & sContainerName  
        End If 
          
        Set objInst = SelectRR("MicrosoftDNS_CNAMEType", " ownerName=" & Chr(34) & sOwnerName & Chr(34), errMsg)  
          
        If errMsg <> "" Then 
            CreateCName = False 
            Exit Function 
        End If 
          
        If objInst.Count > 0 Then 
            errMsg = "该记录已存在" 
            CreateCName = False 
        End If 
          
        Set objInst = Nothing 
          
        Dim oParams As New Dictionary  
        oParams.Add "ContainerName", sContainerName  
          
        If sHostName = "" Then 
            oParams.Add "OwnerName", sContainerName  
        Else 
            oParams.Add "OwnerName", sHostName & "." & sContainerName  
        End If 
          
        oParams.Add "PrimaryName", sPrimaryName  
           
        CreateCName = Create("MicrosoftDNS_CNAMEType", "CreateInstanceFromPropertyData", oParams, errMsg)  
          
        Set oParams = Nothing 
      
    End Function 
      
      
      
    '//   
    '// 修改别名  
    '//   
    '// 别名全称 比方说 www.mglz.net   
    '// 目标主机名称  
    Public Function ModifyCName(ByVal sOwnerName As Variant, ByVal sPrimaryName As Variant, ByRef errMsg As Variant) As Variant 
          
        Dim oParams As New Dictionary  
          
        oParams.Add "PrimaryName", sPrimaryName  
          
        ModifyCName = Modify("MicrosoftDNS_CNAMEType", "OwnerName", sOwnerName, "Modify", oParams, errMsg)  
          
        Set oParams = Nothing 
      
    End Function 
      
      
      
    '//   
    '// 删除别名  
    '//   
    '// 别名全称 比方说 www.mglz.net  
    Public Function DeleteCName(ByVal sOwnerName As Variant, ByRef errMsg As Variant) As Variant 
        DeleteCName = Delete("MicrosoftDNS_CNAMEType", "OwnerName", sOwnerName, errMsg)  
    End Function 
      
      
      
    Private Function Create(ByVal sTableName As String, ByVal MethodName As String, ByRef oParms As Dictionary, ByRef errMsg As Variant) As Boolean 
          
        On Error GoTo ll  
          
        Set oProcess = objService.Get(sTableName)  
          
        Set oInParams = oProcess.Methods_(MethodName).InParameters.SpawnInstance_()  
          
          
        For Each Key In oParms.Keys  
            oInParams.Properties_.Item(Key).Value = CStr(oParms.Item(Key))  
        Next 
          
          
        objService.ExecMethod sTableName, MethodName, oInParams  
      
        errMsg = "" 
        Create = True 
        Exit Function 
          
    ll:  
        Create = False 
        errMsg = Err.Description  
          
    End Function 
      
      
    Private Function Modify(ByVal sTableName As String, ByVal sFieldName As String, ByVal sFieldValue As String, ByVal MethodName As String, ByRef oParams As Dictionary, ByRef errMsg As Variant) As Boolean 
          
        Dim sQuery As String 
        sQuery = "SELECT * FROM " & sTableName & " WHERE " & sFieldName & " = '" & sFieldValue & "'" 
          
        On Error GoTo ll  
          
        Set objInst = objService.ExecQuery(sQuery)  
          
        For Each o In objInst  
            Set oInParams = o.Methods_(MethodName).InParameters.SpawnInstance_()  
            For Each Key In oParams.Keys  
                oInParams.Properties_.Item(Key).Value = CStr(oParams.Item(Key))  
            Next 
            o.ExecMethod_ MethodName, oInParams  
        Next 
          
        errMsg = "" 
        Modify = True 
        Exit Function 
          
    ll:  
        Modify = False 
        errMsg = Err.Description  
      
    End Function 
      
      
    Private Function Delete(ByVal sTableName As String, ByVal sFieldName As String, ByVal sFieldValue As String, ByRef errMsg As Variant) As Boolean 
          
        Dim sQuery As String 
        sQuery = "SELECT * FROM " & sTableName & " WHERE " & sFieldName & " = '" & sFieldValue & "'" 
          
        On Error GoTo ll  
          
        Set objInst = objService.ExecQuery(sQuery)  
          
        For Each o In objInst  
            o.Delete_  
        Next 
          
        errMsg = "" 
        Delete = True 
        Exit Function 
          
    ll:  
        Delete = False 
        errMsg = Err.Description  
      
    End Function 
      
      
      
    Private Function SelectRR(ByVal recordType As String, ByVal sFilterExpression As String, ByRef errMsg As Variant) As Object 
      
      
        On Error GoTo ll  
              
        errMsg = "" 
                  
        sql = "Select * from " & recordType  
        If sFilterExpression <> "" Then 
            sql = sql & " where " & sFilterExpression  
        End If 
          
        Set SelectRR = objService.ExecQuery(sql)  
          
        errMsg = "" 
        Exit Function 
          
          
    ll: errMsg = Err.Description  
        Set SelectRR = Nothing 
        Err.Clear  
      
      
    End Function 
      
end Class