?? idsyslogmessage.pas
字號:
// day
ADay := StrToIntDef(trim(Copy(TimeStampString, 5, 2)), 0);
if not (ADay in [1..31]) then
Raise EInvalidSyslogMessage.CreateFmt(RSInvalidSyslogTimeStamp, [TimeStampString]);
// Time
AHour := StrToIntDef(trim(Copy(TimeStampString, 8, 2)), 0);
if not AHour in [0..23] then
Raise EInvalidSyslogMessage.CreateFmt(RSInvalidSyslogTimeStamp, [TimeStampString]);
AMin := StrToIntDef(trim(Copy(TimeStampString, 11, 2)), 0);
if not AMin in [0..59] then
Raise EInvalidSyslogMessage.CreateFmt(RSInvalidSyslogTimeStamp, [TimeStampString]);
ASec := StrToIntDef(trim(Copy(TimeStampString, 14, 2)), 0);
if not ASec in [0..59] then
Raise EInvalidSyslogMessage.CreateFmt(RSInvalidSyslogTimeStamp, [TimeStampString]);
if TimeStampString[16] <> ' ' then {Do not Localize}
Raise EInvalidSyslogMessage.CreateFmt(RSInvalidSyslogTimeStamp, [TimeStampString]);
Result := EncodeDate(AYear, AMonth, ADay) + EncodeTime(AHour, AMin, ASec, 0);
end;
procedure TIdSysLogMessage.ReadFromStream(Src: TStream; Size: integer; APeer: String);
var
Buffer: string;
begin
if Size > 1024 then
begin
// Truncate the size to RFC's max {Do not Localize}
Size := 1024;
end
else
SetLength(Buffer, Size);
FPeer := APeer;
Src.ReadBuffer(PChar(Buffer)^, Size);
RawMessage := Buffer;
end;
procedure TIdSysLogMessage.parse;
var
APos: Integer;
begin
APos := 1;
ReadPRI(APos);
ReadHeader(APos);
ReadMSG(APos);
end;
procedure TIdSysLogMessage.ReadHeader(var StartPos: Integer);
var
AHostNameEnd: Integer;
begin
// DateTimeToInternetStr and StrInternetToDateTime
// Time stamp string is 15 char long
try
FTimeStamp := DecodeTimeStamp(Copy(FRawMessage, StartPos, 16));
Inc(StartPos, 16);
// HostName
AHostNameEnd := StartPos;
while (AHostNameEnd < Length(FRawMessage)) and (FRawMessage[AHostNameEnd] <> ' ') do {Do not Localize}
begin
Inc(AHostNameEnd);
end; // while
FHostname := Copy(FRawMessage, StartPos, AHostNameEnd - StartPos);
// SG 25/2/02: Check the ASCII range of host name
CheckASCIIRange(FHostname);
StartPos := AHostNameEnd + 1;
except
on e: Exception do
begin
FTimeStamp := Now;
FHostname := FPeer;
end;
end;
end;
procedure TIdSysLogMessage.ReadMSG(var StartPos: Integer);
begin
FMessage := Copy(FRawMessage, StartPos, Length(FRawMessage));
Msg.text := FMessage;
end;
procedure TIdSysLogMessage.ReadPRI(var StartPos: Integer);
var
StartPosSave: Integer;
Buffer: string;
begin
StartPosSave := StartPos;
try
// Read the PRI string
// PRI must start with "less than" sign
Buffer := ''; {Do not Localize}
if FRawMessage[StartPos] <> '<' then {Do not Localize}
raise EInvalidSyslogMessage.Create(RSInvalidSyslogPRI);
repeat
Inc(StartPos);
if FRawMessage[StartPos] = '>' then {Do not Localize}
begin
Break;
end
else
if not (FRawMessage[StartPos] in ['0'..'9']) then {Do not Localize}
raise EInvalidSyslogMessage.CreateFmt(RSInvalidSyslogPRINumber, [Buffer])
else
Buffer := Buffer + FRawMessage[StartPos];
until StartPos = StartPosSave + 5;
// PRI must end with "greater than" sign
if (FRawMessage[StartPos] <> '>') then {Do not Localize}
raise EInvalidSyslogMessage.Create(RSInvalidSyslogPRI);
// Convert PRI to numerical value
Inc(StartPos);
CheckASCIIRange(Buffer);
PRI := StrToIntDef(Buffer, -1);
except
// as per RFC, on invalid/missing PRI, use value 13
on e: Exception do
begin
Pri := 13;
// Reset the position to saved value
StartPos := StartPosSave;
end;
end;
end;
procedure TIdSysLogMessage.UpdatePRI;
begin
PRI := logFacilityToNo(Facility) * 8 + logSeverityToNo(Severity);
end;
procedure TIdSysLogMessage.SetFacility(const AValue: TidSyslogFacility);
begin
if FFacility <> AValue then
begin
FFacility := AValue;
UpdatePRI;
end;
end;
procedure TIdSysLogMessage.SetHostname(const AValue: string);
begin
if Pos(' ', AValue) <> 0 then {Do not Localize}
begin
Raise EInvalidSyslogMessage.CreateFmt(RSInvalidHostName, [AValue]);
end
else
FHostname := AValue;
end;
procedure TIdSysLogMessage.SetSeverity(const AValue: TIdSyslogSeverity);
begin
if FSeverity <> AValue then
begin
FSeverity := AValue;
UpdatePRI;
end;
end;
procedure TIdSysLogMessage.SetTimeStamp(const AValue: TDateTime);
begin
FTimeStamp := AValue;
end;
function TIdSysLogMessage.GetHeader: String;
var
AYear, AMonth, ADay, AHour, AMin, ASec, AMSec: Word;
function YearOf(ADate : TDateTime) : Word;
var mm, dd : Word;
begin
DecodeDate(ADate,Result,mm,dd);
end;
Function DayToStr(day: Word): String;
begin
if Day < 10 then
result := ' ' + IntToStr(day) {Do not Localize}
else
result := IntToStr(day);
end;
begin
// if the year of the message is not the current year, the timestamp is
// invalid -> Create a new timestamp with the current date/time
if YearOf(date) <> YearOf(TimeStamp) then
TimeStamp := Now;
DecodeDate(TimeStamp, AYear, AMonth, ADay);
DecodeTime(TimeStamp, AHour, AMin, ASec, AMSec);
result := Format('%s %s %.2d:%.2d:%.2d %s',[monthnames[AMonth], DayToStr(ADay), AHour, AMin, ASec, Hostname]); {Do not Localize}
end;
function TIdSysLogMessage.EncodeMessage: String;
begin
// Create a syslog message string
// PRI
result := Format('<%d>%s %s', [PRI, GetHeader, FMsg.Text]); {Do not Localize}
// If the message is too long, tuncate it
if Length(result) > 1024 then
begin
result := Copy(result, 1, 1024);
end;
end;
procedure TIdSysLogMessage.SetPri(const Value: TIdSyslogPRI);
begin
if FPri <> value then
begin
if not (value in [0..191]) then
raise EInvalidSyslogMessage.CreateFmt(RSInvalidSyslogPRINumber, [IntToStr(value)]);
FPri := Value;
FFacility := NoToFacility(Value div 8);
FSeverity := NoToSeverity(Value mod 8);
end;
end;
constructor TIdSysLogMessage.Create(AOwner: TComponent);
var bCreatedStack : Boolean;
begin
inherited Create(AOwner);
PRI := 13; //default
{This stuff is necessary to prevent an AV in the IDE if GStack does not exist}
bCreatedStack := False;
if not Assigned(GStack) then
begin
GStack := TIdStack.CreateStack;
bCreatedStack := True;
end;
try
Hostname := GStack.LocalAddress;
finally
{Free the stack ONLY if we created it to prevent a memory leak}
if bCreatedStack then
begin
FreeAndNil(GStack);
end;
end;
FMsg := TIdSysLogMsgPart.Create;
end;
procedure TIdSysLogMessage.CheckASCIIRange(var Data: String);
const
ValidChars = [#0..#127];
var
i: Integer;
begin
for i := 1 to Length(Data) do // Iterate
begin
if not (Data[i] in ValidChars) then
data[i] := '?'; {Do not Localize}
end; // for
end;
destructor TIdSysLogMessage.Destroy;
begin
FreeAndNil(FMsg);
inherited Destroy;
end;
procedure TIdSysLogMessage.SetMsg(const AValue: TIdSysLogMsgPart);
begin
FMsg.Assign(AValue);
end;
procedure TIdSysLogMessage.SetRawMessage(const Value: string);
begin
FRawMessage := Value;
// check that message contains only valid ASCII chars.
// Replace Invalid entries by "?"
// SG 25/2/02: Moved to header decoding
Parse;
end;
procedure TIdSysLogMessage.SendToHost(const Dest: String);
begin
if not assigned(FUDPCliComp) then
FUDPCliComp := TIdUDPClient.Create(self);
(FUDPCliComp as TIdUDPClient).Send(Dest, IdPORT_syslog, EncodeMessage);
end;
{ TIdSysLogMsgPart }
procedure TIdSysLogMsgPart.Assign(Source: Tpersistent);
var m : TIdSysLogMsgPart;
begin
if Source is TIdSysLogMsgPart then
begin
m := Source as TIdSysLogMsgPart;
{This sets about everything here}
FText := m.Text;
end
else
begin
inherited Assign(Source);
end;
end;
function TIdSysLogMsgPart.GetContent: String;
begin
Result := FText;
if Pos(':',Result)>1 then {Do not Localize}
begin
Fetch(Result,':'); {Do not Localize}
end;
end;
function TIdSysLogMsgPart.GetMaxTagLength: Integer;
begin
Result := 32 - Length(PIDToStr(PID));
end;
function TIdSysLogMsgPart.GetPID: Integer;
var SBuf : String;
begin
Result := -1;
SBuf := FText;
if Pos(':',FText)> 1 then {Do not Localize}
begin
SBuf := Fetch(SBuf,':'); {Do not Localize}
Fetch(SBuf,'['); {Do not Localize}
//there may not be a PID number in the Text property
SBuf := Fetch(SBuf,']'); {Do not Localize}
if (Length(SBuf)>0) then
begin
Result := StrToInt(SBuf);
end;
end;
end;
function TIdSysLogMsgPart.GetProcess: String;
begin
if Pos(':',FText)>1 then {Do not Localize}
begin
Result := Fetch(FText,':',False); {Do not Localize}
//strip of the PID if it's there {Do not Localize}
Result := Fetch(Result,'['); {Do not Localize}
end
else
begin
Result := ''; {Do not Localize}
end;
end;
function TIdSysLogMsgPart.PIDToStr(APID: Integer): String;
begin
if FPIDAvailable then
begin
Result := Format('[%d]:',[APID]); {Do not Localize}
end
else
begin
Result := ':'; {Do not Localize}
end;
end;
procedure TIdSysLogMsgPart.SetContent(const AValue: String);
begin
FText := Process + PIDToStr(PID) + AValue;
end;
procedure TIdSysLogMsgPart.SetPID(const AValue: Integer);
begin
FText := Process + PIDToStr(AValue) + Content;
end;
procedure TIdSysLogMsgPart.SetPIDAvailable(const AValue: Boolean);
var SSaveProcess : String;
begin
SSaveProcess := Process;
FPIDAvailable := AValue;
FText := SSaveProcess + PidToStr(PID)+Content;
if not AValue and (FText = ':') then {Do not Localize}
begin
FText := ''; {Do not Localize}
end;
end;
procedure TIdSysLogMsgPart.SetProcess(const AValue: String);
function AlphaNumericStr(AString : String) : String;
var i : Integer;
begin
for i := 1 to Length(AString) do
begin
//numbers
if ((Ord(AString[i])>=$30) and (Ord(AString[i])<$3A)) or
//alphabet
((Ord(AString[i])>=$61) and (Ord(AString[i])<$5B)) or
((Ord(AString[i])>=$41) and (Ord(AString[i])<$7B)) then
begin
Result := Result + AString[i];
end
else
begin
Break;
end;
end;
end;
begin
//we have to ensure that the TAG feild will never be greater than 32 charactors
//and the program name must contain alphanumeric charactors
FText := AlphaNumericStr(Copy(AValue,1,GetMaxTagLength))
+ PIDToStr(PID) + Content;
end;
procedure TIdSysLogMsgPart.SetText(const AValue: String);
begin
FText := AValue;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -