pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 25

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@53 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
2008-04-24 07:09:13 +00:00
parent 155969aef8
commit ecf3d4aa68
12 changed files with 877 additions and 183 deletions
Download Patch File Download Diff File Expand all files Collapse all files

164
slogsend.pas Normal file
View File

@ -0,0 +1,164 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
|==============================================================================|
| Content: SysLog client |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
| (the "License"); you may not use this file except in compliance with the |
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
| |
| Software distributed under the License is distributed on an "AS IS" basis, |
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
| the specific language governing rights and limitations under the License. |
|==============================================================================|
| The Original Code is Synapse Delphi Library. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2001. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
// RFC-3164
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit SLogSend;
interface
uses
SysUtils, Classes,
blcksock, SynaUtil;
const
cSysLogProtocol = '514';
FCL_Kernel = 0;
FCL_UserLevel = 1;
FCL_MailSystem = 2;
FCL_System = 3;
FCL_Security = 4;
FCL_Syslogd = 5;
FCL_Printer = 6;
FCL_News = 7;
FCL_UUCP = 8;
FCL_Clock = 9;
FCL_Authorization = 10;
FCL_FTP = 11;
FCL_NTP = 12;
FCL_LogAudit = 13;
FCL_LogAlert = 14;
FCL_Time = 15;
FCL_Local0 = 16;
FCL_Local1 = 17;
FCL_Local2 = 18;
FCL_Local3 = 19;
FCL_Local4 = 20;
FCL_Local5 = 21;
FCL_Local6 = 22;
FCL_Local7 = 23;
type
TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
Debug);
TSyslogSend = class(TObject)
private
FSyslogHost: string;
FSyslogPort: string;
FSock: TUDPBlockSocket;
FFacility: Byte;
FSeverity: TSyslogSeverity;
FTag: string;
FMessage: string;
public
constructor Create;
destructor Destroy; override;
function DoIt: Boolean;
published
property SyslogHost: string read FSyslogHost Write FSyslogHost;
property SyslogPort: string read FSyslogPort Write FSyslogPort;
property Facility: Byte read FFacility Write FFacility;
property Severity: TSyslogSeverity read FSeverity Write FSeverity;
property Tag: string read FTag Write FTag;
property LogMessage: string read FMessage Write FMessage;
end;
function ToSysLog(const SyslogServer: string; Facil: Byte;
Sever: TSyslogSeverity; const Content: string): Boolean;
implementation
constructor TSyslogSend.Create;
begin
inherited Create;
FSock := TUDPBlockSocket.Create;
FSock.CreateSocket;
FSyslogHost := cLocalhost;
FSyslogPort := cSysLogProtocol;
FFacility := FCL_Local0;
FSeverity := Debug;
FTag := ExtractFileName(ParamStr(0));
FMessage := '';
end;
destructor TSyslogSend.Destroy;
begin
FSock.Free;
inherited Destroy;
end;
function TSyslogSend.DoIt: Boolean;
var
Buf: string;
S: string;
L: TStringList;
begin
Result := False;
Buf := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
Buf := Buf + CDateTime(now) + ' ';
L := TStringList.Create;
try
FSock.ResolveNameToIP(FSock.Localname, L);
if L.Count < 1 then
S := '0.0.0.0'
else
S := L[0];
finally
L.Free;
end;
Buf := Buf + S + ' ';
Buf := Buf + Tag + ': ' + FMessage;
if Length(Buf) <= 1024 then
begin
FSock.Connect(FSyslogHost, FSyslogPort);
FSock.SendString(Buf);
Result := FSock.LastError = 0;
end;
end;
{==============================================================================}
function ToSysLog(const SyslogServer: string; Facil: Byte;
Sever: TSyslogSeverity; const Content: string): Boolean;
begin
Result := False;
with TSyslogSend.Create do
try
SyslogHost :=SyslogServer;
Facility := Facil;
Severity := Sever;
LogMessage := Content;
Result := DoIt;
finally
Free;
end;
end;
end.