当 Delphi/QuickReport 在 DLL 中时，无法在 Windows10 中打印

Question

Delphi 7 / 快报 5.02.2

我们多年来一直使用类似的代码，但最近运行遇到了一个问题，因为我们正在将工作站迁移到 Windows 10。以前，我们使用 Windows 7 一切都很好。也许我遗漏了什么或做错了什么？

这是我整理的一个简单的测试项目来测试它。当报告在 DLL 中时，对 Printer.GetPrinter 的每次调用都会在 Windows 10 中失败。但是，如果报告在主应用程序中的表单上，它工作正常。

下面是代码，以及任何感兴趣的人的压缩文件夹。虽然有对 QuickReport 的依赖，但没办法。感谢观看。

https://1drv.ms/u/s!AsbtokV75aocsXM6MQZcrvwpHKcg

DLL 项目。

library test_dll;

uses
  SysUtils,
  Classes,
  Forms,
  report in 'report.pas' {report_test};

{$R *.res}

function Report_Print(PrinterName: Widestring): Integer; export;
var
  Receipt: Treport_test;
begin
  try
    Receipt := Treport_test.Create(nil);
    try
      Receipt.Print(PrinterName);
      Receipt.Close;
    finally
      Receipt.Free;
    end;
  except
    Application.HandleException(Application.Mainform);
  end;
  Result := 1;
end;

exports
  Report_Print;
begin

end.

报告单位

unit report;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, QRCtrls, QuickRpt, ExtCtrls, Printers, QRpCtrls, QRPrntr;

type
  Treport_test = class(TForm)
    QuickRep1: TQuickRep;
    DetailBand1: TQRBand;
    TitleBand1: TQRBand;
    QRLabel1: TQRLabel;
    SummaryBand1: TQRBand;
    QRLabel2: TQRLabel;
    QRLabel3: TQRLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  procedure Print(const PrinterName: string);
  end;

var
  report_test: Treport_test;

procedure SetupPrinter(QuickRep: TQuickRep; const PrinterName: string);
function SelectPrinter(QuickRep: TQuickRep; const PrinterName: string): boolean;

implementation

var
  DLL_QRPrinter: TQRPrinter;

{$R *.dfm}

function SelectPrinter(QuickRep: TQuickRep; const PrinterName: string): boolean;
var
  i: integer;
  compareLength: integer;
  windowsPrinterName: string;
  selectedPrinter: Integer;
  defaultPrinterAvailable: Boolean;
begin
  defaultPrinterAvailable := True;
  try // an exception will occur if there is no default printer
    i := Printer.printerIndex;
    if i > 0 then ; // this line is here so Delphi does not generate a hint
  except
    defaultPrinterAvailable := False;
  end;

  compareLength := Length(PrinterName);
  if (not Assigned(QuickRep.QRPrinter)) then
  begin
    QuickRep.QRPrinter := DLL_QRPrinter;
  end;
  // Look for the printer.
  selectedPrinter := -1;

  // Attempt #1: first try to find an exact match
  for i := 0 to QuickRep.QRPrinter.Printers.Count - 1 do
  begin
    windowsPrinterName := Copy(QuickRep.QRPrinter.Printers.Strings[i], 1, compareLength);
    if (UpperCase(windowsPrinterName) = UpperCase(PrinterName)) then
    begin
      selectedPrinter := i;
      Break;
    end;
  end;

  // Attempt #2: if no exact matches, look for the closest
  if (selectedPrinter < 0) then
    for i := 0 to QuickRep.QRPrinter.Printers.Count - 1 do
    begin
      windowsPrinterName := Copy(QuickRep.QRPrinter.Printers.Strings[i], 1, compareLength);
      if (Pos(UpperCase(PrinterName), UpperCase(QuickRep.QRPrinter.Printers.Strings[i])) > 0) then
      begin
        selectedPrinter := i;
        Break;
      end;
    end;

  // Attempt #3: if no exact matches, and nothing close, use default printer
  if (selectedPrinter < 0) and (defaultPrinterAvailable) then
    selectedPrinter := QuickRep.Printer.printerIndex;

  Result := False;
  if (selectedPrinter > -1) then
  begin
    QuickRep.PrinterSettings.PrinterIndex := selectedPrinter;
    Result := True;
  end;
end;

procedure SetupPrinter(QuickRep: TQuickRep; const PrinterName: string);
begin
  //check if we have the default printer instead of the selected printer
  SelectPrinter(QuickRep, PrinterName);

  QuickRep.Page.Units := Inches;
  QuickRep.Page.Length := 11;
end;

procedure Treport_test.Print(const PrinterName: string);
begin
  SetupPrinter(QuickRep1, PrinterName);
  QuickRep1.Print;
end;

initialization
  DLL_QRPrinter := TQRPrinter.Create(nil);

finalization
  DLL_QRPrinter.Free;
  DLL_QRPrinter := nil;
end.

测试应用程序

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

主窗体

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, QRPrntr,
  Dialogs, StdCtrls, QuickRpt, QRCtrls, ExtCtrls, Printers, QRPCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;

    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TPrintReport = function(PrinterName: Widestring): Integer;

var
  Form1: TForm1;

procedure PrintReport(const PrinterName: string);

implementation

var
  DLLHandle: THandle = 0;
    POS: TPrintReport = nil;

{$R *.dfm}

procedure PrintReport(const PrinterName: string);
begin
  try
    POS(PrinterName);
  except on e: Exception do
    ShowMessage(e.Message);
  end;
end;

procedure LoadDLL;
var
  DLLName: string;
  DLLRoutine: PChar;
begin
  DLLName := 'test_dll.dll';
  DLLRoutine := 'Report_Print';
  if not (FileExists(DLLName)) then
    raise Exception.CreateFmt('The DLL "%s" is missing. Build the DLL project and try again.', [DLLName]);

  Application.ProcessMessages;
  DLLHandle := LoadLibrary(PChar(DLLName));
  Application.ProcessMessages;

  if (DLLHandle = 0) then
    raise Exception.CreateFmt('Error: %s, while attempting to load DLL %s.', [IntToStr(GetLastError), DLLName]);

  POS := GetProcAddress(DLLHandle, DLLRoutine);
  if (@POS = nil) then
    raise Exception.CreateFmt('Error: %s, while attempting get address to %s in DLL %s.', [IntToStr(GetLastError), DLLRoutine, DLLName]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  LoadDLL;
  ShowMessage('dll loaded');
  PrintReport('MyPrinter');
  FreeLibrary(DLLHandle);
end;

end.

来自 QuickReport 的片段

procedure TPrinterSettings.ApplySettings;
var
  Cancel : boolean;
begin
  FPrinter.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
  DevMode := GlobalLock(DeviceMode);
  begin
    SetField(dm_paperlength); 
...

DeviceMode 为 0，因此 SetField 引发访问冲突。见下文。

模块 'test_dll.dll' 中地址 036BFBA7 的访问冲突。写入地址 00000028.

Answer 1

尝试为 GetPrinter 和 DevMode 注释掉这两行

procedure TPrinterSettings.ApplySettings;
var
  Cancel : boolean;
begin
  // FPrinter.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
  // DevMode := GlobalLock(DeviceMode);
  begin
    SetField(dm_paperlength); 
   ...
end

Answer 2

uses ComObj, ActiveX, StdVcl; 



if Printer.Printers.Count>0 then
  begin
 FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
 FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
 FWbemObject   := FWMIService.Get(Format('Win32_Printer.DeviceID="%s"',[Printer.Printers.Strings[0]]));
 if not VarIsClear(FWbemObject) then
 FWbemObject.SetDefaultPrinter();
 end;

新解决方案

Windows 10 没有使用此代码的默认打印机，您可以设置默认打印机

当 Delphi/QuickReport 在 DLL 中时，无法在 Windows10 中打印

Unable to a print in Windows 10 when Delphi / QuickReport is within a DLL

delphi

quickreports