idsyslogmessage.pas

indy的原文件哈!大家可以下来参考和学习之用.也可以用以作组件.开发其他的应用程序.

  // 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.