PITransferRecordDB / PITransferRecordList / PITransferRecord Example

 

Option Explicit
Const g_QuantityPropName As String = "Quantity"

Private Sub Command1_Click()
'
'  Create some TransferRecords to Find
'
   Dim module1 As PIModule
   Dim module2 As PIModule
   Dim startTime As New PITime
   Dim endTime As New PITime
   Dim unitBatch As PIUnitBatch
   Dim ubList As New PIUnitBatchList
   Dim batch As PIBatch
   Dim i As Long
   Dim transferRecord As PISDK.PITransferRecord
'
'  Create a Batch
'
   endTime.SetToCurrent
   startTime.UTCSeconds = endTime.UTCSeconds - 10  ' 10 second batch
   Set batch = PISDK.Servers.DefaultServer.PIBatchDB.Add("Batch1", "Product1", "Recipe1", startTime, endTime)
   
   On Error Resume Next
   Set module1 = PISDK.Servers.DefaultServer.PIModuleDB.PIModules.Add("PITransferRecordDBTest1")
   Set module1 = PISDK.Servers.DefaultServer.PIModuleDB.PIModules.Item("PITransferRecordDBTest1")
   Set module2 = PISDK.Servers.DefaultServer.PIModuleDB.PIModules.Add("PITransferRecordDBTest2")
   Set module2 = PISDK.Servers.DefaultServer.PIModuleDB.PIModules.Item("PITransferRecordDBTest2")
   module1.IsPIUnit = True  ' make module1 a unit
   On Error GoTo 0
'
'  Add 3 UnitBatches to this module, and then add them to a batch at the same time
'
   endTime.SetToCurrent
   endTime.UTCSeconds = endTime.UTCSeconds - (2 * 60)  ' start 2 minutes ago
   For i = 1 To 3
      startTime.UTCSeconds = endTime.UTCSeconds - 1    ' 1 second batch to avoid overlapping problems
      Set unitBatch = module1.AddPIUnitBatch("UB1", "Product", startTime, endTime)
      batch.PIUnitBatches.Insert unitBatch   ' add it to this batch
      ubList.Insert unitBatch ' insert into a list
      endTime = endTime + 30   ' next unitBatch
   Next
'
'  Now add some transfer records, and add a quantity to two of them
'
   endTime.SetToCurrent
   startTime.UTCSeconds = endTime.UTCSeconds - 60  ' 1 minute transfer
   Set transferRecord = PISDK.Servers.DefaultServer.PIBatchDB.PITransferRecordDB.Add(ubList(1), ubList(2), startTime, endTime)
   transferRecord.PIProperties.Add g_QuantityPropName, 60
   Set transferRecord = PISDK.Servers.DefaultServer.PIBatchDB.PITransferRecordDB.Add(ubList(3), batch, startTime, endTime)
   transferRecord.PIProperties.Add g_QuantityPropName, 100
'
'  Now add a PIModule transfer without a quantity
'
   Set transferRecord = PISDK.Servers.DefaultServer.PIBatchDB.PITransferRecordDB.Add(module1, module2, startTime, endTime)
'
'  Now display the TransferRecords
'
   LoadPITransferRecordList
End Sub

Private Sub LoadPITransferRecordList()
   Dim piServer As PISDK.Server
   Dim transferRecordDB As PISDK.PITransferRecordDB
   Dim transferRecords As PISDK.PITransferRecordList
   Dim transferRecord As PISDK.PITransferRecord
   Dim searchStart As New PITime
   Dim searchEnd As New PITime
   Dim mItem As ListItem
   Dim batch As PIBatch
   Dim unitBatch As PIUnitBatch
   Dim module As PIModule
   Dim nbrItem As Long
   Dim quantity As PIProperty
   
   Set piServer = PISDK.Servers.DefaultServer
   Set transferRecordDB = piServer.PIBatchDB.PITransferRecordDB
