基本信息
源码名称：libnodave（vb项目源码）
源码大小：7.99M
文件格式：.rar
开发语言：ASP
更新时间：2019-12-18
友情提示：（无需注册或充值，赞助后即可获取资源下载链接）
嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300
本次赞助数额为： 3 元×
微信扫码支付：3 元
×
请留下您的邮箱，我们将在2小时内将文件发到您的邮箱
源码介绍
Public Class OPCServer
Public TagHandle(1000) As Integer
Dim MyError As Integer
Dim GUID(16) As Byte
Dim SvrName(100) As Byte
Dim SvrDesc(100) As Byte
Dim ExePath(100) As Byte
Dim VendorInfo(100) As Byte
Dim CurrentTime As Date
Dim MyTimeStamp As Double
Public OutData() As String
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As Integer, ByRef source As Object, ByVal numbytes As Integer)
Public Delegate Sub MyWriteCallback1(ByVal Itemhandle As Integer, ByRef newValue As Object, ByRef DeviceMyError As Integer)
Public Delegate Sub MyUnknownItemCallback1(ByRef Path As Byte, ByRef Item As Byte)
Public Structure FileTime
Dim dwLowDateTime As Integer
Dim dwHighDateTime As Integer
End Structure
' Initialization and Registration functions
'
' WTOPCsvrRevision()
' Simply returns a version identifier for the DLL
Declare Function WTOPCsvrRevision Lib "WtOPCSvr" Alias "_WTOPCsvrRevision@0" () As Integer
'
' InitWTOPCsvrB()
' Initializes DCOM, Security, and creates the Server ClassFactory
Declare Function InitWTOPCsvr Lib "WtOPCSvr" Alias "_InitWTOPCsvr@8" (ByRef CLSID_Svr As Byte, ByVal ServerRate As Integer) As Integer
'
' UninitWTOPCsvr()
' Uninitializes COM.
Declare Function UninitWTOPCsvr Lib "WtOPCSvr" Alias "_UninitWTOPCsvr@0" () As Integer
'
' ResetServerRate()
' The specified ServerRate is the fastest rate at which the data can
' be updated to a client. The minimum server rate that may be selected is
' 10 ms.
Declare Function ResetServerRate Lib "WtOPCSvr" Alias "_ResetServerRate@4" (ByVal ServerRate As Integer) As Integer
'
' SetVendorInfoA()
' Allows the application to specify a vendor specifc string to identify
' the server. This string will appear as part of the OPCSERVERSTATUS structure
' returned by the GetStatus Interface.
Declare Function SetVendorInfo Lib "WtOPCSvr" Alias "_SetVendorInfo@4" (ByRef VendorInfo As Byte) As Integer
'
' UpdateRegistryB()
' Makes the appropriate entries to the Windows Registry to identify the Server.
' the argument types.
Declare Function UpdateRegistry Lib "WtOPCSvr" Alias "_UpdateRegistry@16" (ByRef CLSID_Svr As Byte, ByRef Name As Byte, ByRef Descr As Byte, ByRef ExePath As Byte) As Integer
'
' AddLocalServiceKeysToRegistry()
' Makes additional Registry Entries required if the Server is to be installed
' as an NT Service.
Declare Function AddLocalServiceKeysToRegistry Lib "WtOPCSvr" Alias "_AddLocalServiceKeysToRegistry@4" (ByRef Name As Byte) As Integer
'
' UnregisterServerB()
' Removes the Registry Entries
Declare Function UnregisterServer Lib "WtOPCSvr" Alias "_UnregisterServer@8" (ByRef CLSID_Svr As Byte, ByRef Name As Byte) As Integer
'
' OPC Item Functions
'
' CreateTagA()
' Add an OPC Item to the WtOPCsvr.DLL local tag list. The dll takes care of
' all client references to the tag and provides a callback to the application
' if the tag is updated by a client. Once a tag gets created, it's name will
' automatically be presented in the browse list to any interested OPC Client.
Declare Function CreateTag Lib "WtOPCSvr" Alias "_CreateTag@28" (ByRef Name As Byte, ByVal Value As Object, ByVal InitialQuality As Integer, ByVal IsWritable As Boolean) As Integer
'
' UpdateTag()
' UpdateTagWithTimeStamp()
' UpdateTagByNameA()
' Allows the Server Application to change the value, quality and timestamp of
' a tag. All updates are automatically provided to subscribing clients as defined
' by the particular connection.
Declare Function UpdateTag Lib "WtOPCSvr" Alias "_UpdateTag@24" (ByVal TagHandle As Integer, ByVal Value As Object, ByVal Quality As Integer) As Integer
Declare Function UpdateTagWithTimeStamp Lib "WtOPCSvr" Alias "_UpdateTagWithTimeStamp@32" (ByVal TagHandle As Integer, ByVal Value As Object, ByVal Quality As Integer, ByVal Timestamp As Double) As Integer
Declare Function UpdateTagByName Lib "WtOPCSvr" Alias "_UpdateTagByName@24" (ByRef Name As Byte, ByVal Value As Object, ByVal Quality As Integer) As Integer
'
'''''''''''''''''''
'These three functions must be used together, and provide a more efficient means
'of updating multiple tags.
'UpdateTagToList replaces UpdateTag call, requires prior StartUpdateTags else fails
'and EndUpdateTags after all tags are updated.
' StartUpdateTags()
Declare Function StartUpdateTags Lib "WtOPCSvr" Alias "_StartUpdateTags@0" () As Integer
' UpdateTagToList()
Declare Function UpdateTagToList Lib "WtOPCSvr" Alias "_UpdateTagToList@24" (ByVal TagHandle As Integer, ByVal Value As Object, ByVal Quality As Integer) As Integer
' EndUpdateTags()
Declare Function EndUpdateTags Lib "WtOPCSvr" Alias "_EndUpdateTags@0" () As Integer
''''''''''''''''''
'
' SetTagProperties()
' Tag Properties are values associated with an OPC Item other than its Value,
' Quality and TimeStamp. Any property value may be assigned by the server
' for a defined tag.
Declare Function SetTagProperties Lib "WtOPCSvr" Alias "_SetTagProperties@28" (ByVal TagHandle As Integer, ByVal PropertyID As Integer, ByRef Description As Byte, ByVal Value As Object) As Integer
'
' ReadTag()
' ReadTagWithTimeStamp()
' Allows the Application to read each tag value from the WtOPCsvr.dll local Tag List.
Declare Function ReadTag Lib "WtOPCSvr" Alias "_ReadTag@8" (ByVal TagHandle As Integer, ByRef Value As Object) As Integer
Declare Function ReadTagWithTimeStamp Lib "WtOPCSvr" Alias "_ReadTagWithTimeStamp&16" (ByVal TagHandle As Integer, ByRef Value As Object, ByRef Quality As Integer, ByRef Timestamp As FileTime) As Integer
'
' SuspendTagUpdates()
' When a Tag is created by the Server Application, it is automatically enabled for
' client subscription. The tag name will automatically be included in the server
' browse list and any client may connect and read it's current value. In certain
' applications, it is desirable to only create the tag whenever a client requests it.
' The UNKNOWNITEMPROC callback may be used for dynamic tag allocation, but until the
' tag is created, the tag name will not show up in the browse list. Creation of the
' tag followed by a call to SuspendTagUpdates() will allow the tag name to be browsed
' by a client, but not subscribed to. In this scenario, the WtOPCsvr.dll will issue
' the UNKNOWNITEMPROC callback to allow the Application to enable the tag and begin
' updating it's value only when being actively subscribed by an OPC Client.
Declare Function SuspendTagUpdates Lib "WtOPCSvr" Alias "_SuspendTagUpdates@8" (ByVal TagHandle As Integer, ByVal OnOff As Integer) As Integer
'
' RemoveTag()
' Deletes a tag from the WtOPCsvr Tag List.
Declare Function RemoveTag Lib "WtOPCSvr" Alias "_RemoveTag@4" (ByVal TagHandle As Integer) As Integer
'
' Auxilary Functions
'
' NumbrClientConnections()
' Allows the Server Application to determine the number of OPC Clients
' currently connected.
Declare Function NumbrClientConnections Lib "WtOPCSvr" Alias "_NumbrClientConnections@0" () As Integer
'
' RequestDisconnect()
' Provides the ability for the Server Application to request that all
' Clients gracefully disconnect. There is no guarantee that any client
' will honor the request.
Declare Sub RequestDisconnect Lib "WtOPCSvr" Alias "_RequestDisconnect@0" ()
'
' RefreshAllClients()
' Forces the WtOPCsvr.DLL to issue data updates to all connected Clients.
' (Primarily used for debugging. Normal client updates are issued automatically
' by the WtOPCsvr.DLL based on an iternal clock tick.)
Declare Function RefreshAllClients Lib "WtOPCSvr" Alias "_RefreshAllClients@0" () As Integer
'
' ConvertVBDateToFileTime1()
' ConvertFileTimeToVBDate1()
' Allows VB applications to convert standard Variant Date to OPC Specified Filetime
Declare Function ConvertVBDateToFileTime1 Lib "WtOPCSvr" Alias "_ConvertVBDateToFileTime1@8" (ByRef VBDate As Date, ByRef Timestamp As Double) As Integer
Declare Function ConvertFileTimeToVBDate1 Lib "WtOPCSvr" Alias "_ConvertFileTimeToVBDate1@8" (ByRef Timestamp As Double, ByRef VBDate As Date) As Integer
'
' Deactivate30MinTimerA
Declare Function Deactivate30MinTimer Lib "WtOPCSvr" Alias "_Deactivate30MinTimer@4" (ByVal Authorization As String) As Integer
'
' Support for Alarms & Events
'
' Literal Definitions for LevelID
'
' ID_LOLO_LIMIT 1
' ID_LO_LIMIT 2
' ID_HI_LIMIT 3
' ID_HIHI_LIMIT 4
'
'
' UserAEMessage()
Declare Function UserAEMessage Lib "WtOPCSvr" Alias "_UserAEMessage@8" (ByRef Msg As Byte, ByVal Severity As Integer) As Integer
'
' SetItemLevelAlarm()
Declare Function SetItemLevelAlarm Lib "WtOPCSvr" Alias "_SetItemLevelAlarm@20" (ByVal TagHandle As Integer, ByVal LevelID As Integer, ByVal Limit As Single, ByVal Severity As Integer, ByVal Enabled As Integer) As Integer
'
' GetItemLevelAlarm()
Declare Function GetItemLevelAlarm Lib "WtOPCSvr" Alias "_GetItemLevelAlarm@20" (ByVal TagHandle As Integer, ByVal LevelID As Integer, ByRef Limit As Single, ByRef Severity As Integer, ByRef Enabled As Integer) As Integer
'
' Callback Definitions
'
' Used by the DLL to pass control back to the Server Application
' Each callback must be explicitly enabled by calling one of the following
' exported API functions:
' EnableNotification (NOTIFYPROC lpCallback);
Declare Function EnableWriteNotification Lib "WtOPCSvr" Alias "_EnableWriteNotification@8" (ByVal Callback As MyWriteCallback1, ByVal ConvertToNative As Integer) As Integer
' EnableUnknownItemNotification (UNKNOWNITEMPROC lpCallback);
Declare Function EnableUnknownItemNotification Lib "WtOPCSvr" Alias "_EnableUnknownItemNotification@4" (ByVal Callback As MyUnknownItemCallback1) As Integer
' EnableItemRemovalNotification (ITEMREMOVEDPROC lpCallback);
Declare Function EnableItemRemovalNotification Lib "WtOPCSvr" Alias "_EnableItemRemovalNotification@4" (ByVal Callback As Integer) As Integer
' EnableDisconnectNotification (DISCONNECTPROC lpCallback);
Declare Function EnableDisconnectNotification Lib "WtOPCSvr" Alias "_EnableDisconnectNotification@4" (ByVal Callback As Integer) As Integer
' EnableEventMsgs (EVENTMSGPROC lpCallback);
Declare Function EnableEventMsgs Lib "WtOPCSvr" Alias "_EnableEventMsgs@4" (ByVal Callback As Integer) As Integer
' EnableDeviceRead (DEVICEREADPROC lpCallback);
Declare Function EnableDeviceRead Lib "WtOPCSvr" Alias "_EnableDeviceRead@4" (ByVal Callback As Integer) As Integer
'
'
' NOTIFYPROC
' Signals the Application that an OPC Client has written data to a
' tag. HANDLE value represents the tag item that was written
' NewValue is teh value written and DeviceMyError allows the application to
' provide an MyError indication back to the client if the write to the device fails
Sub NotificationCallback(ByVal TagHandle As Integer, ByRef newValue As Object, ByRef DeviceMyError As Integer)
End Sub
' UNKNOWNITEMPROC
' Signals the Application that a Client has requested a tag that has
' not been previously defined, (or has been suspended). The two character
' pointer arguments represent the OPC Path Name and Item Name of the requested
' tag. This callback allows the Server Application to operate with dynamic
' tags that are created and maintained only when subscribed to by a connected
' Client.
Sub UnknownItemCallback(ByRef PathName As Byte, ByRef ItemName As Byte)
End Sub
' ITEMREMOVEDPROC
' Works in conjuction with the above UNKNOWNITEMPROC. This callback signals the
' Application that the last client subscription for a given item has ended. The
' HANDLE of the tag item is returned as well as the Path and Item Name. The
' Server Application may choose to remove or suspend the tag when no clients are
' subscribing to the data.
Sub ItemremovedCallback(ByVal Itemhandle As Integer, ByRef PathName As Byte, ByRef ItemName As Byte)
End Sub
' DISCONNECTPROC
' Notifies the Server Application whenever a client disconnects. The DWORD argument
' defines the number of client connections remaining. This callback may be used
' to shutdown the server when the last client disconnects.
Sub DisconnectCallback(ByVal nConnects As Integer)
End Sub
' EVENTMSGPROC
' Allows the Application to receive event messages from the WtOPCsvr.dll for
' tracing OPC Client Interface calls. Primarily used for debugging purposes.
'
Sub EventMsgCallback(ByRef Msg As Byte)
End Sub
' DEVICEREADPROC
' Callback into the application whenever a client requests a SyncIO Read
' with dwSource set to OPC_DS_DEVICE.
'
Sub DeviceReadCallback(ByVal TagHandle As Integer, ByRef newValue As Object, ByRef Quality As Integer, ByRef Timestamp As Date)
End Sub
Sub GUIDToByte(ByVal strGUID As String, ByVal GUID() As Byte)
' Copy a GUID in string form from GUIDGEN.EXE into a VB byte array for WinTech OPC server.
' Required format, including brackets. "{BB352C70-0BB4-11d4-80Cr0-00C04F790F3B}"
GUID(0) = Val("&H" & Mid$(strGUID, 8, 2))
GUID(1) = Val("&H" & Mid$(strGUID, 6, 2))
GUID(2) = Val("&H" & Mid$(strGUID, 4, 2))
GUID(3) = Val("&H" & Mid$(strGUID, 2, 2))
GUID(4) = Val("&H" & Mid$(strGUID, 13, 2))
GUID(5) = Val("&H" & Mid$(strGUID, 11, 2))
GUID(6) = Val("&H" & Mid$(strGUID, 18, 2))
GUID(7) = Val("&H" & Mid$(strGUID, 16, 2))
GUID(8) = Val("&H" & Mid$(strGUID, 21, 2)) 'Swapped due to Intel "big endian" format
GUID(9) = Val("&H" & Mid$(strGUID, 23, 2)) '
GUID(10) = Val("&H" & Mid$(strGUID, 26, 2))
GUID(11) = Val("&H" & Mid$(strGUID, 28, 2))
GUID(12) = Val("&H" & Mid$(strGUID, 30, 2))
GUID(13) = Val("&H" & Mid$(strGUID, 32, 2))
GUID(14) = Val("&H" & Mid$(strGUID, 34, 2))
GUID(15) = Val("&H" & Mid$(strGUID, 36, 2))
End Sub
'Sub StringToByte(ByVal strString As String, ByVal ByteArray() As Byte)
' 'Copy a string to a null terminalted VB byte array.
' Dim i As Integer
' Try
' For i = 1 To strString.Length
' ByteArray(i - 1) = Asc(Mid$(strString, i, 1))
' Next i
' ByteArray(i - 1) = 0
' Catch ex As Exception
' MsgBox("程序不支持中文路径！")
' End Try
'End Sub
'使程序支持中文
Sub StringToByte(ByVal strString As String, ByVal ByteArray() As Byte)
'将字符串转换成字节数组，汉字占2字节
Dim i As Integer
Dim j As Integer
Dim A As Long
On Error Resume Next
For i = 0 To strString.Length - 1
A = Asc(Mid$(strString, i 1, 1))
If A < 0 Then
ByteArray(i j) = Int((65536 A) / 256)
j = j 1
ByteArray(i j) = Int((65536 A) Mod 256)
Else
ByteArray(i j) = A
End If
Next
ByteArray(i j) = 0
End Sub
Sub MyWriteCallback(ByVal Itemhandle As Integer, ByRef newValue As Object, ByRef DeviceMyError As Integer)
DeviceMyError = 0
If (Itemhandle = TagHandle(0)) Then
'Form1.TAG1.Text = newValue
MyError = UpdateTag(TagHandle(0), newValue, 192)
End If
If (Itemhandle = TagHandle(1)) Then
'Form1.TAG2.Text = newValue
MyError = UpdateTag(TagHandle(1), newValue, 192)
End If
If (Itemhandle = TagHandle(2)) Then
'Form1.TAG3.Text = newValue
MyError = UpdateTag(TagHandle(2), newValue, 192)
End If
If (Itemhandle = TagHandle(3)) Then
'Form1.TAG4.Text = newValue
MyError = UpdateTag(TagHandle(3), newValue, 192)
End If
End Sub
Sub MyUnknownItemCallback(ByRef Path As Byte, ByRef Item As Byte)
Dim ItemName(100) As Byte
Dim PathName(100) As Byte
Dim TagName As String
CopyMemory(PathName(0), Path, 100)
CopyMemory(ItemName(0), Item, 100)
TagName = "Client Requested Unknown Item: "
For i = 0 To 99
If PathName(i) <> 0 Then
TagName = TagName Chr(PathName(i))
Else
Exit For
End If
Next i
If PathName(0) <> 0 Then
TagName = TagName "."
End If
For i = 0 To 99
If ItemName(i) <> 0 Then
TagName = TagName Chr(ItemName(i))
Else
Exit For
End If
Next i
End Sub
Public Sub Init()
InitOPC()
RegistOPC()
End Sub
Private Sub RegistOPC()
Dim retval As Integer = 0
Dim NumberSerial As String
Try
'版权网站：www.win-tech.com。
NumberSerial = "JVRPS53R5V64226N62H4"
retval = Deactivate30MinTimer(NumberSerial)
UpdateRegistry(GUID(0), SvrName(0), SvrDesc(0), ExePath(0))
MyError = SetVendorInfo(VendorInfo(0))
MyError = InitWTOPCsvr(GUID(0), 1000)
MyError = EnableWriteNotification(AddressOf MyWriteCallback, True)
MyError = EnableUnknownItemNotification(AddressOf MyUnknownItemCallback)
Catch ex As Exception
message("OPCServer:RegistOP-" ex.Message)
End Try
End Sub
Private Sub InitOPC()
'initialize GUID, SvrName, SvrDesc & Exe Path
' GUID from GUIDGEN
' {BB352C70-0BB4-11d4-80C0-00C04F790F3B}
'{ 0xbb352c70, 0xbb4, 0x11d4, { 0x80, 0xc0, 0x0, 0xc0, 0x4f, 0x79, 0xf, 0x3b } };
'GUIDToByte("{BB352C70-0BB4-11d4-80C0-00C04F790F3B}", GUID)
GUIDToByte("{BB352C70-0BB4-11d4-80C0-00C04F790F3B}", GUID)
StringToByte("VBOPCServer", SvrName)
StringToByte("DLGTY", SvrDesc)
StringToByte(Application.StartupPath & "\" & Application.CompanyName & ".exe", ExePath)
StringToByte("DLGTY Corp.", VendorInfo)
'UnComment the following three lines to automatically
' initialize the server dll, create the tags and start the timer
'(Useful for testing VB app installed as NT Service)
'InitButton_Click
'AddButton_Click
'TimerButton_Click
End Sub
Public Sub AddTags(ByVal tag() As String, ByVal sort As String, ByVal StartId As Integer)
Dim TagName(100) As Byte
' Add four OPC items
' OPC_QUALITY_GOOD literalizes to 0xc0 (192)
For i = 0 To tag.Count - 1
StringToByte(tag(i), TagName)
Select Case sort
Case "bool"
TagHandle(StartId i) = CreateTag(TagName(0), CBool(0), 192, True)
Case "byte"
TagHandle(StartId i) = CreateTag(TagName(0), CByte(0), 192, True)
Case "integer"
TagHandle(StartId i) = CreateTag(TagName(0), Math.Round(0), 192, True)
Case "single"
TagHandle(StartId i) = CreateTag(TagName(0), CSng(0), 192, True)
Case "string"
TagHandle(StartId i) = CreateTag(TagName(0), CStr(0), 192, True)
End Select
Next
End Sub
Public Sub UpdateTags(ByVal tag() As Object, ByVal StartId As Integer)
' Update the OPC Item Values
' The application can either provide it's own timestamp
' or use the default current time stamped by the dll
CurrentTime = Now
MyError = ConvertVBDateToFileTime1(CurrentTime, MyTimeStamp)
For i = 0 To tag.Count - 1
MyError = UpdateTag(TagHandle(StartId i), tag(i), 192)
Next
End Sub
Public Sub CloseServer()
' Remove the Registry Entries
MyError = UnregisterServer(GUID(0), SvrName(0))
End Sub
End Class