Problem with GetForm crashing my app

[paulbent]

VB6 SP4/XP Pro.

I'm calling the functions to manage printer forms. They are supported by NT/2000/XP. AddForm, DeleteForm, SetForm and EnumForms work fine but there's a problem with GetForm. It's called once to return the required size of the byte buffer that holdes a PRINTER_INFO_1 udt and a second time with the correct buffer size to return the udt. The first call works fine and in debug it returns the correct bytes needed. The second call crashes the IDE.

This is the code, I've simplified the fGetForm function by removing error checking. Can anybody see what I'm doing wrong?

'In a bas module:
Option Explicit

Public Declare Function OpenPrinter Lib "winspool.drv" _
Alias "OpenPrinterA" (ByVal pPrinterName As String, _
phPrinter As Long, ByVal pDefault As Long) As Long

Public Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Public Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Declare Function lstrcpy Lib "Kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As String, ByRef lpString2 As Long) As Long

Public Declare Function GetForm Lib "winspool.drv" Alias "GetFormA" _
(ByVal hPrinter As Long, ByVal pFormName As String, _
ByVal Level As Long, pForm As Byte, ByVal cbBuf As Long, _
pcbNeeded As Long) As Long

'Null pointer
Public Const NULLPTR = 0&

Public Type RECTL
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Public Type SIZEL
        cx As Long
        cy As Long
End Type

Public Type FORM_INFO_1
        Flags As Long
        pName As Long   'String pointer
        Size As SIZEL
        ImageableArea As RECTL
End Type

Public Function fGetForm(ByVal strPrinter As String, _
ByVal strFormName As String, _
ByRef udtFI1 As FORM_INFO_1) As Boolean
    
    '--- Given a printer name and a form name, returns the form settings
    
    '--- Parameters
    '    [In]
    '    strPrinter: the name of the printer
    '    strFormName: the name of the form to get
    '    [In/Out]
    '    udtFI1: form info structure in which the form settings are returned
    
    '--- Return value
    '    Returns True if the form was selected successfully
    '    else False if an error occurred
        
    Dim phPrinter As Long        'Handle to the printer
    Dim plngBytesNeeded As Long  'Number of bytes occupied by structure
    Dim plngRtn As Long          'API function return value
    Dim pabytTmp() As Byte       'Byte array to buffer structure
    
    'Get a handle to the printer
    plngRtn = OpenPrinter(strPrinter, phPrinter, NULLPTR)
    
    'Size the temp byte array
    ReDim pabytTmp(0 To 0)
    'First call retrieves the BytesNeeded.
    plngRtn = GetForm(phPrinter, strFormName, 1, _
    pabytTmp(0), 1, plngBytesNeeded)
    'Resize the byte array to the required size
    ReDim pabytTmp(0 To plngBytesNeeded - 1)
    'Call GetForm again with correct buffer size
    [red]'This line crashes the IDE
    plngRtn = GetForm(phPrinter, strFormName, 1, _
    pabytTmp(0), plngBytesNeeded, plngBytesNeeded)[/red]
    If plngRtn > 0 Then
        'Form was returned successfully
        'Copy the byte array to the form info structure
        Call CopyMemory(udtFI1, pabytTmp(0), plngBytesNeeded)
        'Return success
        fGetForm = True
    End If
    
    'Close printer
    If Not phPrinter = 0 Then
        ClosePrinter phPrinter
    End If
    
End Function

Public Function fPtrCtoVbString(ByVal lngPtr As Long) As String

    'Given a pointer to a string, returns the string
    
    Dim lngRtn As Long          'API function return value
    Dim pstrTmp As String * 512 'Buffer to copy the string into
    
    lngRtn = lstrcpy(pstrTmp, ByVal lngPtr)
    If InStr(1, pstrTmp, vbNullChar) > 0 Then
        'Return the string
         fPtrCtoVbString = Left$(pstrTmp, _
         InStr(1, pstrTmp, vbNullChar) - 1)
    End If

End Function
'_____________________________

'In Form1 there is a list box containing names of installed
'forms (lstForms) and a command button labelled
'Get Form Details (cmdGetForm)

Option Explicit

