TC3: Multiple Instance of FB_TcAlarm Issue - twincat

I am new to using the Tc3EventLogger functionality. I have created my EventClasses in the Type system. I have successfully created and raised single instances of different alarms based on an EventClass using CreateEx, IpArguments, Raise, etc.
Issue:
My issue is that I have multiple pieces of equipment that need to raise the same Alarm Type, but I differentiate them to the operator (HMI EventGrid) by supplying arguments.
My approach to this has been to create arrays of FB_TcAlarm and iterate through them in a loop to CreateEx, verify creation by HRESULT, modify arguments for each FB_TcAlarm instance in the array, and then later raise them individually when process conditions should trigger the alarm.
// Bank Global Pressure Limit Alarms
FOR nLoopCtr := 1 TO nNumBanks BY 1 DO
arrFbBankPressHresult[nLoopCtr] := arrFbBankPressAlm[nLoopCtr].CreateEx(TC_Events.BankPressureAlarm.Trigger, FALSE, 0);
END_FOR
However when I do this, only a single alarm instance is created (verified by one index having an HRESULT = S_OK), while the remaining FB_TcAlarm objects in the array have a HRESULT = 16#B7 which is "ERROR_ALREADY_EXISTS". Also, when I inspect the TcSourceInfo.nId of the created alarm instances in the array, they are all the same.
I have read through the Beckhoff manual TC3 Event Logger.
Any feedback on why this is happening or how my understanding of the EventClass or FB_TcAlarm is incorrect would be greatly appreciated.
Thank you.
Adam

Some time ago I did a workaround so that you can use the same TcEventEntry multiple times.
When creating the Alarm instances you have to make sure that the tcEventEntry.nEventId are unique!
You can set that property before creating the instance, just adding by 1 is sufficient.
Example:
// Set the event text from tmc file
tcEventEntry := TC_Events.TcGeneralAdsEventClass.AddHash;
// Set event id to 1
tcEventEntry.nEventId := 1;
// Create instance 1 of event text 'AddHash'
nResult := fbTcAlarm[1].CreateEx( tcEventEntry, TRUE, _ipSourceInfo )
// Set event id to 2
tcEventEntry.nEventId := 2;
// Create instance 2 of event text 'AddHash'
nResult := fbTcAlarm[2].CreateEx( tcEventEntry, TRUE, _ipSourceInfo )
In your case:
Declaration:
VAR
tcEventEntry := TC_Events.BankPressureAlarm.Trigger;
END_VAR
Code:
// Bank Global Pressure Limit Alarms
FOR nLoopCtr := 1 TO nNumBanks BY 1 DO
tcEventEntry.nEventId := nLoopCtr;
arrFbBankPressHresult[nLoopCtr] := arrFbBankPressAlm[nLoopCtr].CreateEx(tcEventEntry, FALSE, 0);
END_FOR
Now when you raise your events, you should see all of them individually in the TcHmiEventGrid

Your issue appears to be related to the use of the same TcEventEntry (Tc_Events.BankPressureAlarm.Trigger) in multiple alarm instances.
My understanding is that every Alarm, Message (any thing that extends TcEventBase) must be registered back to a an individual EventEntry. 'Create' appears to bundle this EventEntry generation as part of the method while 'CreateEx' puts this burden on you.
Failing code
Result2, Result3 return 16#B7.
AdsErr_TO_TcEventEntry( ErrCode, Event1 );
Result1 := Alarm1.CreateEx( Event1, FALSE, 0 );
Result2 := Alarm2.CreateEx( Event1, FALSE, 0 );
Result3 := Alarm3.CreateEx( Event1, FALSE, 0 );
Working code
All alarms return S_OK
AdsErr_TO_TcEventEntry( ErrCode, Event1 );
AdsErr_TO_TcEventEntry( ErrCode, Event2 );
AdsErr_TO_TcEventEntry( ErrCode, Event3 );
Result1 := Alarm1.CreateEx( Event1, FALSE, 0 );
Result2 := Alarm2.CreateEx( Event2, FALSE, 0 );
Result3 := Alarm3.CreateEx( Event3, FALSE, 0 );

Related

How to trigger a Function_Block

