unit svc;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls, Db, ADODB,syncobjs;type
  TWaitThread=Class;
  TService1 = class(TService)
    ADOConnection1: TADOConnection;
    ADODataSet1: TADODataSet;
    ADODataSet1DSDesigner: TWideStringField;
    ADODataSet1DSDesigner2: TWideStringField;
    ADODataSet1DSDesigner3: TDateTimeField;
    ADODataSet1DSDesigner4: TWideStringField;
    ADODataSet1DSDesigner5: TWideStringField;
    ADODataSet1DSDesigner6: TWideStringField;
    ADODataSet1DSDesigner7: TIntegerField;
    ADODataSet1DSDesigner8: TSmallintField;
    procedure Timer1Timer(Sender: TObject);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
  private
    { Private declarations }
    LogHandle:HWND;
    Thread:TWaitThread;
  public
    Counter:Integer;
    DataError:Boolean;
    function GetServiceController: TServiceController; override;
    procedure PrintEvent(Sender:TObject);
    { Public declarations }
  end;  TWaitThread=class(TThread)
  private
    E:TSimpleEvent;
    F:TNotifyEvent;
    procedure Execute; override;
  public
    constructor Create(AHandle:HWND; aF:TNotifyEvent);
    destructor Destroy;override;
  end;  TEventLogRecord=record
    Length: DWORD;
    Reserved:DWORD;
    RecordNumber:DWORD;
    TimeGenerated:DWORD;
    TimeWritten:DWORD;
    EventID:DWORD;
    EventType:WORD;
    NumStrings:WORD;
    EventCategory:WORD;
    ReservedFlags:WORD;
    ClosingRecordNumber:DWORD;
    StringOffset:DWORD;
    UserSidLength:DWORD;
    UserSidOffset:DWORD;
    DataLength:DWORD;
    DataOffset:DWORD;
    Buf:array [0..1023] of Char;
  end;var
  Service1: TService1;implementation{$R *.DFM}procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;procedure TService1.ServiceCreate(Sender: TObject);
begin
  Counter:=0;
  DataError:=False;
  try
          if not ADOConnection1.Connected then
                ADOConnection1.Connected:=True;
          if not ADODataSet1.Active then
                ADODataSet1.Active:=True;
          LogHandle:=OpenEventLog(nil, PChar('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Eventlog\Application\hpmon'));
          if LogHandle=NULL then
          begin
                DataError:=True;
                Exit;
          end;
          Thread:=TWaitThread.Create(LogHandle, PrintEvent);
  except
        DataError:=True;
  end;
end;procedure TService1.ServiceDestroy(Sender: TObject);
begin
  CloseEventLog(LogHandle);
  ADODataSet1.Active:=False;
  ADOConnection1.Connected:=False;
  Thread.Free;
end;
const EVENTLOG_SEQUENTIAL_READ        =$0001;
const ENTLOG_SEEK_READ              =$0002;
const EVENTLOG_FORWARDS_READ          =$0004;
const EVENTLOG_BACKWARDS_READ         =$0008 ;function GetString(var S:String; P:Pointer):Pointer;
begin
        S:=PChar(P);
        Result:=Pointer(LongInt(P)+Length(S)+1);
end;function GetTime(N:DWord):TDateTime;
var
  BaseTime:TDateTime;
  AddTime:TDateTime;
  BS,DS,a:TtIMEStamp;
begin
  BaseTime:=EncodeDate(1970,1,1)+EncodeTime(0,0,0,0);
  BS:=DateTimeToTimeStamp(BaseTime);
  Ds.Time:=(N mod (60*60*24))*1000;
  Ds.Date:=N div (60*60*24);
  a.Time:=(BS.Time+DS.Time) mod (60*60*24*1000);
  a.Date:=(BS.Time+DS.Time) div (60*60*24*1000)+BS.Date+DS.Date;
  Result:=TimeStampToDateTime(a);
end;procedure TService1.PrintEvent(Sender:TObject);
var
  ByteRead, LogSize:DWORD;
  Buf:array [0..4095] of char;
  B,P:^TEventLogRecord;
  sAppName:String;
  sDoc:String;
  sUser:String;
  sPrinter:String;
  sPort:String;
  sSize:String;
  sPages:String;
begin
        FillChar(Buf, Sizeof(TEventLogRecord), 0);
        while (ReadEventLog(LogHandle, EVENTLOG_FORWARDS_READ or EVENTLOG_SEQUENTIAL_READ , 0, @Buf, Sizeof(Buf), ByteRead, LogSize) ) do
        begin
                B:=@Buf;
                repeat
                        if PChar(Pointer(Longint(B)+sizeof(TEventLogRecord)))='Print' then
                        begin
                              P:=Pointer(Longint(B)+B^.StringOffset);
                              if B^.NumStrings=7 then
                              begin
                                    p := GetString( sAppName, p);
                                    p := GetString( sDoc, p);
                                    p := GetString( sUser, p);
                                    p := GetString( sPrinter, p);
                                    p := GetString( sPort, p);
                                    p := GetString( sSize, p);
                                    p := GetString( sPages, p);
                                    //Memo1.Lines.Add(sAppName+' '+' '+sDoc+' '+sUser+' '+sPrinter+' '+sPort+' '+sSize+' '+sPages);
                                    with ADODataSet1 do
                                    begin
                                        Insert;
                                        FieldByName('用户名缩写').asString:=sUser;
                                        FieldByName('时间').asDateTime:=GetTime(B^.TimeGenerated);
                                        FieldByName('文档名称').asString:=sDoc;
                                        FieldByName('打印机').asString:=sPrinter;
                                        FieldByName('端口').asString:=sPort;
                                        FieldByName('字节大小').asInteger:=StrToInt(sSize);
                                        FieldByName('打印页数').asInteger:=StrToInt(sPages);
                                        Post;
                                    end;
                              end;
                        end;
                        B:=Pointer(Longint(B)+B^.Length);
                until Longint(B)>=Longint(@Buf)+ByteRead;
        end;
end;constructor TWaitThread.Create(AHandle:HWND; aF:TNotifyEvent);
begin
  Inherited Create(True);
  E:=TSimpleEvent.Create;
  F:=aF;
  if NotifyChangeEventLog(AHandle, E.Handle) then
        if Assigned(F) then Resume;
end;destructor TWaitThread.Destroy;
begin
        E.SetEvent;
        Terminate;
        WaitFor;
        E.Free;
        inherited Destroy;
end;
procedure TWaitThread.Execute;
begin
        While not Terminated do
        begin
                if E.WaitFor(INFINITE)=wrSignaled then
                begin
                        if Terminated then Exit;
                        F(Self);
                end;
        end;
end;end.