Private Sub cmdGetForm_Click()
    
    Dim udtFI1 As FORM_INFO_1  'Form settings returned in this udt
    Dim strPrinter As String   'Name of printer
    Dim strFormName As String  'Name of form to retrieve settings for
    
    strPrinter = Printer.DeviceName  ' Current printer
    'Form selected in the listbox
    strFormName = Mid(lstForms.Text, 1, InStr(1, lstForms.Text, " -") - 1)
    If fGetForm(strPrinter, strFormName, udtFI1) Then
        'Print the form settings
        With udtFI1
            Debug.Print "Form name: " & fPtrCtoVbString(.pName)
            Debug.Print "Width (mm): " & _
            Format$(.Size.cx / 1000, "#0.000")
            Debug.Print "Height (mm): " & _
            Format$(.Size.cy / 1000, "#0.000")
            Debug.Print "Imageable Area Top (mm): " & _
            Format$(.ImageableArea.Top / 1000, "#0.000")
            Debug.Print "Imageable Area Left (mm): " & _
            Format$(.ImageableArea.Left / 1000, "#0.000")
            Debug.Print "Imageable Area Right (mm): " & _
            Format$(.ImageableArea.Right / 1000, "#0.000")
            Debug.Print "Imageable Area Bottom (mm): " & _
            Format$(.ImageableArea.Bottom / 1000, "#0.000")
        End With
    Else
        MsgBox "Failed to get the form settings.", 16, "GetForm Error"
    End If
    
End Sub

Private Sub Form_Load()

    Dim lngNumForms As Long     'Number of forms returned
    Dim lngC1 As Long           'Loop counter
    Dim lngBytesNeeded As Long  'Size of buffer needed for udt array
    Dim lngRtn As Long          'API function return value
    Dim strPrinter As String    'Current printer name
    Dim hPrinter As Long        'Handle to printer
    Dim strFormItem As String   'ListBox item
    Dim udtFI1 As FORM_INFO_1   'Form info structure
    Dim audtFI1() As FORM_INFO_1   'Udt array to hold enumerated forms
    Dim abytTmp() As Byte       'Byte array to buffer the udt array
    
    strPrinter = Printer.DeviceName    ' Current printer
    If OpenPrinter(strPrinter, hPrinter, 0&) Then
        'Size the byte array to anything
        ReDim audtFI1(0 To 1)
        'Call EnumForms to get BytesNeeded
        lngRtn = EnumForms(hPrinter, 1, audtFI1(0), 0&, _
        lngBytesNeeded, lngNumForms)
        'Size the byte array to the required size
        ReDim abytTmp(0 To lngBytesNeeded)
        'Size the udt array to the required size
        ReDim audtFI1(lngBytesNeeded / Len(udtFI1))
        'Call EnumForms with the correct buffer size
        lngRtn = EnumForms(hPrinter, 1, abytTmp(0), _
        lngBytesNeeded, lngBytesNeeded, lngNumForms)
        'Copy the forms from the byte array to the udt array
        Call CopyMemory(audtFI1(0), abytTmp(0), lngBytesNeeded)
        'Move through the udt array and add the forms to the listbox
        For lngC1 = 0 To lngNumForms - 1
            With audtFI1(lngC1)
                'List name, size and the count index
                strFormItem = fPtrCtoVbString(.pName) & _
                " - " & .Size.cx / 1000 & _
               " mm X " & .Size.cy / 1000 & " mm   (" & _
                lngC1 + 1 & ")"
                lstForms.AddItem strFormItem
            End With
        Next
        'Select first form in listbox
        lstForms.ListIndex = 0
        ClosePrinter hPrinter
    End If
    
End Sub

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[paulbent]

It get stranger. The above code actually works fine in an exe. I'm writing an ActiveX DLL and when I put the equivalent of the cmdGetForm_Click code in a public method it crashes where I indicated.

I developed the code for the other methods in a pilot exe then moved it to the dll. All other methods worked fine in the dll. For some reason I did it the other way round with GetForm and have only just discovered it's OK in an exe.

I've also tried moving all the fGetForm code into the DLL method so it doesn't call an external function and hence creates a buffer on the stack.

Still crashes... I'm baffled.

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[mpakzadm]

Use static data for byref var!!!

[mPakzadM@yahoo.com]

 

[strongm]

It gets much stranger, Paul - your code (with one minor change) works fine in the IDE on my XP Pro SP1 VB6 SP5 rig.

The minor change I made was in the Form_Load code:
Changed:

If OpenPrinter(strPrinter, hPrinter, 0&) Then
        'Size the byte array to anything
        ReDim audtFI1(0 To 1)
        'Call EnumForms to get BytesNeeded
        lngRtn = EnumForms(hPrinter, 1, audtFI1(0), 0&, _
        lngBytesNeeded, lngNumForms)

to

If OpenPrinter(strPrinter, hPrinter, 0&) Then
        'Size the byte array to anything
        [b]ReDim abytTmp(0 To 0)[/b]
        'Call EnumForms to get BytesNeeded
        lngRtn = EnumForms(hPrinter, 1, [b]abytTmp(0)[/b], 0&, _
        lngBytesNeeded, lngNumForms)