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

Delphi 7 / QuickReport 5.02.2

We've used similar code for several years but have run into an issue recently now that we're migrating workstations to Windows 10. Previously, we were using Windows 7 and all was fine. Maybe there's something I'm missing or doing wrong?

Here's a simple test project I put together to test this. When the report is within a DLL every call to Printer.GetPrinter fails in Windows 10. Though, if the report is on a form within the main application it works fine.

Below is the code, and a zipped up folder for anyone that's interested. There is the dependency on QuickReport though, which can't be helped. Thanks for looking.

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

DLL Project.

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.

Report Unit

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.

Test Application

program Project1;

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

{$R *.res}

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

Main Form

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.

Snippet from QuickReport

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

DeviceMode is 0, so SetField throws an access violation. See below.

Access violation at address 036BFBA7 in module 'test_dll.dll'. Write of address 00000028.