delphi 实现虚拟打印, 远程集中打印

 

技术重点:

说白了就是利用已安装在电脑中的打开印驱动, 打印出Prn文件.再用Prn文件在其它地方相同驱动的打印机上打印.

1.从注册表(HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Printers)中读出要监控的打印机的端口(Port)和设置(Attributes)保存备份.

2.在注册表(HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Ports)中创建一个指向一个文件名的端口.

3.修改注册表(HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Printers)令Port为(2.)所创建的端口, 令Attributes := Attributes or $00000100.

   这样可令打印任务在Spooler列表中打印到打定(文件)端口并且打印完成后不会自动删除已完成的任务.

4.重新启动打印任务服务(Spooler).

5.定时读取Spooler的打印任务列表的打印任务信息, 如果打印任务已完成, 则处理打印出来的文件, 并删除打印任务.

6.这样的结果是,打印任务不再到印到打印机, 而是打印到一个*.prn文件(这里是C:\1.prn), 我们就可以将此文件保存到数据库或上传到服务器, 在任何其他地方可取出来再打印.

   这样就可以实现远程打印.

 

以上就是制作出Prn打印文件的原理,在制作prn打印文时并不需要打印机, 只要装上了打印机的驱动即可,

我写成一个类, 源码:

 

 {
  VB声明
  Declare Function SetJob Lib "winspool.drv" Alias "SetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, ByVal Level As Long, pJob As Byte, ByVal Command As Long) As Long
  说明
  对一个打印作业的状态进行控制
  返回值
  Long，非零表示成功，零表示失败。会设置GetLastError
  参数表
  参数 类型及说明
  hPrinter Long，指定一个打开打印机的句柄（用OpenPrinter取得）
  JobId Long，要修改的作业的编号
  Level Long，0，1或2
  pJob Byte，指定一个缓冲区。如级别（Level）设为1或2，那该缓冲区就包含了一个JOB_INFO_1或JOB_INFO_2结构。
  如级别为0，缓冲区为NULL（变成ByVal As Long，以便传递零值）。
  如指定了一个结构，则来自那个结构的信息会用于改变打印作业的设置
  （除JobId，pPrinterName，pMachineName，pDriverName，Size，Submitte以及Time字段外）
  Command Long，下述常数之一：
  JOB_CONTROL_CANCEL 取消作业
  JOB_CONTROL_PAUSE 暂停作业
  JOB_CONTROL_RESTART 重新启动一个已开始打印的作业
  JOB_CONTROL_RESUME 恢复一个暂停的作业


  Attributes: 打印机属性, 否脱机使用打印机也是这个属性控制
  0×0     立即开始打印(默认)
  0×1     在后台处理完最后一页时开始打印
  0×2     直接打印到打印机


  以上设置只有一个会生效,


  0×80    挂起不匹配文档
  0×100   保留打印的文档
  0×200   首先打印后台文档
  0×800   双向打印
}


{
Record 作为参数:
  procedure F(r: JOB_INFO_1);这种方式传的是内容,你那RECORD里面只有8X4==32字节...这么大小的RECORD,整个压栈也没事....因为是值原样复制,函数里面修改了也不会影响到外面.
  procedure F(p: PJobInfo1A);这种方式你传的是4字节地址值.
注:
  当用传值方式传比较长的RECORD, 栈会溢出.
  传进去的那块内存空间因为是在栈中, 所以不用释放, 函数返回它就释放了.
}


unit VirtualPrinter;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Dialogs, Forms,
  ExtCtrls, DateUtils, IniFiles, Registry, Printers, WinSVC, WinSpool;


