Simple VB6 code example needed

Hi,

I have VB 6.0 sample somewhere. I will find and post it during this week.

Best Regards,

Mikko

Hi,

Here is a VB sample code that reads DLMS/COSEM device.

You have to change following:
- HostName and HostPort for Network media.

UseLogicalNameReferencing, ClientID and ServerID for DLMS/COSEM component.

Happy Coding,

Mikko
-----------------------------------------------------------------------------
Option Explicit

Dim Cosem1 As GuruxDLMS2.CGXCOSEM
Dim Net1 As GXNet
Dim WaitTime

Sub WriteLog(txt, data)
Dim it, str
str = txt
If IsArray(data) Then
For Each it In data
str = str + Hex(it) + " "
Next
End If
Debug.Print str
End Sub

Sub ReadDeviceID()
WaitTime = 5
'Create Network component
Set Net1 = CreateObject("GuruxNet.GXNet")
'Create DLMS/COSEM component
Set Cosem1 = CreateObject("GuruxDLMS2.GXCOSEM")
'Set Network properties
Net1.Protocol = GX_NW_TCPIP
Net1.HostName = "" 'Change this
Net1.HostPort = 1000 'Change this

'Set COSEM Properties
Cosem1.UseLogicalNameReferencing = False 'Change this
Cosem1.Authentication = GXDLMS_AUTHENTICATION_NONE 'Change this
Cosem1.Password = "" 'Change this
Cosem1.ClientID = CByte(&H21) 'Change this
Cosem1.ServerID = CByte(&H3) 'Change this

InitializeNetworkConnection
'Read Association View
Dim data, reply
Dim objects 'As GuruxDLMS2.CDLMSObjectCollection
data = ReadDataBlock(Cosem1.GetObjects(GX_REGISTER_OBJECT_TYPE_ASSOCIATION_VIEW))
Set objects = Cosem1.ParseObjects(data, 0)
Dim cols As GuruxDLMS2.CDLMSObjectCollection
Dim obj As GuruxDLMS2.CDLMSObject

'Find Device ID using OBIS code and read it.
Set obj = objects.FindByLN("0.0.96.1.1.255")
If Not obj Is Nothing Then
reply = ReadDataBlock(Cosem1.Read(obj.Name, 1, 1, obj.InterfaceType, 2))
data = Cosem1.GetValue(reply)
MsgBox "Device ID: " & data
End If

'Read Load profile with recording period 1
'This sample shows how to read table (aka Profile Generic).
Set obj = objects.FindByLN("1.0.99.1.0.255")
If Not obj Is Nothing Then
'Read Load Profile Columns
data = ReadDataBlock(Cosem1.Read(obj.Name, 1, 1, obj.InterfaceType, 3))
Set cols = Cosem1.ParseObjects(data, OBJECT_TYPE_PROFILE_GENERIC)
'Read Load Profile data.
Dim it, len1, pos, arr, from
from = DateAdd("d", -7, Now)
data = Cosem1.ReadProfileGenericData(obj.Name, 7, "0.0.1.0.0", cols(0).EDISType, cols(0).Version, from, Now)
arr = Cosem1.SplitDataToPackets(data)
len1 = UBound(arr) + 1
For Each it In arr
pos = pos + 1
data = Cosem1.Read(it, pos, len1, 0, 0)
reply = ReadDataBlock(data)
Next
data = Cosem1.GetValue(reply)
End If
'Close network connection
Net1.Close
MsgBox "done"
End Sub

Function ReadDLMSPacket(data)
If IsEmpty(data) Then
ReadDLMSPacket = Empty
Exit Function
End If
Dim str, reply, Terminator
'With Network connection terminaltor is not used.
Terminator = Empty 'CByte(&H7E)

