Results 1 to 24 of 24

Thread: [RESOLVED] PrintDlgEx API failed to return full name of printer

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Resolved [RESOLVED] PrintDlgEx API failed to return full name of printer

    I used Krool's OpenPrinterEx function in CommonDialog class. The function failed to return the full name of the chosen printer. The printer name is "\\192.4.4.143\Canon iR2002/2202 UFRII LT(1)" showing on the Printer Dialog. But I watched the return printer name (NewPrinterName) is "\\192.4.4.143\Canon iR2002/220" which is 30 characters length. what is the reason?

    When a Microsoft Windows application prints, it must identify the target printer by its full name. The DEVMODE structure that was introduced in 16-bit Windows version 3.1 has a limitation of 32 characters for a printer name. However, printer names in Win32 operating systems can be much longer.
    Look like the string is being truncated. I tried to changed CCHDEVICENAME =32 to 128 to increase the buffer but still no luck. Maybe the DMDeviceName in DEVMODE structure should be defined to Pointer?

    Code:
    Private Type PRINTDLGEX
        lStructSize As Long
        hWndOwner As Long
        hDevMode As Long
        hDevNames As Long
        hDC As Long
        Flags As Long
        Flags2 As Long
        ExclusionFlags As Long
        nPageRanges As Long
        nMaxPageRanges As Long
        lpPageRanges As Long
        nMinPage As Long
        nMaxPage As Long
        nCopies As Long
        hInstance As Long
        lpPrintTemplateName As Long
        lpCallback As Long
        nPropertyPages As Long
        lphPropertyPages As Long
        nStartPage As Long
        dwResultAction As Long
    End Type
    
    Private Const CCHDEVNAMESEXTRA As Long = 100
    Private Type DEVNAMES
        wDriverOffset As Integer
        wDeviceOffset As Integer
        wOutputOffset As Integer
        wDefault As Integer
        wExtra(0 To ((CCHDEVNAMESEXTRA * 2) - 1)) As Byte
    End Type
    Private Const CCHDEVICENAME As Long = 128 '32
    Private Const CCHFORMNAME As Long = 32
    Private Const DM_ORIENTATION As Long = &H1
    Private Const DM_PAPERSIZE As Long = &H2
    Private Const DM_COPIES As Long = &H100
    Private Const DM_DEFAULTSOURCE As Long = &H200
    Private Const DM_PRINTQUALITY As Long = &H400
    Private Const DM_COLOR As Long = &H800
    Private Const DM_DUPLEX As Long = &H1000
    Private Const DM_COLLATE As Long = &H8000&
    Private Type DEVMODE
        DMDeviceName(0 To ((CCHDEVICENAME * 2) - 1)) As Byte
        DMSpecVersion As Integer
        DMDriverVersion As Integer
        DMSize As Integer
        DMDriverExtra As Integer
        DMFields As Long
        DMOrientation As Integer
        DMPaperSize As Integer
        DMPaperLength As Integer
        DMPaperWidth As Integer
        DMScale As Integer
        DMCopies As Integer
        DMDefaultSource As Integer
        DMPrintQuality As Integer
        DMColor As Integer
        DMDuplex As Integer
        DMYResolution As Integer
        DMTTOption As Integer
        DMCollate As Integer
        DMFormName(0 To ((CCHFORMNAME * 2) - 1)) As Byte
        DMLogPixels As Integer
        DMBitsPerPel As Long
        DMPelsWidth As Long
        DMPelsHeight As Long
        DMDisplayFlags As Long
        DMDisplayFrequency As Long
        DMICMMethod As Long
        DMICMIntent As Long
        DMMediaType As Long
        DMDitherType As Long
        DMReserved1 As Long
        DMReserved2 As Long
        DMPanningWidth As Long
        DMPanningHeight As Long
    End Type
    
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function PrintDialogEx Lib "comdlg32" Alias "PrintDlgExW" (ByRef lpPrintDlgEx As PRINTDLGEX) As Long
    
    Private PropFlags As Long
    Private PropMin As Long, PropMax As Long
    Private PropFromPage As Long, PropToPage As Long
    Private PropPrinterDefault As Boolean
    Code:
    Public Function ShowPrinterEx() As CdlPDResultConstants
    Dim PDLGEX As PRINTDLGEX, PPAGERANGE As PRINTPAGERANGE, DMODE As DEVMODE, DNAMES As DEVNAMES
    Dim lpDevMode As Long, lpDevNames As Long
    Dim ObjPrinter As VB.Printer, NewPrinterName As String, Buffer As String
    With PDLGEX
    .lStructSize = LenB(PDLGEX)
    If Not Screen.ActiveForm Is Nothing Then
        .hWndOwner = Screen.ActiveForm.hWnd
    Else
        .hWndOwner = GetActiveWindow()
    End If
    .Flags = PropFlags
    .nPageRanges = 1
    .nMaxPageRanges = 1
    PPAGERANGE.nFromPage = PropFromPage
    PPAGERANGE.nToPage = PropToPage
    .nMinPage = PropMin
    .nMaxPage = PropMax
    .lpPageRanges = VarPtr(PPAGERANGE)
    Const START_PAGE_GENERAL As Long = &HFFFFFFFF
    .nStartPage = START_PAGE_GENERAL
    End With
    If VB.Printers.Count > 0 And (PDLGEX.Flags And CdlPDReturnDefault) = 0 Then
        With VB.Printer
        DMODE.DMSize = LenB(DMODE)
        Buffer = Left$(.DeviceName, CCHDEVICENAME)
        CopyMemory DMODE.DMDeviceName(0), ByVal StrPtr(Buffer), LenB(Buffer)
        DMODE.DMFields = DM_ORIENTATION Or DM_PAPERSIZE Or DM_COPIES Or DM_DEFAULTSOURCE Or DM_PRINTQUALITY Or DM_COLOR Or DM_DUPLEX Or DM_COLLATE
        DMODE.DMOrientation = .Orientation
        DMODE.DMPaperSize = .PaperSize
        DMODE.DMCopies = .Copies
        DMODE.DMDefaultSource = .PaperBin
        DMODE.DMPrintQuality = .PrintQuality
        DMODE.DMColor = .ColorMode
        DMODE.DMDuplex = .Duplex
        DMODE.DMCollate = IIf((PDLGEX.Flags And CdlPDCollate) <> 0, 1, 0)
        DNAMES.wDriverOffset = 4
        DNAMES.wDeviceOffset = DNAMES.wDriverOffset + Len(.DriverName) + 1
        DNAMES.wOutputOffset = DNAMES.wDeviceOffset + Len(.DeviceName) + 1
        DNAMES.wDefault = 0
        Buffer = Left$(.DriverName & vbNullChar & .DeviceName & vbNullChar & .Port & vbNullChar, CCHDEVNAMESEXTRA)
        CopyMemory DNAMES.wExtra(0), ByVal StrPtr(Buffer), LenB(Buffer)
        PDLGEX.nCopies = .Copies
        PDLGEX.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(DMODE))
        lpDevMode = GlobalLock(PDLGEX.hDevMode)
        CopyMemory ByVal lpDevMode, DMODE, LenB(DMODE)
        GlobalUnlock PDLGEX.hDevMode
        PDLGEX.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(DNAMES))
        lpDevNames = GlobalLock(PDLGEX.hDevNames)
        CopyMemory ByVal lpDevNames, DNAMES, LenB(DNAMES)
        GlobalUnlock PDLGEX.hDevNames
        End With
    End If
    Dim ErrVal As Long
    If PropHookEvents = False Then
        ErrVal = PrintDialogEx(PDLGEX)
    Else
        Call ComCtlsCdlPDEXSetHook(Me)
        ErrVal = PrintDialogEx(PDLGEX)
        Call ComCtlsCdlPDEXRemoveHook
    End If
    If ErrVal = S_OK Then
        If PDLGEX.dwResultAction <> CdlPDResultCancel Then
            lpDevMode = GlobalLock(PDLGEX.hDevMode)
            CopyMemory DMODE, ByVal lpDevMode, LenB(DMODE)
            GlobalUnlock PDLGEX.hDevMode
            GlobalFree PDLGEX.hDevMode
            lpDevNames = GlobalLock(PDLGEX.hDevNames)
            CopyMemory DNAMES, ByVal lpDevNames, LenB(DNAMES)
            GlobalUnlock PDLGEX.hDevNames
            GlobalFree PDLGEX.hDevNames
            NewPrinterName = Left$(DMODE.DMDeviceName(), InStr(DMODE.DMDeviceName(), vbNullChar) - 1)
            Dim PrinterFound As Boolean
            If StrComp(VB.Printer.DeviceName, NewPrinterName, vbTextCompare) <> 0 Then
                For Each ObjPrinter In VB.Printers
                    If StrComp(ObjPrinter.DeviceName, NewPrinterName, vbTextCompare) = 0 Then
                        Set VB.Printer = ObjPrinter
                        PrinterFound = True
                        Exit For
                    End If
                Next ObjPrinter
            Else
                PrinterFound = True
            End If
            If PropPrinterDefault = True Then Call SetPrinterDefault(NewPrinterName)
            If PrinterFound = True Then
                On Error Resume Next
                With VB.Printer
                .Copies = DMODE.DMCopies
                .Duplex = DMODE.DMDuplex
                .Orientation = DMODE.DMOrientation
                .PaperSize = DMODE.DMPaperSize
                .PrintQuality = DMODE.DMPrintQuality
                .ColorMode = DMODE.DMColor
                .PaperBin = DMODE.DMDefaultSource
                End With
                On Error GoTo 0
            End If
            PropFlags = PDLGEX.Flags
            If (PropFlags And CdlPDUseDevModeCopiesAndCollate) <> 0 Then
                If DMODE.DMCollate = 1 And (PropFlags And CdlPDCollate) = 0 Then PropFlags = PropFlags Or CdlPDCollate
            End If
            PropFromPage = PPAGERANGE.nFromPage
            PropToPage = PPAGERANGE.nToPage
            PropMin = PDLGEX.nMinPage
            PropMax = PDLGEX.nMaxPage
            If (PropFlags And (CdlPDReturnDC Or CdlPDReturnIC)) <> 0 Then PropDC = PDLGEX.hDC
            ShowPrinterEx = PDLGEX.dwResultAction
        Else
            If PropCancelError = True Then Err.Raise Number:=CdlCancel, Description:="Cancel was selected."
        End If
    Else
        If PDLGEX.hDevMode <> 0 Then GlobalFree PDLGEX.hDevMode
        If PDLGEX.hDevNames <> 0 Then GlobalFree PDLGEX.hDevNames
        Const E_OUTOFMEMORY As Long = &H8007000E, E_INVALIDARG As Long = &H80070057, E_POINTER As Long = &H80004003, E_HANDLE As Long = &H80070006, E_FAIL As Long = &H80004005
        Select Case ErrVal
            Case E_OUTOFMEMORY, E_INVALIDARG, E_POINTER, E_HANDLE, E_FAIL
                Err.Raise Number:=CdlInitFailure, Description:="The PrintDlgEx function failed during initialization."
            Case Else
                Err.Raise Number:=ErrVal, Description:="Unexpected error."
        End Select
    End If
    End Function
    Name:  OpenPrinterEx_2.jpg
