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 结构。当它试图从 Vcl.Printers:

调用 Windows DocumentProperties 函数时失败

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 失败了：它正在 returning -1。这很奇怪，因为参数在概念上错误没有什么特别的。

DocumentProperties 未记录到 SetLastError 失败，但 GetLastError 一致 returns:

50 - The request is not supported

代码审查

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

它正在调用 DocumentProperties 并且不检查 return 值（return如果失败，则该值小于零）
DocumentProperties returns a signed 32 位整数
当 GlobalAlloc 采用 无符号 32 位整数时发生下溢
DocumentProperties 因 returning -1
传递给GlobalAlloc时转换为$ffffffff，然后尝试分配4 GB内存

但只在XE6中失败

奇怪的是，相同的代码在Delphi 7 中工作。它不应该在Unicode-enabled 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 函数。然后该函数因参数无效而失败，导致代码 fall-back 转而使用检查 win.ini 的 16 位 Windows 遗留兼容性函数。所有这一切，而不是首先使用正确的功能。

Answer 1

我也有这个错误......它总是 returns -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;

我知道这很奇怪，它对我有用（使用柏林 10.1）。我们之前在所有 Delphi 版本中都有这个错误，随机出现。

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

DocumentProperties fails in XE6; works in Delphi 7

delphi

winapi

delphi-xe6

调试他们的代码

代码审查

但只在XE6中失败

完成最小测试程序

奖金聊天