delphi 实现虚拟打印, 远程集中打印 |
您所在的位置：网站首页 › 打印机打印prn文件 › delphi 实现虚拟打印, 远程集中打印 |
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 ' + 命令), 运行目录名, 显示方式 ); 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 |
【本文地址】
今日新闻 |
推荐新闻 |