VB6连接PI实时数据库

Option Explicit

Dim tagName As String   '保存单个工位号
Dim tagPoint As Long    '保存单个点源
Dim apiState As Long    '保存返回状态
Dim loginState As Long '保存登录状态

Private Sub cmdAutoGet_Click()
    If Me.cmdAutoGet.Caption = "自动采集" Then
        Me.TimerGet.Enabled = True
        Me.cmdAutoGet.Caption = "停止采集"
       
    ElseIf Me.cmdAutoGet.Caption = "停止采集" Then
        Me.TimerGet.Enabled = False
        Me.cmdAutoGet.Caption = "自动采集"
    End If
End Sub

Private Sub cmdConnect_Click()
On Error GoTo errHandle
    '连接服务器
    If Me.cmdConnect.Caption = "Connect" Then
        Connect Trim(Me.txtPIServer.Text) '用封装的Connect函数连接数据库，实际本质是调用函数piut_setservernode(servername)
       
        Dim quanXian As Long       '保存返回的权限信息
       
        loginState = piut_login("piadmin", "", quanXian)    '登录数据库
       
        If loginState <> 0 Then     '返回0则登录成功，否则登录失败
            MsgBox "function piut_login() has errors!"
        End If
        Me.lblConnState.Caption = "Connected..."
        Me.cmdConnect.Caption = "Disconnect"
    ElseIf Me.cmdConnect.Caption = "Disconnect" Then
        Dim connState As Long
        connState = piut_disconnect()       '断开数据库连接
        Me.txtGetValue.Text = connState
        Me.lblConnState.Caption = "Disconnected!"
        Me.cmdConnect.Caption = "Connect"
    End If
    Exit Sub
errHandle:
    Me.lblConnState.Caption = "Disconnected!"
End Sub

Private Sub cmdFindPoint_Click()
    If loginState <> 0 Then Exit Sub
    tagName = Me.txtGWH.Text        '输入工位号
   
    apiState = pipt_findpoint(tagName, tagPoint)    '根据工位号查找点源
   
    If apiState = -5 Then       '返回-5表示没找到点源
        MsgBox "Tag is not found!"
    ElseIf apiState = 0 Then    '返回0表示找到点源
        MsgBox "Tag is found!"
    End If
End Sub

'读取单个点源
Private Sub cmdGet_Click()
    If apiState <> 0 Then Exit Sub
    Dim getState As Long    '保存返回状态
    Dim tagValue As Single '保存读取的点源对应的值
    Dim tagValueState, tagValueTime As Long     '保存返回的数据状态，数据存储时间
    getState = pisn_getsnapshot(tagPoint, tagValue, tagValueState, tagValueTime)    '读取单个点源的数据
    If getState = 0 Then    '0表示读取成功
        Me.txtGetValue.Text = Me.txtGetValue.Text & tagValue & ","
    Else
        MsgBox "Can't get value!"
    End If
End Sub

'批量写入数据
Private Sub Command1_Click()
    If apiState <> 0 Then Exit Sub
   
    Dim tagName(3) As String    '保存工位号的数组
   
    'pt-点源；iStat-数据状态，初始化为0即可；timedate-设置时间，为0则自动为当前时间
    'piapierror-写入时返回的错误信息；iCount-写入数据的个数
   
    '特别注意，不能这样定义： dim pt(3),iStat(3),timedate(3),piapierror(3) as Long
    '这样定义只会将最后一个认为是Long类型，前面的都为Variant类型
    '或者可以分别单个定义
    Dim pt(3) As Long, iStat(3) As Long, timedate(3) As Long, piapierror(3) As Long, iCount As Long
    'Dim iStat(3) As Long
    Dim rval(3) As Single
   
    '给工位号数组赋值
    tagName(0) = "TI1602A"
    tagName(1) = "TI1602B"
    tagName(2) = "TI1602C"
    tagName(3) = "TI1602D"
   
    '初始化数据
    Dim i As Integer
    For i = 0 To 3
        pt(i) = 0
        rval(i) = Rnd()     '需保存的值
        iStat(i) = 0
        timedate(i) = 0
        piapierror(i) = 0
    Next i
    iCount = 4
   
    Me.Text2.Text = ""
    For i = 0 To 3
        apiState = pipt_findpoint(tagName(i), pt(i))    '循环查找点源，不能批量查找
        Me.Text2.Text = Me.Text2.Text & rval(i) & vbCrLf
    Next i

    Dim setState As Long    '保存函数返回值
    setState = pisn_putsnapshots(pt(0), rval(0), iStat(0), timedate(0), piapierror(0), iCount) '批量上传数据，参数为数组，由于是传址，故参数为数组第一个元素的地址
    'pisn_putsnapshotsx(ByVal count&, PtNum&, drVal#, iVal&, bVal As Any, bSize&, istat&, FLAGS%, time0 As Any, errors&) As Long
    'setState = pisn_putsnapshotsx(Count, pt(0), rval(0), iVal(0), bVal(0), bSize, iStat(0), FLAGS(0), timedate(0), piapierror(0))
   
    If setState = 0 Then
        MsgBox "set sucess!"
    Else
        MsgBox "error is: " & setState
    End If
End Sub

'定时读取单个数据
Private Sub TimerGet_Timer()
    If apiState <> 0 Then Exit Sub
    Dim getState As Long
    Dim tagValue As Single
    Dim tagValueState, tagValueTime As Long
    getState = pisn_getsnapshot(tagPoint, tagValue, tagValueState, tagValueTime)
    Dim tagValueXlTime As Date
    tagValueXlTime = CDate(pitime2xl(tagValueTime))
    If getState = 0 Then
        Me.txtGetValue.Text = Me.txtGetValue.Text & tagValue & "," & tagValueState & "," & tagValueXlTime & vbCrLf
    End If
End Sub