DECLARE EXTERNAL FUNCTION EVPUTEVENT
DOUBLE PRECISION,
CSTRING(254),
CSTRING(2000),
CSTRING(2000),
DOUBLE PRECISION,
INTEGER
RETURNS INTEGER BY VALUE
ENTRY_POINT 'fn_putevent' MODULE_NAME 'logfilefunc'
CREATE PROCEDURE PUTEVENT (
NTYPE NUMERIC(11,0),
SCONTEXT VARCHAR(254),
SPARAMS VARCHAR(2000),
SDESCR VARCHAR(2000),
NOBJECT NUMERIC(15,0))
AS
DECLARE VARIABLE NRESULT INTEGER;
BEGIN
nResult = EVPutEvent(nType,sContext,sParams,sDescr,nObject,CURRENT_CONNECTION);
END;
-------------------------------------------------------------
function fn_putevent(nType: PNumeric; sConext: PChar; sParams: PChar; sDescr: PChar; nObject: PNumeric; pUserConnection: PInteger): Integer;
var Variables: TVariables;
begin
Result := 0;
Variables := EventService.TempVariables[pUserConnection^];
try
Variables.Logon;
except
Result := -1;
Exit;
end;
Variables.Transaction.StartTransaction;
try
Variables.PutEvent(DoubleToInt64(nType^), string(sConext),
string(sParams),string(sDescr),DoubleToInt64(nObject^));
except
Result := -900;
end;
Variables.Transaction.Commit;
end;
TVariables = class
public
bStartSession : boolean;
nSession: Int64;
dtLogonTime: TDateTime;
sUserHost: string;
recError: TRecError;
recLocalError: TRecError;
recFatalError: TRecError;
bRaiseError: boolean;
bWaitingError: boolean;
nErrorDepth: integer;
nBlockDepth: integer;
arrError: TArrError;
nMinCategory: integer;
bLogOpen: boolean;
bInternalEvent: boolean;
bOutOfCapacity: boolean;
nEventCapacity: integer;
nEventCount: integer;
nEventLog: Int64;
nLogType: Int64;
nLogMask: integer;
sLogLabel: string;
sLogDescr: string;
sQuestion: string;
sChoice: string;
nBeginID: Int64;
dtBeginTime: TDateTime;
nReadLog: Int64;
recEvent: TRecEvent;
nEventCategory: integer;
nEventRegister: integer;
nTraceEnters: Int64;
nUserEnters: Int64;
nMinTraceDepth: integer;
nMinUserDepth: integer;
nWriteCount: integer;
arrLocalEvent: TArrEvent;
nLongCount: integer;
arrLongEvent: TArrEvent;
UserConnection: integer;
sUser: string;
FTransaction: TJvUIBTransaction;
FQuery: TJvUIBQuery;
constructor Create(ACurrentConnection: integer);
destructor Destroy; override;
property Transaction: TJvUIBTransaction read FTransaction;
property Query: TJvUIBQuery read FQuery;
procedure StartLog(
nType: Int64;
niMinCategory: Integer;
sLabel: string;
sDescription: string;
bInternalLog: boolean;
nObject: Int64
);
procedure ClearLog;
procedure EndLog;
procedure PutEvent(
nType: Int64;
sContext: string;
sParams: string;
sDescr: string;
nObject: Int64
);
procedure PutError(
sContext: string;
nType: Int64;
sParams: string;
sDescr: string;
bRaise: boolean;
nObject: Int64
);
procedure InitSession;
procedure StartSession;
procedure RegisterEvent(sParams: string; bError: boolean);
procedure RegisterError(sDescr: string);
procedure SetLastError;
procedure Logon;
procedure Logoff;
end;
procedure TVariables.PutEvent(
nType: Int64;
sContext: string;
sParams: string;
sDescr: string;
nObject: Int64
);
begin
recEvent.nEventType := nType;
recEvent.sEventInfo := sContext;
recEvent.sDescription := sDescr;
recEvent.nObject := nObject;
try
RegisterEvent(sParams,false);
except
end;
end;
procedure TVariables.RegisterEvent(sParams: string; bError: boolean);
var nOrgType: Integer;
nBeginType: Int64;
sMessageText: string;
nParamCount: integer;
nTypeStatus: integer;
nTraceBlock: integer;
nUserBlock: integer;
nPos: integer;
nNewPos: integer;
nLocEventStatus: integer;
nIndex: integer;
nNextIndex: integer;
nOwner: integer;
bInLog: boolean;
i: integer;
sParams2: string;
sParamName: string;
Hour, Minute, Second, Msec: word;
begin
begin
if nSession <=0 then
InitSession;
begin
if not Transaction.InTransaction then Transaction.StartTransaction;
Query.Close;
Query.SQL.Text := 'SELECT Category, OrgType, BeginType, MessageText, ParamCount,'#13#10 +
' Status, TraceBlock, UserBlock, RegisterMode'#13#10 +
'FROM EventType'#13#10 +
'WHERE TypeID = :nEventType';
try
Query.Prepare;
Query.Params.ByNameAsInt64['NEVENTTYPE'] := recEvent.nEventType;
Query.Open;
nEventCategory := VarToInt(Query.Fields.ByNameAsVariant['CATEGORY']);
nOrgType := VarToInt(Query.Fields.ByNameAsVariant['ORGTYPE']);
nBeginType := VarToInt64(Query.Fields.ByNameAsVariant['BEGINTYPE']);
sMessageText := VarToStr(Query.Fields.ByNameAsVariant['MESSAGETEXT']);
nParamCount := VarToInt(Query.Fields.ByNameAsVariant['PARAMCOUNT']);
nTypeStatus := VarToInt(Query.Fields.ByNameAsVariant['STATUS']);
nTraceBlock := VarToInt(Query.Fields.ByNameAsVariant['TRACEBLOCK']);
nUserBlock := VarToInt(Query.Fields.ByNameAsVariant['USERBLOCK']);
nEventRegister := VarToInt(Query.Fields.ByNameAsVariant['REGISTERMODE']);
except
nParamCount := 0;
nBeginType := 0;
if bError then
begin
if Copy(sParams,1,3) = '~\~' then
recEvent.sLabel := Copy('Âíóòðåííÿÿ îøèáêà êîä {' + IntToStr(recEvent.nEventType) +
AnsiReplaceStr(AnsiReplaceStr(sParams,'~\~','},{'),'\\','\') + '}',1,254)
else if sParams <> '' then
recEvent.sLabel := Copy('Âíóòðåííÿÿ îøèáêà êîä {' + IntToStr(recEvent.nEventType) +
'},{' + sParams + '}',1,254)
else
recEvent.sLabel := 'Âíóòðåííÿÿ îøèáêà êîä {' + IntToStr(recEvent.nEventType) + '}';
recEvent.nEventType := 99999;
nEventCategory := 8;
nOrgType := 0;
nTypeStatus := 3;
nTraceBlock := 0;
nUserBlock := 0;
nEventRegister := 1 + 2;
end
else
begin
nEventRegister := 0;
Query.Close;
Exit;
end;
end;
Query.Close;
if Copy(sParams,1,3) = '~\~' then
begin
nPos := 4;
i := 1;
while (i<=nParamCount) do
begin
sParams2 := Copy(sParams,nPos,2000);
nNewPos := Pos('~\~',sParams2);
if (nNewPos > 0) then
begin
nNewPos := nNewPos+nPos-1;
sParamName := AnsiReplaceStr(Copy(sParams, nPos, nNewPos - nPos),'\\','\');
sMessageText := Copy(AnsiReplaceStr(sMessageText,':Parameter' + IntToSTr(i),sParamName),1,2000);
nPos := nNewPos + 3;
end
else
begin
if (nPos > 0) then
begin
sParamName := AnsiReplaceStr(Copy(sParams, nPos, length(sParams)-nPos+1),'\\','\');
sMessageText := Copy(AnsiReplaceStr(sMessageText,':Parameter' + IntToStr(i),sParamName),1,2000);
end;
i := nParamCount;
end;
i := i + 1;
end;
recEvent.sLabel := Copy(sMessageText,1,254);
end
else if (sParams <> '') and (nParamCount > 0) then
recEvent.sLabel := Copy(AnsiReplaceStr(sMessageText, ':Parameter1', sParams),1,254)
else
recEvent.sLabel := Copy(sMessageText, 1, 254);
if nEventCategory = 8 then
begin
if not bError then
begin
if bWaitingError then
begin
arrError[nErrorDepth] := recError;
nErrorDepth := nErrorDepth + 1;
bWaitingError := false;
end;
recError.nSqlCode := -20005;
recError.bNew := false;
recError.nBlockDepth := nBlockDepth;
recError.nBlockMode := 0;
recError.nEventType := recEvent.nEventType;
recError.sDescription := recEvent.sDescription;
recError.nObject := recEvent.nObject;
end;
recError.nTypeStatus := nTypeStatus;
recError.sContext := recEvent.sEventInfo;
recError.sLabel := recEvent.sLabel;
if not bError then
SetLastError;
end;
if nEventRegister < 2 then
begin
if bLogOpen and (nEventRegister > 0) and (nEventCategory >= nMinCategory) then
begin
if nEventCount >= nEventCapacity then
begin
if not bInternalEvent then
begin
bInternalEvent := true;
try
PutError(recEvent.sEventInfo,10030,IntToStr(nEventCapacity), '', true, -1 );
except
end;
bInternalEvent := false;
end
else if bOutOfCapacity then
begin
Query.Close;
Exit;
end;
end;
end
else
begin
nEventRegister := 0;
Query.Close;
Exit;
end;
end;
if ( nEventRegister mod 4 >= 2 ) or (bLogOpen and (nEventLog > 0)
and (nEventRegister > 0) and (nEventCategory > nMinCategory)) then
StartSession
else if (nEventRegister >= 2) and not bStartSession then
StartSession;
if nOrgType = 2 then
begin
nIndex := arrLongEvent.Count - 1;
nLocEventStatus := recEvent.nEventStatus;
if recEvent.nObject <= 0 then
begin
while nIndex>= 0 do
begin
if arrLongEvent[nIndex].nEventType = nBeginType then break;
nLocEventStatus := nLocEventStatus or arrLongEvent[nIndex].nEventStatus;
nIndex := nIndex - 1;
end;
end
else
begin
while nIndex>=0 do
begin
if (arrLongEvent[nIndex].nEventID = recEvent.nObject)
and (arrLongEvent[nIndex].nEventType = nBeginType) then break;
nLocEventStatus := nLocEventStatus or arrLongEvent[nIndex].nEventStatus;
nIndex := nIndex - 1;
end;
end;
if nIndex < 0 then
begin
nEventRegister := 0;
Query.Close;
Exit;
end;
recEvent.nEventStatus := recEvent.nEventStatus or nEventCategory;
nLocEventStatus := nLocEventStatus or nEventCategory;
if arrLongEvent[nIndex].nTraceDepth mod 2 = 0 then
nTraceBlock := 0
else if arrLongEvent[nIndex].nTraceDepth < nMinTraceDepth then
begin
if recEvent.nObject <=0 then
begin
nEventRegister := 0;
Query.Close;
Exit;
end;
nTraceBlock := 0;
end
else
begin
nTraceBlock := 1;
recEvent.nTraceDepth := arrLongEvent[nIndex].nTraceDepth;
end;
if arrLongEvent[nIndex].nUserDepth mod 2 = 0 then
nUserBlock := 0
else if arrLongEvent[nIndex].nUserDepth < nMinUserDepth then
begin
if recEvent.nObject <= 0 then
begin
nEventRegister := 0;
Query.Close;
Exit;
end;
nUserBlock := 0;
end
else
begin
nUserBlock := 1;
recEvent.nUserDepth := arrLongEvent[nIndex].nUserDepth;
end;
if recEvent.nObject <= 0 then
recEvent.nObject := arrLongEvent[nIndex].nEventId;
nNextIndex := nIndex + 1;
if nNextIndex >= arrLongEvent.Count then
begin
recEvent.nEventStatus := recEvent.nEventStatus or arrLongEvent[nIndex].nEventStatus;
arrLongEvent.Delete(nIndex);
nLongCount := arrLongEvent.Count + 1;
end
else
begin
arrLongEvent[nNextIndex].nEventStatus := arrLongEvent[nNextIndex].nEventStatus or
arrLongEvent[nIndex].nEventStatus;
arrLongEvent.Delete(nIndex);
if (nTraceBlock > 0) or (nUserBlock > 0) then
begin
nIndex := arrLongEvent.Count - 1 ;
while nIndex >= nNextIndex do
begin
if (nTraceBlock > 0)
and (arrLongEvent[nIndex].nTraceDepth > recEvent.nTraceDepth - 1) then
begin
arrLongEvent[nIndex].nTraceDepth := recEvent.nTraceDepth - 1;
if (nUserBlock > 0)
and (arrLongEvent[nIndex].nUserDepth > recEvent.nUserDepth - 1) then
arrLongEvent[nIndex].nUserDepth := recEvent.nUserDepth - 1;
end
else if (nUserBlock > 0)
and (arrLongEvent[nIndex].nUserDepth > recEvent.nUserDepth - 1) then
arrLongEvent[nIndex].nUserDepth := recEvent.nUserDepth - 1
else
break;
nIndex := nIndex - 1;
end;
end;
end;
Query.Close;
Query.SQL.Text := 'SELECT GEN_ID(EVENTID,1) NEW_ID FROM DUAL';
try
Query.Prepare;
Query.Open;
recEvent.nEventId := VarToInt64(Query.Fields.ByNameAsVariant['NEW_ID']);
except
end;
Query.Close;
DecodeTime(Now,Hour,Minute,Second,MSec);
recEvent.nEventMsec := Msec;
recEvent.dtEventTime := Now;
end
else // nOrgType in ( 1, 0 )
begin
Query.Close;
Query.SQL.Text := 'SELECT GEN_ID(EVENTID,1) NEW_ID FROM DUAL';
try
Query.Prepare;
Query.Open;
recEvent.nEventId := VarToInt64(Query.Fields.ByNameAsVariant['NEW_ID']);
except
end;
Query.Close;
DecodeTime(Now,Hour,Minute,Second,MSec);
recEvent.nEventMsec := Msec;
recEvent.dtEventTime := Now;
nLocEventStatus := nEventCategory;
if nOrgType = 1 then
begin
if nTraceBlock > 0 then
begin
recEvent.nTraceDepth := recEvent.nTraceDepth + 1;
nTraceEnters := nTraceEnters + 1;
end;
if nUserBlock > 0 then
begin
recEvent.nUserDepth := recEvent.nUserDepth + 1;
nUserEnters := nUserEnters + 1;
end;
arrLongEvent[nLongCount] := recEvent;
nLongCount := nLongCount + 1;
recEvent.nEventStatus := nEventCategory;
end
else // nOrgType = 0
recEvent.nEventStatus := recEvent.nEventStatus or nEventCategory;
end;
recEvent.sEventInfo :=
Copy('~\~TE=' + IntToStr(nTraceEnters) + '~\~UE=' + IntToStr(nUserEnters) + '~\~' + recEvent.sEventInfo,1,254);
if (nEventRegister >= 4) then
nOwner := nEventRegister - 4
else
nOwner := nEventRegister;
if nOwner in [1,1+2] then
begin
bInLog := bLogOpen and (nEventCategory >= nMinCategory);
if not bLogOpen or (nEventLog <= 0) or ((nEventCount >= nEventCapacity)
and (not bInternalEvent or bOutOfCapacity)) then
nOwner := nOwner - 1;
end
else
bInLog := false;
if nEventRegister >= 4 then
begin
Query.Close;
Query.SQL.Text := 'INSERT INTO EventCommit (EventID, EventMsec, EventTime, EventSession, EventType, EventInfo,'#13#10 +
' Label, Description, TraceDepth, UserDepth, Object, EventStatus)'#13#10 +
'VALUES (:nEventID, :nEventMsec, :dtEventTime, :nSession, :nEventType, :sEventInfo,'#13#10 +
' :sLabel, :sDescription, :nTraceDepth, :nUserDepth, :nObject, :nEventStatus)';
try
Query.Prepare;
Query.Params.ByNameAsInt64['NEVENTID']:= recEvent.nEventId;
Query.Params.ByNameAsInt64['NEVENTMSEC']:= recEvent.nEventMsec;
Query.Params.ByNameAsDateTime['DTEVENTTIME']:=recEvent.dtEventTime;
Query.Params.ByNameAsInt64['NSESSION']:= nSession;
Query.Params.ByNameAsInt64['NEVENTTYPE']:= recEvent.nEventType;
Query.Params.ByNameAsString['SEVENTINFO']:= recEvent.sEventInfo;
Query.Params.ByNameAsString['SLABEL']:= recEvent.sLabel;
Query.Params.ByNameAsString['SDESCRIPTION']:= recEvent.sDescription;
Query.Params.ByNameAsInteger['NTRACEDEPTH']:= recEvent.nTraceDepth;
Query.Params.ByNameAsInteger['NUSERDEPTH']:= recEvent.nUserDepth;
Query.Params.ByNameAsInt64['NOBJECT']:= recEvent.nObject;
Query.Params.ByNameAsInteger['NEVENTSTATUS']:= nLocEventStatus + 16;
Query.ExecSQL;
except
end;
Query.Close;
nLocEventStatus := nLocEventStatus + 32;
end;
if nOwner > 0 then
begin
Query.Close;
Query.SQL.Text := 'INSERT INTO EventRecord( EventId, EventMsec, EventTime, EventSession, EventType,'#13#10 +
' EventInfo, Label, Description, TraceDepth, UserDepth,'#13#10 +
' Object, EventStatus, EventOwner )'#13#10 +
'VALUES ( :nEventId, :nEventMsec, :dtEventTime, :nSession, :nEventType,'#13#10 +
' :sEventInfo, :sLabel, :sDescription, :nTraceDepth, :nUserDepth, :nObject,'#13#10 +
' :nEventStatus, :nOwner )';
try
Query.Prepare;
Query.Params.ByNameAsInt64['NEVENTID']:= recEvent.nEventId;
Query.Params.ByNameAsInt64['NEVENTMSEC']:= recEvent.nEventMsec;
Query.Params.ByNameAsDateTime['DTEVENTTIME']:=recEvent.dtEventTime;
Query.Params.ByNameAsInt64['NSESSION']:= nSession;
Query.Params.ByNameAsInt64['NEVENTTYPE']:= recEvent.nEventType;
Query.Params.ByNameAsString['SEVENTINFO']:= recEvent.sEventInfo;
Query.Params.ByNameAsString['SLABEL']:= recEvent.sLabel;
Query.Params.ByNameAsString['SDESCRIPTION']:= recEvent.sDescription;
Query.Params.ByNameAsInteger['NTRACEDEPTH']:= recEvent.nTraceDepth;
Query.Params.ByNameAsInteger['NUSERDEPTH']:= recEvent.nUserDepth;
Query.Params.ByNameAsInt64['NOBJECT']:= recEvent.nObject;
Query.Params.ByNameAsInteger['NEVENTSTATUS']:= nLocEventStatus;
Query.Params.ByNameAsInteger['NOWNER']:= nOwner;
Query.ExecSQL;
except
Query.Close;
Query.SQL.Text := 'INSERT INTO EventSession ( SessionId, BeginTime )'#13#10 +
'VALUES ( :nSession, :dtEventTime )';
try
Query.Prepare;
QUery.Params.ByNameAsInt64['NSESSION']:= nSession;
Query.Params.ByNameAsDateTime['DTEVENTTIME']:= recEvent.dtEventTime;
Query.ExecSQL;
except
end;
Query.Close;
Query.SQL.Text := 'INSERT INTO EventRecord( EventId, EventMsec, EventTime, EventSession, EventType,'#13#10 +
' EventInfo, Label, Description, TraceDepth, UserDepth,'#13#10 +
' Object, EventStatus, EventOwner )'#13#10 +
'VALUES ( :nEventId, :nEventMsec, :dtEventTime, :nSession, :nEventType,'#13#10 +
' :sEventInfo, :sLabel, :sDescription, :nTraceDepth, :nUserDepth, :nObject,'#13#10 +
' :nEventStatus, :nOwner )';
try
Query.Prepare;
Query.Params.ByNameAsInt64['NEVENTID']:= recEvent.nEventId;
Query.Params.ByNameAsInt64['NEVENTMSEC']:= recEvent.nEventMsec;
Query.Params.ByNameAsDateTime['DTEVENTTIME']:=recEvent.dtEventTime;
Query.Params.ByNameAsInt64['NSESSION']:= nSession;
Query.Params.ByNameAsInt64['NEVENTTYPE']:= recEvent.nEventType;
Query.Params.ByNameAsString['SEVENTINFO']:= recEvent.sEventInfo;
Query.Params.ByNameAsString['SLABEL']:= recEvent.sLabel;
Query.Params.ByNameAsString['SDESCRIPTION']:= recEvent.sDescription;
Query.Params.ByNameAsInteger['NTRACEDEPTH']:= recEvent.nTraceDepth;
Query.Params.ByNameAsInteger['NUSERDEPTH']:= recEvent.nUserDepth;
Query.Params.ByNameAsInt64['NOBJECT']:= recEvent.nObject;
Query.Params.ByNameAsInteger['NEVENTSTATUS']:= nLocEventStatus;
Query.Params.ByNameAsInteger['NOWNER']:= nOwner;
Query.ExecSQL;
except
end;
Query.Close;
end;
Transaction.CommitRetaining;
end;
if bInLog and ( (nEventCount < nEventCapacity)
or bInternalEvent and not bOutOfCapacity ) then
begin
if (nEventLog <= 0) and (nOwner = 0) then
begin
arrLocalEvent[nWriteCount] := recEvent;
arrLocalEvent[nWriteCount].nEventStatus := nLocEventStatus;
nWriteCount := nWriteCount + 1;
end;
nLogMask := nLogMask or nEventCategory;
nEventCount := nEventCount + 1;
end;
if nOrgType = 1 then
begin
recEvent.nTraceDepth := recEvent.nTraceDepth + nTraceBlock;
recEvent.nUserDepth := recEvent.nUserDepth + nUserBlock;
end
else if nOrgType = 2 then
begin
recEvent.nTraceDepth := recEvent.nTraceDepth - nTraceBlock;
recEvent.nUserDepth := recEvent.nUserDepth - nUserBlock;
end;
if nEventCategory = 8 then
begin
if not bError then
recError.nObject := recEvent.nObject;
recError.sContext := recEvent.sEventInfo;
if not bError then
SetLastError;
end;
if bInLog and (nEventCount >= nEventCapacity) and not bInternalEvent then
begin
bInternalEvent := true;
try
PutError(recEvent.sEventInfo,10030,IntToSTr(nEventCapacity),'', true, -1 );
except
end;
bInternalEvent := false;
end;
if bInternalEvent and (nEventCount >= nEventCapacity) then
bOutOfCapacity := true;
end;
end;
end;
|