谁能把cmwdelphier的这段调试一下，适合我用呀。
此程序是一个Windows NT/2000的Service程序，它检测Windows NT的打印日志事件，
当有打印任务时，自动将打印信息读取出来保存到数据库中。
本人用的是SQL Server,只有一个表，表结构为：
CREATE TABLE [dbo].[PrintRecord] (
[id] [int] IDENTITY (1, 1) NOT NULL ,
[用户名缩写] [nvarchar] (20) NULL ,
[用户名] [nvarchar] (20) NULL ,
[时间] [smalldatetime] NOT NULL ,
[文档名称] [nvarchar] (100) NULL ,
[打印机] [nvarchar] (100) NULL ,
[端口] [nvarchar] (100) NULL ,
[字节大小] [int] NULL ,
[打印页数] [smallint] NULL
) ON [PRIMARY]
在Service上只有一个ADOConnection和一个ADODataSet连接这个表。
Service的程序：
unit svc;
interface
uses
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
WORD;
RecordNumber
WORD;
TimeGenerated
WORD;
TimeWritten
WORD;
EventID
WORD;
EventType:WORD;
NumStrings:WORD;
EventCategory:WORD;
ReservedFlags:WORD;
ClosingRecordNumber
WORD;
StringOffset
WORD;
UserSidLength
WORD;
UserSidOffset
WORD;
DataLength
WORD;
DataOffset
WORD;
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
ointer)
ointer;
begin
S:=PChar(P);
Result:=Pointer(LongInt(P)+Length(S)+1);
end;
function GetTime(N
Word):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
WORD;
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 ADODataSet1do
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 Terminateddo
begin
if E.WaitFor(INFINITE)=wrSignaled then
begin
if Terminated then
Exit;
F(Self);
end;
end;
end;
end.
客户端程序可以直接查数据库。我这里不列出客户程序了
