Как определить статус печати документов принтера "по умолчанию"?
// Способ первый
unit PrintStatus;
interface
function PrinterStatus( var aStatus: LongWord; var aNrJobs: Integer ): string;
implementation
uses
Windows, SysUtils, Printers, WinSpool;
resourcestring
rsNrJobsWaiting = '%0:u document(s) waiting';
rsStatusSep = '; ';
rsStatusIdle = 'Idle';
rsStatusUnknown = 'Unknown';
rsStatusBusy = 'Busy';
rsStatusDoorOpen = 'Door open';
rsStatusError = 'Error';
rsStatusInitializing = 'Initialising';
rsStatusIOActive = 'I/O active';
rsStatusManualFeed = 'Manual feed';
rsStatusNoToner = 'No toner';
rsStatusNotAvailable = 'Not available';
rsStatusOffline = 'Offline';
rsStatusOutOfMemory = 'Out of memory';
rsStatusOutputBinFull = 'Output bin full';
rsStatusPagePunt = 'Page punt';
rsStatusPaperJam = 'Paper jam';
rsStatusPaperOut = 'Paper out';
rsStatusPaperProblem = 'Paper problem';
rsStatusPaused = 'Paused';
rsStatusPendingDeletion = 'Pending deletion';
rsStatusPowerSave = 'Power-save';
rsStatusPrinting = 'Printing';
rsStatusProcessing = 'Processing';
rsStatusServerUnknown = 'Server unknown';
rsStatusTonerLow = 'Toner low';
rsStatusUserIntervention = 'User intervention';
rsStatusWaiting = 'Waiting';
rsStatusWarmingUp = 'Warming up';
function PrinterStatus( var aStatus: LongWord; var aNrJobs: Integer ): string;
procedure AddStatus( aStr: string );
begin
if Result <> '' then
Result := Result + rsStatusSep;
Result := Result + aStr;
end;
function NewStatus( var aNJ: Integer ): LongWord;
var
Count: LongWord;
DevName: string;
hPrinter: THandle;
JobInfoCount: LongWord;
JobInfo2: PJobInfo2;
PrinterInfo2: PPrinterInfo2;
begin
Result := 0;
DevName := Printer.Printers[Printer.PrinterIndex];
if OpenPrinter( PChar( DevName ), hPrinter, nil ) then
begin
Count := 0;
GetPrinter( hPrinter, 2, nil, 0, @Count );
if Count > 0 then
begin
GetMem( PrinterInfo2, Count );
GetPrinter( hPrinter, 2, PrinterInfo2, Count, @Count );
Result := PrinterInfo2.Status;
aNJ := PrinterInfo2.cJobs;
FreeMem( PrinterInfo2 );
if aNJ > 0 then
begin
Count := 0;
EnumJobs( hPrinter, 0, 1, 2, nil, 0, Count, JobInfoCount );
if Count > 0 then
begin
GetMem( JobInfo2, Count );
EnumJobs( hPrinter, 0, 1, 2, JobInfo2, Count, Count, JobInfoCount );
if ( JobInfoCount > 0 ) and ( JobInfo2.Status <> 0 ) then
begin
if ( JobInfo2.Status and JOB_STATUS_BLOCKED_DEVQ ) <> 0 then
Result := Result or PRINTER_STATUS_ERROR;
if ( JobInfo2.Status and JOB_STATUS_DELETING ) <> 0 then
Result := Result or PRINTER_STATUS_PENDING_DELETION;
if ( JobInfo2.Status and JOB_STATUS_ERROR ) <> 0 then
Result := Result or PRINTER_STATUS_ERROR;
if ( JobInfo2.Status and JOB_STATUS_OFFLINE ) <> 0 then
Result := Result or PRINTER_STATUS_OFFLINE;
if ( JobInfo2.Status and JOB_STATUS_PAPEROUT ) <> 0 then
Result := Result or PRINTER_STATUS_PAPER_OUT;
if ( JobInfo2.Status and JOB_STATUS_PAUSED ) <> 0 then
Result := Result or PRINTER_STATUS_PAUSED;
if ( JobInfo2.Status and ( JOB_STATUS_PRINTING or JOB_STATUS_RESTART ) ) <> 0 then
Result := Result or PRINTER_STATUS_PRINTING;
if (JobInfo2.Status and JOB_STATUS_USER_INTERVENTION) <> 0 then
Result := Result or PRINTER_STATUS_USER_INTERVENTION;
end;
FreeMem( JobInfo2 );
end;
end;
end;
ClosePrinter( hPrinter );
end;
end;
begin
Result := '';
aNrJobs := 0;
aStatus := NewStatus( aNrJobs );
if aStatus = 0 then
begin
if aNrJobs > 0 then
Result := rsStatusPrinting
else
Result := rsStatusIdle;
end
else
begin
if ( aStatus and PRINTER_STATUS_BUSY <> 0 ) then
AddStatus( rsStatusBusy );
if ( aStatus and PRINTER_STATUS_DOOR_OPEN <> 0 ) then
AddStatus( rsStatusDoorOpen );
if ( aStatus and PRINTER_STATUS_ERROR <> 0 ) then
AddStatus( rsStatusError );
if ( aStatus and PRINTER_STATUS_INITIALIZING <> 0 ) then
AddStatus( rsStatusInitializing );
if ( aStatus and PRINTER_STATUS_IO_ACTIVE <> 0 ) then
AddStatus( rsStatusIOActive );
if ( aStatus and PRINTER_STATUS_MANUAL_FEED <> 0 ) then
AddStatus( rsStatusManualFeed );
if ( aStatus and PRINTER_STATUS_NO_TONER <> 0 ) then
AddStatus( rsStatusNoToner );
if ( aStatus and PRINTER_STATUS_NOT_AVAILABLE <> 0 ) then
AddStatus( rsStatusNotAvailable );
if ( aStatus and PRINTER_STATUS_OFFLINE <> 0 ) then
AddStatus( rsStatusOffline );
if ( aStatus and PRINTER_STATUS_OUT_OF_MEMORY <> 0 ) then
AddStatus( rsStatusOutOfMemory );
if ( aStatus and PRINTER_STATUS_OUTPUT_BIN_FULL <> 0 ) then
AddStatus( rsStatusOutputBinFull );
if ( aStatus and PRINTER_STATUS_PAGE_PUNT <> 0 ) then
AddStatus( rsStatusPagePunt );
if ( aStatus and PRINTER_STATUS_PAPER_JAM <> 0 ) then
AddStatus( rsStatusPaperJam );
if ( aStatus and PRINTER_STATUS_PAPER_OUT <> 0 ) then
AddStatus( rsStatusPaperOut );
if ( aStatus and PRINTER_STATUS_PAPER_PROBLEM <> 0 ) then
AddStatus( rsStatusPaperProblem );
if ( aStatus and PRINTER_STATUS_PAUSED <> 0 ) then
AddStatus( rsStatusPaused );
if ( aStatus and PRINTER_STATUS_PENDING_DELETION <> 0 ) then
AddStatus( rsStatusPendingDeletion );
if ( aStatus and PRINTER_STATUS_POWER_SAVE <> 0 ) then
AddStatus( rsStatusPowerSave );
if ( aStatus and PRINTER_STATUS_PRINTING <> 0 ) then
AddStatus( rsStatusPrinting );
if ( aStatus and PRINTER_STATUS_PROCESSING <> 0 ) then
AddStatus( rsStatusProcessing );
if ( aStatus and PRINTER_STATUS_SERVER_UNKNOWN <> 0 ) then
AddStatus( rsStatusServerUnknown );
if ( aStatus and PRINTER_STATUS_TONER_LOW <> 0 ) then
AddStatus( rsStatusTonerLow );
if ( aStatus and PRINTER_STATUS_USER_INTERVENTION <> 0 ) then
AddStatus( rsStatusUserIntervention );
if ( aStatus and PRINTER_STATUS_WAITING <> 0 ) then
AddStatus( rsStatusWaiting );
if ( aStatus and PRINTER_STATUS_WARMING_UP <> 0 ) then
AddStatus( rsStatusWarmingUp );
end;
if aNrJobs > 0 then
Result := Result + rsStatusSep + Format( rsNrJobsWaiting, [aNrJobs] );
end;
end.
{...}
procedure TForm1.Button1Click(Sender: TObject);
var
Status: Cardinal;
NrJobs: Integer;
s: string;
begin
s := PrinterStatus( Status, NrJobs );
ShowMessage( s + #13 + IntToStr( Status ) + #13 + IntToStr( NrJobs ) );
end;
// Способ второй
unit PrintStatus;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, WinSpool, Generics.Collections, Menus{, WinSock};
type
PTMibTCPRow = ^TMibTCPRow;
TMibTCPRow = packed record
dwState: DWORD;
dwLocalAddr: DWORD;
dwLocalPort: DWORD;
dwRemoteAddr: DWORD;
dwRemotePort: DWORD;
end;
PTMibTCPTable = ^TMibTCPTable;
TMibTCPTable = packed record
dwNumEntries: DWORD;
Table: array[0..0] of TMibTCPRow;
end;
TProcessEntry32 = packed record
dwSize: DWORD;
cntUsage: DWORD;
th32ProcessID: DWORD;
th32DefaultHeapID: DWORD;
th32ModuleID: DWORD;
cntThreads: DWORD;
th32ParentProcessID: DWORD;
pcPriClassBase: Longint;
dwFlags: DWORD;
szExeFile: array [0..MAX_PATH - 1] of WideChar;
end;
JOB_INFO_1_ARRAY = array [0..0] of JOB_INFO_1;
function GetTcpTable(var pTCPTable: PTMibTCPTable; var pDWSize: PDWORD;
bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';
var
JobList: TList< JOB_INFO_1 >;
procedure JobToListView( Job: JOB_INFO_1; var List: TStrings );
function ListJobOfPrinter( PrinterName: AnsiString ): Boolean;
implementation
uses
Printers;
//const
// // Константы состояний порта
// MIB_TCP_STATE_CLOSED = 1;
// MIB_TCP_STATE_LISTEN = 2;
// MIB_TCP_STATE_SYN_SENT = 3;
// MIB_TCP_STATE_SYN_RCVD = 4;
// MIB_TCP_STATE_ESTAB = 5;
// MIB_TCP_STATE_FIN_WAIT1 = 6;
// MIB_TCP_STATE_FIN_WAIT2 = 7;
// MIB_TCP_STATE_CLOSE_WAIT = 8;
// MIB_TCP_STATE_CLOSING = 9;
// MIB_TCP_STATE_LAST_ACK = 10;
// MIB_TCP_STATE_TIME_WAIT = 11;
// MIB_TCP_STATE_DELETE_TCB = 12;
//// Функция преобразует состояние порта в строковый эквивалент
//function PortStateToStr( const State: DWORD ): String;
//begin
// case State of
// MIB_TCP_STATE_CLOSED: Result := 'CLOSED';
// MIB_TCP_STATE_LISTEN: Result := 'LISTEN';
// MIB_TCP_STATE_SYN_SENT: Result := 'SYN SENT';
// MIB_TCP_STATE_SYN_RCVD: Result := 'SYN RECEIVED';
// MIB_TCP_STATE_ESTAB: Result := 'ESTABLISHED';
// MIB_TCP_STATE_FIN_WAIT1: Result := 'FIN WAIT 1';
// MIB_TCP_STATE_FIN_WAIT2: Result := 'FIN WAIT 2';
// MIB_TCP_STATE_CLOSE_WAIT: Result := 'CLOSE WAIT';
// MIB_TCP_STATE_CLOSING: Result := 'CLOSING';
// MIB_TCP_STATE_LAST_ACK: Result := 'LAST ACK';
// MIB_TCP_STATE_TIME_WAIT: Result := 'TIME WAIT';
// MIB_TCP_STATE_DELETE_TCB: Result := 'DELETE TCB';
// else
// Result := 'UNKNOWN';
// end;
//end;
function GetStatus( Job: JOB_INFO_1 ): AnsiString;
begin
case Job.Status of
JOB_STATUS_PAUSED: result := 'JOB_STATUS_PAUSED';
JOB_STATUS_ERROR: result := 'JOB_STATUS_ERROR';
JOB_STATUS_DELETING: result := 'JOB_STATUS_DELETING';
JOB_STATUS_SPOOLING: result := 'JOB_STATUS_SPOOLING';
JOB_STATUS_PRINTING: result := 'JOB_STATUS_PRINTING';
JOB_STATUS_OFFLINE: result := 'JOB_STATUS_OFFLINE';
JOB_STATUS_PAPEROUT: result := 'JOB_STATUS_PAPEROUT';
JOB_STATUS_PRINTED: result := 'JOB_STATUS_PRINTED';
JOB_STATUS_DELETED: result := 'JOB_STATUS_DELETED';
JOB_STATUS_BLOCKED_DEVQ: result := 'JOB_STATUS_BLOCKED_DEVQ';
JOB_STATUS_USER_INTERVENTION: result := 'JOB_STATUS_USER_INTERVENTION';
JOB_STATUS_RESTART: result := 'JOB_STATUS_RESTART';
JOB_POSITION_UNSPECIFIED: result := 'JOB_POSITION_UNSPECIFIED';
else
Result := 'Unknown status...';
end;
end;
procedure GetPortStats;
var
Size: PDWORD;
i: DWORD;
TCPTable: PTMibTCPTable;
begin
GetMem( TCPTable, SizeOf( TMibTCPTable ) );
try
Size := 0;
finally
FreeMem( TCPTable );
end;
// GetMem( TCPTable, Size^ );
// try
// if GetTcpTable( TCPTable, Size, True ) = NO_ERROR then
// begin
// for i := 0 to TCPTable^.dwNumEntries-1 do
// Memo1.Lines.Add( Format( '%15s: | %5d %s', [inet_ntoa( in_addr( TCPTable^.Table[i].dwLocalAddr ) ),
// htons( TCPTable^.Table[i].dwLocalPort ),
// PortStateToStr( TCPTable^.Table[i].dwState )] ) );
// end;
// finally
// FreeMem( TCPTable );
// end;
end;
procedure JobToListView(Job: JOB_INFO_1; var List: TStrings);
var
lv: TListItem;
begin
List.Clear;
List.Add( IntToStr( Job.JobId ) );
List.Add( Job.pPrinterName );
List.Add( Job.pMachineName );
List.Add( Job.pUserName );
List.Add( Job.pDocument );
List.Add( Job.pDatatype );
List.Add( GetStatus( Job ) );
List.Add( IntToStr( Job.TotalPages ) );
List.Add( IntToStr( Job.PagesPrinted ) );
List.Add( DateTimeToStr( SystemTimeToDateTime( Job.Submitted ) ) );
end;
function ListJobOfPrinter( PrinterName: AnsiString ): Boolean;
var
hPrinter: THandle;
dwNeeded, dwReturned: DWORD;
i: integer;
PJobInfo: ^JOB_INFO_1_ARRAY;
begin
if not OpenPrinterA( PAnsiChar( PrinterName ), hPrinter, nil ) then
begin
Result := False;
Exit;
end;
if not EnumJobs( hPrinter, 0, $FFFFFFFF, 1, nil, 0, dwNeeded, dwReturned ) then
begin
if( GetLastError <> ERROR_INSUFFICIENT_BUFFER ) then
begin
ClosePrinter( hPrinter );
Result := False;
Exit;
end;
end;
try
GetMem( PJobInfo, SizeOf( JOB_INFO_1 ) * dwNeeded );
if not EnumJobs( hPrinter, 0, $FFFFFFFF, 1, LPBYTE( pJobInfo ),
dwNeeded, dwNeeded, dwReturned ) then
begin
ClosePrinter( hPrinter );
Result := False;
end;
for i := 0 to dwReturned-1 do
JobList.Add( PJobInfo[i] );
finally
ClosePrinter( hPrinter );
FreeMem( PJobInfo );
end;
end;
initialization
JobList := TList< JOB_INFO_1 >.Create;
finalization
JobList.Free;
end.
{...}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, PrintStatus;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ListView1: TListView; // ViewStyle = vsReport, 10 колонок
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Printers;
procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.Items.Assign( Printer.Printers );
Combobox1.ItemIndex := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
sl: TStrings;
li: TListItem;
begin
if ListJobOfPrinter( ComboBox1.Items[ComboBox1.ItemIndex] ) then
begin
ListView1.Items.BeginUpdate;
sl := TStringList.Create;
for i := 0 to JobList.Count-1 do
begin
JobToListView( JobList[i], sl );
li := ListView1.Items.Add;
li.Caption := sl[0];
for j := 1 to sl.Count-1 do
li.SubItems.Add( sl[j] );
end;
ListView1.Items.EndUpdate;
sl.Free;
end;
end;
end.
|
