Программирование на Delphi

// Способ первый
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.