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就表示成功了.