Um mit OPC einfacher arbeiten zu können habe ich nun die erste DLL am laufen. Als LIB kann ich diese leider nicht liefern da Tailbite den Code mit der komplexen DCOM Schnitstelle (OPC Costumer Interface) nicht erfolgreich kompilieren kann.
Kurzbeschreibung PBOPC.HTML
DLL und Includes Pack OpcPack.zip
Update v2.4
- Fixed: Speicherleck bei Items löschen.
- Neu: Das ShutdownObject ist jetzt ein Teil des ServerObject und es wird allen Shutdown-Funktionen das ServerObject angegeben.
- Neu: OpcRelease(...) beendet jetzt auch automatisch das ShutdownObject.
Beispiel mit Inat OPC Server
Code: Alles auswählen
;- 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()
P.S. Beispiel überarbeitet
