PureBasic Forums - English

Posted: **Sat May 16, 2009 2:32 pm**

Hi,

her now my first OPC interface DLL for writing OPC client software.
Is using internal the customer interface of OPC servers and syncron IO.
The DLL can automatic type adjustment for items and server shutdown callback.

Description PBOPCEN.HTML

DLL and Includes OpcPack.zip

Update v2.4
- Fixed: Memoryleak by remove items
- New: The ShutdownObject is a part of the ServerObject and it all shutdown functions the ServerObject is indicated now.
- New: OpcRelease (...) terminated now also automatically the ShutdownObject.

Simple example for Inat OPC Server (Germany)

Code: Select all

;- TOP

; Komment   : OPC Test 
; Version   : v2.2
; Erstellt  : 15.05.2009
; Geändert  : 
; Author    : Michael Kastner (mk-soft)

; Compiler  : Unicode

; *********************************************************************************************************

IncludeFile "PBOPC.pbi"
IncludeFile "PBOPC_Help.pbi"

; *********************************************************************************************************

#OPC_QUALITY_BAD = $00
#OPC_QUALITY_UNCERTAIN = $40
#OPC_QUALITY_GOOD = $C0
#OPC_QUALITY_CONFIG_ERROR = $04
#OPC_QUALITY_NOT_CONNECTED = $08
#OPC_QUALITY_DEVICE_FAILURE = $0c
#OPC_QUALITY_SENSOR_FAILURE = $10
#OPC_QUALITY_LAST_KNOWN = $14
#OPC_QUALITY_COMM_FAILURE = $18
#OPC_QUALITY_OUT_OF_SERVICE = $1C
#OPC_QUALITY_LAST_USABLE = $44
#OPC_QUALITY_SENSOR_CAL = $50
#OPC_QUALITY_EGU_EXCEEDED = $54
#OPC_QUALITY_SUB_NORMAL = $58
#OPC_QUALITY_LOCAL_OVERRIDE = $D8

; *********************************************************************************************************