type
//  TJobMonitorsEvent = procedure(AJob: JOB_INFO_1; AJobStatus: string) of object;
//  TJobPrintingEvent = procedure(AJob: JOB_INFO_1) of object;
//  TJobCompleteEvent = procedure(AJob: JOB_INFO_1) of object;
  TJobMonitorsEvent = procedure(AJobDocName: string; AJobPStatus: string; AJobStatus: DWORD) of object;
  TJobPrintingEvent = procedure(AJobDocName: string) of object;
  TJobCompleteEvent = procedure(AJobDocName: string; APageCount: integer) of object;


  JOB_INFO_1_ARRAY = Array of JOB_INFO_1; //PJobInfo1A


  TVirtualPrinter = class(TObject)
  private
    FPrinterName: string;
    FSaveFileName: string;
    FSpoolerJobs: JOB_INFO_1_ARRAY;
    FTimer: TTimer;
    FJobMonitorsEvent: TJobMonitorsEvent;
    FJobPrintingEvent: TJobPrintingEvent;
    FJobCompleteEvent: TJobCompleteEvent;
    //
    FMonitorDateTime: TDateTime;
    procedure OnTimer(Sender: TObject);
    // 正在打印的打印机名字，这里我的打印机时网打。这里你要自己改
    // GetSpoolerJobs('\ibmserverHP LaserJet 1100');
    function GetSpoolerJobs: JOB_INFO_1_ARRAY;
  protected
  public
    //保存制作打印机设置
    class procedure SetPreparePrinter(APrinterName: string);
    //保存打印打印机设置
    class procedure SetPrintPrinter(APrinterName: string);


    //打印打印打印机名
    class var PrintPrinter: string;
    class function GetPrintPrinter: string;
    //制作打印打印机名
    class var PreparePrinter: string;
    class function GetPreparePrinter: string;
    //制作打印打印机端口
    class var PreparePrinterPort: string;
    class function GetPreparePrinterPort: string;
    //制作打印打印机属性
    class var PreparePrinterAttributes: integer;
    class function GetPreparePrinterAttributes: Integer;


    //增加打印端口
    class procedure AddPrinterPort(APort: string);
    class procedure DelPrinterPort(APort: string);
    //取指定打印机名的端口
    class function GetPrinterPort(APrinterName: string): string;
    //设置打印机的端口
    class procedure SetPrinterPort(APrinterName: string; APort: string);
    //取指定打印机名的属性
    class function GetPrinterAttributes(APrinterName: string): Integer;
    class procedure SetPrinterAttributes(APrinterName: string; AAttributes: integer);


    //检查是否已设定制作打印的打印机
    class function CheckPreparePrinter: string;
    //检查是否已设定打印打印的打印机
    class function CheckPrintPrinter: string;


    //直接用命令行打印*.prn文件到打印机
    class procedure Print(AFileName, APort: string);
  public
    constructor Create(APrinterName, ASaveFileName: string);
    destructor Destroy; override;
    procedure BackUpReg;
    procedure RestoreReg;
    // 添加一个文件端口
    procedure AddPort;
    // 删除一个文件端口
    procedure DelPort;
    // 目的是将打印任务打印到文件
    procedure SetPort;
    // 设置打印机属性, 即打印属性中的保留文档选项, 目的是令打印任务完成后, 保留任务, 不自动取消.
    procedure SetAttrib;
    // 重新启动打印任务服务
    procedure RestSpooler;
    procedure SetPrintInfo;
    function CtrlService(ServiceName: string; Status: Boolean; OverTime: Integer): Boolean;
    function SetJobPort: Boolean;
    // 删除打印任务
    function RemoveJob(JobId: DWORD): Boolean;
    property SpoolerJobs: JOB_INFO_1_ARRAY read GetSpoolerJobs;


    //启动虚拟打印监控
    procedure Start;
    //停止虚拟打印监控
    procedure Stop;


    //Windows的打印任务列表事件
    property JobMonitorsEvent: TJobMonitorsEvent read FJobMonitorsEvent write FJobMonitorsEvent;
    property JobPrintingEvent: TJobPrintingEvent read FJobPrintingEvent write FJobPrintingEvent;
    property JobCompleteEvent: TJobCompleteEvent read FJobCompleteEvent write FJobCompleteEvent;
  end;


