[SOLVED] DocumentProperties fails in XE6; works in Delphi 7

There's another bug tucked away in Delphi XE6 (probably added around the time Unicode support was added).

You can originally expose it by trying to call:

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

This fails with the cryptic error

Operation not supported on the selected printer

Debug their code

When you trace into the VCL, the problem comes down to the fact that the global TPrinter was unable to get a DEVMODE structure for the printer. This fails when it tries to call the Windows DocumentProperties function from 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

What is strange is that DocumentProperties is failing: it is returning -1. This is strange because there's nothing particularly conceptually wrong with the parameters.

DocumentProperties isn't documented to SetLastError on failure, but GetLastError consistently returns:

50 - The request is not supported

Code Review

There is some pretty bad code going on here:

it's calling DocumentProperties and not checking the return value (returns a value less than zero if it fails)
DocumentProperties returns a signed 32-bit integer
doing underflow when GlobalAlloc takes an unsigned 32-bit integer
DocumentProperties fails by returning -1
that is converted into $ffffffff when being passed to GlobalAlloc, when then tries to allocate 4 GB of memory

But it only fails in XE6

What is strange is that the same code works in Delphi 7. It shouldn't be failing in Unicode-enabled XE6. Looking at the header translation of DocumentProperties from Winapi.WinSpool in XE6:

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;

They did some pretty fancy const-var / typed-untyped overloading footwork there.

Where Delphi 7 has the simpler:

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;

Complete Minimal Test Program

It's after midnight here. Some of you are just waking up. And i'm past my bedtime, with a lot of cursing and swearing:

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.

How to make go?

Bonus Chatter

QC#6725: A separate printing related bug, that was closed eight years ago, that still exists in the VCL. They pass an invalid parameter to a Windows function they shouldn't even be using. The function then fails with the invalid parameter, causing the code to fall-back to using a 16-bit Windows legacy compatibility function that checks win.ini. All this rather than using the correct function in the first place.