Procedure test()
; OPC Server verbinden
  Debug "OPC Server verbinden"
  *Server = OpcConnect("INAT TCPIPH1 OPC Server", "")
  Debug GetErrorString(*Server, OpcGetLastError())
  If *Server = 0
    ProcedureReturn 0
  EndIf
  Debug "Fertig."
  ; Gruppe anlegen
  Debug "Gruppe anlegen"
  *Group = OpcAddGroup(*Server, "Test")
  Debug GetErrorString(*Server, OpcGetLastError())
  If *Group = 0
    ProcedureReturn 0
  EndIf
  ; Items anlegen
  Debug "Items anlegen"
  *item1 = OpcAddItem(*Group, "", "Labor.mw80")
  *item2 = OpcAddItem(*Group, "", "Labor.mreal82")
  *item3 = OpcAddItem(*Group, "", "Labor.mstring90.20")
  *item4 = OpcAddItem(*Group, "", "Labor.mx86,1")
  Debug "Fertig."
  
  ; wait for plc
  Debug "PLC Verbinung püfen"
  value1.l
  quality.l
  Repeat
    r1 = OpcReadWord(*item1, @value1, @quality)
    If r1
      Debug GetErrorString(*Server, r1)
      OpcRelease(*server)
      End
    EndIf
    If quality = #OPC_QUALITY_GOOD
      Break
    Else
      count + 1
      If count > 10
        OpcRelease(*Server)
        Debug "PLC Offline"
        End
      EndIf
    EndIf
  ForEver
  Debug "Fertig."
  ; Items schreiben
  r1 = OpcWriteWord(*item1, 100)
  If r1
    Debug GetErrorString(*Server, r1)
  Else
    Debug "Item 1 geschieben. Variant Type: " + Str(OpcGetItemDataType(*item1))
  EndIf  
  set2.f = 11.5
  r1 = OpcWriteFloat(*item2, set2)
  If r1
    Debug GetErrorString(*Server, r1)
  Else
    Debug "Item 2 geschieben. Variant Type: " + Str(OpcGetItemDataType(*item2))
  EndIf
  r1 = OpcWriteString(*item3, "Hallo Welt")
  If r1
    Debug GetErrorString(*Server, r1)
  Else
    Debug "Item 3 geschieben. Variant Type: " + Str(OpcGetItemDataType(*item3))
  EndIf
  Delay(1000)  
  r1 = OpcWriteBool(*item4, #True)
  If r1
    Debug GetErrorString(*Server, r1)
  Else
    Debug "Item 4 geschieben. Variant Type: " + Str(OpcGetItemDataType(*item4))
  EndIf
  Delay(1000)  
  ; item lesen
  value1.l
  quality.l
  r1 = OpcReadWord(*item1, @value1, @quality)
  If r1
    Debug GetErrorString(*Server, r1)
  Else
    Debug "Item 1 gelesen: " + Str(value1) + " Qulity: " + GetQualityText(quality)
  EndIf
  
  value2.f
  r1 = OpcReadFloat(*item2, @value2, @quality)
  If r1
    Debug GetErrorString(*Server, r1)
  Else
    Debug "Item 2 gelesen: " + StrF(value2) + " Qulity: " + GetQualityText(quality)
  EndIf
  
  text.s = Space(100) ; Nur in Unicode
  r1 = OpcReadString(*item3, @text, 100, @quality)
  If r1
    Debug GetErrorString(*Server, r1)
  Else
    Debug "Item 3 gelesen: " + text + " Qulity: " + GetQualityText(quality)
  EndIf
  
  value4.l = 0
  r1 = OpcReadBool(*item4, @value4, @quality)
  If r1
    Debug GetErrorString(*Server, r1)
  Else
    Debug "Item 4 gelesen: " + Str(value4) + " Qulity: " + GetQualityText(quality)
  EndIf
  
  ; Server beenden - Intern werden automatisch die Gruppen gelöscht (OpcRemoveGroup(...))
  Debug "Beenden Server"
  hResult = OpcRelease(*Server)
  Debug "Fertig"
  
EndProcedure

test()

Germany Forum Link http://www.purebasic.fr/german/viewtopic.php?t=20003

Greate Time

P.S. Update
- Added Read and write boolean

Posted: **Sun May 17, 2009 4:26 pm**

Update v2.22

Added
- OpcReadItems
- OpcWriteItems
- VariantHelper_Include v2.08

Several Items to read at one time or write this than block goes being transferred faster there.
The Items must be however in the same group

GT

Posted: **Mon May 18, 2009 9:06 pm**

Update v2.23

Bugfixed
- OpcWriteItems (...) - memory leakage and IMA
- VariantHelper_Include.pb - macros SafeArray

Added
- DateTime correction INAT OPC server VT_DATE <> VT_BSTR

Info:
With the functions OpcReadVariant (...) and OpcWriteVariant (...) are accomplished no type adjustment.
All Variant variable with Safearray is accomplished also no type adjustment.

FF

Posted: **Sun Jun 07, 2009 2:17 pm**

Update v2.26

Added:
- VB2005 Example

Bugfix:
- Add Item

Thanks to Chris for ABB test project.
Thanks to ABB support for help and C++ Example

GT

Posted: **Wed Dec 02, 2009 6:47 pm**

Update v2.27

Fixed:
- Remove Items from internal list by OpcRemoveGroup(...) and OpcRelease(...)

Update v2.30

Bugfix:
- Memory leak by OpcRemoveGroup(...) and OpcRelease(...)

GT

Posted: **Fri Dec 04, 2009 5:01 am**

thanks this could be very useful.

Posted: **Tue May 25, 2010 9:39 pm**

Update v2.4

- Fixed: Memoryleak by remove items
- New: The ShutdownObject is a part of the ServerObject and it all shutdown functions the ServerObject is indicated now.
- New: OpcRelease (...) terminated now also automatically the ShutdownObject.

GT

Posted: **Wed Jul 06, 2016 8:58 pm**

Hi,

I'm testing an OPC server and the library works properly until I leave my application.
Once I leave my application, I can not re-connect to the OPC server without rebooting the OPC server.
In the DLL, I do not find the function "OPCdisconnect"
Could that be?

Thanks in advanced.

My test code is:

Code: Select all

Procedure test()
; OPC Server verbinden
  Debug "OPC Server verbinden"
  *Server = OpcConnect("Ecava.IntegraXor.tank", "")
  Debug GetErrorString(*Server, OpcGetLastError())
  If *Server = 0
    ProcedureReturn 0
  Else
     Debug OpcRelease(*Server)
  EndIf
EndProcedure

Posted: **Thu Jul 07, 2016 6:56 am**

Hi,

OpcRelease disconnect from server. Please check the result to #S_Ok (0).

P.S. Next weekend I publish the source code

Posted: **Thu Jul 07, 2016 7:26 am**

This is the debut output:

OPC Server verbinden
[00000000] La operación se completó correctamente.
0

Thanks

Posted: **Fri Jul 22, 2016 1:21 pm**

Any news, mk-soft?
Thanks

Posted: **Fri Jul 22, 2016 7:53 pm**

I thought it was all sorted

If result of "OpcDisconnect(*Server)" = 0 then it´s all ok

News: Link http://www.purebasic.fr/english/viewtop ... 12&t=66106

Posted: **Sun Jul 24, 2016 12:41 pm**

thanks a lot!

PureBasic Forums - English

Simple OPC interface as DLL for PB

Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB

Re: Simple OPC interface as DLL for PB