Ich bin gerade dabei ein App/runtime zu testen wo ich in Threads einmal die Verbindung über die dll halten und in weiteren Werte berechne usw. . Klappt mit den Abfragen gut . Bei zb. Verbindungsunterbrechung , meinem timeoutthread dauert es zulange oder wenn alle Items einen Fehler bringen , bau ich die OPC Verbindung ab und starte sie nach einer Zeit neu usw.. Nun ist mir beim testen aufgefallen das dabei meine Anwendung dabei Speichermäßig wächst . Hatte erst an irgendwelche Probleme mit den Thread´s gedacht aber als ich nach einigem herumprobieren nicht mehr weiterkam habe ich eines der Testprogramme genommen und lasse es verbinden , abfragen , neustarten usw. . Hier tritt das gleiche Problem auf wenn man dieses im taskmanager beobachtet . Bei meinen Tests kommt es mir so vor als wenn beim Neuverbinden und beim Abbau der speicher wächst .
; Compiler : Unicode
; *********************************************************************************************************
IncludeFile "PBOPC.pbi"
IncludeFile "PBOPC_Help.pbi"
IncludeFile "VariantHelper_Include.pb"
Global restart = 0
; *********************************************************************************************************
#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
; *********************************************************************************************************
Global Exit.l
Global y.l
Global Dim *items(6)
Procedure.s PeekUnicode(*text)
Protected result.s
If *text
result = PeekS(*text, #PB_Any, #PB_Unicode)
Else
result = ""
EndIf
ProcedureReturn result
EndProcedure
Procedure MyCallback(*szReason)
Debug "Shutdown erkannt: " + PeekUnicode(*szReason)
exit = 1
EndProcedure
Procedure test()
; OPC Server verbinden
Debug "OPC Server verbinden"
;*Server = OpcConnect("INAT TCPIPH1 OPC Server", "") ;MpiCom.OPC.Server
*Server = OpcConnect("MpiCom.OPC.Server", "") ;MpiCom.OPC.Server
Debug GetErrorString(*Server, OpcGetLastError())
If *Server = 0
ProcedureReturn 0
EndIf
Debug "Fertig OPC verbinden."
Delay(500)
Debug "Init Shutdown"
*Shutdown = OpcInitShutdown(*Server)
If *shutdown = 0
Debug GetErrorString(*Server, OpcGetLastError())
Else
Debug "Setze MyCallback"
OpcSetShutdownCallBack(*shutdown, @MyCallback())
EndIf
Debug "Fertig Init shutdown."
Delay(500)
; Gruppe anlegen
Debug "Gruppe anlegen"
*Group = OpcAddGroup(*Server, "Test")
Debug GetErrorString(*Server, OpcGetLastError())
If *Group = 0
ProcedureReturn 0
EndIf
Debug "Fertig Gruppe anlegen."
Delay(500)
; Items anlegen
Debug "Items anlegen"
prefix.s = "testverbindung."
*items(0) = OpcAddItem(*Group, "", prefix + "DB1.W8")
*items(1) = OpcAddItem(*Group, "", prefix + "mb4")
*items(2) = OpcAddItem(*Group, "", prefix + "db1.w0")
*items(3) = OpcAddItem(*Group, "", prefix + "db1.w2")
*items(4) = OpcAddItem(*Group, "", prefix + "db1.w4")
*items(5) = OpcAddItem(*Group, "", prefix + "db1.w6")
Debug "Fertig Items anlegen ."
Delay(500)
; wait for plc
Debug "PLC Verbinung püfen"
value1.l
quality.l
Repeat
r1 = OpcReadWord(*items(0), @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 Verbindung prüfen."
Delay(500)
; item lesen
While exit = 0
; r1 = OpcReadWord(*items(0), @value1, @quality)
If r1
Debug GetErrorString(*Server, r1)
Else
Debug "Item 1 gelesen: " + Str(value1) + " Qulity: " + GetQualityText(quality)
EndIf
Delay(200)
y = y + 1
If y = 5
exit = 1
EndIf
Wend
; Server beenden - Intern werden automatisch die Gruppen gelöscht (OpcRemoveGroup(...))
Debug "Beenden Server"
r1 = OpcReleaseShutdown(*shutdown)
r1 = OpcRelease(*Server)
Debug "Fertig beenden."
Delay(500)
EndProcedure
For x = 1 To 200
test()
exit = 0
y = 0
Next x