Below is a sample that you can use. It is not perfect, but you get all necessary from this. Main is main function. Before you start, you must change all TODOs.
Those values depend on what manufacturers meter you are using.
Note! This is not a perfect sample. :-) Please, ask if you have anything.
BR,
Mikko
Option Explicit
Dim Cosem1 As GuruxDLMS2.CGXCOSEM
Dim serial1 As GXSerial
Dim WaitTime
'If we are using infrared eye we must send Keep alive message or reopen connection after 40 second.
Dim ConnectionStartTime
Sub WriteLog(str, data)
End Sub
Sub main()
WaitTime = 5 '5 second.
'Create Serial component
Set serial1 = CreateObject("GuruxSerial.GXSerial")
'Create DLMS/COSEM component
Set Cosem1 = CreateObject("GuruxDLMS2.GXCOSEM")
Function ReadDLMSPacket(data)
If data Is Null Then
ReadDLMSPacket = Null
Exit Function
End If
Dim str, reply, Terminator
Terminator = CByte(&H7E)
If Not serial1.SendSync(data, Gurux.Common.VariantType.None, Terminator, 5, WaitTime * 1000, False, Gurux.Common.VariantType.Array Or Gurux.Common.VariantType.UInt8, reply) Then
serial1.SendSyncComplete = True
serial1.WaitMoreReplyData Terminator, 1, 1000, True, Gurux.Common.VariantType.Array Or Gurux.Common.VariantType.UInt8, reply
str = "Failed to receive reply from the device in given time."
WriteLog str, reply
err.Raise -1, , str
End If
'Loop until whole m_Cosem packet is received.
While Not m_Cosem.IsDLMSPacketComplete(reply)
If Not serial1.WaitMoreReplyData(Terminator, 1, WaitTime * 1000, True, Gurux.Common.VariantType.Array Or Gurux.Common.VariantType.UInt8, reply) Then
serial1.SendSyncComplete = True
Dim str
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 m_Cosem.CheckReplyErrors(data, reply, Errors) Then
err.Raise -1, , UBound(Errors)
End If
serial1.SendSyncComplete = True
ReadDLMSPacket = reply
End Function
Function ReadDataBlock(data As Object)
'Reopen connection.
'With IskraEmecon using optical eye connection must reopen after 40 second.
'If connection is not reopened, device stops answering.
If DateDiff("s", Now, ConnectionStartTime) > 40 Then
ReadDLMSPacket Cosem1.DisconnectRequest()
InitializeConnection
ConnectionStartTime = Now
End If
Dim allData, reply As Object
Dim maxProgress ' as Integer
WriteLog Text, data
reply = ReadDLMSPacket(data)
m_Cosem.GetDataFromPacket reply, allData
maxProgress = m_Cosem.GetMaxProgressStatus(allData)
Dim moredata 'As GuruxDLMS2.GXDLMS_DATA_REQUEST_TYPES
moredata = m_Cosem.IsMoreDataAvailable(reply)
While (moredata > 0)
While ((moredata & GXDLMS_DATA_REQUEST_TYPES_FRAME) > 0)
data = m_Cosem.ReceiverReady(GXDLMS_DATA_REQUEST_TYPES_FRAME)
'WriteLog("Get next frame: ", (byte[])data);
reply = ReadDLMSPacket(data)
m_Cosem.GetDataFromPacket reply, allData
If (m_Cosem.IsMoreDataAvailable(reply) & GXDLMS_DATA_REQUEST_TYPES_FRAME) = 0 Then
moredata = moredata And Not GXDLMS_DATA_REQUEST_TYPES_FRAME 'moredata &= ~RequestTypes.Frame
End If
Wend
If DateDiff("s", Now, ConnectionStartTime) > 40 Then
Disconnect
InitializeConnection
ConnectionStartTime = Now
End If
If (moredata & GXDLMS_DATA_REQUEST_TYPES_BLOCK) > 0 Then
'Send Receiver Ready.
data = m_Cosem.ReceiverReady(GXDLMS_DATA_REQUEST_TYPES_BLOCK)
WriteLog "Get Next Data block: ", data
reply = ReadDLMSPacket(data)
m_Cosem.GetDataFromPacket reply, allData
moredata = m_Cosem.IsMoreDataAvailable(reply)
End If
Wend
ReadDataBlock = allData
End Function
Sub InitializeSerialConnection()
'WriteLog "Initializing serial connection.", Empty
InitializeIEC
ConnectionStartTime = Now
Dim it, data, reply ' As Object
data = Cosem1.SNRMRequest()
'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.");
'Generate AARQ request.
data = Cosem1.AARQRequest(Empty)
'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)
For Each it In arr
pos = pos + 1
data = Cosem1.Read(it, pos, len1, OBJECT_TYPE_NONE, 0)
reply = Cosem1.ReadDLMSPacket(it)
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 Sub
Sub InitializeIEC()
Dim reply
Dim Terminator
Terminator = CByte(&HA)
'Set Serial port properties for IEC
serial1.Port = "COM18" 'TODO: Change this.
serial1.bitrate = 300
serial1.DataBits = GX_7
serial1.Parity = GX_EVEN_PARITY
serial1.StopBits = GX_ONEBIT
serial1.Open
'Query device information.
Dim data
data = "/?!\r\n"
If Not serial1.SendSync(data, GX_VT_STR, Terminator, 0, WaitTime * 1000, False, GX_VT_STR, reply) Then
data = "Failed to receive reply from the device in given time."
err.Raise -1, , data
End If
If Left(reply, 1) > "/" Then
err.Raise -1, , "Invalid responce."
End If
Dim bitrate, baudrate, manufactureID
manufactureID = Mid(reply, 2, 3)
baudrate = Mid(reply, 5, 1)
Select Case baudrate
Case "0"
bitrate = 300
Case "1"
bitrate = 600
Case "2"
bitrate = 1200
Case "3"
bitrate = 2400
Case "4"
bitrate = 4800
Case "5"
bitrate = 9600
Case "6"
bitrate = 19200
Case Else
err.Raise -1, , "Unknown baud rate."
End Select
Debug.Print "Bitrate is : " & bitrate
Dim controlCharacter, ModeControlCharacter
'Send ACK
'Send Protocol control character
controlCharacter = CByte("2") '"2" HDLC protocol procedure (Mode E)
'Send Baudrate character
'Mode control character
ModeControlCharacter = CByte("2") '"2" //(HDLC protocol procedure) (Binary mode)
'Set mode E.
Dim arr(6)
arr(0) = CByte(&H6)
arr(1) = CByte(controlCharacter)
arr(2) = CByte(baudrate)
arr(3) = CByte(ModeControlCharacter)
arr(4) = CByte(13)
arr(5) = CByte(10)
WriteLog "Moving to mode E.", Empty
serial1.SendSync arr, GX_VT_NONE, Terminator, 0, 500, False, GX_VT_ARRAY Or GX_VT_BYTE, reply
serial1.bitrate = bitrate
serial1.DataBits = GX_8
serial1.Parity = 0 'GX_NONE_PARITY
serial1.StopBits = GX_ONEBIT
End Sub
In a perfect world every manufacturer have implemented addressing as it should be.
Unfortunately, there are manufacturers that are using 16 bits clients addresses. :-(
For this reason client address is object (variant) type. You can give any lenght address as you wish.
You should give both server and client addresses in VB example like this:
ClientID = CByte(&H10)
ServerID = CInt(&H3) or ServerID = CLng(1234)
If you are using VB 6 you do not need to use Gurux.Common.
What meter you are using (manufacturer and model)?
This sample reads first Association View and then finds Device ID using OBIS code and reads it.
Happy coding,
Mikko
'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
Private Function GetObjects(objMedia As GXSerial) As CDLMSObjectCollection
'
On Error GoTo GetObjects_Err
'
Dim data As Variant, reply As Variant, allData As Variant, maxProgress
As Long, objDLMSObjectCol As CDLMSObjectCollection
Dim dataAvailable As Integer
With objCosem
data = .GetObjects(GX_REGISTER_OBJECT_TYPE_ASSOCIATION_VIEW)
dear Sir,
i have download that gurux client application for vb.net but when i compiled that a window comes with u/ and all ,tell me how to download meter with this.because there is only option to exit by pressing any key
DLMS + Serial port connection using vb 6.0
Hi,
Below is a sample that you can use. It is not perfect, but you get all necessary from this. Main is main function. Before you start, you must change all TODOs.
Those values depend on what manufacturers meter you are using.
Note! This is not a perfect sample. :-) Please, ask if you have anything.
BR,
Mikko
Option Explicit
Dim Cosem1 As GuruxDLMS2.CGXCOSEM
Dim serial1 As GXSerial
Dim WaitTime
'If we are using infrared eye we must send Keep alive message or reopen connection after 40 second.
Dim ConnectionStartTime
Sub WriteLog(str, data)
End Sub
Sub main()
WaitTime = 5 '5 second.
'Create Serial component
Set serial1 = CreateObject("GuruxSerial.GXSerial")
'Create DLMS/COSEM component
Set Cosem1 = CreateObject("GuruxDLMS2.GXCOSEM")
'Set COSEM Properties
Cosem1.UseFromVBScript = True
Cosem1.Authentication = GXDLMS_AUTHENTICATION_NONE 'TODO: Change this.
Cosem1.UseLogicalNameReferencing = True 'TODO: Change this.
Cosem1.Password = "" ''TODO: Change this.
Cosem1.ClientID = &H21 ''TODO: Change this.
Cosem1.ServerID = &H3 'TODO: Change this.
InitializeSerialConnection
End Sub
Function ReadDLMSPacket(data)
If data Is Null Then
ReadDLMSPacket = Null
Exit Function
End If
Dim str, reply, Terminator
Terminator = CByte(&H7E)
If Not serial1.SendSync(data, Gurux.Common.VariantType.None, Terminator, 5, WaitTime * 1000, False, Gurux.Common.VariantType.Array Or Gurux.Common.VariantType.UInt8, reply) Then
serial1.SendSyncComplete = True
serial1.WaitMoreReplyData Terminator, 1, 1000, True, Gurux.Common.VariantType.Array Or Gurux.Common.VariantType.UInt8, reply
str = "Failed to receive reply from the device in given time."
WriteLog str, reply
err.Raise -1, , str
End If
'Loop until whole m_Cosem packet is received.
While Not m_Cosem.IsDLMSPacketComplete(reply)
If Not serial1.WaitMoreReplyData(Terminator, 1, WaitTime * 1000, True, Gurux.Common.VariantType.Array Or Gurux.Common.VariantType.UInt8, reply) Then
serial1.SendSyncComplete = True
Dim str
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 m_Cosem.CheckReplyErrors(data, reply, Errors) Then
err.Raise -1, , UBound(Errors)
End If
serial1.SendSyncComplete = True
ReadDLMSPacket = reply
End Function
Function ReadDataBlock(data As Object)
'Reopen connection.
'With IskraEmecon using optical eye connection must reopen after 40 second.
'If connection is not reopened, device stops answering.
If DateDiff("s", Now, ConnectionStartTime) > 40 Then
ReadDLMSPacket Cosem1.DisconnectRequest()
InitializeConnection
ConnectionStartTime = Now
End If
Dim allData, reply As Object
Dim maxProgress ' as Integer
WriteLog Text, data
reply = ReadDLMSPacket(data)
m_Cosem.GetDataFromPacket reply, allData
maxProgress = m_Cosem.GetMaxProgressStatus(allData)
Dim moredata 'As GuruxDLMS2.GXDLMS_DATA_REQUEST_TYPES
moredata = m_Cosem.IsMoreDataAvailable(reply)
While (moredata > 0)
While ((moredata & GXDLMS_DATA_REQUEST_TYPES_FRAME) > 0)
data = m_Cosem.ReceiverReady(GXDLMS_DATA_REQUEST_TYPES_FRAME)
'WriteLog("Get next frame: ", (byte[])data);
reply = ReadDLMSPacket(data)
m_Cosem.GetDataFromPacket reply, allData
If (m_Cosem.IsMoreDataAvailable(reply) & GXDLMS_DATA_REQUEST_TYPES_FRAME) = 0 Then
moredata = moredata And Not GXDLMS_DATA_REQUEST_TYPES_FRAME 'moredata &= ~RequestTypes.Frame
End If
Wend
If DateDiff("s", Now, ConnectionStartTime) > 40 Then
Disconnect
InitializeConnection
ConnectionStartTime = Now
End If
If (moredata & GXDLMS_DATA_REQUEST_TYPES_BLOCK) > 0 Then
'Send Receiver Ready.
data = m_Cosem.ReceiverReady(GXDLMS_DATA_REQUEST_TYPES_BLOCK)
WriteLog "Get Next Data block: ", data
reply = ReadDLMSPacket(data)
m_Cosem.GetDataFromPacket reply, allData
moredata = m_Cosem.IsMoreDataAvailable(reply)
End If
Wend
ReadDataBlock = allData
End Function
Sub InitializeSerialConnection()
'WriteLog "Initializing serial connection.", Empty
InitializeIEC
ConnectionStartTime = Now
Dim it, data, reply ' As Object
data = Cosem1.SNRMRequest()
'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.");
'Generate AARQ request.
data = Cosem1.AARQRequest(Empty)
'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)
For Each it In arr
pos = pos + 1
data = Cosem1.Read(it, pos, len1, OBJECT_TYPE_NONE, 0)
reply = Cosem1.ReadDLMSPacket(it)
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 Sub
Sub InitializeIEC()
Dim reply
Dim Terminator
Terminator = CByte(&HA)
'Set Serial port properties for IEC
serial1.Port = "COM18" 'TODO: Change this.
serial1.bitrate = 300
serial1.DataBits = GX_7
serial1.Parity = GX_EVEN_PARITY
serial1.StopBits = GX_ONEBIT
serial1.Open
'Query device information.
Dim data
data = "/?!\r\n"
If Not serial1.SendSync(data, GX_VT_STR, Terminator, 0, WaitTime * 1000, False, GX_VT_STR, reply) Then
data = "Failed to receive reply from the device in given time."
err.Raise -1, , data
End If
If Left(reply, 1) > "/" Then
err.Raise -1, , "Invalid responce."
End If
Dim bitrate, baudrate, manufactureID
manufactureID = Mid(reply, 2, 3)
baudrate = Mid(reply, 5, 1)
Select Case baudrate
Case "0"
bitrate = 300
Case "1"
bitrate = 600
Case "2"
bitrate = 1200
Case "3"
bitrate = 2400
Case "4"
bitrate = 4800
Case "5"
bitrate = 9600
Case "6"
bitrate = 19200
Case Else
err.Raise -1, , "Unknown baud rate."
End Select
Debug.Print "Bitrate is : " & bitrate
Dim controlCharacter, ModeControlCharacter
'Send ACK
'Send Protocol control character
controlCharacter = CByte("2") '"2" HDLC protocol procedure (Mode E)
'Send Baudrate character
'Mode control character
ModeControlCharacter = CByte("2") '"2" //(HDLC protocol procedure) (Binary mode)
'Set mode E.
Dim arr(6)
arr(0) = CByte(&H6)
arr(1) = CByte(controlCharacter)
arr(2) = CByte(baudrate)
arr(3) = CByte(ModeControlCharacter)
arr(4) = CByte(13)
arr(5) = CByte(10)
WriteLog "Moving to mode E.", Empty
serial1.SendSync arr, GX_VT_NONE, Terminator, 0, 500, False, GX_VT_ARRAY Or GX_VT_BYTE, reply
serial1.bitrate = bitrate
serial1.DataBits = GX_8
serial1.Parity = 0 'GX_NONE_PARITY
serial1.StopBits = GX_ONEBIT
End Sub
how to specify addressing mode
Hi mikko,
Thank you for the posted code.
Presently we are not using Mode E Of IEC 62056-21.Our server (Meter) is
implemented with Direct DLMS.
Following are the things i observed
1.In the SNRM Request there are 2 bytes generated for Client ID Which should be one byte according to HDLC Procedure.
2.There is no option to specify the addressing mode of the server.
i.e 1 byte or 2 byte or 4 byte.
3.I am unable to get Gurux.Common in intellisense.
Eventhough i am getting GuruxCommon in intellisense i am unable to specify the
datatypes like UInt8.
Awaiting your reply.
Thanks in advance
Addressing
Hi,
In a perfect world every manufacturer have implemented addressing as it should be.
Unfortunately, there are manufacturers that are using 16 bits clients addresses. :-(
For this reason client address is object (variant) type. You can give any lenght address as you wish.
You should give both server and client addresses in VB example like this:
ClientID = CByte(&H10)
ServerID = CInt(&H3) or ServerID = CLng(1234)
If you are using VB 6 you do not need to use Gurux.Common.
Happy coding,
Mikko
Addressing
Hi kurumi,
Thank you for the response.
I am able to see the proper lengths of bytes in SNRM Now.
But i think there is a need for implementing extended addressing mechanism as per HDLC Procedure.
Whatever i specify as address bytes,it is encoded as it is in Address fields of SNRM Frame.
Suppose the actual client address is say &H20 and as per HDLC procedure it is to be converted to &H41 Before sending SNRM Request.
Hope it is clear to you.
Thanks in advance.
Awaiting your reply.
HDLC Addressing
Hi,
I agree with you. In fact in our first releases we worked like this.
Sifted Server address by 1 and set LSB to 1.
Unfortunately, there are DLMS electricity meters that violate HDLC calulating. :-(
For this reson, application must done this simple calculation.
BR,
Mikko
error vb6.0
Hi
when i using this source to vb6.0 i get this error:
Dim Cosem1 As GuruxDLMS2.CGXCOSEM
user-defined typenof defined
please help me.
error vb6.0
Hi,
You must add refecence to GuruxDLMS.dll.
If I remember right, from the project menu select References.
Select GuruxDLMS component from the list.
BR,
Mikko
Unable to browse attributes
Hi,
Thanks to your valuable suggestions,i am able to download object list from my VB6 application.
But now when i am trying to access the attributes through
the "Attributes" property of the object,it is always showing count as zero.
Please guide me in this regard.
ps:I Tried communication with sample c# code but ParseAAREResponse method is getting
failed.It is crashing at that method call.
Thanks in advance..
Re: Unable to browse attributes
Hi,
What meter you are using (manufacturer and model)?
This sample reads first Association View and then finds Device ID using OBIS code and reads it.
Happy coding,
Mikko
'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
Re:Re:Unable to browse attributes
Dear Mikko,
I am posting my code to read objects.Please suggest any changes required.
'//----------------------------------------------------------------------------------
Private Function GetObjects(objMedia As GXSerial) As CDLMSObjectCollection
'
On Error GoTo GetObjects_Err
'
Dim data As Variant, reply As Variant, allData As Variant, maxProgress
As Long, objDLMSObjectCol As CDLMSObjectCollection
Dim dataAvailable As Integer
With objCosem
data = .GetObjects(GX_REGISTER_OBJECT_TYPE_ASSOCIATION_VIEW)
reply = ReadDLMSPacket(objMedia, data, waitTime)
.GetDataFromPacket reply, allData
maxProgress = .GetMaxProgressStatus(allData)
dataAvailable = .IsMoreDataAvailable(reply)
While (dataAvailable)
data = .ReceiverReady(GXDLMS_DATA_REQUEST_TYPES_BLOCK)
reply = ReadDLMSPacket(objMedia, data, waitTime)
.GetDataFromPacket reply, allData
dataAvailable = .IsMoreDataAvailable(reply)
Wend
Set objDLMSObjectCol = .ParseObjects(allData, OBJECT_TYPE_ASSOCIATION_LN)
End With
Set GetObjects = objDLMSObjectCol
'
Exit Function
GetObjects_Err:
logError Err.Number, Err.Description, "Project1.clsCosemClient.GetObjects", Erl
'
End Function
'//--------------------------------------------------------------------------------
Thanks in advance.
VB
Hi,
Have I understand right that you can read objects, but you are not able to read objects data?
So everything works so far:
Set objDLMSObjectCol = .ParseObjects(allData, OBJECT_TYPE_ASSOCIATION_LN)
Have I understand right?
Could you download GXDLMSDirector and try to read Association View with it.
If you succeeded, please, send the log file to me.
What device you are using (Model and Manufacturer)?
BR,
Mikko
DLMS Reader in VB6
Hi there, do you have any vb6 program that can read dlms meters like SL7000 or ACE6000
DLMS Reader in VB6
Hi,
We have not used VB 6 for a long time. We had OCX component made with ATL,
but that is not updated for a long time.
Is it possible that you move to VB.Net?
BR,
Mikko
Dear Sir,
Dear Sir,
I am trying this vb code but unable to load references ,error comes cant add a reference to specified file
dear sir,
dear sir,
do u have any vb.net code to download normal dlms meter
Dear Sachin Sharma,
Dear Sachin Sharma,
Please, if you have a new question create a new topic. There is VN.Net client available at
https://github.com/Gurux/Gurux.DLMS.Net/tree/master/Gurux.DLMS.Client.E…
BR,
Mikko
dear Sir,
dear Sir,
i have download that gurux client application for vb.net but when i compiled that a window comes with u/ and all ,tell me how to download meter with this.because there is only option to exit by pressing any key
Dear Sachin Sharma,
Dear Sachin Sharma,
Settings depend from the meter that you try to read. I propose that you download GXDLMSDirector and try to read your meter with that first.
BR,
Mikko