home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d3456 / SYNAPSE.ZIP / source / lib / SLogSend.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-07  |  7KB  |  184 lines
  1. {==============================================================================|
  2. | Project : Delphree - Synapse                                   | 001.001.000 |
  3. |==============================================================================|
  4. | Content: SysLog client                                                       |
  5. |==============================================================================|
  6. | Copyright (c)1999-2002, Lukas Gebauer                                        |
  7. | All rights reserved.                                                         |
  8. |                                                                              |
  9. | Redistribution and use in source and binary forms, with or without           |
  10. | modification, are permitted provided that the following conditions are met:  |
  11. |                                                                              |
  12. | Redistributions of source code must retain the above copyright notice, this  |
  13. | list of conditions and the following disclaimer.                             |
  14. |                                                                              |
  15. | Redistributions in binary form must reproduce the above copyright notice,    |
  16. | this list of conditions and the following disclaimer in the documentation    |
  17. | and/or other materials provided with the distribution.                       |
  18. |                                                                              |
  19. | Neither the name of Lukas Gebauer nor the names of its contributors may      |
  20. | be used to endorse or promote products derived from this software without    |
  21. | specific prior written permission.                                           |
  22. |                                                                              |
  23. | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
  24. | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
  25. | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
  26. | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
  27. | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
  28. | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
  29. | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
  30. | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
  31. | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
  32. | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
  33. | DAMAGE.                                                                      |
  34. |==============================================================================|
  35. | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
  36. | Portions created by Lukas Gebauer are Copyright (c)2001.                     |
  37. | All Rights Reserved.                                                         |
  38. |==============================================================================|
  39. | Contributor(s):                                                              |
  40. |==============================================================================|
  41. | History: see HISTORY.HTM from distribution package                           |
  42. |          (Found at URL: http://www.ararat.cz/synapse/)                       |
  43. |==============================================================================}
  44.  
  45. // RFC-3164
  46.  
  47. {$Q-}
  48. {$WEAKPACKAGEUNIT ON}
  49.  
  50. unit SLogSend;
  51.  
  52. interface
  53.  
  54. uses
  55.   SysUtils, Classes,
  56.   blcksock, SynaUtil;
  57.  
  58. const
  59.   cSysLogProtocol = '514';
  60.  
  61.   FCL_Kernel = 0;
  62.   FCL_UserLevel = 1;
  63.   FCL_MailSystem = 2;
  64.   FCL_System = 3;
  65.   FCL_Security = 4;
  66.   FCL_Syslogd = 5;
  67.   FCL_Printer = 6;
  68.   FCL_News = 7;
  69.   FCL_UUCP = 8;
  70.   FCL_Clock = 9;
  71.   FCL_Authorization = 10;
  72.   FCL_FTP = 11;
  73.   FCL_NTP = 12;
  74.   FCL_LogAudit = 13;
  75.   FCL_LogAlert = 14;
  76.   FCL_Time = 15;
  77.   FCL_Local0 = 16;
  78.   FCL_Local1 = 17;
  79.   FCL_Local2 = 18;
  80.   FCL_Local3 = 19;
  81.   FCL_Local4 = 20;
  82.   FCL_Local5 = 21;
  83.   FCL_Local6 = 22;
  84.   FCL_Local7 = 23;
  85.  
  86. type
  87.   TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
  88.     Debug);
  89.  
  90.   TSyslogSend = class(TSynaClient)
  91.   private
  92.     FSock: TUDPBlockSocket;
  93.     FFacility: Byte;
  94.     FSeverity: TSyslogSeverity;
  95.     FTag: string;
  96.     FMessage: string;
  97.   public
  98.     constructor Create;
  99.     destructor Destroy; override;
  100.     function DoIt: Boolean;
  101.   published
  102.     property Facility: Byte read FFacility Write FFacility;
  103.     property Severity: TSyslogSeverity read FSeverity Write FSeverity;
  104.     property Tag: string read FTag Write FTag;
  105.     property LogMessage: string read FMessage Write FMessage;
  106.   end;
  107.  
  108. function ToSysLog(const SyslogServer: string; Facil: Byte;
  109.   Sever: TSyslogSeverity; const Content: string): Boolean;
  110.  
  111. implementation
  112.  
  113. constructor TSyslogSend.Create;
  114. begin
  115.   inherited Create;
  116.   FSock := TUDPBlockSocket.Create;
  117.   FSock.CreateSocket;
  118.   FTargetPort := cSysLogProtocol;
  119.   FFacility := FCL_Local0;
  120.   FSeverity := Debug;
  121.   FTag := ExtractFileName(ParamStr(0));
  122.   FMessage := '';
  123.   FIPInterface := cAnyHost;
  124. end;
  125.  
  126. destructor TSyslogSend.Destroy;
  127. begin
  128.   FSock.Free;
  129.   inherited Destroy;
  130. end;
  131.  
  132. function TSyslogSend.DoIt: Boolean;
  133. var
  134.   Buf: string;
  135.   S: string;
  136.   L: TStringList;
  137. begin
  138.   Result := False;
  139.   Buf := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
  140.   Buf := Buf + CDateTime(now) + ' ';
  141.   L := TStringList.Create;
  142.   try
  143.     FSock.ResolveNameToIP(FSock.Localname, L);
  144.     if L.Count < 1 then
  145.       S := '0.0.0.0'
  146.     else
  147.       S := L[0];
  148.   finally
  149.     L.Free;
  150.   end;
  151.   Buf := Buf + S + ' ';
  152.   Buf := Buf + Tag + ': ' + FMessage;
  153.   if Length(Buf) <= 1024 then
  154.   begin
  155.     if FSock.EnableReuse(True) then
  156.       Fsock.Bind(FIPInterface, FTargetPort)
  157.     else
  158.       FSock.Bind(FIPInterface, cAnyPort);
  159.     FSock.Connect(FTargetHost, FTargetPort);
  160.     FSock.SendString(Buf);
  161.     Result := FSock.LastError = 0;
  162.   end;
  163. end;
  164.  
  165. {==============================================================================}
  166.  
  167. function ToSysLog(const SyslogServer: string; Facil: Byte;
  168.   Sever: TSyslogSeverity; const Content: string): Boolean;
  169. begin
  170.   Result := False;
  171.   with TSyslogSend.Create do
  172.     try
  173.       TargetHost :=SyslogServer;
  174.       Facility := Facil;
  175.       Severity := Sever;
  176.       LogMessage := Content;
  177.       Result := DoIt;
  178.     finally
  179.       Free;
  180.     end;
  181. end;
  182.  
  183. end.
  184.