Example of Accessing the COM Data Server

The following example includes the code you use in Microsoft Visual Basic 6.0 to access the COM Data Server. You must write and run this code outside of Siebel Tools. For example, in Microsoft Visual Basic:

Private Sub Command1_Click()
'Siebel Application Object
Dim siebApp As SiebelApplication
Dim siebBusObj As SiebelBusObject
Dim siebBusComp As SiebelBusComp
Dim siebSvcs As SiebelService
Dim siebPropSet As SiebelPropertySet
Dim bool As Boolean
Dim errCode As Integer
Dim errText As String
Dim connStr As String
Dim lng As String
Dim cfgLoc As String
ChDrive "C"
ChDir "C:\Server\siebsrvr\bin"

'Create The COM Data Server Object
Set siebApp = CreateObject("SiebelDataServer.ApplicationObject")

If Not siebApp Is Nothing Then

'''COM Data Server
cfgLoc = " C:\Siebel\8.1\Server\BIN\ENU\siebel.cfg,ServerDataSrc"
siebApp.LoadObjects cfgLoc, errCode
If errCode = 0 Then
   'Log in to the Siebel Server
   siebApp.Login "username", "password", errCode
   If errCode = 0 Then
      'Creat A Business Object
      Set siebBusObj = siebApp.GetBusObject("Contact", errCode)
      If errCode = 0 Then
         'Create a Business Component
         Set siebBusComp = siebBusObj.GetBusComp("Contact")
   Else
      errText = siebApp.GetLastErrText
      siebApp.RaiseErrorText("Business Object Creation failed: " & errCode & "::" & 
errText)
   End If
 
  'Create A New Property Set
   Set siebPropSet = siebApp.NewPropertySet(errCode)
   If errCode = 0 Then
      Set siebPropSet = Nothing
   Else
      errText = siebApp.GetLastErrText
      siebApp.RaiseErrorText("Property Set Creation failed: " & errCode & "::" & 
errText)
   End If
 
  'Get A Siebel Service
   Set siebSvcs = siebApp.GetService("Workflow Process Manager", errCode)
   If Not siebSvcs Is Nothing Then
      Set siebSvcs = Nothing
   Else
      errText = siebApp.GetLastErrText
      siebApp.RaiseErrorText("Could not Get Siebel Service: " & errCode & "::" & 
errText)
   End If
 
  If Not siebBusComp Is Nothing Then
      Set siebBusComp = Nothing
   End If
   If Not siebBusObj Is Nothing Then
      Set siebBusObj = Nothing
   End If
Else
     errText = siebApp.GetLastErrText
     siebApp.RaiseErrorText("Login Failed: " & errCode & "::" & errText)
   End If
Else
   errText = siebApp.GetLastErrText
   siebApp.RaiseErrorText("Load Objects Failed: " & errCode & "::" & errText)
End If

Set siebApp = Nothing

End If

End Sub