Получение информации об очереди на принтере
[more=Пример кода намба раз
]uses
Winspool, Printers;
Function GetCurrentPrinterHandle: THandle;
var
Device, Driver, Port: array[0..255] of Char;
hDeviceMode: THandle;
Begin
Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
If not OpenPrinter(@Device, Result, nil) Then
RaiseLastWin32Error;
End;
Function SavePChar(p: PChar): PChar;
Const
error: PChar = 'Nil';
Begin
If not Assigned(p) Then
Result := error
Else
Result := p;
End;
Procedure TForm1.Button1Click(SEnder: TObject);
Type
TJobs = array [0..1000] of JOB_INFO_1;
PJobs = ^TJobs;
var
hPrinter: THandle;
bytesNeeded, numJobs, i: Cardinal;
pJ: PJobs;
Begin
hPrinter := GetCurrentPrinterHandle;
Try
EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded,
numJobs);
pJ := AllocMem(bytesNeeded);
If not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded,
bytesNeeded, numJobs) Then
RaiseLastWin32Error;
memo1.Clear;
If numJobs = 0 Then
memo1.Lines.Add('No jobs in queue')
Else
For i := 0 to Pred(numJobs) do
memo1.Lines.Add(Format('Printer %s, Job %s, Status (%d): %s',
[SavePChar(pJ^[i].pPrinterName), SavePChar(pJ^[i].pDocument), pJ^[i].Status, SavePChar(pJ^[i].pStatus)]));
finally
ClosePrinter(hPrinter);
End;
End;[/more]
[more=Пример кода намба два
]unit MyHook;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,WinSpool, DB, DBTables, RxQuery;
const MaxPrinters=10;
NPrinter=1;
MaxJobs=5;
Level=1;
type TJob=TJobInfo1;
PJob=^TJob;
TInfo=TPrinterInfo1;
AInfo=array[1..MaxPrinters]of TInfo;
PInfo=^AInfo;
type
TTestThread=class(TThread)
constructor Create(aNot:THandle);
private
msg:string;
hNot,hWait:THandle;
protected
Procedure SendStatus;
procedure WhenStop(Sender:TObject);
procedure Execute;override;
end;
TPrintThread=class(TThread)
constructor Create(aPrinter:THandle;aNot:THandle);
procedure SendStatus;
private
hPrinter:Thandle;
hNotification:DWORD;
hWait:THandle;
msg:string[30];
protected
procedure WhenStop(Sender:TObject);
procedure Execute;override;
end;
TPrintTestForm = class(TForm)
Status: TMemo;
Header: TPanel;
Start: TButton;
Clear: TButton;
Exits: TButton;
Catch: TButton;
procedure StartClick(Sender: TObject);
procedure ClearClick(Sender: TObject);
procedure ExitsClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CatchClick(Sender: TObject);
private
PT:TPrintThread;
TT:TTestThread;
end;
var
PrintTestForm: TPrintTestForm;
DelayTime:word;
implementation
{$R *.DFM}
Function GetSysError:string;
var Buffer:PChar;
I:DWORD;
begin
GetMem(Buffer,1024);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,GetLastError,0,Buffer,1024,nil);
I:=0;While(Buffer[I]<>#0)and(I<1024)do Inc(I);Buffer[I-1]:=#0;
Result:='['+inttostr(GetLastError)+']='+Buffer;
SetLastError(0);FreeMem(Buffer,1024);
end;
procedure TPrintTestForm.StartClick(Sender: TObject);
label all;
var I,Count:DWORD;
Info:AInfo;
begin
Screen.Cursor:=crHourglass;DelayTime:=1000;
if Start.Tag=0 then begin
if not EnumPrinters(PRINTER_ENUM_LOCAL,nil,Level,@Info,sizeof(Info),I,Count) then begin
Status.Lines.Add('Can''t enumerate printers!');goto all;end;
if I>sizeof(Info) then begin Status.Lines.Add('Too many printers!');goto all;end;
if Count=0 then begin Status.Lines.Add('No printers in system!');goto all;end;
For I:=1 to Count do Status.Lines.Add(Info[i].pName);
if(not OpenPrinter(Info[1].pName,I,nil))or(I<32)then begin Status.Lines.Add('Error opening printer!');goto all;end;
Count:=FindFirstPrinterChangeNotification(I,PRINTER_CHANGE_SET_JOB,0,nil);
if(Count=INVALID_HANDLE_VALUE)then begin Status.Lines.Add('Failed to notificate printer'+GetSysError);ClosePrinter(I);goto all;end;
try PT:=TPrintThread.Create(I,Count);Start.Tag:=1;Start.Caption:='Stop';PT.Resume;
except Status.Lines.Add('Error during initialization thread!');end;
end else begin
PT.Free;Start.Tag:=0;Start.Caption:='Start';
end;
all:Screen.Cursor:=crDefault;
end;
constructor TPrintThread.Create(aPrinter:THandle;aNot:THandle);
begin
inherited Create(true);
Priority:=tpLowest;OnTerminate:=WhenStop;SetLastError(0);
hPrinter:=aPrinter;hNotification:=aNot;
Msg:='Process executed!';Synchronize(SendStatus);
end;
procedure TPrintThread.Execute;
var Jobs:array[1..MaxJobs]of TJob;
I,Count:DWORD;
begin
while not Terminated do begin
hWait:=WaitForSingleObjectEx(hNotification,10000,true);
if hWait<>WAIT_OBJECT_0 then begin {Msg:=inttostr(hWait);Synchronize(SendStatus);}continue;end;
if not EnumJobs(hPrinter,0,MaxJobs-1,1,@Jobs,sizeof(Jobs),I,Count)then begin
Msg:='Error!';Synchronize(SendStatus);continue;end;
For I:=1 to Count do begin Msg:='Job:'+Jobs[I].pDocument;Synchronize(SendStatus);end;
end;
end;
procedure TPrintThread.SendStatus;
var Buffer:PChar;
I:DWORD;
begin
GetMem(Buffer,1024);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,GetLastError,0,Buffer,1024,nil);
I:=0;While(Buffer[I]<>#0)and(I<1024)do Inc(I);Buffer[I-1]:=#0;
if GetLastError<>0 then PrintTestForm.Status.Lines.Add(Msg+'. Last error['+inttostr(GetLastError)+']='+Buffer)
else PrintTestForm.Status.Lines.Add(Msg);
SetLastError(0);
FreeMem(Buffer,1024);
end;
procedure TPrintThread.WhenStop(Sender:TObject);
begin
if not FindClosePrinterChangeNotification(hNotification) then begin
Msg:='Can''t close notification';
Synchronize(SendStatus);
end;
ClosePrinter(hPrinter);
Msg:='Process done!';Synchronize(SendStatus);
end;
procedure TPrintTestForm.ClearClick(Sender: TObject);
begin
Status.Lines.Clear;
end;
procedure TPrintTestForm.ExitsClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure TPrintTestForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if Start.Tag<>0 then StartClick(Sender);
end;
constructor TTestThread.Create(aNot:THandle);
begin
Priority:=tpLowest;OnTerminate:=WhenStop;SetLastError(0);hNot:=aNot;
inherited Create(true);
end;
Procedure TTestThread.SendStatus;
begin PrintTestForm.Status.Lines.Add(Msg+GetSysError);end;
procedure TTestThread.WhenStop(Sender:TObject);
begin FindCloseChangeNotification(hNot);hNot:=0;end;
procedure TTestThread.Execute;
begin
while not Terminated do begin
hWait:=WaitForSingleObject(hNot,1000);
if hWait=WAIT_OBJECT_0 then begin
Msg:='Found!';Synchronize(SendStatus);
if not FindNextChangeNotification(hNot)then begin
Msg:='Fuck!';Synchronize(SendStatus);Terminate;
end;
end;
end;
end;
procedure TPrintTestForm.CatchClick(Sender: TObject);
var hNot:THandle;
begin
if Catch.Tag=0 then begin
try
hNot:=FindFirstChangeNotification('C:\EXE',false,FILE_NOTIFY_CHANGE_FILE_NAME);
if hNot=INVALID_HANDLE_VALUE then Exception.Create('Fuflo!');
TT:=TTestThread.Create(hNot);Catch.Tag:=1;Catch.Caption:='Uncatch';TT.Resume;
except Status.Lines.Add('Oblom pri zapuske!');end;
end else begin
TT.Suspend;Catch.Tag:=0;Catch.Caption:='Catch';TT.Free;
end;
end;
end.[/more]
где-то я туплю?