Views: 2655
Size:  35.6 KB



    Name:  OpenPrinterEx_Dialog.png
Views: 2690
Size:  29.8 KB
    Last edited by Jonney; Apr 12th, 2015 at 07:31 PM.

  2. #2

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx failed to return full name of my Network printer

    I verified the max length of the printer name is restricted within 30 characters.

    Refer to my another two screenshots.


    Name:  OpenPrinterEx_3.jpg
Views: 2503
Size:  36.0 KB


    Name:  OpenPrinterEx_Dialog2.png
Views: 2649
Size:  37.5 KB
    Last edited by Jonney; Apr 12th, 2015 at 10:02 PM.

  3. #3

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx failed to return full name of my Network printer

    I tried to define String type instead of byte, but still cannot retrieve the full name of my Printer.
    The maximum characters are 30 for both of local and network printer.

    I attach a simply demo.
    Attached Files Attached Files
    Last edited by Jonney; Apr 12th, 2015 at 04:28 AM.

  4. #4
    gibra
    Guest

    Re: PrintDlgEx failed to return full name of my Network printer

    First of all, the instruction:

    Code:
    If Printer.DeviceName <> strNewPrinterName Then
    return always True, because strNewPrinterName variable is always on upper case, while Printer.DeviceName not.

    Second:
    on Microsoft DEVMODE structure (Windows) web page:https://msdn.microsoft.com/en-us/lib...or=-2147217396

    You read, about member dmDeviceName
    A zero-terminated character array that specifies the "friendly" name of the printer or display; for example, "PCL/HP LaserJet" in the case of PCL/HP LaserJet. This string is unique among device drivers. Note that this name may be truncated to fit in the dmDeviceName array.

    I don't know is there a different wayto solveyour question, but you may modify the comparison as workaround:

    Code:
        'If UCase$(objPrinter.DeviceName) = strNewPrinterName Then ' old camparison
        If (UCase$(objPrinter.DeviceName) Like Trim$(strNewPrinterName) & "*") = True Then
    Surely it could not be 100% accurate, but the probability that two printers have a name with the first 30 characters equal is rather remote.

    Perhaps, I've never tried it, you might think to use the Unicode version of DEVMODE:
    DEVMODEW structure (Windows Drivers)
    https://msdn.microsoft.com/en-us/lib...or=-2147217396


  5. #5
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: PrintDlgEx failed to return full name of my Network printer

    but the probability that two printers have a name with the first 30 characters equal is rather remote.
    i often see like printername (copy 2), so not totally unlikely
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  6. #6

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx failed to return full name of my Network printer

    Quote Originally Posted by gibra View Post
    First of all, the instruction:

    Code:
    If Printer.DeviceName <> strNewPrinterName Then
    return always True, because strNewPrinterName variable is always on upper case, while Printer.DeviceName not.

    Second:
    on Microsoft DEVMODE structure (Windows) web page:https://msdn.microsoft.com/en-us/lib...or=-2147217396

    You read, about member dmDeviceName
    A zero-terminated character array that specifies the "friendly" name of the printer or display; for example, "PCL/HP LaserJet" in the case of PCL/HP LaserJet. This string is unique among device drivers. Note that this name may be truncated to fit in the dmDeviceName array.

    I don't know is there a different wayto solveyour question, but you may modify the comparison as workaround:

    Code:
        'If UCase$(objPrinter.DeviceName) = strNewPrinterName Then ' old camparison
        If (UCase$(objPrinter.DeviceName) Like Trim$(strNewPrinterName) & "*") = True Then
    Surely it could not be 100% accurate, but the probability that two printers have a name with the first 30 characters equal is rather remote.

    Perhaps, I've never tried it, you might think to use the Unicode version of DEVMODE:
    DEVMODEW structure (Windows Drivers)
    https://msdn.microsoft.com/en-us/lib...or=-2147217396

    If Printer.DeviceName <> strNewPrinterName Then
    strComp will be better. But the following loop put UCase$ to check every pinter in printers collection, so it is not root cause.
    'If UCase$(objPrinter.DeviceName) = strNewPrinterName Then ' old camparison
    If (UCase$(objPrinter.DeviceName) Like Trim$(strNewPrinterName) & "*") = True Then
    Code:
    If UCase$(ObjPrinter.DeviceName) Like UCase$(NewPrinterName) & "*" And StrComp(VBA.Left$(ObjPrinter.DeviceName, 30), VBA.Left$(NewPrinterName, 30), vbTextCompare) = 0 Then
    I am afraid this workaround is not 100% accurate, it is not reliable to check up the first of 30 Characters.

    DEVMODE in Krool's CommonDialog is Unicode friendly declaration and Unicode API, I will change the declaration and give a try.

    I am not sure why we cannot retrieve FULL name of Printer. The max characters are 30 always regardless of English Characters or Unicode Characters. No wonder why many commercial software which got Preview feature used Own Printer Dialog Form instead of MS ShowPrinter Dialog API Window.
    Attached Images Attached Images  
    Last edited by Jonney; Apr 12th, 2015 at 11:02 PM.

  7. #7

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx failed to return full name of my Network printer

    Choosing a printer name
    Windows XP supports the use of long printer names. This allows you to create printer names that contain spaces and special characters. However, if you share a printer over a network, some clients will not recognize or correctly handle the long names, and users may experience problems printing. Also, some programs cannot print to printers with names longer than 31 characters.
    For shared printers, the entire qualified name (including the server name, for example \\PRINTER2\PSCRIPT) must be fewer than 31 characters.


    If you share a printer with a variety of clients on a network, use 31 or fewer characters for printer names, and do not include spaces or special characters in these names.

    If you share a printer with MS-DOS computers, do not use more than eight characters for the printer's share name. You can lengthen the name by adding a period followed by no more than three characters, but you cannot use spaces in the name.
    Several Windows version 3.x programs cannot print to a printer if its name contains more than the specified number of characters and will generate an Access Violation or other message if printing is attempted. Other programs may not print to any printer, even printers with short names, if the default printer's name is too long. To resolve these problems, rename the printers used by these programs with shorter names and make one of the renamed printers the default printer.
    The link is here.

    the local printer name also limit 30 characters from what I tested on Win7.

    .NET C#'s PrinterDialog just work fine for longer printer name. .NET reflector shows the class also call PrintDlgEx API to show Printer Dialog.

    [DllImport("comdlg32.dll", CharSet = CharSet.Auto, SetLastError = true)]
    public static extern int PrintDlgEx([In] [Out] NativeMethods.PRINTDLGEX lppdex);
    Code:
    /// <summary>Copies the relevant information out of the given handle and into the <see cref="T:System.Drawing.Printing.PrinterSettings" />.</summary>
    /// <param name="hdevnames">The handle to a Win32 DEVNAMES structure. </param>
    /// <exception cref="T:System.ArgumentException">The printer handle is invalid. </exception>
    /// <PermissionSet>
    ///   <IPermission class="System.Drawing.Printing.PrintingPermission, System.Drawing, Version=2.0.3600.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" version="1" Unrestricted="true" />
    /// </PermissionSet>
    public void SetHdevnames(IntPtr hdevnames)
    {
    	IntSecurity.AllPrintingAndUnmanagedCode.Demand();
    	if (hdevnames == IntPtr.Zero)
    	{
    		throw new ArgumentException(SR.GetString("InvalidPrinterHandle", new object[]
    		{
    			hdevnames
    		}));
    	}
    	IntPtr pDevnames = SafeNativeMethods.GlobalLock(new HandleRef(null, hdevnames));
    	this.driverName = PrinterSettings.ReadOneDEVNAME(pDevnames, 0);
    	this.printerName = PrinterSettings.ReadOneDEVNAME(pDevnames, 1);
    	this.outputPort = PrinterSettings.ReadOneDEVNAME(pDevnames, 2);
    	this.PrintDialogDisplayed = true;
    	SafeNativeMethods.GlobalUnlock(new HandleRef(null, hdevnames));
    }
    
    // System.Drawing.Printing.PrinterSettings
    private static string ReadOneDEVNAME(IntPtr pDevnames, int slot)
    {
    	checked
    	{
    		int num = Marshal.SystemDefaultCharSize * (int)Marshal.ReadInt16((IntPtr)((long)pDevnames + unchecked((long)checked(slot * 2))));
    		return Marshal.PtrToStringAuto((IntPtr)((long)pDevnames + unchecked((long)num)));
    	}
    }
    Look into the above code, the printer name is located at pDevnames + 2* ConvertTo16bitInteger(pDevnames+2). I don't know how to convert to VB6 code. Please help.

    Code:
            'In Krool's CommonDialog ShowPrinterEx
            lpDevMode = GlobalLock(PDLGEX.hDevMode)
            CopyMemory DMODE, ByVal lpDevMode, LenB(DMODE)
            GlobalUnlock PDLGEX.hDevMode
            GlobalFree PDLGEX.hDevMode
            lpDevNames = GlobalLock(PDLGEX.hDevNames)
            CopyMemory DNAMES, ByVal lpDevNames, LenB(DNAMES)
            GlobalUnlock PDLGEX.hDevNames
            GlobalFree PDLGEX.hDevNames
            NewPrinterName = VBA.Left$(DMODE.DMDeviceName(), InStr(DMODE.DMDeviceName(), vbNullChar) - 1)
    Last edited by Jonney; Apr 12th, 2015 at 08:52 PM.

  8. #8
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    Jonney, per MSDN the EnumPrinters API can return long printer names if a PRINTER_INFO_2 structure (level 2) is passed. Does that help?
    Last edited by LaVolpe; Apr 13th, 2015 at 11:55 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  9. #9
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    Ignore my previous reply, I misread. The problem is that the full name of the selected printer is not returned after the dialog closes, correct?
    In that case, per msdn, the full length can be recovered from the DEVNAMES structure... does that work?
    Code:
    Private Declare Function lstrlenA Lib "kernel32" _
                              (ByVal hMem As Long) As Long
    
    ...
            Dim lSize As Long, tBytes() As Byte
            lpDevName = GlobalLock(PrintDlg.hDevNames)
            CopyMemory DevName, ByVal lpDevName, 8 ' the 200 extra bytes you added to the structure is incorrect
            lSize = lstrlenA(lpDevName + DevName.wDeviceOffset)
            ReDim tBytes(0 To lSize - 1)
            CopyMemory tBytes(0), ByVal lpDevName + DevName.wDeviceOffset, lSize
            intReturn = GlobalUnlock(PrintDlg.hDevNames)
    
            Debug.Print "Full Name of Selected Printer: "; StrConv(tBytes(), vbUnicode)
    ...
    On a side note. Your sample zip project always crashes for me. The reason for the crash I believe is this line in your sample project:
    Code:
    CopyMemory DevName, ByVal lpDevName, LenB(DevName)
    LenB(DevName) = 208 and if the number of bytes @ lpDevName < 208 then crash

    Your structure definition is wrong. There should be no 'extra' bytes member added in my opinion. Granted that if you are going to provide the DEVNAMES structure, you will need extra bytes, but that should not be part of the structure definition. Why is this important? As is, when you send the PrintDlgEx the DevNames structure, that structure is 208 bytes, but when it returns from the PrintDlgEx, it is changed. And when you use CopyMemory to copy LenB(DevNames), crash. So, how do you add extra bytes without adding them to the structure definition?
    1. GlobalAlloc the total number of bytes needed, say 208?
    2. Get a pointer via GlobalLock
    3. Copy the 8 byte DEVNAMES structure
    4. Build a temp array (200 bytes?) that contain the strings you want passed with DEVNAMES
    5. Copy that array to the pointer + 8.

    --------------------------------------------------------------------------------------
    And yet more notes:

    I see you are populating the DEVNAMES structure before calling PrintDlgEx. This is not necessary if you want to initialize the dialog to the default printer. If the hDevNames member is zero, the default printer is used

    If the PrintDlg.hwndOwner member is zero, on Vista+ I get a different dialog GUI than if it is non-zero, haven't tried it on XP
    Last edited by LaVolpe; Apr 14th, 2015 at 09:28 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  10. #10

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx API failed to return full name of printer

    Quote Originally Posted by LaVolpe View Post
    Ignore my previous reply, I misread. The problem is that the full name of the selected printer is not returned after the dialog closes, correct?
    In that case, per msdn, the full length can be recovered from the DEVNAMES structure... does that work?
    Code:
    Private Declare Function lstrlen Lib "kernel32" _
                              (ByVal hMem As Long) As Long
    
    ...
            Dim lSize As Long, tBytes() As Byte
            lpDevName = GlobalLock(PrintDlg.hDevNames)
            CopyMemory DevName, ByVal lpDevName, 8 ' the 200 extra bytes you added to the structure is incorrect
            lSize = lstrlen(lpDevName + DevName.wDeviceOffset)
            ReDim tBytes(0 To lSize - 1)
            CopyMemory tBytes(0), ByVal lpDevName + DevName.wDeviceOffset, lSize
            intReturn = GlobalUnlock(PrintDlg.hDevNames)
    
            Debug.Print "Full Name of Selected Printer: "; StrConv(tBytes(), vbUnicode)
    ...
    On a side note. Your sample zip project always crashes for me. The reason for the crash I believe is this line in your sample project:
    Code:
    CopyMemory DevName, ByVal lpDevName, LenB(DevName)
    LenB(DevName) = 208 and if the number of bytes @ lpDevName < 208 then crash

    Your structure definition is wrong. There should be no 'extra' bytes member added in my opinion. Granted that if you are going to provide the DEVNAMES structure, you will need extra bytes, but that should not be part of the structure definition. Why is this important? As is, when you send the PrintDlgEx the DevNames structure, that structure is 208 bytes, but when it returns from the PrintDlgEx, it is changed. And when you use CopyMemory to copy LenB(DevNames), crash. So, how do you add extra bytes without adding them to the structure definition?
    1. GlobalAlloc the total number of bytes needed, say 208?
    2. Get a pointer via GlobalLock
    3. Copy the 8 byte DEVNAMES structure
    4. Build a temp array (200 bytes?) that contain the strings you want passed with DEVNAMES
    5. Copy that array to the pointer + 8.

    --------------------------------------------------------------------------------------
    And yet more notes:

    I see you are populating the DEVNAMES structure before calling PrintDlgEx. This is not necessary if you want to initialize the dialog to the default printer. If the hDevNames member is zero, the default printer is used

    If the PrintDlg.hwndOwner member is zero, on Vista+ I get a different dialog GUI than if it is non-zero, haven't tried it on XP
    First of all, Thank you very much, Sir.
    And, Honestly, Such advanced stuff with memory operation is my weakness. I don't REALLY understand deeply.
    The demo I provided has many testing code, it confuse you initially but you went out because you really understood!

    Now I see the beautiful Printer name now though it returns weird characters when the printer name is Unicode. I think we should define the structure by byte() instead of String.
    With Krool's CommonDialog class, I also saw the beautiful FULL printer name. It is better because the declared structure is Unicode friendly.

    One question:
    I used SysReAllocString API to get the printer string. Why the string pointer is located at lpDevNames + 8 +18? Please explain a bit.

    NewPrinterName = GetStrFromPtrW4(lpDevNames + 8 + 18)
    Code:
    Private Function GetStrFromPtrW4(ByVal Ptr As Long) As String
        'Bonnie West - Benchmarks demo on VBForums
        SysReAllocString VarPtr(GetStrFromPtrW4), Ptr
    End Function
    
    Public Function ShowPrinterEx() As CdlPDResultConstants
    Dim PDLGEX As PRINTDLGEX, PPAGERANGE As PRINTPAGERANGE, DMODE As DEVMODE, DNAMES As DEVNAMES
    Dim lpDevMode As Long, lpDevNames As Long
    Dim ObjPrinter As VB.Printer, NewPrinterName As String, Buffer As String
    With PDLGEX
    .lStructSize = LenB(PDLGEX)
    If Not Screen.ActiveForm Is Nothing Then
        .hWndOwner = Screen.ActiveForm.hWnd
    Else
        .hWndOwner = GetActiveWindow()
    End If
    .Flags = PropFlags
    .nPageRanges = 1
    .nMaxPageRanges = 1
    PPAGERANGE.nFromPage = PropFromPage
    PPAGERANGE.nToPage = PropToPage
    .nMinPage = PropMin
    .nMaxPage = PropMax
    .nCopies = PropCopies
    .lpPageRanges = VarPtr(PPAGERANGE)
    Const START_PAGE_GENERAL As Long = &HFFFFFFFF
    .nStartPage = START_PAGE_GENERAL
    End With
    If VB.Printers.Count > 0 And (PDLGEX.Flags And CdlPDReturnDefault) = 0 Then
        With VB.Printer
        DMODE.DMSize = LenB(DMODE)
        Buffer = VBA.Left$(.DeviceName, CCHDEVICENAME)
        CopyMemory DMODE.DMDeviceName(0), ByVal StrPtr(Buffer), LenB(Buffer)
        DMODE.DMFields = DM_ORIENTATION Or DM_PAPERSIZE Or DM_COPIES Or DM_DEFAULTSOURCE Or DM_PRINTQUALITY Or DM_COLOR Or DM_DUPLEX Or DM_COLLATE
        DMODE.DMOrientation = .Orientation
        DMODE.DMPaperSize = PaperSize '.PaperSize
        DMODE.DMCopies = PropCopies ' .Copies
        DMODE.DMDefaultSource = .PaperBin
        DMODE.DMPrintQuality = .PrintQuality
        DMODE.DMColor = .ColorMode
        DMODE.DMDuplex = .Duplex
        DMODE.DMCollate = IIf((PDLGEX.Flags And CdlPDCollate) <> 0, 1, 0)
        PDLGEX.nCopies = .Copies
        PDLGEX.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(DMODE))
        lpDevMode = GlobalLock(PDLGEX.hDevMode)
        CopyMemory ByVal lpDevMode, DMODE, LenB(DMODE)
        GlobalUnlock PDLGEX.hDevMode
        
        DNAMES.wDriverOffset = 4
        DNAMES.wDeviceOffset = DNAMES.wDriverOffset + Len(.DriverName) + 1
        Debug.Print "DNAMES.wDriverOffset + Len(.DriverName) + 1="; DNAMES.wDriverOffset + Len(.DriverName) + 1
        DNAMES.wOutputOffset = DNAMES.wDeviceOffset + Len(.DeviceName) + 1
        DNAMES.wDefault = 0
        Buffer = VBA.Left$(.DriverName & vbNullChar & .DeviceName & vbNullChar & .Port & vbNullChar, CCHDEVNAMESEXTRA)
        CopyMemory DNAMES.wExtra(0), ByVal StrPtr(Buffer), LenB(Buffer)
        PDLGEX.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(DNAMES))
        lpDevNames = GlobalLock(PDLGEX.hDevNames)
        CopyMemory ByVal lpDevNames, DNAMES, LenB(DNAMES)
        GlobalUnlock PDLGEX.hDevNames
        End With
    End If
    Dim ErrVal As Long
    If PropHookEvents = False Then
        ErrVal = PrintDialogEx(PDLGEX)
    Else
        Call ComCtlsCdlPDEXSetHook(Me)
        ErrVal = PrintDialogEx(PDLGEX)
        Call ComCtlsCdlPDEXRemoveHook
    End If
    If ErrVal = S_OK Then
        If PDLGEX.dwResultAction <> CdlPDResultCancel Then
            lpDevMode = GlobalLock(PDLGEX.hDevMode)
            CopyMemory DMODE, ByVal lpDevMode, LenB(DMODE)
            GlobalUnlock PDLGEX.hDevMode
            GlobalFree PDLGEX.hDevMode
            
            lpDevNames = GlobalLock(PDLGEX.hDevNames)
            CopyMemory DNAMES, ByVal lpDevNames, 8 'LenB(DNAMES)
            NewPrinterName = GetStrFromPtrW4(lpDevNames + 8 + 18)
            
            GlobalUnlock PDLGEX.hDevNames
            GlobalFree PDLGEX.hDevNames
            'NewPrinterName = VBA.Left$(DMODE.DMDeviceName, InStr(DMODE.DMDeviceName, vbNullChar) - 1)
                 
            Dim PrinterFound As Boolean
            If StrComp(VB.Printer.DeviceName, NewPrinterName, vbTextCompare) <> 0 Then
                For Each ObjPrinter In VB.Printers
                    If StrComp(ObjPrinter.DeviceName, NewPrinterName, vbTextCompare) = 0 Then
                        Set VB.Printer = ObjPrinter
                        PrinterFound = True
                        Exit For
                    End If
                Next ObjPrinter
            Else
                PrinterFound = True
            End If
            If PropPrinterDefault = True Then Call SetPrinterDefault(NewPrinterName)
            If PrinterFound = True Then
                On Error Resume Next
                With VB.Printer
                .Copies = DMODE.DMCopies
                .Duplex = DMODE.DMDuplex
                .Orientation = DMODE.DMOrientation
                .PaperSize = DMODE.DMPaperSize
                .PrintQuality = DMODE.DMPrintQuality
                .ColorMode = DMODE.DMColor
                .PaperBin = DMODE.DMDefaultSource
                End With
                On Error GoTo 0
            End If
            PropFlags = PDLGEX.Flags
            If (PropFlags And CdlPDUseDevModeCopiesAndCollate) <> 0 Then
                If DMODE.DMCollate = 1 And (PropFlags And CdlPDCollate) = 0 Then PropFlags = PropFlags Or CdlPDCollate
            End If
            PropFromPage = PPAGERANGE.nFromPage
            PropToPage = PPAGERANGE.nToPage
            PropMin = PDLGEX.nMinPage
            PropMax = PDLGEX.nMaxPage
            If (PropFlags And (CdlPDReturnDC Or CdlPDReturnIC)) <> 0 Then PropDC = PDLGEX.hDc
            ShowPrinterEx = PDLGEX.dwResultAction
        Else
            If PropCancelError = True Then Err.Raise Number:=CdlCancel, Description:="Cancel was selected."
        End If
    Else
        If PDLGEX.hDevMode <> 0 Then GlobalFree PDLGEX.hDevMode
        If PDLGEX.hDevNames <> 0 Then GlobalFree PDLGEX.hDevNames
        Const E_OUTOFMEMORY As Long = &H8007000E, E_INVALIDARG As Long = &H80070057, E_POINTER As Long = &H80004003, E_HANDLE As Long = &H80070006, E_FAIL As Long = &H80004005
        Select Case ErrVal
            Case E_OUTOFMEMORY, E_INVALIDARG, E_POINTER, E_HANDLE, E_FAIL
                Err.Raise Number:=CdlInitFailure, Description:="The PrintDlgEx function failed during initialization."
            Case Else
                Err.Raise Number:=ErrVal, Description:="Unexpected error."
        End Select
    End If
    End Function
    Code:
    Private Type PRINTDLGEX
    lStructSize As Long
    hWndOwner As Long
    hDevMode As Long
    hDevNames As Long
    hDc As Long
    Flags As Long
    Flags2 As Long
    ExclusionFlags As Long
    nPageRanges As Long
    nMaxPageRanges As Long
    lpPageRanges As Long
    nMinPage As Long
    nMaxPage As Long
    nCopies As Long
    hInstance As Long
    lpPrintTemplateName As Long
    lpCallback As Long
    nPropertyPages As Long
    lphPropertyPages As Long
    nStartPage As Long
    dwResultAction As Long
    End Type
    Private Const CCHDEVNAMESEXTRA As Long = 100
    Private Type DEVNAMES
    wDriverOffset As Integer
    wDeviceOffset As Integer
    wOutputOffset As Integer
    wDefault As Integer
    wExtra(0 To ((CCHDEVNAMESEXTRA * 2) - 1)) As Byte
    End Type
    Private Const CCHDEVICENAME As Long = 32
    Private Const CCHFORMNAME As Long = 32
    Private Const DM_ORIENTATION As Long = &H1
    Private Const DM_PAPERSIZE As Long = &H2
    Private Const DM_COPIES As Long = &H100
    Private Const DM_DEFAULTSOURCE As Long = &H200
    Private Const DM_PRINTQUALITY As Long = &H400
    Private Const DM_COLOR As Long = &H800
    Private Const DM_DUPLEX As Long = &H1000
    Private Const DM_COLLATE As Long = &H8000&
    Private Type DEVMODE
    DMDeviceName(0 To ((CCHDEVICENAME * 2) - 1)) As Byte
    DMSpecVersion As Integer
    DMDriverVersion As Integer
    DMSize As Integer
    DMDriverExtra As Integer
    DMFields As Long
    DMOrientation As Integer
    DMPaperSize As Integer
    DMPaperLength As Integer
    DMPaperWidth As Integer
    DMScale As Integer
    DMCopies As Integer
    DMDefaultSource As Integer
    DMPrintQuality As Integer
    DMColor As Integer
    DMDuplex As Integer
    DMYResolution As Integer
    DMTTOption As Integer
    DMCollate As Integer
    DMFormName(0 To ((CCHFORMNAME * 2) - 1)) As Byte
    DMLogPixels As Integer
    DMBitsPerPel As Long
    DMPelsWidth As Long
    DMPelsHeight As Long
    DMDisplayFlags As Long
    DMDisplayFrequency As Long
    DMICMMethod As Long
    DMICMIntent As Long
    DMMediaType As Long
    DMDitherType As Long
    DMReserved1 As Long
    DMReserved2 As Long
    DMPanningWidth As Long
    DMPanningHeight As Long
    End Type
    
    Private Declare Function PrintDialogEx Lib "comdlg32" Alias "PrintDlgExW" (ByRef lpPrintDlgEx As PRINTDLGEX) As Long
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    
    Public Property Get Min() As Long
    Min = PropMin
    End Property
    
    Public Property Let Min(ByVal value As Long)
    If value < 0 Then Err.Raise 380
    PropMin = value
    End Property
    
    Public Property Get Max() As Long
    Max = PropMax
    End Property
    
    Public Property Let Max(ByVal value As Long)
    If value < 0 Then Err.Raise 380
    PropMax = value
    End Property
    
    Public Property Get FromPage() As Long
    FromPage = PropFromPage
    End Property
    
    Public Property Let FromPage(ByVal value As Long)
    If value < 0 Then Err.Raise 380
    PropFromPage = value
    End Property
    
    Public Property Get ToPage() As Long
    ToPage = PropToPage
    End Property
    
    Public Property Let ToPage(ByVal value As Long)
    If value < 0 Then Err.Raise 380
    PropToPage = value
    End Property
    
    Public Property Get Copies() As Long '***Add
    Copies = PropCopies
    End Property
    
    Public Property Let Copies(ByVal value As Long) '***Add
    If value < 0 Then Err.Raise 380
    PropCopies = value
    End Property
    
    Public Property Get PaperSize() As Long '***Add
    PaperSize = PropPaperSize
    End Property
    
    Public Property Let PaperSize(ByVal value As Long) '***Add
    If value < 0 Then Err.Raise 380
    PropPaperSize = value
    End Property
    Last edited by Jonney; Apr 13th, 2015 at 09:44 PM. Reason: update the declaration

  11. #11
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    Per MSDN, when PrintDlgExW is used, all strings must be unicode. When PrintDlgExA is used strings must be ANSI. This includes any strings you provide as strings or in a byte array. This also includes any strings/pointers returned from the API. When using the W version, pass the structure by VarPtr() and redefine your API
    Code:
    Private Declare Function PrintDialogW Lib "comdlg32.dll" Alias "PrintDlgW" _
                              (ByVal pPrintdlg As Long) As Long
    
    ...
    If PrintDialogW(VarPtr(PrintDlg)) Then
    
    ...
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  12. #12
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    I think you are right. You will want to use arrays for the dmDeviceName & dmFormName members. For ANSI version, sized 32 and 64 for unicode. I don't have time to play with this today. After reviewing the class you included in your zip file, I have seen other things that can lead to problems
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  13. #13
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    Quote Originally Posted by Jonney
    I used SysReAllocString API to get the printer string. Why the string pointer is located at lpDevNames + 8 +18? Please explain a bit.
    Per msdn, the correct structure is
    Code:
    Private Type DEVNAMES_TYPE
        wDriverOffset As Integer
        wDeviceOffset As Integer
        wOutputOffset As Integer
        wDefault As Integer
    End Type
    That structure is 8 bytes: 4 integers of 2 bytes each. Each integer is an offset from the pointer you get from GlobalLock(.hDevNames). Let's just assume these values are given to us for those members:
    wDriverOffset = 8
    wDeviceOffset = 18
    wOutputOffset = 32
    wDefault = 50

    This tells us that the printer name starts at the memory address of the pointer + 18 bytes. The wDefault string starts at the pointer + 50 bytes, etc, etc. The DEVNAMES structure is just 8 bytes, but the global pointer you were given by the API is the 8 bytes + the total bytes needed to store the strings. They are just packed/stacked together

    Does that help?
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  14. #14

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx API failed to return full name of printer

    Quote Originally Posted by LaVolpe View Post
    Per msdn, the correct structure is
    Code:
    Private Type DEVNAMES_TYPE
        wDriverOffset As Integer
        wDeviceOffset As Integer
        wOutputOffset As Integer
        wDefault As Integer
    End Type
    That structure is 8 bytes: 4 integers of 2 bytes each. Each integer is an offset from the pointer you get from GlobalLock(.hDevNames). Let's just assume these values are given to us for those members:
    wDriverOffset = 8
    wDeviceOffset = 18
    wOutputOffset = 32
    wDefault = 50

    This tells us that the printer name starts at the memory address of the pointer + 18 bytes. The wDefault string starts at the pointer + 50 bytes, etc, etc. The DEVNAMES structure is just 8 bytes, but the global pointer you were given by the API is the 8 bytes + the total bytes needed to store the strings. They are just packed/stacked together

    Does that help?
    Let's just assume these values are given to us for those members:
    wDriverOffset = 8
    wDeviceOffset = 18
    wOutputOffset = 32
    wDefault = 50
    "Assume"? those are exact memory address. How you get the 8,18,32,50?

  15. #15
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    I made them up for the example. They can change depending on which printer was selected and/or however the print dialog organizes the memory it allocates and sends to you through the hDevNames global pointer.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  16. #16

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx API failed to return full name of printer

    Quote Originally Posted by LaVolpe View Post
    I made them up for the example. They can change depending on which printer was selected and/or however the print dialog organizes the memory it allocates and sends to you through the hDevNames global pointer.
    Refer to #10 code, Is it reliable to use GetStrFromPtrW4(lpDevNames + 8 + 18) to retrieve the printer name?
    CopyMemory DNAMES, ByVal lpDevNames, 8 'LenB(DNAMES)
    NewPrinterName = GetStrFromPtrW4(lpDevNames + 8 + 18)

  17. #17
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    Have never used GetStrFromPtrW4. But no, the parameters are not correct. You cannot hard code the offsets

    Here is an example, using Unicode version
    Code:
    Private Declare Function lstrlenW Lib "kernel32" _
                              (ByVal hMem As Long) As Long
    
    Private Declare Function PrintDialogW Lib "comdlg32.dll" Alias "PrintDlgW" _
                              (ByVal pPrintdlg As Long) As Long
    
    Private Type DEVMODE_TYPE
        dmDeviceName(1 To CCHDEVICENAME * 2) As Byte '32 ANSI 64  Unicode
        ...
        dmFormName(1 To CCHFORMNAME * 2) As Byte '32 ANSI 64 Unicode
        ...
    End Type
    
    ...
        If PrintDialogW(VarPtr(PrintDlg)) Then
    
            Dim lSize As Long, tBytes() As Byte
            lpDevName = GlobalLock(PrintDlg.hDevNames)
            CopyMemory DevName, ByVal lpDevName, 8 ' the 200 extra bytes you added to the structure is incorrect
            lSize = lstrlenW(lpDevName + DevName.wDeviceOffset * 2)
            strNewPrinterName = String$(lSize, vbNullChar)
            CopyMemory ByVal StrPtr(strNewPrinterName), ByVal lpDevName + DevName.wDeviceOffset * 2, lSize * 2
            intReturn = GlobalUnlock(PrintDlg.hDevNames)
    
            Debug.Print "Full Name of Selected Printer: "; strNewPrinterName
    ...
    Notice that when retrieving the full printer name, that the offsets in the DEVNAMES members are * 2. This is because the offsets are not provided as bytes, they are provided as characters and unicode is 2 bytes per character

    The DEVNAMES structure is referenced differently depending on ANSI or unicode version of API being called. The offsets are measured in characters from the beginning of the structure, not bytes from beginning of structure

    ANSI: global pointer data is 1 byte per character
    - Retrieving strings: Use pointer + DevName.[offset], lstrLenA to get length
    - Setting strings: string data must be 1 byte per character, 1st position for any DevName.[offset] member is 8
    i.e., DevName.wDeviceOffset = 8. Copy the default printer name + null char to global pointer + 8
    Note: So, 1st position is (8 bytes from start of structure) / (1 byte per character) = offset of 8

    Unicode: global pointer data is 2 bytes per character
    - Retrieving strings: Use pointer + DevName.[offset] * 2, lstrLenW to get length
    - Setting strings: string data must be 2 bytes per character, 1st position for any DevName.[offset] member is 4
    i.e., DevName.wDeviceOffset = 4. Copy the default printer name + 2 null chars to global pointer + 8
    Note: So, 1st position is (8 bytes from start of structure) / (2 bytes per character) = offset of 4
    Last edited by LaVolpe; Apr 14th, 2015 at 11:11 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  18. #18
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    Jonney, here's something to play with. But see my previous reply regarding DEVNAMES

    Here's a generic unicode/ansi version of your ShowPrinter function
    Code:
    Public Function ShowPrinter(Optional ByVal hWndOwner As Long) As Boolean
    
        Dim PrintDlg As PRINTDLG_TYPE
        Dim DevMode As DEVMODE_TYPE
        Dim DevName As DEVNAMES_TYPE
        Dim lpDevMode As Long, lpDevName As Long
        Dim lngReturn As Long
        Dim objPrinter As Printer
        Dim strNewPrinterName As String
        Dim blnCancel As Boolean
        Dim lSize As Long, tBytes() As Byte
        Dim lTrailingBytes As Long
    
        With PrintDlg
            .lStructSize = Len(PrintDlg)
            .hWndOwner = hWndOwner
            .Flags = Flags
            .nMinPage = intMinPage
            .nFromPage = intFromPage
            .nToPage = intToPage
            .nMaxPage = intMaxPage
        End With
    
        ' if you want to choose a different printer to be selected as default
        ' add a property to allow user to select printer beforehand, may need EnumPrinters to fill a list
        ' for example, we'll say the  property name is m_DefaultPrinter (string)
        If Len(m_DefaultPrinter) > 0 Then
            If m_Unicode Then
                lSize = Len(m_DefaultPrinter) * 2 + 2
                tBytes() = m_DefaultPrinter & vbNullChar
                DevName.wDeviceOffset = 4
                DevMode.dmDeviceName(1) = 48 ' dummy to force dmDeviceName <> DevNames
            Else
                lSize = Len(m_DefaultPrinter) + 1
                tBytes() = StrConv(m_DefaultPrinter & vbNullChar, vbFromUnicode)
                DevName.wDeviceOffset = 8
                DevMode.dmDeviceName(33) = 48 ' dummy to force dmDeviceName <> DevNames
            End If
            PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, lSize + 8)
            lpDevName = GlobalLock(PrintDlg.hDevNames)
            If lpDevName Then
                CopyMemory ByVal lpDevName, DevName, 8
                CopyMemory ByVal lpDevName + 8, tBytes(0), lSize
                GlobalUnlock PrintDlg.hDevNames
                Erase tBytes()
            End If
        End If
        
        On Error Resume Next ' some of your test code?
        DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
        DevMode.dmOrientation = Printer.Orientation
        DevMode.dmDuplex = Printer.Duplex
        On Error GoTo 0
    
        DevMode.dmSpecVersion = &H320    
        DevMode.dmSize = LenB(DevMode)
        If m_Unicode = False Then DevMode.dmSize = DevMode.dmSize - CCHDEVICENAME - CCHFORMNAME
        
        PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, DevMode.dmSize)
        lpDevMode = GlobalLock(PrintDlg.hDevMode)
        If lpDevMode Then
            If m_Unicode Then
                CopyMemory ByVal lpDevMode, DevMode, DevMode.dmSize
            Else
                ' number of bytes from dmUnusedPadding to end of the structure
                lTrailingBytes = VarPtr(DevMode) + Len(DevMode) - VarPtr(DevMode.dmUnusedPadding)
                ' copy 32 bytes of both dmDeviceName/dmFormName + 38 bytes (up to and including dmCollate)
                CopyMemory ByVal lpDevMode, ByVal VarPtr(DevMode) + CCHDEVICENAME, DevMode.dmSize - lTrailingBytes
                ' copy all members including and after dmUnusedPadding
                CopyMemory ByVal lpDevMode + DevMode.dmSize - lTrailingBytes, ByVal VarPtr(DevMode.dmUnusedPadding), lTrailingBytes
            End If
            lngReturn = GlobalUnlock(PrintDlg.hDevMode)
        End If
    
        If m_Unicode Then
            lngReturn = PrintDialogW(VarPtr(PrintDlg))
        Else
            lngReturn = PrintDialog(PrintDlg)
        End If
        
        If lngReturn = 0 Then ' user canceled?
            If PrintDlg.hDevMode Then GlobalFree PrintDlg.hDevMode
            If PrintDlg.hDevNames Then GlobalFree PrintDlg.hDevNames
            blnCancel = True
            If CancelError Then _
               Err.Raise cdlCancel, "LM PrintDialog", "Cancel."
        Else
        
            ' get full printer name to assign to VB.Printers object
            If Not (PrintDlg.hDevNames = 0 Or PrintDlg.hDevMode = 0) Then
                lpDevName = GlobalLock(PrintDlg.hDevNames)
                CopyMemory DevName, ByVal lpDevName, 8
                If m_Unicode Then
                    lSize = lstrlenW(lpDevName + DevName.wDeviceOffset * 2)
                    strNewPrinterName = String$(lSize, vbNullChar)
                    CopyMemory ByVal StrPtr(strNewPrinterName), ByVal lpDevName + DevName.wDeviceOffset * 2, lSize * 2
                Else
                    lSize = lstrlenA(lpDevName + DevName.wDeviceOffset)
                    ReDim tBytes(0 To lSize - 1)
                    CopyMemory tBytes(0), ByVal lpDevName + DevName.wDeviceOffset, lSize
                    strNewPrinterName = StrConv(tBytes(), vbUnicode)
                    Erase tBytes()
                End If
                GlobalUnlock PrintDlg.hDevNames
                GlobalFree PrintDlg.hDevNames
                
                lpDevMode = GlobalLock(PrintDlg.hDevMode)
                If m_Unicode Then
                    CopyMemory DevMode, ByVal lpDevMode, DevMode.dmSize
                Else
                    lSize = DevMode.dmSize
                    CopyMemory ByVal VarPtr(DevMode) + CCHDEVICENAME, ByVal lpDevMode, lSize - lTrailingBytes
                    CopyMemory ByVal VarPtr(DevMode.dmUnusedPadding), ByVal lpDevMode + lSize - lTrailingBytes, lTrailingBytes
                End If
                GlobalUnlock PrintDlg.hDevMode
                GlobalFree PrintDlg.hDevMode
                
                On Error Resume Next
                For Each objPrinter In Printers
                    If StrComp(objPrinter.DeviceName, strNewPrinterName, vbTextCompare) = 0 Then
                        Set Printer = objPrinter
                        Exit For
                    End If
                Next objPrinter
                With Printer
                    .Copies = DevMode.dmCopies
                    .Duplex = DevMode.dmDuplex
                    .Orientation = DevMode.dmOrientation
                End With
                On Error GoTo 0
                
            Else
                If PrintDlg.hDevNames Then GlobalFree PrintDlg.hDevNames
                If PrintDlg.hDevMode Then GlobalFree PrintDlg.hDevMode
                ' something's wrong, should have hDevNames & hDevMode values
                Err.Raise cdlCancel, "LM PrintDialog", "Cancel."
            End If
        End If
    
        ShowPrinter = Not blnCancel
    
    End Function
    Also, here are changes to API and TYPE declarations. Note that I am using the same DEVMODE structure for both ANSI/Unicode. When ANSI is used, the code in the ShowPrinter function customizes copying it to a global pointer for ANSI use
    Code:
    Private Declare Function lstrlenA Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function lstrlenW Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" _
                              (pPrintdlg As PRINTDLG_TYPE) As Long
    Private Declare Function PrintDialogW Lib "comdlg32.dll" Alias "PrintDlgW" _
                              (ByVal pPrintdlg As Long) As Long
    Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
    Private Declare Function IsWindowUnicode Lib "user32.dll" (ByVal hWnd As Long) As Long
    
    Private Type DEVMODE_TYPE ' https://msdn.microsoft.com/en-us/library/windows/desktop/dd183565%28v=vs.85%29.aspx
        dmDeviceName(1 To CCHDEVICENAME * 2) As Byte
        dmSpecVersion As Integer
        dmDriverVersion As Integer
        dmSize As Integer
        dmDriverExtra As Integer
        dmFields As Long
        dmOrientation As Integer
        dmPaperSize As Integer
        dmPaperLength As Integer
        dmPaperWidth As Integer
        dmScale As Integer
        dmCopies As Integer
        dmDefaultSource As Integer
        dmPrintQuality As Integer
        dmColor As Integer
        dmDuplex As Integer
        dmYResolution As Integer
        dmTTOption As Integer
        dmCollate As Integer            ' note: from dmSpecVersion to dmCollate, inclusively, 38 bytes
        dmFormName(1 To CCHFORMNAME * 2) As Byte
        dmUnusedPadding As Integer
        dmBitsPerPel As Integer
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long      ' note: from dmUnusedPadding to dmDisplayFrequency, inclusively, 20 bytes
        ' there are up to 32 additional bytes of extended data as needed
    End Type
    
    Private m_Unicode As Boolean
    Private m_DefaultPrinter As String
    Add this line to your class initialize event
    Code:
    m_Unicode = CBool(IsWindowUnicode(GetDesktopWindow))
    Last edited by LaVolpe; Apr 14th, 2015 at 03:09 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  19. #19

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx API failed to return full name of printer

    I am studying...

    Your code is for PrintDlgW not PrintDlgEx.
    Please add the ShowPrinter and ShowPrinterEx in your classic OpenFile/SaveAsFile class. Thanks.

  20. #20
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    Quote Originally Posted by Jonney View Post
    I am studying...

    Your code is for PrintDlgW not PrintDlgEx.
    I was simply using the class you gave us in post #3 above. Should not be difficult to enhance it for the newer API
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  21. #21
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: PrintDlgEx API failed to return full name of printer

    Quote Originally Posted by Jonney View Post
    Please add the ShowPrinter and ShowPrinterEx in your classic OpenFile/SaveAsFile class. Thanks.
    Not appropriate. If I were to wrap a class around the function, I'd create a separate class not add it to the open/save dialog class. Same would apply for the color selection dialog. But this isn't really an interest for me at this time. I just thought I could help you get the full printer name and answer some of your questions regarding using the structures for that API
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  22. #22

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx API failed to return full name of printer

    Quote Originally Posted by LaVolpe View Post
    Not appropriate. If I were to wrap a class around the function, I'd create a separate class not add it to the open/save dialog class. Same would apply for the color selection dialog. But this isn't really an interest for me at this time. I just thought I could help you get the full printer name and answer some of your questions regarding using the structures for that API
    Thank you very much,Sir.

  23. #23

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: PrintDlgEx API failed to return full name of printer

    Quote Originally Posted by LaVolpe View Post
    Not appropriate. If I were to wrap a class around the function, I'd create a separate class not add it to the open/save dialog class. Same would apply for the color selection dialog. But this isn't really an interest for me at this time. I just thought I could help you get the full printer name and answer some of your questions regarding using the structures for that API
    Oh,oh, the full printer name in Krool's Unicode friendly CommonDialog class can be retrieved by:
    Code:
    NewPrinterName = Mid$(DNAMES.wExtra, _
                              DNAMES.wDeviceOffset - DNAMES.wDriverOffset + 1)
    NewPrinterName = VBA.Left$(NewPrinterName, _
                              InStr(NewPrinterName, Chr$(0)) - 1)
    Last edited by Jonney; Apr 15th, 2015 at 08:12 PM.

  24. #24

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [RESOLVED] PrintDlgEx API failed to return full name of printer

    FYI, For those who visit my thread,VBAccelerator also has comprehensive CommonDialog Class at : http://www.vbaccelerator.com/home/VB...ull_Source.asp

    The addressing for retrieve Printer name is something like C# PrinterDialog class (Reflector shown):
    m_sDevice = getDevNameString(ptrDevNames, tDevNames.wDeviceOffset)
    Code:
    Private Function getDevNameString( _
          ByVal ptrDevNames As Long, _
          ByVal ptrOffset As Long _
       )
       Dim ptr As Long
       Dim lSize As Long
       Dim b() As Byte
          
       ptr = UnsignedAdd(ptrDevNames, ptrOffset)
       lSize = lstrlenPtr(ptr)
       If (lSize > 0) Then
          ReDim b(0 To lSize - 1) As Byte
          CopyMemory b(0), ByVal ptr, lSize
          getDevNameString = StrConv(b, vbUnicode)
       End If
    End Function
    
    Private Function UnsignedAdd(Start As Long, Incr As Long) As Long
    ' This function is useful when doing pointer arithmetic,
    ' but note it only works for positive values of Incr
    
       If Start And &H80000000 Then 'Start < 0
          UnsignedAdd = Start + Incr
       ElseIf (Start Or &H80000000) < -Incr Then
          UnsignedAdd = Start + Incr
       Else
          UnsignedAdd = (Start + &H80000000) + (Incr + &H80000000)
       End If
       
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width