'
'  Set up list view
'
   ListView1.ListItems.Clear
   nbrItem = 9
   ListView1.ColumnHeaders.Add , , "SourceType", ListView1.Width / nbrItem
   ListView1.ColumnHeaders.Add , , "SourceID", ListView1.Width / nbrItem
   ListView1.ColumnHeaders.Add , , "StartTime", ListView1.Width / nbrItem
   ListView1.ColumnHeaders.Add , , "EndTime", ListView1.Width / nbrItem
   ListView1.ColumnHeaders.Add , , "DesitinationType", ListView1.Width / nbrItem
   ListView1.ColumnHeaders.Add , , "DesitinationID", ListView1.Width / nbrItem
   ListView1.ColumnHeaders.Add , , "StartTime", ListView1.Width / nbrItem
   ListView1.ColumnHeaders.Add , , "EndTime", ListView1.Width / nbrItem
   ListView1.ColumnHeaders.Add , , g_QuantityPropName, ListView1.Width / nbrItem
   ListView1.View = lvwReport
'
' Search from one hour ago to current time
'
   searchEnd.SetToCurrent
   searchStart.UTCSeconds = searchEnd.UTCSeconds - 3600
   Set transferRecords = transferRecordDB.PITransferRecordSearch(searchStart, searchEnd)
'
'  List the Transfer records
'
   For Each transferRecord In transferRecords
      Set mItem = ListView1.ListItems.Add
'
'  Check the source and destination types
'
      mItem.Text = TypeName(transferRecord.Source)
      If (TypeName(transferRecord.Source) = "PIBatch") Then
         Set batch = transferRecord.Source
         mItem.SubItems(1) = batch.BatchID
         mItem.SubItems(2) = batch.startTime.LocalDate
         mItem.SubItems(3) = batch.endTime.LocalDate
      ElseIf (TypeName(transferRecord.Source) = "PIUnitBatch") Then
         Set unitBatch = transferRecord.Source
         mItem.SubItems(1) = unitBatch.BatchID
         mItem.SubItems(2) = unitBatch.startTime.LocalDate
         mItem.SubItems(3) = unitBatch.endTime.LocalDate
      ElseIf (TypeName(transferRecord.Source) = "PIModule") Then
         Set module = transferRecord.Source
         mItem.SubItems(1) = module.Name
         mItem.SubItems(2) = "N/A"
         mItem.SubItems(3) = "N/A"
      Else
         MsgBox "Source Type: " & TypeName(transferRecord.Source) & " not supported"
      End If
      mItem.SubItems(4) = TypeName(transferRecord.Destination)
      If (TypeName(transferRecord.Destination) = "PIBatch") Then
         Set batch = transferRecord.Destination
         mItem.SubItems(5) = batch.BatchID
         mItem.SubItems(6) = batch.startTime.LocalDate
         mItem.SubItems(7) = batch.endTime.LocalDate
      ElseIf (TypeName(transferRecord.Destination) = "PIUnitBatch") Then
         Set unitBatch = transferRecord.Destination
         mItem.SubItems(5) = unitBatch.BatchID
         mItem.SubItems(6) = unitBatch.startTime.LocalDate
         mItem.SubItems(7) = unitBatch.endTime.LocalDate
      ElseIf (TypeName(transferRecord.Destination) = "PIModule") Then
         Set module = transferRecord.Destination
         mItem.SubItems(5) = module.Name
         mItem.SubItems(6) = "N/A"
         mItem.SubItems(7) = "N/A"
      Else
         MsgBox "Destination Type: " & TypeName(transferRecord.Source) & " not supported"
      End If
'
'  Get transfer quantity from the PIProperties
'
      On Error Resume Next
      Set quantity = transferRecord.PIProperties.Item(g_QuantityPropName)
      If (Err <> 0) Then
         Err.Clear
         mItem.SubItems(8) = g_QuantityPropName & " not found"
      Else
         mItem.SubItems(8) = quantity.Value
      End If
      On Error GoTo 0
   Next transferRecord

End Sub
	
Enabling Operational Intelligence