log.pas

来自「详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...」· PAS 代码 · 共 338 行

//
// Thread safe method of recording messages in a log file. Error messages can
// optionally be recorded in the Event Log on an NT server (can be a remote
// server)
//
// If the filenames are empty strings ('') then no log files are created
// or written to
//                     
// (c) Chicony Software 20001
//
unit log;

interface

uses windows, sysutils, classes, filectrl, syncobjs;

const RECENT_MESSAGES_COUNT = 50;       // Number of recent messages stored in
                                        // g_RecentMessages and g_RecentErrors

type
  TPodmsLog = class
  private
    g_LogFileCrit: TCriticalSection;    // For controlling access
    g_ErrLogFileCrit: TCriticalSection; // For controlling access

    g_LogFile: TFileStream;             // Log file (for non-error messages)
    g_ErrLogFile: TFileStream;          // Log file for error messages

    g_RecentMessages: TStringList;      // Recent messages
    g_RecentErrors: TStringList;        // Recent error messages

    g_use_eventlog: Boolean;            // If TRUE then error messages are
                                        // recorded in an NT Servers event log
    g_h_elog: HWND;                     // Event log handle

    procedure p_OpenLogFile(var logfile: TFileStream; filename: String);
  public
    function LogMessage(const msg: string; const obj: TObject=nil): boolean;
    function LogErrMessage(const thefunc, msg: string; const err: integer=0; const obj: TObject=nil): boolean;
    procedure RecentMessages(var message_list, error_list: TStringList); overload;
    procedure RecentMessages(var message_list, error_list: OleVariant); overload;
    constructor Create(nt_server, el_name, logfile, errlogfile: String);
    destructor Free;
  end;

implementation

//=============================================================================

//
// Class creator
//
// For example: g_LogFiles:=TPodmsLog.Create('', 'PodmsDS',
//                                            'C:\PXM_LOGS\DS_LOG.TXT',
//                                            'C:\PXM_LOGS\DS_ERRLOG.TXT);
//
// Note that the log files will be prefixed by the current date. In the above
// example the error log would actually be C:\PXM_LOGS\19980131_DS_ERRLOG.TXT
// if the current date was 31st Jan 1998
//
// Args: UNC name of NT server to record events on (empty string for local)
//       name of event log application (empty string not to use event log)
//       log filename (empty string not to use a log file)
//       error log filename (empty string not to use an error log log)
//
constructor TPodmsLog.Create(nt_server, el_name, logfile, errlogfile: String);
begin
   // Initialise
   g_LogFileCrit:=nil;
   g_ErrLogFileCrit:=nil;
   g_LogFile:=nil;
   g_ErrLogFile:=nil;

   g_RecentMessages:=TStringList.Create;
   g_RecentErrors:=TStringList.Create;

   // Create & open the log file
   g_LogFileCrit:=TCriticalSection.Create;
   if logfile<>'' then p_OpenLogFile(g_LogFile, logfile);

   // Create & open the error log file
   g_ErrLogFileCrit:=TCriticalSection.Create;
   if errlogfile<>'' then p_OpenLogFile(g_ErrLogFile, errlogfile);

   try
      // Open NT event
      if el_name='' then
         // Do not record to event log
         g_use_eventlog:=FALSE
      else begin
         // Record to event log
         if nt_server='' then g_h_elog:=RegisterEventSource(nil, PChar(el_name))
         else g_h_elog:=RegisterEventSource(PChar(nt_server), PChar(el_name));

         if g_h_elog<1 then g_use_eventlog:=FALSE
         else g_use_eventlog:=TRUE;
      end;
   except on E:Exception do begin
         // Cannot use event log
         g_use_eventlog:=FALSE;
         LogErrMessage('LOG', 'Exception raised opening event log:'+E.Message, 0);
      end;
   end;

   // Continue with creation of object
   inherited Create;
end;

//
// Class destructor - closes log files
//
destructor TPodmsLog.Free;
begin
   // Record in log file
   LogMessage('CLOSING LOG');
   //LogErrMessage('LOG', 'CLOSING LOG', 0);

   try
      // Close event log
      if g_use_eventlog then DeregisterEventSource(g_h_elog);
   except
      // Ignore
   end;

   // Free memory & resources used
   try
      g_LogFile.Free;
      g_RecentMessages.Free;
      g_LogFileCrit.Free;

      g_ErrLogFile.Free;
      g_RecentErrors.Free;
      g_ErrLogFileCrit.Free;
   except
      // Ignore
   end;
   g_LogFile:=nil;
   g_ErrLogFile:=nil;
   g_LogFileCrit:=nil;
   g_ErrLogFileCrit:=nil;
   g_RecentMessages:=nil;
   g_RecentErrors:=nil;
end;

//
// Open/create a log file for appending
//
// The filename is treated as a suffix. The current date will be placed
// before the filename, e.g.
//
// e.g. 'C:\PXMLOGS\CSLOG.TXT' will become 'C:\PXMLOGS\19981231_CSLOG.TXT'
//
procedure TPodmsLog.p_OpenLogFile(var logfile: TFileStream; filename: String);
var line, fdir, fname, newfname: String;
    year, month, day: Word;
