How to Change or Reset the PIP Templates in the BTSKInstances Database (329082)

MORE INFORMATION

Sample Code

Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and the tools that are used to create and debug procedures. Microsoft support professionals can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. If you have limited programming experience, you may want to contact a Microsoft Certified Partner or the Microsoft fee-based consulting line at (800) 936-5200. For more information about Microsoft Certified Partners, see the following Microsoft Web site:For additional information about the support options available from Microsoft, visit the following Microsoft Web site:

1. On a computer running Microsoft BizTalk Server that has the BizTalk Server Accelerator for RosettaNet 2.0 installed, paste the following sample code in a text editor (such as Notepad):

   ' This script will retrieve the existing Partner Interface Processes (PIPs) from the PartnerAgreementXML column of the 
   ' tblGlobalChannels table in the BTSKInstances database and optionally update this column with a new XML payload.
   ' Typically, you would retrieve your existing PIPs into an XML file, modify the XML file to include any new PIPs, and then 
   ' update the table with the modified XML file.
   '
   ' NOTE: when you update the PartnerAgreementXML column with this script, it will overwrite all of the existing PIPs and 
   ' replace them with the PIPs specified in the source XML file.  It is recommended that you maintain a separate copy 
   ' of your existing PIPs before you run the script to update your existing PIPs
   
   Option Explicit
   
   Dim retrievePIPxml 
   Dim filesave
   Dim PIPxml
   Dim writePIPxml
   Dim fileretrieve
   Dim fso
   Dim f1
   Dim updatefile
   Dim validate
   Dim continue
   Dim m_SQLServerName
   Dim m_DatabaseName 
   Dim m_ConnectionString 
   Dim conn 
   
   Call UpdatePIPS
   
   Sub UpdatePIPS()
   On Error Resume Next
   
   m_SQLServerName = GetSQLServer()
   m_DatabaseName = GetDatabase()
   m_ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & m_DatabaseName & ";Data Source=" & m_SQLServerName
   Set conn = CreateObject("ADODB.Connection")
   conn.Open m_ConnectionString
   Set fso = CreateObject("Scripting.FileSystemObject")
   
   If Err.Number <> 0 Then 
      MsgBox "Error occurred!" + vbCRLF  + "Error Description is: " + err.description + vbCRLF + "Error Number is: " + err.number, 16, "Error" 
      Exit Sub
   End If
   
   retrievePIPxml = MsgBox("Would you like to retrieve the existing Partner Agreement XML payload and save to a file?", 4, "Retrieve existing Partner Agreement XML from BTSKInstances database")
   If retrievePIPxml  = vbYes Then 
      filesave = InputBox("Please enter file to save Partner Agreement XML file to:", "Enter file to save Partner Agreement XML File", "C:\Temp\PIPS.xml")
      PIPxml = GetPIPxml()
   
      If Err.Number <> 0 Then 
         MsgBox "Error occurred!" + vbCRLF + "Error Description is: " + Err.Description + vbCRLF + "Error Number is: " + err.number, 16, "Error" 
         Exit Sub
      End If
   
      Set f1 = fso.CreateTextFile(filesave, True)
      f1.Write PIPxml
      fso.CopyFile filesave, filesave + ".bak", False
   
      If Err.Number = 58 Then 
         Err.Number = 0
      ElseIf Err.Number <> 0 Then
         MsgBox "Error occurred!" + vbCRLF + "Error Description is: " + Err.Description + vbCRLF + "Error Number is: " + err.number, 16, "Error"
         Exit Sub 
      End If   
   
   End If 
   
   writePIPxml = MsgBox("Would you like to update the PIP database with a new XML file?", 4, "Update PIP database with XML file")
   If writePIPxml = vbYes Then 
      fileretrieve = Inputbox("Please Enter location of XML file with updated PIPs:", "Enter location of XML File with updated PIPs", filesave)
      If fileretrieve <> ""  Then
         Set f1 = fso.OpenTextFile(fileretrieve, 1)
         updatefile = f1.ReadAll
         PutPIPxml(updatefile)
      Else
         MsgBox "You did not enter a valid location for the XML file." & vbCRLF & "Update Cancelled.",0, "Update Cancelled" 
      End If
   
      Set f1 = Nothing
      
   If Err.Number <> 0 Then 
      MsgBox "Error occurred!" + vbCRLF + "Error Description is: " + Err.Description + vbCRLF + "Error Number is: " + err.number, 16, "Error" 
      Exit Sub
   End If
   
   End If 
   
   Set fso = Nothing
   conn.Close
   Set conn = Nothing
   
   End Sub
   
   'Function for retrieving PIP XML
   Function GetPIPxml() 
   Dim rst 
   Set rst = CreateObject("ADODB.Recordset")
   rst.Open "Exec sp_GetPIDXML", conn
   GetPIPxml = rst.Fields("PartnerAgreementXML")
   Set rst = Nothing
   
   If Err.Number <> 0 Then 
      MsgBox "Error occurred!" + vbCRLF + "Error Description is: " + Err.Description + vbCRLF + "Error Number is: " + err.number, 16, "Error" 
      Exit Function
   End If
   
   End Function
   
   'Function for storing PIP XML to PartnerAgreementXML column of the tblGlobalChannels table in the BTSKInstances database
   Function PutPIPxml(pidXML)
   On Error Resume Next
   continue = vbYes
   Dim testXML
   Set testXML = CreateObject("Msxml2.DOMDocument.3.0")
   validate = testXML.LoadXML(pidXML)
   set testXML = Nothing
   If validate = False Then continue = MsgBox("The file that you are updating the PartnerAgreementXML column with is not a valid XML file, Continue?", 4, "Invalid XML file")
   If continue = vbYes Then
      conn.Execute "Exec sp_UpdatePIDXML N'" & pidXML & "'"
   Else
      MsgBox "Update Cancelled",0, "Update Cancelled"
   End If
   
   If Err.Number <> 0 Then 
      MsgBox "Error occurred!" + vbCRLF + "Error Description is: " + Err.Description + vbCRLF + "Error Number is: " + err.number, 16, "Error" 
      Exit Function
   End If
   
   End Function
   
   Function GetSQLServer() 
       Dim objShell 
       Set objShell = CreateObject("WScript.Shell")
       GetSQLServer = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\BizTalk Server Accelerator for RosettaNet\1.0\Administration\Server")
       Set objShell = Nothing
   
   If Err.Number <> 0 Then 
      MsgBox "Error occurred!" + vbCRLF + "Error Description is: " + Err.Description + vbCRLF + "Error Number is: " + err.number, 16, "Error" 
      Exit Function
   End If
   
   End Function
   
   Function GetDatabase()
       Dim objShell 
       Set objShell = CreateObject("WScript.Shell")
       GetDatabase = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\BizTalk Server Accelerator for RosettaNet\1.0\Administration\Database")
       Set objShell = Nothing
   
   If Err.Number <> 0 Then 
      MsgBox "Error occurred!" + vbCRLF + "Error Description is: " + Err.Description + vbCRLF + "Error Number is: " + err.number, 16, "Error" 
      Exit Function
   End If
   
   End Function
   

2. Save the file. When you save the file, use a Visual Basic Script (.vbs) file name extension.
3. Double-click the saved file to retrieve or update the PIP templates in your BTSKInstances database.