Hello to all TwinCAT developers,
I am currently developing function blocks with TwinCAT.
I'm trying to find a "standard" way to interact with the outside of the block.
The Beckhoff examples always have a bExec signal to start a state machine on the rising edge.
fbRisingEdge(CLK := bExec);
IF fbRisingEdge.Q THEN
nStep := 1;
END_IF
CASE nStep OF
1:
nStep := nStep + 1;
2:
nStep := nStep + 1;
END_CASE
I find that this principle is heavy to use and requires more code to create the rising edge:
fbFileOpen(sPathName := sPathName, bExecute := FALSE);
fbFileOpen(sPathName := sPathName, bExecute := TRUE);
Would anyone use another alternative to start a state-machine inside a FB?
Thank you, Happy new year!
I use a method defined inside my function block to trigger an action. I Also (sometimes) return a bool from the method which indicates weather the action can be performend or not, depending on the current state.
METHOD M_Open : BOOL
VAR_IN
sPath : STRING;
END_VAR
VAR_OUTPUT
bExecutionAllowed : BOOL;
END_VAR
bExecutionAllowed := _ ; // Calculate depending on the current state
sPathName := sPath;
IF bExecutionAllowed THEN
nStep := 1;
END_IF
Then call the method somewhere once
fbFileHandler.M_Open("Path/To/File");
And the fucntion block cyclically
fbFileHandler();
The function block can than handles multiple different actions which may be triggered each by their own method.

How to set a procedure (function) to an event in delphi 7?

I am writing which component will run through the array like ['form1.Button1', 'form1.memo1', 'form1'] - like
And put the showms2 handler on it (form1.Button1.onclick: = showms2)
var
comp: array of Tcomponent;
met: Tmethod;
start off
setlength (comp, Lines.Count);
for i: = 0 to Lines.Count-1 do
start off
comp [i]: = (FindComponent (Lines.Names [i]) as TControl);
met: = GetMethodProp (comp [i], 'OnClick');
meth.Code: = form1.MethodAddress ('showms2');
met.Data: = 0;
// When splitting into elements, nothing happens, is there an alternative?
FindComponent() does not work the way you are using it. You need to specify only the name of a component that is directly owned by the component being searched, you can't specify a chain of components, ie Form1.FindComponent('Form1.Button1') won't ever work, but Form1.FindComponent('Button1') will work, if Form1 owns Button1.
Also, if you are going to set both TMethod.Code and TMethod.Data then calling GetMethodProp() is completely redundant and should be removed.
Also, you need to use SetMethodProp() to actually assign the TMethod to the target event.
Try this instead:
var
comp: TComponent;
met: TMethod;
i: Integer;
begin
for i := 0 to Lines.Count-1 do
begin
comp := FindComponent(Lines.Names[i]);
if comp <> nil then
begin
if IsPublishedProp(comp, 'OnClick') then
begin
meth.Code := Form1.MethodAddress('showms2');
meth.Data := Form1;
SetMethodProp(comp, 'OnClick', met);
end;
end;
end;
end;

ReportEvent limits

I am trying to write a detailed error message to the system log using the ReportEventW function. Unfortunately, I am encountering problems which are apparently related to the limits within the function but I can't find any real documentation of them: there is a documented limit on dwDataSize and another limit on the maximum length of each string. I am not violating any of these limits, but I am still receiving a FALSE and GetLastError reports RPC_S_INVALID_BOUND.
Through testing, I found that for my test case the limit is caused by the number of strings (wNumStrings), with 203 being the most I can put through correctly (additionally, for 204-206 strings the ReportEventW will return a TRUE but will not write to the log!). If I add 1024 dummy characters to the first line, I once again get an error and have to decrease the number of lines, as far as I can tell, by the same number of characters I added earlier, which would indicate that some total character limit on the whole message is coming to play. Unfortunately, I can't match it against any documented limit even if I ignore what the limits should apply to - my value of about 33300 characters is close to the value 31839 characters (max. length of each string), but sufficiently higher than that to make me discard the theory that the limit on a length of individual string also applies to the total length of the whole message. Apparently, if I add extra raw data, the limit goes down again, which suggests a limitation on the size of the whole event log record.
My questions are:
1) Does anyone know the actual limits for writing to the event log?
2) Do these limits change with the different operating systems? All my tests were performed on Win10 x64, but I have a nasty suspicion that with different OSes, I will encounter a different limitation.
3) Is this documented somewhere?
Thanks.
Actual code (added on request)
procedure WriteToEventLog(const Messages: array of string; const RawData: AnsiString);
const
MaxStringCount = High(Word); // je to WORD! Realne se limit zda byt mnohem mensi
MaxRawDataLen = 61440;
EmptyMessage = #0#0#0#0;
type
TPCharArray = array[0..65535] of PChar;
var
Handle: THandle;
Msgs: ^TPCharArray;
MsgCount: integer;
DataPtr: PAnsiChar;
DataLen: integer;
i: Integer;
begin
MsgCount := Length(Messages);
if MsgCount > MaxStringCount then
MsgCount := MaxStringCount;
Msgs := AllocMem(MsgCount * Sizeof(PChar));
try
for i := 0 to Pred(MsgCount) do
begin
if Messages[i] = ''
then Msgs[i] := EmptyMessage
else Msgs[i] := PChar(Messages[i]);
end;
if RawData = '' then
begin
DataPtr := nil;
DataLen := 0;
end
else
begin
DataPtr := #RawData[1];
DataLen := Length(RawData);
if DataLen > MaxRawDataLen then
DataLen := MaxRawDataLen;
end;
Handle := RegisterEventSource(nil, PChar(ParamStr(0)));
if Handle <> 0 then
begin
try
ReportEvent(Handle, EVENTLOG_ERROR_TYPE, 0, 0, nil, MsgCount, DataLen, Msgs, DataPtr);
finally
DeregisterEventSource(Handle);
end;
end;
finally
FreeMem(Msgs);
end;
end;
It is called with Messages array containing rows from an EurekaLog report (one row per message, about 300 rows).
I can't answer your questions comprehensively, but I just ran into a similar issue. I only used the wNumStrings and lpStrings parameters and, contrary to documentation, still received the RPC_S_INVALID_BOUND error code (1734). On a nagging suspicion, I reduced the number of strings to 256 and it worked. Sure enough, it failed with 257. This was true regardless of the size of the individual strings. There are probably upper limits for individual strings and total message size too, but I didn't bother figuring those out.
TL/DR: wNumStrings <= 256

