не подскажите почему может отваливаться ADAM... функции ADAMTCP_ReadCoil возвращают -6 а потом и ADAMTCP_Connect начинает возвращать -4?.. останавливаешь программу, запускаешь - опять работает какое-то время...
причём большинство прмеров, которые идут вместе с дровами не работают впринципе... поэтому я извратился так:
поток который работает с адамами:
unit uadammanager;
interface
uses
classes, windows,
uAdam, uObserver, ubaseobject, usensor;
Type
TSKUDADAMManager=class(TThread)
Private
m_Adams : TList;
Constructor Create(Suspended : boolean);
Public
class function instance () : TSKUDADAMManager;
Destructor Destroy();override;
Function Add(szName, szIP, wModNm, wdevID: string) : TSKUDADAM;
Procedure Insert(adam : TSKUDADAM);
Procedure AppendTo (szName : string; Sens : TSKUDBaseObject);
procedure Execute();override;
End;
implementation
{ TSKUDADAMManager }
Var
Inst : TSKUDADAMManager;
function TSKUDADAMManager.Add(szName, szIP, wModNm,
wdevID: string): TSKUDADAM;
begin
Result := Nil;
if m_Adams = nil then
Exit;
Result := TSKUDADAM.Create(szName, szIP, wModNM, wDevID);
m_Adams.Add(Result);
end;
procedure TSKUDADAMManager.AppendTo(szName: string; Sens: TSKUDBaseObject);
Var
I : integer;
begin
if m_Adams = nil then
Exit;
For I := 0 to m_Adams.Count-1 do begin
if TSKUDADAM(m_Adams.Items).GetName() = szName then begin
TSKUDADAM(m_Adams.Items).AddSensor(TSKUDBaseSensor(Sens));
End;
End;
end;
constructor TSKUDADAMManager.Create(Suspended : boolean);
begin
inherited Create(suspended);
m_Adams := TList.Create();
end;
destructor TSKUDADAMManager.Destroy;
begin
if m_Adams <> nil then
m_Adams.Free;
inherited;
end;
procedure TSKUDADAMManager.Execute;
Var
I : integer;
begin
inherited;
while true do begin
For i := 0 to m_Adams.Count-1 do begin
TSKUDADAM(m_Adams.Items).AlarmTest;
End;
sleep(100);
End;
end;
procedure TSKUDADAMManager.Insert(adam: TSKUDADAM);
begin
if m_Adams <> nil then
m_Adams.Add(Adam);
end;
class function TSKUDADAMManager.instance: TSKUDADAMManager;
begin
if inst = nil then
inst := TSKUDADAMManager.Create(true);
Result := inst;
end;
end.
-----------
Класс для адама
unit uADAM;
interface
uses
classes, sysutils, windows,
usensor, uController, ADAMTCP, uLogWriter, uAlarmManager;
const DEFAULT_PORT = 502; // Port for Modbus/TCP
Type
TSKUDADAM=class(TSKUDBaseController)
Private
m_wDeviceID : word;
m_wModuleName : word;
Function Reinit() : integer;
Function Communicate () : integer;
Public
Constructor Create(szName, szIP, wModNm, wdevID : string);
Destructor Destroy();override;
Function isAlarm () : boolean; override;
Procedure AlarmTest;
End;
implementation
{ TSKUDADAM }
var
iConnectionTimeout : Integer = 2000;
iSendTimeout : Integer = 2000;
iReceiveTimeout : Integer = 2000;
procedure TSKUDADAM.AlarmTest;
var
i,j : Integer;
iRetVal : Integer;
wDeviceID : WORD;
wStartAddress : WORD;
wCount : WORD;
byData : Array [0..127] of Byte;
alrmmng : TSKUDAlarmManager;
s : string;
begin
//--- try to create a connection to 5000/TCP ---
iRetVal := ADAMTCP_Connect(PChar(GetIp),DEFAULT_PORT,
iConnectionTimeout, iSendTimeout, iReceiveTimeout);
if iRetVal = -2 then begin
alrmmng := TSKUDAlarmManager.Instance();
s := 'Íå óäàëîñü ñâÿçàòüñÿ. Îøèáêà ' + IntToStr(iRetVal) +'.';
alrmmng.Print(GetName(), s);
ADAMTCP_OPEN();
Exit;
End;
if iRetVal = -4 then begin
alrmmng := TSKUDAlarmManager.Instance();
s := 'Íå óäàëîñü ñâÿçàòüñÿ. Îøèáêà ' + IntToStr(iRetVal) +'.';
alrmmng.Print(GetName(), s);
ADAMTCP_Close();
ADAMTCP_OPEN();
Exit;
End;
if ( iRetVal<0 ) then begin
alrmmng := TSKUDAlarmManager.Instance();
s := 'Íå óäàëîñü ñâÿçàòüñÿ. Îøèáêà ' + IntToStr(iRetVal) +'.';
alrmmng.Print(GetName(), s);
// ShowMessage('ADAMTCP_Connect() Failure!, Error Code:' + IntToStr(iRetVal) );
// ADAMTCP_Close();
Exit;
end;
//--- reading Coil ---
wDeviceID:=m_wDeviceID;
wStartAddress:=1;
wCount := m_Sensors.Count;
if ( (wCount<1) or (wCount>128) ) then begin
// ShowMessage('No. have to between 1 to 128');
alrmmng := TSKUDAlarmManager.Instance();
s := 'Îøèáêà íàñòðîéêè. Îøèáêà ' + IntToStr(wCount) +'.';
alrmmng.Print(GetName(), s);
ADAMTCP_Disconnect();
// ADAMTCP_Close();
Exit;
end;
for i := 0 to wCount - 1 do
byData := 255;
iRetVal := ADAMTCP_ReadCoil(PChar(getIP()), wDeviceID, wStartAddress, wCount, @byData);
if iRetVal = -4 then begin
alrmmng := TSKUDAlarmManager.Instance();
s := 'Íå óäàëîñü ïîëó÷èòü çíà÷åíèÿ. Îøèáêà ' + IntToStr(iRetVal) +'.';
alrmmng.Print(GetName(), s);
ADAMTCP_Disconnect();
ADAMTCP_Close();
ADAMTCP_OPEN();
Exit;
End;
if ( iRetVal <> 0 ) then begin
// ShowMessage('ADAMTCP_ReadCoil() Failure!, Error Code:' + IntToStr(iRetVal) );
alrmmng := TSKUDAlarmManager.Instance();
s := 'Íå óäàëîñü ïîëó÷èòü çíà÷åíèÿ. Îøèáêà ' + IntToStr(iRetVal) +'.';
alrmmng.Print(GetName(), s);
ADAMTCP_Disconnect();
// ADAMTCP_Close();
Exit;
end;
for i:=0 to wCount -1 do begin
if byData <> 1 then
TSKUDBaseSensor(m_Sensors.Items).SetAlarm(true)
else
TSKUDBaseSensor(m_Sensors.Items).SetAlarm(false);
end;
//--- disconnt connection to 5000/TCP ---
ADAMTCP_Disconnect();
end;
function TSKUDADAM.Communicate: integer;
begin
Result := ADAMTCP_Connect(PChar(GetIP()), DEFAULT_PORT,
1000, 1000, 1000);
end;
constructor TSKUDADAM.Create(szName, szIP, wModNm, wdevID: string);
begin
inherited create(szName, 'ADAM', szIP);
m_wDeviceID := StrToInt(wDevID);
m_wModuleName := StrToInt(wModNm);
ADAMTCP_Open();
ADAMTCP_GetDllVersion();
end;
destructor TSKUDADAM.Destroy;
begin
ADAMTCP_Close();
inherited;
end;
function TSKUDADAM.isAlarm: boolean;
Var
i, iRetVal, j : Integer;
byDI : Array [0..127] of Byte;
byDO : Array [0..15] of Byte;
s : string;
lwrt : TSKUDLOgWriter;
wCount : WORD;
begin
iRetVal := ADAMTCP_Connect(PChar(GetIP()),DEFAULT_PORT,
iConnectionTimeout, iSendTimeout, iReceiveTimeout);
if (iRetVal = -6) then begin
lwrt := TSKUDLogWriter.Instance();
lwrt.WriteEvent(Date, Time, 'Connection Problem', GetName(), 'Connect Failure (-6).');
Exit;
End;
if ( iRetVal<0 ) then begin
s := 'ADAMTCP_Connect() Failure!' + IntToStr(IRetVal);
MessageBox(0, pchar(s),
'Error', MB_OK or MB_ICONEXCLAMATION );
adamtcp_close();
sleep(100);
adamtcp_open();
Exit;
end;
wCount := m_Sensors.Count;
iRetVal := ADAMTCP_ReadCoil(PChar(GetIP()), m_wDeviceID, 1, wCount, @byDI);
if iRetVal = -6 then begin
lwrt := TSKUDLogWriter.Instance();
lwrt.WriteEvent(Date, Time, 'Reading Coil Problem', GetName(), 'ReadCoil Failure (-6).');
ADAMTCP_DISCONNECT();
Exit;
End;
if ( iRetVal <> 0 ) then begin
s := 'ADAMTCP_ReadCoil() Failure' + IntToStr(IRetVal);
MessageBox(0, pchar(s),
'Error', MB_OK or MB_ICONEXCLAMATION);
adamtcp_Disconnect();
sleep(100);
Exit;
End;
For I := 0 to wCount-1 do begin
if byDI <> 1 then begin
// s := IntToStr(bydi);
// MessageBox(0, Pchar(s), 'Sensor Signal', MB_OK);
result := True;
TSKUDBaseSensor(m_Sensors.Items).SetAlarm(True);
End
else
TSKUDBaseSensor(m_Sensors.Items).SetAlarm(False);
End;
ADAMTCP_DISCONNECT();
end;
Function TSKUDADAM.Reinit : integer;
begin
ADAMTCP_Disconnect();
sleep(100);
end;
end.
