delphi - DocumentProperties 在 XE6 中失败；在 Delphi 7 中工作

Question

Delphi XE6 中隐藏着另一个错误(可能是在添加 Unicode 支持时添加的)。

您最初可以通过尝试调用来公开它:

procedure TForm1.Button1Click(Sender: TObject);
begin
   Printer.Orientation := poLandscape; //use Vcl.Printers
end;

由于神秘错误而失败

Operation not supported on the selected printer

调试他们的代码

当您跟踪 VCL 时，问题归结为全局 TPrinter 无法获取打印机的 DEVMODE 结构。当它尝试调用 Windows DocumentProperties 时会失败。 Vcl.Printers 的函数:

if DeviceMode = 0 then  // alloc new device mode block if one was not passed in
begin
    DeviceMode := GlobalAlloc(GHND,
          DocumentProperties(0, FPrinterHandle, ADevice, nil, nil, 0));
    //...snip...
end;

bufferSize := DocumentProperties(0, FPrinterHandle, ADevice, PDeviceMode(@dummyDevMode), PDeviceMode(@dummyDevMode), 0); //20160522 Borland forgot to check the result

奇怪的是 DocumentProperties 失败了:它返回 -1。这很奇怪，因为参数在概念上没有任何错误。

DocumentProperties 失败时不会记录到 SetLastError，但 GetLastError 始终返回:

50 - The request is not supported

代码审查

这里有一些非常糟糕的代码:

• 它调用 DocumentProperties 并且不检查返回值(如果失败则返回小于零的值)
• DocumentProperties 返回一个有符号 32 位整数
• 当 GlobalAlloc 采用无符号 32 位整数时发生下溢
• DocumentProperties 失败并返回 -1
• 在传递给 GlobalAlloc 时转换为 $ffffffff，然后尝试分配 4 GB 内存

但仅在 XE6 中失败

奇怪的是，相同的代码可以在 Delphi 7 中运行。它不应该在支持 Unicode 的 XE6 中失败。查看 XE6 中 Winapi.WinSpool 中 DocumentProperties 的 header 翻译:

function DocumentProperties( hWnd: HWND; hPrinter: THandle; pDeviceName: LPWSTR; const pDevModeOutput: TDeviceMode;  var pDevModeInput: TDeviceMode;  fMode: DWORD): Longint; stdcall; overload;
function DocumentProperties( hWnd: HWND; hPrinter: THandle; pDeviceName: LPWSTR;       pDevModeOutput: PDeviceMode;      pDevModeInput: PDeviceMode;  fMode: DWORD): Longint; stdcall; overload;
function DocumentPropertiesA(hWnd: HWND; hPrinter: THandle; pDeviceName: LPSTR;  const pDevModeOutput: TDeviceModeA; var pDevModeInput: TDeviceModeA; fMode: DWORD): Longint; stdcall; overload;
function DocumentPropertiesA(hWnd: HWND; hPrinter: THandle; pDeviceName: LPSTR;        pDevModeOutput: PDeviceModeA;     pDevModeInput: PDeviceModeA; fMode: DWORD): Longint; stdcall; overload;
function DocumentPropertiesW(hWnd: HWND; hPrinter: THandle; pDeviceName: LPWSTR; const pDevModeOutput: TDeviceModeW; var pDevModeInput: TDeviceModeW; fMode: DWORD): Longint; stdcall; overload;
function DocumentPropertiesW(hWnd: HWND; hPrinter: THandle; pDeviceName: LPWSTR;       pDevModeOutput: PDeviceModeW;     pDevModeInput: PDeviceModeW; fMode: DWORD): Longint; stdcall; overload;

他们在那里做了一些非常奇特的 const-var/typed-untyped 重载步法。

Delphi 7 更简单的地方:

function DocumentProperties( hWnd: HWND; hPrinter: THandle; pDeviceName: PChar;     const pDevModeOutput: TDeviceMode;  var pDevModeInput: TDeviceMode;  fMode: DWORD): Longint; stdcall;
function DocumentPropertiesA(hWnd: HWND; hPrinter: THandle; pDeviceName: PAnsiChar; const pDevModeOutput: TDeviceModeA; var pDevModeInput: TDeviceModeA; fMode: DWORD): Longint; stdcall;
function DocumentPropertiesW(hWnd: HWND; hPrinter: THandle; pDeviceName: PWideChar; const pDevModeOutput: TDeviceModeW; var pDevModeInput: TDeviceModeW; fMode: DWORD): Longint; stdcall;

完成最小测试程序

现在已经是午夜过后了。你们中的一些人刚刚醒来。我已经过了就寝时间，充满了咒骂和咒骂:

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, Windows, WinSpool;

var
    dwBufferLen: DWORD;
    defaultPrinter: string;
    ADevice: PChar; //Pointer to printer name
    printerHandle: THandle;
    devModeSize: Integer;
    deviceMode: THandle;
begin
    dwBufferLen := 1024;
    SetLength(defaultPrinter, dwBufferLen);
    GetDefaultPrinter(PChar(defaultPrinter), @dwBufferLen);
    SetLength(defaultPrinter, dwBufferLen);
    ADevice := PChar(defaultPrinter);

    if not OpenPrinter(ADevice, {var}printerHandle, nil) then
        raise Exception.Create('Error checking removed for expository purposes');

    devModeSize := DocumentProperties(0, printerHandle, ADevice, nil, nil, 0);
    if devModeSize < 0 then
    begin
        //DocumentProperties is documented to have failed if it returns a value less than zero.
        //It's not documented to have also SetLastError; but we'll raise it anyway (Error code 50 - The request is not supported)
        RaiseLastOSError;
        Exit;
        //It's a good thing we fail. Because the return value -1 is coerced into an unsigned $FFFFFFFF.
        //Delphi then asks GlobalAlloc to try to allocate 4 GB of memory. *le sigh*
    end;

    deviceMode := GlobalAlloc(GHND, NativeUInt(devModeSize));
    if deviceMode = 0 then
        raise Exception.Create('It''s DocumentProperties above that fails. GlobalAlloc is just the victim of being asked to allocate 4GB of memory.');
end.

如何出发？

奖金闲聊

• QC#6725 :一个与打印相关的单独错误，已于八年前关闭，但仍然存在于 VCL 中。他们将无效参数传递给他们甚至不应该使用的 Windows 函数。然后，该函数会因参数无效而失败，导致代码回退到使用检查 win.ini 的 16 位 Windows 旧版兼容性函数。所有这些，而不是首先使用正确的功能。

Answer 1

我也遇到过这个错误...它总是返回 -1，但前提是我在 IDE 中调试。该错误突然出现。我认为这是 Windows 更新或自动驱动程序更新。我没有更改我的工作站设置的任何具体内容。经过几个小时的测试和调试，我注意到一个解决问题的技巧:

查询“GetDriverInfos”似乎会发出某种重置并且 PrinterSystem 开始工作。

DevSize := DocumentPropertiesA(0,FDriverHandle,FDeviceName,nil, nil,0);
if DevSize = -1 then
begin
  log('Failed to communicate with printer driver! Trying to ByPass Bug ');
  GetDriverInfos(FDriverHandle);
  DevSize := DocumentPropertiesA(0,FDriverHandle,FDeviceName,nil, nil,0);
  if DevSize <> -1 then
     log('Bug bypassed.');
end;

我知道这很奇怪，它对我有用(使用 Berlin 10.1)。我们以前在所有 Delphi 版本中都有这个错误，随机出现。