Delphi : Sleep without freeze and processmessages

I need a way to pause the execution of a function for some seconds. I know i can use the sleep method to do it, but this method 'freezes' the application while its execution. I also know i can use something like the code below to avoid freezing :
// sleeps for 5 seconds without freezing
for i := 1 to 5 do
begin
sleep(1000);
application.processmessages;
end;
There are two problems of this approach : one is the fact the freezing still occurs each one second and the second problem is the calling to 'application.processmessages' each second. My app is CPU intensive and each processmessages call do a lot of unnecessary work that uses unnecessary CPU power ; i just want to pause the workflow, nothing more.
What i really need would be a way to pause the execution just like a TTimer, in the example below :
// sleeps for 5 seconds
mytimer.interval := 5000;
mytimer.enabled := true;
// wait the timer executes
// then continue the flow
// running myfunction
myfunction;
The problem of this approach is 'myfunction' won't wait the for mytimer, it will run right after the mytimer is enabled.
Is there another approach to achieve a pause like i want ?
Thanks in advance.
As David stated, the best option is to move the work into a separate thread and stop blocking the main thread altogether. But, if you must block the main thread, then at the very least you should only call ProcessMessages() when there really are messages waiting to be processed, and let the thread sleep the rest of the time. You can use MsgWaitForMultipleObjects() to handle that, eg:
var
Start, Elapsed: DWORD;
// sleep for 5 seconds without freezing
Start := GetTickCount;
Elapsed := 0;
repeat
// (WAIT_OBJECT_0+nCount) is returned when a message is in the queue.
// WAIT_TIMEOUT is returned when the timeout elapses.
if MsgWaitForMultipleObjects(0, Pointer(nil)^, FALSE, 5000-Elapsed, QS_ALLINPUT) <> WAIT_OBJECT_0 then Break;
Application.ProcessMessages;
Elapsed := GetTickCount - Start;
until Elapsed >= 5000;
Alternatively:
var
Ret: DWORD;
WaitTime: TLargeInteger;
Timer: THandle;
// sleep for 5 seconds without freezing
Timer := CreateWaitableTimer(nil, TRUE, nil);
WaitTime := -50000000; // 5 seconds
SetWaitableTimer(Timer, WaitTime, 0, nil, nil, FALSE);
repeat
// (WAIT_OBJECT_0+0) is returned when the timer is signaled.
// (WAIT_OBJECT_0+1) is returned when a message is in the queue.
Ret := MsgWaitForMultipleObjects(1, Timer, FALSE, INFINITE, QS_ALLINPUT);
if Ret <> (WAIT_OBJECT_0+1) then Break;
Application.ProcessMessages;
until False;
if Ret <> WAIT_OBJECT_0 then
CancelWaitableTimer(Timer);
CloseHandle(Timer);
Move the task that needs to be paused into a separate thread so that it does not interfere with the UI.
It is rather doubtful, that Application.ProcessMessages will really consumpt too much processor time. You can try to store the moment of time when you start waiting and then begin a repeat Application.ProcessMessages until...; circle checking the time span between the stored and current time.
If you have not a problem with using a timer, you can do this:
(ouside the timer-event:)
mytimer.interval := 5000;
mytimer.tag:=0;
mytimer.enabled := true;
(inside the timer-event:)
mytimer.tag:=mytimer.tag+1;
if mytimer.tag=2 then begin
mytimer.enabled:=false;
myfunction;
end;

