Перехватывать печать на принтере

Нужно перехватывать печать на принтере: на каком принтере, какой документ, сколько страниц распечатали.
Нашёл, что надо использовать FindFirstPrinterChangeNotification.
Может у кого нибудь есть пример рабочего кода?

Вот накидал на скорую руку, дальше развивай по аналогии:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinSpool;
 
type
  TForm1 = class(TForm)
    btnStart: TButton;
    cbPrinters: TComboBox;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  PrintersInfo: array of TPrinterInfo5;
  I, Needed, Returned: DWORD;
begin
  EnumPrinters(PRINTER_ENUM_LOCAL, nil, 5, nil,
    0, Needed, Returned);
  SetLength(PrintersInfo, Needed div SizeOf(TPrinterInfo5));
  if EnumPrinters(PRINTER_ENUM_LOCAL, nil, 5, PrintersInfo,
    Needed, Needed, Returned) then
    if Returned > 0 then
    begin
      for I := 0 to Returned - 1 do
        cbPrinters.Items.Add(PrintersInfo[I].pPrinterName);
      btnStart.Enabled := True;
      cbPrinters.ItemIndex := 1;
    end;
end;
 
procedure TForm1.btnStartClick(Sender: TObject);
var
  hPrinter, hChanges: THandle;
  NotifyOption: TPrinterNotifyOptions;
  NotifyTipes: TPrinterNotifyOptionsType;
  Field: TPrinterNotifyInfoData;
begin
  if OpenPrinter(PChar(cbPrinters.Items.Strings[cbPrinters.ItemIndex]),
    hPrinter, nil) then
  try
 
    NotifyTipes.wType := JOB_NOTIFY_TYPE;
    NotifyTipes.Reserved0 := 0;
    NotifyTipes.Reserved1 := 0;
    NotifyTipes.Reserved2 := 0;
    NotifyTipes.Count := 1;
    NotifyTipes.pFields := @Field;
 
    NotifyOption.Version := 2;
    NotifyOption.Flags := PRINTER_CHANGE_ALL;
    NotifyOption.Count := 1;
    NotifyOption.pTypes := @NotifyTipes;
    
    hChanges := FindFirstPrinterChangeNotification(hPrinter, PRINTER_CHANGE_ALL,
      0, @NotifyOption);
    if hChanges = INVALID_HANDLE_VALUE then
      RaiseLastOSError
    else
    try
      case WaitForSingleObject(hChanges, INFINITE) of
        WAIT_OBJECT_0: ShowMessage('Есть изменения');
        WAIT_FAILED: RaiseLastOSError;
      end;
    finally
      FindClosePrinterChangeNotification(hChanges);
    end;
  finally
    ClosePrinter(hPrinter);
  end;
end;
 
end.

А как быть если нужно отслеживать появление нового принтера?
Какой handle hPrinter должен быть? Ведь принтера нет

Сообщение отредактировано: Cyr - 26.05.08, 11:04

WM_DEVICECHANGE и там смотри список принтеров...

Всем привет! Rouse, сделал всё по-твоему примеру, но у меня почему-то при создании объекта уведомления выдает ошибку. Если не трудно посмотри, пожалуйста, может я что-то пропустил?

unit Otlov;
 
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinSpool;
 
 
type
  TForm1 = class(TForm)
    btnStart: TButton;
    cbPrinters: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.btnStartClick(Sender: TObject);
var
  hPrinter, hChanges: THandle;
  NotifyOption: TPrinterNotifyOptions;
  NotifyTipes: TPrinterNotifyOptionsType;
  Field: TPrinterNotifyInfoData;
  JobInfo, TmpJobInfo: PJobInfo3;
  pcReturned, jpcbNeeded, jpcReturned, JobId: DWORD;
  pcbNeeded:PDWORD;
  j:integer;
  pJob:^JOB_INFO_1;
  pDocument:Pointer;
begin
  if OpenPrinter(PChar(cbPrinters.Items.Strings[cbPrinters.ItemIndex]),
    hPrinter, nil) then
  try
 
    NotifyTipes.wType := JOB_NOTIFY_TYPE;
    NotifyTipes.Reserved0 := 0;
    NotifyTipes.Reserved1 := 0;
    NotifyTipes.Reserved2 := 0;
    NotifyTipes.Count := 1;
    NotifyTipes.pFields := @Field;
 
    NotifyOption.Version := 2;
    NotifyOption.Flags := PRINTER_CHANGE_ALL;
    NotifyOption.Count := 1;
    NotifyOption.pTypes := @NotifyTipes;
 
    hChanges := FindFirstPrinterChangeNotification(hPrinter, PRINTER_CHANGE_JOB,
      0, @NotifyOption);
    if hChanges = INVALID_HANDLE_VALUE then
      ShowMessage('Ошибка')
    else
    try
      case WaitForSingleObject(hChanges, INFINITE) of
 
        WAIT_OBJECT_0:
          begin
            if EnumJobs(hPrinter, 0, 100, 3, JobInfo,
                  jpcbNeeded, jpcbNeeded, jpcReturned) then
                begin
                  TmpJobInfo := JobInfo;
                  JobId:=TmpJobInfo^.JobId;
                  for J := 0 to jpcReturned - 1 do
                  begin
                    GetJob(hPrinter,JobId,1,pJob,0,pcbNeeded);
                    pDocument:=pJob.pDocument;
                  end;
                end;
 
            ShowMessage('Есть изменения');
          end;
 
        WAIT_FAILED: RaiseLastOSError;
      end;
    finally
      FindClosePrinterChangeNotification(hChanges);
    end;
  finally
    ClosePrinter(hPrinter);
  end
  else
    ShowMessage('Никак')
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
var
  PrintersInfo: array of TPrinterInfo5;
  I, Needed, Returned: DWORD;