const
  // Key_Printers2 = 'SOFTWARE\System\CurrentControlSet\Control\Print\Printers';
  // Key_Printers1 = 'SOFTWARE\System\ControlSet001\Control\Print\Printers';
  Key_Printers = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Printers';
  // 这里改变后, Key_Printers1, Key_Printers2 在注册表中会自动被同步, 真神奇.
  Key_Ports = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Ports';


implementation


{ TVirtualPrinter }


class procedure TVirtualPrinter.SetPrintPrinter(APrinterName: string);
begin
  TVirtualPrinter.PrintPrinter := APrinterName;
  with TiniFile.Create(ExtractFilePath(Application.ExeName) + 'System\System.ini') do
  begin
    try
      WriteString('BillPrint', 'PrintPrinter', APrinterName);
    finally
      Free;
    end;
  end;
end;


class procedure TVirtualPrinter.SetPreparePrinter(APrinterName: string);
begin
  TVirtualPrinter.PreparePrinter := APrinterName;
  TVirtualPrinter.GetPreparePrinterPort;
  TVirtualPrinter.GetPreparePrinterAttributes;
  with TiniFile.Create(ExtractFilePath(Application.ExeName) + 'System\System.ini') do
  begin
    try
      WriteString('BillPrint', 'PreparePrinter', APrinterName);
    finally
      Free;
    end;
  end;
end;


class function TVirtualPrinter.GetPrintPrinter: string;
begin
  if Trim(TVirtualPrinter.PrintPrinter) = '' then
  begin
    with TiniFile.Create(ExtractFilePath(Application.ExeName) + 'System\System.ini') do
    begin
      try
        TVirtualPrinter.PrintPrinter := ReadString('BillPrint', 'PrintPrinter', '');
      finally
        Free;
      end;
    end;
  end;


  Result := TVirtualPrinter.PrintPrinter;
end;


class function TVirtualPrinter.GetPreparePrinter: string;
begin
  if Trim(TVirtualPrinter.PreparePrinter) = '' then
  begin
    with TiniFile.Create(ExtractFilePath(Application.ExeName) + 'System\System.ini') do
    begin
      try
        TVirtualPrinter.PreparePrinter := ReadString('BillPrint', 'PreparePrinter', '');
      finally
        Free;
      end;
    end;
  end;


  Result := TVirtualPrinter.PreparePrinter;
end;


class function TVirtualPrinter.GetPreparePrinterPort: string;
begin
  if TVirtualPrinter.PreparePrinterPort = '' then
    TVirtualPrinter.PreparePrinterPort := TVirtualPrinter.GetPrinterPort(TVirtualPrinter.GetPreparePrinter);
  Result := TVirtualPrinter.PreparePrinterPort;
end;


class function TVirtualPrinter.GetPreparePrinterAttributes: Integer;
begin
  if TVirtualPrinter.PreparePrinterAttributes = 0 then
    TVirtualPrinter.PreparePrinterAttributes := TVirtualPrinter.GetPrinterAttributes(TVirtualPrinter.GetPreparePrinter);
  Result := TVirtualPrinter.PreparePrinterAttributes;
end;


class procedure TVirtualPrinter.AddPrinterPort(APort: string);
var
  lList: TStringList;
  i: Integer;
begin
  with TRegistry.Create do
  begin
    try
      // 指定根键为HKEY—LOCAL—MACHINE
      RootKey := HKEY_LOCAL_MACHINE;
      // 打开主键
      if OpenKey(Key_Ports, false) then
      begin
        lList := TStringList.Create;
        try
          GetValueNames(lList);
          for i := 0 to lList.Count - 1 do
          begin
            if SameText(lList.Strings[i], APort) then
            begin
              Break;
            end;
          end;
          WriteString(APort, '');
        finally
          FreeAndNil(lList);
        end;
      end;
    finally
      // 关闭主键
      CloseKey;
      Free;
    end;
  end;
end;