begin
     // Create directory
     try
       ForceDirectories(ExtractFileDir(filename));
     except
       // Ignore
     end;

     try
        fdir:=ExtractFileDir(filename);
        fname:=ExtractFileName(filename);

        // Modify filename
        DecodeDate(Now, year, month, day);
        if fdir<>'' then FmtStr(newfname, '%s\%.4d%.2d%.2d_%s', [fdir, year, month, day, fname])
        else FmtStr(newfname, '%.4d%.2d%.2d_%s', [year, month, day, fname]);
     except
        raise;
     end;

     // Open log file
     try
        // Do we need to create the log file?
        if not FileExists(newfname) then begin
           LogFile:=TFileStream.Create(newfname, fmCreate);
           LogFile.Free;
           Sleep(100);
        end;

        // (Re)-open file
        LogFile:=TFileStream.Create(newfname, fmOpenWrite + fmShareDenyWrite);
        LogFile.Seek(0, soFromEnd);
        line:=DateTimeToStr(now)+'=OPENING LOG '+newfname+#13+#10;
        LogFile.WriteBuffer(PChar(line)^, Length(line));
        FlushFileBuffers(LogFile.Handle);
     except on E:Exception do begin
            // Failed to open file
            raise;
        end;
     end;
end;

//
// Log a message (not an error, just information)
//
// Args: message to record
//       current class (optional), e.g. self 
//
// Returns TRUE on success
//
function TPodmsLog.LogMessage(const msg: string; const obj: TObject): boolean;
var pfx_msg: string;
begin
     // Construct complete messages
     pfx_msg:=DateTimeToStr(now)+'=';
     if obj<>nil then pfx_msg:=pfx_msg+'['+obj.ClassName+'],';
     pfx_msg:=pfx_msg + msg;

     // Dump to log file
     g_LogFileCrit.Acquire;
     try
        // Add to recent messages
        g_RecentMessages.Add(pfx_msg);
        if g_RecentMessages.Count > RECENT_MESSAGES_COUNT then
           g_RecentMessages.Delete(0);

        // Add to file
        if g_LogFile<>nil then begin
           g_LogFile.WriteBuffer(PChar(pfx_msg+#13+#10)^, Length(pfx_msg)+2);
           FlushFileBuffers(g_LogFile.Handle);
        end;
     finally
        g_LogFileCrit.Release;
     end;
     Result:=True;
end;

//
// Log an error message
//
// Args: the name of the function that failed, e.g. procedure name
//       error message to record
//       error value (optional), e.g. -1
//       current class (optional), e.g. self
//
// NOTE: If enabled, error messages are recorded to the event log
//
// Returns TRUE on success
//
function TPodmsLog.LogErrMessage(const thefunc, msg: string;
         const err: integer; const obj: TObject): boolean;
var pfx_msg: string;
begin
     // Save to event log (if enabled)
     if g_use_eventlog then begin
        try
           if obj<>nil then pfx_msg:=obj.ClassName+'.' else pfx_msg:='';
           pfx_msg:=pfx_msg + thefunc + ',Err#' + IntToStr(err);
           ReportEvent(g_h_elog, EVENTLOG_ERROR_TYPE, 0, 0, nil, 1, Length(pfx_msg), PChar(@msg), PChar(pfx_msg));
        except
           // Ignore
        end;
     end;

     // Construct complete messages
     pfx_msg:=DateTimeToStr(now)+' ';
     if obj<>nil then pfx_msg:=pfx_msg + obj.ClassName+'.';
     pfx_msg:=pfx_msg + thefunc + '(Err#' + IntToStr(err)+ '):' + msg;

     // Dump to error log file
     g_ErrLogFileCrit.Acquire;
     try
        // Add to recent messages
        g_RecentErrors.Add(pfx_msg);
        if g_RecentErrors.Count > RECENT_MESSAGES_COUNT then
           g_RecentErrors.Delete(0);

        // Add to file
        if g_ErrLogFile<>nil then begin
           g_ErrLogFile.WriteBuffer(PChar(pfx_msg+#13+#10)^, Length(pfx_msg)+2);
           FlushFileBuffers(g_ErrLogFile.Handle);
        end;
     finally
        g_ErrLogFileCrit.Release;
     end;
     Result:=True;
end;

//
// Return the most recent messages recorded. This works even if there is no
// messages file.
//
// Args: message_list is filled with the most recent messages
//       error_list if filled with the most recent error messages
//
procedure TPodmsLog.RecentMessages(var message_list, error_list: TStringList);
begin
     g_LogFileCrit.Acquire;
     try
        message_list:=g_RecentMessages;
        error_list:=g_RecentErrors;
     finally
        g_LogFileCrit.Release;
     end;
end;

//
// Return the most recent messages and error messages recorded. This works even
// if there is no message and/or error messages file.
//
// Args: message_list is filled with the most recent messages
//       error_list if filled with the most recent error messages
//
procedure TPodmsLog.RecentMessages(var message_list, error_list: OleVariant);
var ml, el: TStringList;
    i: Integer;
begin
     // Initialise
     message_list:=Unassigned;
     error_list:=Unassigned;

     // Quickly grab a list of the messages
     g_LogFileCrit.Acquire;
     try
        ml:=g_RecentMessages;
        el:=g_RecentErrors;
     finally
        g_LogFileCrit.Release;
     end;

     // Now copy them to an OLE variant
     if ml.Count > 0 then begin
        message_list:=VarArrayCreate([0, ml.Count - 1], varOLEStr);
        for i:=0 to ml.Count - 1 do message_list[i]:=ml[i];
     end;
     if el.Count > 0 then begin
        error_list:=VarArrayCreate([0, el.Count - 1], varOLEStr);
        for i:=0 to el.Count - 1 do error_list[i]:=el[i];
     end;
end;

end.