begin
  EnumPrinters(PRINTER_ENUM_LOCAL, nil, 5, nil,
    0, Needed, Returned);
  SetLength(PrintersInfo, Needed div SizeOf(TPrinterInfo5));
  if EnumPrinters(PRINTER_ENUM_LOCAL, nil, 5, PrintersInfo,
    Needed, Needed, Returned) then
    if Returned > 0 then
    begin
      for I := 0 to Returned - 1 do
        cbPrinters.Items.Add(PrintersInfo[I].pPrinterName);
      btnStart.Enabled := True;
      cbPrinters.ItemIndex := 1;
    end;
end;

Сообщение отредактировано: Pacha - 04.03.10, 09:10

Извиняюсь, я сейчас редко бываю на форуме. Где именно ошибка? Вот тут?

    hChanges := FindFirstPrinterChangeNotification(hPrinter, PRINTER_CHANGE_JOB,
      0, @NotifyOption);
    if hChanges = INVALID_HANDLE_VALUE then
      ShowMessage('Ошибка')

Если да, то оставь как и было, т.е. RaiseLastOSError и смотри что выводится, ну и на основании этих данных смотри где именно ляп.

Ошибка как-то сама исчезла. Выдавало ошибку №87. Но сейчас всё нормально. Сейчас назрел новый вопрос. Надо что-бы печать сохранялась в файле и одновременно печаталось на принтер. Не подскажешь куда копать?

Цитата Pacha @ 09.03.10, 12:43

Надо что-бы печать сохранялась в файле и одновременно печаталось на принтер.

Тебе нужно что бы оно прямо с принтера сохранялось?

Или Что бы то что ты отрправляешь печататься ишло в файл.
Если так то

procedure TForm1.Button1Click(Sender: TObject);
var b:TBitmap;
begin
try
     b:=TBitmap.Create;
     b.Height:=100;
     b.Width:=100;
     b.Canvas.Rectangle(10,10,50,50);
     b.SaveToFile('c:\1.bmp');
  finally
     b.Free;
end;
 
end;

Только на БИТМАП рисуй то что рисуешь на принтерер.

Поясню задание: мне надо, чтобы пользователь в одном окне, разделенном на два, мог выбрать принтер для печати и файл, куда сохранить. При нажатии на печать, инфа должна распечататься и сохраниться в файл. Если есь мысли как сделать, буду рад их услышать.

Цитата Pacha @ 10.03.10, 06:37

разделенном на два, мог выбрать принтер для печати и файл, куда сохранить. При нажатии на печать,

Если картинку то вариант я тебе дал.

Тебе нужно сохранить картинку? или даные какого формата?

Документы Word,Excel,Блокнот

Цитата Pacha @ 10.03.10, 12:11

Документы Word,Excel,Блокнот

Тогда только один выход OLE .


И тебе в ручную прийдется писать алгоритм параллелного сохранения.

Зайди сюда

aster_x,спасибо за инфу. Я сделал через OLE, но встал вопрос, когда я вызываю окно Сохранить как, то оно появляется. Всё нормально, но когда я пытаюсь вызвать его для этого же документа второй раз, то он у меня просто сохраняется. Не знаешь, почему? На всякий случай скину код
<code>
procedure WordSave();
const
wdPromptUser=$00000002;
var
ServerIsRunning:Boolean;
Unknown:IUnknown;
Result:HResult;
AppProgId:string;
App:Variant;
begin
AppProgId:='Word.Application';
ServerIsRunning:=False;
Result:=GetActiveObject(ProgIdToClassId(AppProgId),nil,Unknown);
if Result=MK_E_UNAVAILABLE then App:=CreateOleObject(AppProgId)
else
begin
App:=GetActiveOleObject(AppProgId);
ServerIsRunning:=true;
end;
App.Visable:=true;
App.ActiveDocument.Save; //когда здесь пишу App.ActiveDocument.Save(false,wdPromptUser)
то выскакивает ошибка на серевере.Использую позднее связывание.
App.ActiveDocument.PrintOut;

end;
</code>

Скидаю пример!
Может поможет.

Сообщение отредактировано: aster_x - 11.03.10, 10:39

Прикреплённый файлServers.zip (4.63 Кбайт, скачиваний: 796)

aster_x! Спасибо огромное! Выручил на все сто!!!