class procedure TVirtualPrinter.DelPrinterPort(APort: string);
begin
  with TRegistry.Create do
  begin
    try
      // 指定根键为HKEY—LOCAL—MACHINE
      RootKey := HKEY_LOCAL_MACHINE;
      // 打开主键
      if OpenKey(Key_Ports, false) then
      begin
        If ValueExists(APort) then
          DeleteValue(APort);
      end;
    finally
      // 关闭主键
      CloseKey;
      Free;
    end;
  end;
end;


class function TVirtualPrinter.GetPrinterPort(APrinterName: string): string;
begin
  Result := '';
  if APrinterName <> '' then
  with TRegistry.Create do
  begin
    try
      // 指定根键为HKEY—LOCAL—MACHINE
      RootKey := HKEY_LOCAL_MACHINE;
      // 打开主键
      if OpenKey(Key_Printers + '\' + APrinterName, false) then
        Result := ReadString('Port');
    finally
      // 关闭主键
      CloseKey;
      Free;
    end;
  end;
end;


class procedure TVirtualPrinter.SetPrinterPort(APrinterName: string; APort: string);
begin
  if APrinterName <> '' then
  with TRegistry.Create do
  begin
    try
      // 指定根键为HKEY—LOCAL—MACHINE
      RootKey := HKEY_LOCAL_MACHINE;
      // 打开主键
      if OpenKey(Key_Printers + '\' + APrinterName, false) then
        WriteString('Port', APort);
    finally
      // 关闭主键
      CloseKey;
      Free;
    end;
  end;
end;


class function TVirtualPrinter.GetPrinterAttributes(APrinterName: string): Integer;
begin
  Result := 0;
  if APrinterName <> '' then
  with TRegistry.Create do
  begin
    try
      // 指定根键为HKEY—LOCAL—MACHINE
      RootKey := HKEY_LOCAL_MACHINE;
      // 打开主键
      if OpenKey(Key_Printers + '\' + APrinterName, false) then
        Result := ReadInteger('Attributes');
    finally
      // 关闭主键
      CloseKey;
      Free;
    end;
  end;
end;


class procedure TVirtualPrinter.SetPrinterAttributes(APrinterName: string; AAttributes: integer);
begin
  if APrinterName <> '' then
  with TRegistry.Create do
  begin
    try
      // 指定根键为HKEY—LOCAL—MACHINE
      RootKey := HKEY_LOCAL_MACHINE;
      // 打开主键
      if OpenKey(Key_Printers + '\' + APrinterName, false) then
        WriteInteger('Attributes', AAttributes);
    finally
      // 关闭主键
      CloseKey;
      Free;
    end;
  end;
end;


class function TVirtualPrinter.CheckPreparePrinter: string;
var
  sPrinterName: string;
begin
  Result := '';
  sPrinterName := GetPreparePrinter;
  if Trim(sPrinterName) = '' then
  begin
    Result := '未设置制单打印机';
  end else
  if Printer.Printers.IndexOf(sPrinterName) = -1 then
  begin
    Result := '未安装制单打印机';
  end;
end;


class function TVirtualPrinter.CheckPrintPrinter: string;
var
  sPrinterName: string;
begin
  Result := '';
  sPrinterName := GetPrintPrinter;
  if Trim(sPrinterName) = '' then
  begin
    Result := '未设置打单打印机';
  end else
  if Printer.Printers.IndexOf(sPrinterName) = -1 then
  begin
    Result := '未安装打单打印机';
  end;
end;


class procedure TVirtualPrinter.Print(AFileName, APort: string);
var
  sCmd: string;
begin
  sCmd := 'cmd /c copy ' + AFileName + ' ' + APort + ' /b';
  WinExec(PAnsiChar(AnsiString(sCmd)), SW_HIDE);
  //ShellExecute(0, nil, 'cmd '或 'Command.com ', PChar( '/c ' + 命令), 运行目录名, 显示方式 <SW_HIDE/SW_SHOW>);
end;





constructor TVirtualPrinter.Create(APrinterName, ASaveFileName: string);
begin
  if Trim(APrinterName) = '' then
    raise Exception.Create('必须指定打印机名');
  if Trim(ASaveFileName) = '' then
    raise Exception.Create('必须指定文件全路径名');


  FPrinterName := Trim(APrinterName);
  FSaveFileName := Trim(ASaveFileName);


  BackUpReg;
  SetPrintInfo;


  FMonitorDateTime := Now;
  FTimer := TTimer.Create(nil);
  FTimer.Interval := 1000;
  FTimer.OnTimer := Self.OnTimer;
  //FTimer.Enabled := true;
end;


destructor TVirtualPrinter.Destroy;
begin
  FTimer.Enabled := False;
  FreeAndNil(FTimer);
  RestoreReg;
  inherited;
end;


procedure TVirtualPrinter.BackUpReg;
var
  sPort: string;
  iAttributes: Integer;
begin
  sPort := TVirtualPrinter.GetPrinterPort(FPrinterName);
  iAttributes := TVirtualPrinter.GetPrinterAttributes(FPrinterName);
  with TIniFile.Create(ExtractFileDir(ParamStr(0)) + '\System\System.ini') do
  begin
    try
      if Pos(UpperCase('LPT'), UpperCase(sPort)) > 0 then
      begin
        WriteString('BillPrint', 'Port', sPort);
        WriteInteger('BillPrint', 'Attributes', iAttributes);
      end;
    finally
      Free;
    end;
  end;
end;


procedure TVirtualPrinter.RestoreReg;
var
  sPort: string;
  iAttributes: Integer;
begin
  with TIniFile.Create(ExtractFileDir(ParamStr(0)) + '\System\System.ini') do
  begin
    try
      sPort := ReadString('BillPrint', 'Port', '');
      iAttributes := ReadInteger('BillPrint', 'Attributes', 0);
    finally
      Free;
    end;
  end;
  TVirtualPrinter.SetPrinterPort(FPrinterName, sPort);
  TVirtualPrinter.SetPrinterAttributes(FPrinterName, iAttributes);
  RestSpooler;
  //TVirtualPrinter.SetPrinterAttributes(FPrinterName, iAttributes);
  DelPort;
end;


procedure TVirtualPrinter.SetAttrib;
var
  iAttributes: Integer;
begin
  iAttributes := TVirtualPrinter.GetPrinterAttributes(FPrinterName);
  iAttributes := iAttributes or $00000100; //0x100 :即打印属性中的保留文档选项, 目的是令打印任务完成后, 保留任务, 不自动取消.
  TVirtualPrinter.SetPrinterAttributes(FPrinterName, iAttributes);
end;


procedure TVirtualPrinter.AddPort;
begin
  TVirtualPrinter.AddPrinterPort(FSaveFileName);
end;


procedure TVirtualPrinter.DelPort;
begin
  TVirtualPrinter.DelPrinterPort(FSaveFileName);
end;


procedure TVirtualPrinter.SetPort;
begin
  TVirtualPrinter.SetPrinterPort(FPrinterName, FSaveFileName);
end;


procedure TVirtualPrinter.SetPrintInfo;
var
  lList: TStringList;
  i: Integer;
begin
  with TRegistry.Create do
  begin
    try
      // 指定根键为HKEY—LOCAL—MACHINE
      RootKey := HKEY_LOCAL_MACHINE;
      // 打开主键
      if OpenKey(Key_Printers, false) then
      begin
        lList := TStringList.Create;
        try
          GetKeyNames(lList);
          for i := 0 to lList.Count - 1 do
          begin
            if SameText(lList.Strings[i], FPrinterName) then
            begin
              AddPort;
              SetPort;
              SetAttrib;
              RestSpooler;
              Break;
            end;
          end;
        finally
          FreeAndNil(lList);
        end;
      end;
    finally
      // 关闭主键
      CloseKey;
      Free;
    end;
  end;
end;


procedure TVirtualPrinter.RestSpooler;
begin
  CtrlService('Spooler', false, 30);
  CtrlService('Spooler', true, 30);
end;


function TVirtualPrinter.CtrlService(ServiceName: string; Status: Boolean; OverTime: Integer): Boolean;
// 功能：控制WINDOWS的服务启动与停止
// ServiceName 服务名称
// Status  true 启动，false 停止
// OverTime 为超时处理，单位秒
var
  lpServiceArgVectors: Pchar;
  hscmanager, hService: SC_HANDLE;
  returnstatus: TServiceStatus;
  i: Integer;
begin
  Result := true;
  lpServiceArgVectors := nil;


  // 打开service control manager database
  hscmanager := OpenSCManager(nil, nil, SC_MANAGER_ENUMERATE_SERVICE);
  if hscmanager = 0 then
  begin
    Result := false;
    exit;
  end;


  // 打开服务,检测服务是否存在
  hService := OpenService(hscmanager, Pchar(ServiceName), SERVICE_ALL_ACCESS);
  if hService = 0 then
  begin
    CloseServiceHandle(hscmanager);
    CloseServiceHandle(hService);
    Result := false;
    exit;
  end;


  // 是否可查看该Service的状态
  if not QueryServiceStatus(hService, returnstatus) then
  begin
    CloseServiceHandle(hscmanager);
    CloseServiceHandle(hService);
    Result := false;
    exit;
  end;


  i := 0;
  if Status then // 如果是启动服务
  begin
    if (returnstatus.dwCurrentState = SERVICE_STOPPED) and
      (not WinSVC.StartService(hService, 0, Pchar(lpServiceArgVectors))) then
      Result := false
    else
      while (i < OverTime) and (returnstatus.dwCurrentState <> SERVICE_RUNNING) do
      begin
        Sleep(1000);
        QueryServiceStatus(hService, returnstatus);
        Application.ProcessMessages;
        inc(i);
      end;
    CloseServiceHandle(hscmanager);
    CloseServiceHandle(hService);
    exit;
  end else // 如果是停止服务
  begin
    if (returnstatus.dwCurrentState = SERVICE_RUNNING) and
      (not ControlService(hService, SERVICE_CONTROL_STOP, returnstatus)) then
      Result := false
    else
      while (i < OverTime) and (returnstatus.dwCurrentState <> SERVICE_STOPPED) do
      begin
        Sleep(1000);
        QueryServiceStatus(hService, returnstatus);
        Application.ProcessMessages;
        inc(i);
      end;
    CloseServiceHandle(hscmanager);
    CloseServiceHandle(hService);
    exit;
  end;
end;


Function TVirtualPrinter.GetSpoolerJobs: JOB_INFO_1_ARRAY;
var
  sPrinterName: String;


  i: Integer;
  hPrinter: THandle;
  bResult: Boolean;
  cbBuf: DWORD;
  pcbNeeded: DWORD;
  pcReturned: DWORD;
  aJobs: Array [0 .. 99] of JOB_INFO_1;
begin
  sPrinterName := Self.FPrinterName;


  cbBuf := 1000;


  bResult := OpenPrinter(Pchar(sPrinterName), hPrinter, Nil);
  if NOT bResult then
  begin
    ShowMessage('Error opening the printer');
    exit;
  end;


  // EnumPrinters( ... )
  bResult := EnumJobs(hPrinter, 0, Length(aJobs), 1, @aJobs, cbBuf, pcbNeeded, pcReturned);
  if NOT bResult then
  begin
    ShowMessage('Error Getting Jobs information');
    exit;
  end;


  for i := 0 to pcReturned - 1 do
  begin
    if aJobs[i].pDocument <> Nil then
    begin
      SetLength(Result, Length(Result) + 1);
      Result[Length(Result) - 1] := aJobs[i];
    end;
  end;
  FSpoolerJobs := Result;
end;


function TVirtualPrinter.RemoveJob(JobId: DWORD): Boolean;
var
  sPrinterName: String;
  hPrinter: THandle;
  pd: PRINTER_DEFAULTS;
begin
  sPrinterName := Self.FPrinterName;
  // You need a printer handle, open the printer
  pd.DesiredAccess := PRINTER_ALL_ACCESS;
  pd.pDatatype := nil;
  pd.pDevMode := nil;
  // 打开打印机  hPrinter := GetCurrentPrinterHandle;
  if OpenPrinter(Pchar(sPrinterName), hPrinter, @pd) then
    Result := SetJob(hPrinter, JobId, 0, nil, JOB_CONTROL_DELETE)
  else
    Result := false;
end;


function TVirtualPrinter.SetJobPort: Boolean;
var
  sPrinterName: String;
  hPrinter: THandle;
  pd: PRINTER_DEFAULTS;
  pInfo: PPrinterInfo2;
  bytesNeeded: DWORD;
begin
  sPrinterName := Self.FPrinterName;
  pd.DesiredAccess := PRINTER_ALL_ACCESS;
  pd.pDatatype := nil;
  pd.pDevMode := nil;
  // 打开打印机
  if OpenPrinter(Pchar(sPrinterName), hPrinter, @pd) then
  begin
    pInfo := AllocMem(bytesNeeded);
    try
      GetPrinter(hPrinter, 2, pInfo, bytesNeeded, @bytesNeeded);
      pInfo.pPortName := PChar(FSaveFileName);
      Result := SetPrinter(hPrinter, 2, pInfo, PRINTER_CONTROL_SET_STATUS);
    finally
      FreeMem(pInfo);
    end;
  end else
    Result := false;
end;


procedure TVirtualPrinter.OnTimer(Sender: TObject);
var
  aJobs: JOB_INFO_1_ARRAY;
  aJob: JOB_INFO_1;
  sJobStatus: string;
  dJobDateTime: TDateTime;
  i: Integer;
begin
  FTimer.Enabled := false;
  try
    aJobs := Self.SpoolerJobs;
    for i := 0 to Length(aJobs) - 1 do
    begin
      aJob := aJobs[i];
      sJobStatus := '';
      dJobDateTime := SystemTimeToDateTime(aJob.Submitted) + 8 / 24;//由于时区问题, 我们是处于东8区所以同格林威治时间有8小时差距: 东8区就+8, 西8区-8.
      //dJobDateTime := EncodeDateTime(aJob.Submitted.wYear, aJob.Submitted.wMonth, aJob.Submitted.wDay, aJob.Submitted.wHour + 8, aJob.Submitted.wMinute, aJob.Submitted.wSecond, aJob.Submitted.wMilliseconds);


      //对打开监控前的任务不处理
      if dJobDateTime <= FMonitorDateTime then
        Continue;


      case aJob.Status of
        JOB_STATUS_PAUSED: sJobStatus := 'JOB_STATUS_PAUSED';
        JOB_STATUS_ERROR: sJobStatus := 'JOB_STATUS_ERROR';
        JOB_STATUS_DELETING: sJobStatus := 'JOB_STATUS_DELETING';
        JOB_STATUS_SPOOLING: sJobStatus := 'JOB_STATUS_SPOOLING';
        JOB_STATUS_PRINTING: sJobStatus := 'JOB_STATUS_PRINTING';
        JOB_STATUS_OFFLINE: sJobStatus := 'JOB_STATUS_OFFLINE';
        JOB_STATUS_PAPEROUT: sJobStatus := 'JOB_STATUS_PAPEROUT';
        JOB_STATUS_PRINTED: sJobStatus := 'JOB_STATUS_PRINTED';
        
        JOB_STATUS_DELETED: sJobStatus := 'JOB_STATUS_DELETED';
        JOB_STATUS_BLOCKED_DEVQ: sJobStatus := 'JOB_STATUS_BLOCKED_DEVQ';
        JOB_STATUS_USER_INTERVENTION: sJobStatus := 'JOB_STATUS_USER_INTERVENTION';
        JOB_STATUS_RESTART: sJobStatus := 'JOB_STATUS_RESTART';
        JOB_POSITION_UNSPECIFIED: sJobStatus := 'JOB_POSITION_UNSPECIFIED';
      end;


      if Assigned(JobMonitorsEvent) then
        JobMonitorsEvent(aJob.pDocument, sJobStatus, aJob.Status);


      if (aJob.Status in [JOB_STATUS_PRINTING, JOB_STATUS_SPOOLING]) then
      begin
        if Assigned(JobPrintingEvent) then
          JobPrintingEvent(aJob.pDocument);
      end else
      if (aJob.Status in [JOB_STATUS_PRINTED]) or ((aJob.Status = 4096) and (sJobStatus = '')) then
      begin
        Self.RemoveJob(aJob.JobId);
        if Assigned(JobCompleteEvent) then
          JobCompleteEvent(aJob.pDocument, aJob.TotalPages);
      end;
    end;
  finally
    FTimer.Enabled := true;
  end;
end;


procedure TVirtualPrinter.Start;
begin
  FTimer.Enabled := True;
end;


procedure TVirtualPrinter.Stop;
begin
  FTimer.Enabled := False;
end;


end.

调用例子:

procedure TForm1.FormCreate(Sender: TObject);
begin
  FVirtualPrinter := TVirtualPrinter.Create(sPrinterName, FBillFileName);
  FVirtualPrinter.JobPrintingEvent := Self.JobPrintingEvent;
  FVirtualPrinter.JobCompleteEvent := Self.JobCompleteEvent;
end;

procedure TForm1.JobPrintingEvent(AJobDocName: string);
begin
  labMessage.Caption := '正在打印文件'+AJobDocName+'... ...';
end;

procedure TForm1.JobCompleteEvent(AJobDocName: string);
var
  lFileFullNameList: TStringList;
begin

  //上传打印出来的prn文
  lFileFullNameList := TStringList.Create;
  try
    lFileFullNameList.Add(AJobDocName);
    TfrmUpLoadFile.AutoUploadFiles('BillPrint\', False, lFileFullNameList);
  finally
    FreeAndNil(lFileFullNameList);
  end;

  labMessage.Caption := '打印文件完成!';
  //ShowMyMsg('', '已生成打印文件' + AJobDocName);
end;

 

实际打印时的示例代码:

  sFileFullName := 'c:\1.prn';

  if FileExists(sFileFullName) then
  begin                       
    sPrinterName := '你的打印机名称';
    sPrinterPort := '你的打印机端口号'
    sCmd := 'cmd /c copy ' + sFileFullName + ' ' + sPrinterPort + ' /b';
    WinExec(PChar(sCmd), SW_HIDE);
  end;

 

在打印prn文件时注意:

1.必须统一打印机型号.
2.真实打印的打印机的驱动必须要与制作prn打印文件的打印驱动一致.
3.在装有(1.中所指打印机)的电脑上使用
  a.如果是本地的LPT口打印机:
    Copy /b C:\aaa.PRN PRN:
    或
    Copy /b C:\aaa.PRN LPT1:
    将*.PRN文件打印到默认打印机.(注: LPT1 是本地打印端口, 你的机有可能是 LPT2,3,...)
  b.如果是USB打印机或网络打印机
    1.去市场买条USB转COM口或转LPT口的线(这肯定行,在此不多说);
    2.我们用个办法来骗WINDOWS一下,
      先找到安装打印机的PC机名称,然后把打印机共享,
      然后在你要打印的那台电脑,进入DOS,
      用NET USE命令完成映射:
      NET USE  LPT1 \\安装打印机电脑名\共享打印机名  /persistent:yes
      回车就完成映射,完成后再执行NET USE命令,查看MAP是否成功,显示OK就表示成功了.