If Not Net1.SendSync(data, 0, Empty, Terminator, 5, WaitTime * 1000, True, GX_VT_ARRAY Or GX_VT_BYTE, reply) Then
Net1.SendSyncComplete = True
Net1.WaitMoreReplyData Terminator, 1, 1000, True, GX_VT_ARRAY Or GX_VT_BYTE, reply
str = "Failed to receive reply from the device in given time."
WriteLog str, reply
err.Raise -1, , str
End If
'Loop until whole Cosem1 packet is received.
While Not Cosem1.IsDLMSPacketComplete(reply)
If Not Net1.WaitMoreReplyData(Terminator, 1, WaitTime * 1000, True, GX_VT_ARRAY Or GX_VT_BYTE, reply) Then
Net1.SendSyncComplete = True
str = "Failed to receive reply from the device in given time."
WriteLog str, reply
err.Raise -1, , str
End If
Wend
WriteLog "Reveived data", reply
Dim Errors
If Not Cosem1.CheckReplyErrors(data, reply, Errors) Then
err.Raise -1, , UBound(Errors)
End If
Net1.SendSyncComplete = True
ReadDLMSPacket = reply
End Function

Function ReadDataBlock(data)
Dim allData, reply
Dim maxProgress ' as Integer
WriteLog "", data
reply = ReadDLMSPacket(data)
Cosem1.GetDataFromPacket reply, allData
maxProgress = Cosem1.GetMaxProgressStatus(allData)
Dim tmp, moredata 'As GuruxDLMS2.GXDLMS_DATA_REQUEST_TYPES
moredata = Cosem1.IsMoreDataAvailable(reply)
While (moredata > 0)
While (moredata = 1 Or moredata = 3)
data = Cosem1.ReceiverReady(GXDLMS_DATA_REQUEST_TYPES_FRAME)
WriteLog "Get next frame: ", data
reply = ReadDLMSPacket(data)
Cosem1.GetDataFromPacket reply, allData
tmp = Cosem1.IsMoreDataAvailable(reply)
If tmp = 0 Or tmp = 2 Then
moredata = moredata And Not GXDLMS_DATA_REQUEST_TYPES_FRAME 'moredata &= ~RequestTypes.Frame
End If
Wend
If moredata = 2 Or moredata = 3 Then
'Send Receiver Ready.
data = Cosem1.ReceiverReady(GXDLMS_DATA_REQUEST_TYPES_BLOCK)
WriteLog "Get Next Data block: ", data
reply = ReadDLMSPacket(data)
Cosem1.GetDataFromPacket reply, allData
moredata = Cosem1.IsMoreDataAvailable(reply)
End If
Wend
ReadDataBlock = allData
End Function

Function InitializeNetworkConnection()
Net1.Connect
WriteLog "Initializing Network connection.", Empty
Dim it, data, reply ' As Object
data = Cosem1.SNRMRequest()
If IsEmpty(data) = False Then
WriteLog "Send SNRM request.", data
reply = ReadDLMSPacket(data)
WriteLog "Parsing UA reply.", data
'Has server accepted client.
Cosem1.ParseUAResponse reply
WriteLog "Parsing UA reply succeeded.", Empty
End If
'Generate AARQ request.
data = Cosem1.AARQRequest(Nothing)
WriteLog "Send AARQ request", data
'Split requests to multible packets if needed.
'If password is used all data might not fit to one packet.
Dim pos, len1, arr
arr = Cosem1.SplitDataToPackets(data)
len1 = UBound(arr) + 1
For Each it In arr
pos = pos + 1
data = Cosem1.Read(it, pos, len1, 0, 0)
reply = ReadDLMSPacket(data)
Next
WriteLog "Parsing AARE reply", reply
On Error Resume Next
err.Clear
'Parse reply.
Cosem1.ParseAAREResponse reply
If err.Number > 0 Then
ReadDLMSPacket Cosem1.DisconnectRequest
On Error GoTo 0
err.Raise err.Number, err.Description
End If
On Error GoTo 0
WriteLog "Parsing AARE reply succeeded.", Empty
End Function

Hi,

If you do not know your Electricity Meter DeviceID or ClientID (aka Primary and Secondary station ID), or if you do not know is your device supporting Logical Name or Short Name.

Ask in this forum all DLMS/COSEM questions, do not send email to us. We are drowning emails.

Best Regards,

Mikko