The code in Listing 23.3 creates a BizTalk server configuration with a custom counter, two ports, two receive functions, and a virtual directory, which is used by one of the ports and the receive functions. To deploy the configuration, use the command file in Listing 23.2.
Const HTTPTType_File = 1 Const ADMIN_PROTOCOL_TYPE_FILE = 1 Const HTTP = 3 Const RECVSVC_NAMESPACE = "MicrosoftBizTalkServer_ReceiveFunction" Const SERVER_NAMESPACE = "MicrosoftBizTalkServer_SERVER" Const wbemChangeFlagCreateOnly = 2 Dim strServerName, strGroupName Dim g_objService, l_bAdminUtilInitialized Dim sPath, BT Dim org, doc, env, port, chan, dl Function GetEnvVar(strName) On Error Resume Next Dim wshShell, wshSysEnv Set wshShell = WScript.CreateObject ("WScript.Shell") Set wshSysEnv = wshShell.Environment("PROCESS") GetEnvVar = wshSysEnv(strName) End Function Function InitAdminUtil() If (l_bAdminUtilInitialized = 1) Then Exit Function Set g_objLocator = CreateObject("WbemScripting.SWbemLocator") Set g_objService = g_objLocator.ConnectServer(".", _ "rootMicrosoftBiztalkServer") l_bAdminUtilInitialized = 1 End Function Function CleanupAdminUtil() If (l_bAdminUtilInitialized = 0) Then Exit Function Set g_objService = Nothing Set g_objLocator = Nothing l_bAdminUtilInitialized = 0 End Function Function GetServerByName(inServerName) Set GetServerByName = Nothing Set GetServerByName = g_objService.Get(SERVER_NAMESPACE & ".NAME=""" & _ inServerName & """") End Function Function GetBTSGroupName(strServer) Dim objServer, bOnTheFly If (l_bAdminUtilInitialized = 0) Then InitAdminUtil bOnTheFly = True End If Set objServer = GetServerByName(strServer) GetBTSGroupName = objServer.GroupName Set objServer = Nothing If (bOnTheFly) Then CleanupAdminUtil End If End Function Sub CreateVirtualDirectory(directoryName, _ directoryPath) On Error Resume Next Dim webObj Dim root Dim virtualDir Set webObj = GetObject("IIS://localhost/w3svc/1") Set root = webObj.GetObject("IIsWebVirtualDir", "Root") 'If virtual directory exist, then delete it. Call root.Delete("IIsWebVirtualDir", directoryName) Err.Clear Set virtualDir = root.Create("IIsWebVirtualDir", _ directoryName) virtualDir.AccessRead = True virtualDir.AccessWrite = True virtualDir.AccessExecute = True virtualDir.AccessScript = True virtualDir.Path = directoryPath virtualDir.AppIsolated = 0 virtualDir.EnableDirBrowsing = True virtualDir.SetInfo Err.Clear Set webObj = Nothing End Sub Sub CreateWebApplication(directoryName) On Error Resume Next Dim webObj Dim INPROC Dim OUTPROC Const POOLED = 2 INPROC = True OUTPROC = False Set webObj = GetObject("IIS://localhost/w3svc/1/ROOT/" & directoryName) 'Create an application out-of-process. webObj.AppCreate OUTPROC Set webObj = Nothing End Sub Public Sub SetIsolation(directoryName) On Error Resume Next Dim webObj Dim virtualDir Set webObj = GetObject("IIS://localhost/w3svc/1/Root/" & directoryName) webObj.AppIsolated = 0 webObj.SetInfo Set webObj = Nothing End Sub Function CreateReceiveFunction(strRecvSvcName, _ strGroupName, _ strProcessingServer, _ strFileMask, _ fProtocolType, _ strPollingLoc, _ strPassword, _ strUsername, _ strDocumentName, _ strSourceID, _ strSourceQualifier, _ strDestinationID, _ strDestinationQualifier, _ lOpenness, _ lPassthrough, _ strChannelName, _ fDisabled, _ strEnvelopeName, _ strPreProcessor, _ fHttpTransportType, _ strTransportURL, _ bReturnToken, _ strReturnContentType) Dim objBTSRecvSvc 'As SWbemObject Dim objBTSRecvSvcInstance 'As SWbemObject On Error Resume Next CreateReceiveFunction = True Set g_objLocator = CreateObject ("WbemScripting.SWbemLocator") Set g_objService = g_objLocator.ConnectServer(".", _ "rootMicrosoftBiztalkServer") Set objBTSRecvSvc = g_objService.Get(RECVSVC_NAMESPACE) Set objBTSRecvSvcInstance = objBTSRecvSvc.SpawnInstance_ objBTSRecvSvcInstance.Name = strRecvSvcName objBTSRecvSvcInstance.groupName = strGroupName objBTSRecvSvcInstance.FilenameMask = strFileMask objBTSRecvSvcInstance.ProcessingServer = strProcessingServer objBTSRecvSvcInstance.ProtocolType = fProtocolType objBTSRecvSvcInstance.PollingLocation = strPollingLoc objBTSRecvSvcInstance.password = strPassword objBTSRecvSvcInstance.UserName = strUsername objBTSRecvSvcInstance.DocumentName = strDocumentName objBTSRecvSvcInstance.SourceID = strSourceID objBTSRecvSvcInstance.SourceQualifier = strSourceQualifier objBTSRecvSvcInstance.DestinationID = strDestinationID objBTSRecvSvcInstance.DestinationQualifier = strDestinationQualifier objBTSRecvSvcInstance.envelopeName = strEnvelopeName objBTSRecvSvcInstance.DisableReceiveFunction = fDisabled objBTSRecvSvcInstance.PreProcessor = strPreProcessor If fProtocolType = http Then objBTSRecvSvcInstance.HttpReturnCorrelationToken = bReturnToken objBTSRecvSvcInstance.HttpReturnContentType = strReturnContentType objBTSRecvSvcInstance.HttpTransportType = fHttpTransportType objBTSRecvSvcInstance.TransportURL = strTransportURL End If If lOpenness <> 0 Then objBTSRecvSvcInstance.OpennessFlag = lOpenness End If If lPassthrough <> 0 Then objBTSRecvSvcInstance.IsPassThrough = lPassthrough End If If strChannelName <> "" Then objBTSRecvSvcInstance.channelName = strChannelName End If objBTSRecvSvcInstance.Put_ (wbemChangeFlagCreateOnly) If err <> 0 Then CreateReceiveFunction = False End If End Function Function CreateCustomCounter(strName, _ strDescription, _ strCaption, _ strSrcOrgName, _ strSrcOrgQualifier, _ strSrcOrgQualifierValue, _ strDestOrgName, _ strDestOrgQualifier, _ strDestOrgQualifierValue, _ strDocType, _ intInterval, _ inGroupName, _ strSettingID) Set CCFact = GetObject("Winmgmts:{impersonationlevel=impersonate}"& _ "!root/MicrosoftBizTalkServer").Get("MSBTS_CustomCounterSetting") Set CustCountSetting = CCFact.SpawnInstance_ CreateCustomCounter = True CustCountSetting.Name = strName CustCountSetting.Description = strDescription CustCountSetting.Caption = strCaption CustCountSetting.SrcOrgName = strSrcOrgName CustCountSetting.DestOrgName = strDestOrgName CustCountSetting.DocType = strDocType CustCountSetting.TimeInterval = intInterval ' In seconds CustCountSetting.GroupName = inGroupName CustCountSetting.SettingID = strSettingID If ("" = CustCountSetting.GroupName) Then Exit Function End If Set objObjectPath = CustCountSetting.Put_(wbemChangeFlagCreateOnly) If (IsEmpty(objObjectPath)) Then CreateCustomCounter = False End If End Function Function GetAliasID(ByVal strOrgName, _ ByVal strAliasName, _ ByVal strAliasQual, _ strAliasValue) Dim config, Organization, RS On Error Resume Next Set config = CreateObject("BizTalk.BizTalkConfig") Set Organization = config.CreateOrganization Call Organization.LoadByName(strOrgName) Set RS = Organization.Aliases While Not RS.EOF If RS("Name") = strAliasName And RS("qualifier") = strAliasQual And _ RS("value") = strAliasValue Then GetAliasID = RS("id") End If RS.MoveNext Wend Set Organization = Nothing Set config = Nothing End Function Sub CreateBizTalkConfig() 'Create BizTalk Configuration Set BT = CreateObject("BizTalk.BizTalkConfig") ' Create Orgs Set org = BT.CreateOrganization org.clear org.name = "Dest_Org" Org110001 = org.Create Alias120001 = GetAliasID ("Dest_Org", "Organization", "OrganizationName", _ "Dest_Org") org.clear org.name = "Source_Org" Org110002 = org.Create Alias120002 = GetAliasID ("Source_Org", "Organization", "OrganizationName", _ "Source_Org") Set org = nothing ' Create Docs set doc = BT.CreateDocument doc.clear doc.name = "Common_PO" Set doc.PropertySet = CreateObject("Commerce.Dictionary") doc.reference = "http://"&strServerName& _ "/biztalkserverrepository/docspecs/Microsoft/CommonPO.xml" Doc140001 = doc.create doc.clear doc.name = "Common_Invoice" Set doc.PropertySet = CreateObject("Commerce.Dictionary") doc.reference = "http://"&strServerName& _ "/biztalkserverrepository/docspecs/Microsoft/CommonInvoice.xml" Doc140002 = doc.create Set doc = nothing ' Create Ports set port = BT.CreatePort port.clear port.name = "Port_To_Org_1" port.DestinationEndpoint.Alias = Alias120001 port.DestinationEndpoint.Application = App0 port.DestinationEndpoint.Openness = 1 port.DestinationEndpoint.Organization = Org110001 port.EncodingType = 1 port.PrimaryTransport.Address = "file://C:Port_To_Org_1-%tracking_id%.xml" port.PrimaryTransport.Parameter = "" port.PrimaryTransport.Type = 256 port.SecondaryTransport.Address = "" port.SecondaryTransport.Parameter = "" port.SecondaryTransport.Type = 1 Port160001 = port.create port.clear port.name = "Port_To_Org_2" port.DestinationEndpoint.Alias = Alias120002 port.DestinationEndpoint.Application = App0 port.DestinationEndpoint.Openness = 1 port.DestinationEndpoint.Organization = Org110002 port.EncodingType = 1 port.PrimaryTransport.Address = "file://C:Port_To_Org_2-%tracking_id%.edi" port.PrimaryTransport.Parameter = "" port.PrimaryTransport.Type = 256 port.SecondaryTransport.Address = "" port.SecondaryTransport.Parameter = "" port.SecondaryTransport.Type = 1 Port160002 = port.create set port = nothing ' Create Channels set chan = BT.CreateChannel chan.clear chan.Name = "Channel_From_Org_1" chan.InputDocument = Doc140001 chan.IsReceiptChannel = False chan.LoggingInfo.LogNativeInputDocument = True chan.LoggingInfo.LogNativeOutputDocument = False chan.LoggingInfo.LogXMLInputDocument = True chan.LoggingInfo.LogXMLOutputDocument = False chan.OutputDocument = Doc140001 chan.port = Port160001 chan.ReceiptChannel = Chan0 chan.RetryCount = 3 chan.RetryInterval = 5 chan.SourceEndpoint.Alias = Alias120001 chan.SourceEndpoint.Openness = 1 chan.SourceEndpoint.Organization = Org110001 Chan180001 = chan.Create chan.clear chan.Name = "Channel_From_Org_2" chan.InputDocument = Doc140002 chan.IsReceiptChannel = False chan.LoggingInfo.LogNativeInputDocument = True chan.LoggingInfo.LogNativeOutputDocument = False chan.LoggingInfo.LogXMLInputDocument = False chan.LoggingInfo.LogXMLOutputDocument = False chan.OutputDocument = Doc140002 chan.port = Port160002 chan.ReceiptChannel = Chan0 chan.RetryCount = 3 chan.RetryInterval = 5 chan.SourceEndpoint.Alias = Alias120002 chan.SourceEndpoint.Openness = 1 chan.SourceEndpoint.Organization = Org110002 Chan180002 = chan.Create set chan = nothing Set BT = nothing End Sub 'Get variable values strServerName = GetEnvVar("COMPUTERNAME") strGroupName = GetBTSGroupName(strServerName) sPath = GetEnvVar("ProgramFiles") & "Microsoft BizTalk ServerHTTP Receive" 'Create Virtual Directory Call CreateVirtualDirectory("BizTalk_Virtual_Directory", sPath) Call CreateWebApplication("BizTalk_Virtual_Directory") Call SetIsolation("BizTalk_Virtual_Directory") 'Create Receive Functions Call CreateReceiveFunction("Receive_Function_1", strGroupName, strServerName, _ "*.edi", ADMIN_PROTOCOL_TYPE_FILE, "C:", "", "", "", "", "", "", "", _ 0, 0, "Channel_From_Org_1", false, "", "", "", "", "", "") Call CreateReceiveFunction("Receive_Function_2", strGroupName, strServerName, _ "*.x12", ADMIN_PROTOCOL_TYPE_FILE, "C:", "", "", "", "", "", "", "", 0, _ 0, "Channel_From_Org_2", false, "", "", "", "", "", "") Call CreateReceiveFunction("HTTP_Receive_File", strGroupName, strServerName, _ "*.*", HTTP, "/BizTalk_Virtual_Directory/BizTalkHTTPReceive.dll?file1", _ "", "", "", "", "", "", "", 0, 0, "", false, "", "", HTTPTType_File, _ "\Sample\%guid%.xml", True, "") 'Create Custom Counter Call CreateCustomCounter("Custom_Counter", "Description", "Caption", _ "Source Org", "", "", "Dest Org", "", "", "Testing", 10000, strGroupName, _ "SettingID") Set g_objService = nothing 'Create BizTalk Configuration Call CreateBizTalkConfig MsgBox "Done" |
Note
This is not a working configuration. It is only intended to demonstrate how to deploy a BizTalk configuration.
Sample_Config.vbs is available for download from the publisher's Web site.