Preventing WM_DEVICECHANGE from dispatching

I'm developing a Windows 7 application which has to prevent WinDVD from triggering new disc availability when inserted (i.e. inserting a DVD).
Background information:
I'm working out this little application for a company which has to compare two movie players at a time playing simultaneously the same DVD, from different drives.
They're doing heuristic quality testing to determine best DVD player at the moment to bundle it into their new line of PCs.
At the moment their best choice seem to be WinDVD, so every other test has to be conducted against it. Problem is, when they insert first DVD, it's all right the default player WinDVD starts.
Then when they insert the second disc, the default player responds first, so they are forced to close the window and open the other player they're testing.
This is done for many movies that represent a reference to them to spot color rendering and image quality. It becomes tedious for users to close the additional window when it shows up, as this operation is due to be repeated hundreds of times a week.
My program is trying to inhibit default player' second response
I thought to intercept a WM_DEVICECHANGE message to somehow create a global hook for it.
Problem is, intercepting WM_DEVICECHANGE works very well, but it doesn't block WinDVD's ability to trigger new units insertion, evidently letting the message being delivered anyways. Due to this I started thinking how to prevent that message being dispatched after my interception.
In order to realize this global hook I thought of, I'm using this line of code:
CurrentHook:=setwindowshookex(WH_CALLWNDPROC,HookProcAdd,LibHandle,0);
linked to the callback contained within a DLL of mine and I can see that WM_DEVICECHANGE is correctly intercepted, but as I said the message is still dispatched to the whole system.
Any suggestion appreciated.
Updates:
#TOndrej :
I've tried what follows:
var
rlen : DWORD;
pRelen : ^DWORD;
h : THandle;
val : Boolean;
pVal: ^Boolean;
res : Boolean;
begin
rlen := 0;
val := True;
pVal := #val;
pRelen := #val;
h := CreateFile(PChar('\\.\d:'), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
OPEN_EXISTING, 0, 0);
if h <> INVALID_HANDLE_VALUE then
begin
res:= DeviceIoControl(h,
IOCTL_STORAGE_MCN_CONTROL,
pVal,
SizeOf(val),
nil,
0,
rlen,
nil);
if not res then
begin
ShowMessage('Error');
end;
CloseHandle(h);
end;
end;
but res is false every time. What am I missing?
For IOCTL_STORAGE_MCN_CONTROL control code, files must be opened with the FILE_READ_ATTRIBUTES access right:
var
rlen: DWORD;
pVal: PBOOL;
res: BOOL;
begin
rlen := 0;
GetMem(PVal,SizeOf(BOOL));
pVal^ := TRUE;
h := CreateFile(PChar('\\.\D:'),
FILE_READ_ATTRIBUTES,
FILE_SHARE_READ OR FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
if h <> INVALID_HANDLE_VALUE then
begin
res:= DeviceIoControl(h,
IOCTL_STORAGE_MCN_CONTROL,
pVal,
SizeOf(BOOL),
nil,
0,
rlen,
nil);
if not res then
begin
ShowMessage('Error');
end else
begin
ShowMessage('Device Notification Disabled');
end;
// close file handle
CloseHandle(h);
// After CloseHandle, file notification is restored...
end;
end;
In my test, after CloseHandle, device notification is restored...
The correct, official, and documented way to handle this is to suppress AutoRun programmably. If your app is not in the foreground to receive the "QueryCancelAutoPlay" message, your global hook should be able to respond to the message without dispatching it.
Why not just disable the CD autorun capability by setting the registry key HKLM\System\CurrentControlSet\Services\CDRom and set the key Autorun to 0 instead of 1?
The customer must launch each application separately, or maybe choose an "open with..." option, but that should be perfectly suitable for benchmark testing. By your description they are testing runtime performance and playback quality, not autorun capability.

Resources