Hilfe bei API "DocumentProperties" benötigt

[Schimmel]

Hallo

Ich habe eine Funktion geschrieben, welche eine Printqueue 1:1 kopieren soll. Dies funktioniert im grossen und ganzen schon, nur werden die Einstellungen nicht übernommen. DocumentProperties und SetPrinter geben jeweils mit err.LastDllError 122 zurück (ERROR_INSUFFICIENT_BUFFER).....

    Public Function fMovePrinter( _
                                ByVal sSource As String, _
                                ByVal sDestination As String, _
                                ByVal sPrinter As String, _
                                ByVal lvSource As ListView, _
                                ByVal lvDestination As ListView, _
                                ByVal bDelete As Boolean _
                                ) As Boolean

        Dim hSource As IntPtr
        Dim pd As New PRINTER_DEFAULTS

        pd.DesiredAccess = PrinterAccessRights.PRINTER_ALL_ACCESS
        If Not OpenPrinter(sPrinter, hSource, pd) Then
            Throw New Exception(Err.LastDllError & " unable to OpenPrinter " & sPrinter)
            Return False
        End If

        Dim BytesWritten As Int32 = 0
        Dim ptBuf As IntPtr
        Dim pi2 As New PRINTER_INFO_2
        Dim dmOut As New DEVMODE

        ptBuf = Marshal.AllocHGlobal(1)

        If Not GetPrinter(hSource, 2, ptBuf, 1, BytesWritten) Then
            If BytesWritten > 0 Then
                Marshal.FreeHGlobal(ptBuf)
                ptBuf = Marshal.AllocHGlobal(BytesWritten)
                If GetPrinter(hSource, 2, ptBuf, BytesWritten, BytesWritten) Then
                    Marshal.PtrToStructure(ptBuf, pi2)
                    If pi2.lpDeviceMode > 0 Then
                        Dim ptrDevMode As New IntPtr(pi2.lpDeviceMode)
                        Marshal.PtrToStructure(ptrDevMode, dmOut)
                    End If
                Else
                    Marshal.FreeHGlobal(ptBuf)
                    ClosePrinter(hSource)
                    Throw New Exception(Err.LastDllError & " unable to GetPrinter #2 " & sPrinter)
                    Return False
                End If
                Marshal.FreeHGlobal(ptBuf)
            Else
                Throw New Exception(Err.LastDllError & " BytesWritten #1 " & BytesWritten)
                Return False
            End If

        Else
            Throw New Exception(Err.LastDllError & " unable to GetPrinter #1 " & sPrinter)
            Return False
        End If

        Dim strPrinter As String
        strPrinter = sPrinter
        If strPrinter.LastIndexOf("\") > 0 Then
            strPrinter = strPrinter.Remove(strPrinter.IndexOf("\"), strPrinter.LastIndexOf("\") + 1)
        End If

        With pi2
            .pPrinterName = strPrinter
            .pServerName = sDestination
            .pPortName = "LPT1:"
            '.Attributes = PrinterAttributes.PRINTER_ATTRIBUTE_SHARED Or PrinterAttributes.PRINTER_ATTRIBUTE_PUBLISHED
        End With

        Dim strFullPrinterPath As String = "\\" & sDestination & "\" & strPrinter
        With dmOut
            .pDeviceName = strFullPrinterPath
        End With

        pi2.lpDeviceMode = Marshal.AllocHGlobal(Marshal.SizeOf(dmOut))
        Marshal.StructureToPtr(dmOut, pi2.lpDeviceMode, False)

        If bDelete = True Then
            Call DeletePrinter(hSource)
            hSource = IntPtr.Zero
        End If

        Dim hDestination As IntPtr
        hDestination = AddPrinter("\\" & sDestination, 2, pi2)
        If hDestination = 0 Then
            If Err.LastDllError = 1802 Then
                Call DeletePrinter(hSource)
                Debug.Print(Err.LastDllError.ToString)
                hDestination = AddPrinter("\\" & sDestination, 2, pi2)
                If hDestination = 0 Then
                    Throw New Exception(Err.LastDllError & " unable to AddPrinter, tried twice because printer allready exists on " & sDestination)
                    Return False
                End If
            Else
                Throw New Exception(Err.LastDllError & " unable to AddPrinter")
                Return False
            End If
        End If

        If hSource <> 0 Then
            ClosePrinter(hSource)
            hSource = IntPtr.Zero
        End If

        Dim intRet As Int32
        intRet = DocumentProperties(IntPtr.Zero, hDestination, strFullPrinterPath, IntPtr.Zero, IntPtr.Zero, DocumentPropertiesModes.DM_GETSIZE)
        If intRet < 0 Then
            Throw New Exception(Err.LastDllError & " unable to get DocumentProperties #1")
            Return False
        End If

        Dim hdmIn As IntPtr
        hdmIn = Marshal.AllocHGlobal(intRet)

        intRet = DocumentProperties(IntPtr.Zero, hDestination, strFullPrinterPath, hdmIn, IntPtr.Zero, DocumentPropertiesModes.DM_OUT_BUFFER)
        If intRet < 0 Then
            Throw New Exception(Err.LastDllError & " unable to get DocumentProperties #2")
            Return False
        End If

        Dim dmIn As New DEVMODE
        dmIn = Marshal.PtrToStructure(hdmIn, dmIn.GetType)

        With dmIn
            .dmCollate = dmOut.dmCollate
            .dmColor = dmOut.dmColor
            .dmCopies = dmOut.dmCopies
            .dmDefaultSource = dmOut.dmDefaultSource
            .dmDuplex = dmOut.dmDuplex
            .dmFormName = dmOut.dmFormName
            .dmMediaType = dmOut.dmMediaType
            .dmOrientation = dmOut.dmOrientation
            .dmPaperLength = dmOut.dmPaperLength
            .dmPaperSize = dmOut.dmPaperSize
            .dmPaperWidth = dmOut.dmPaperWidth
            .dmPrintQuality = dmOut.dmPrintQuality
            .dmScale = dmOut.dmScale
            .dmTTOption = dmOut.dmTTOption
            .dmFields = DEVMODEFields.DM_COLLATE Or DEVMODEFields.DM_COLOR Or _
                        DEVMODEFields.DM_COPIES Or DEVMODEFields.DM_DEFAULTSOURCE Or _
                        DEVMODEFields.DM_DUPLEX Or DEVMODEFields.DM_FORMNAME Or _
                        DEVMODEFields.DM_MEDIATYPE Or DEVMODEFields.DM_ORIENTATION Or _
                        DEVMODEFields.DM_PAPERLENGTH Or DEVMODEFields.DM_PAPERSIZE Or _
                        DEVMODEFields.DM_PAPERWIDTH Or DEVMODEFields.DM_PRINTQUALITY Or _
                        DEVMODEFields.DM_SCALE Or DEVMODEFields.DM_TTOPTION
            .dmSize = Marshal.SizeOf(dmIn)
        End With

        Marshal.StructureToPtr(dmIn, hdmIn, False)

        intRet = DocumentProperties(IntPtr.Zero, hDestination, strFullPrinterPath, hdmIn, hdmIn, DocumentPropertiesModes.DM_IN_BUFFER Or DocumentPropertiesModes.DM_OUT_BUFFER)
        Debug.Print(Err.LastDllError.ToString & vbCrLf)
        If intRet < 0 Then
            Throw New Exception(Err.LastDllError & " unable to set DocumentProperties #1")
            Return False
        End If

        Dim PI2In As New PRINTER_INFO_2
        BytesWritten = 0
        ptBuf = Marshal.AllocHGlobal(1)
        If Not GetPrinter(hDestination, 2, ptBuf, 1, BytesWritten) Then
            If BytesWritten > 0 Then
                Marshal.FreeHGlobal(ptBuf)
                ptBuf = Marshal.AllocHGlobal(BytesWritten)
                If GetPrinter(hDestination, 2, ptBuf, BytesWritten, BytesWritten) Then
                    Marshal.PtrToStructure(ptBuf, PI2In)
                    PI2In.lpDeviceMode = hdmIn
                    Dim hPI2In As IntPtr
                    hPI2In = Marshal.AllocHGlobal(Marshal.SizeOf(PI2In))
                    Marshal.StructureToPtr(PI2In, hPI2In, False)
                    intRet = SetPrinter(hDestination, 2, hPI2In, PrinterControlCommands.PRINTER_CONTROL_SETPRINTERINFO)
                    Debug.Print(Err.LastDllError)
                    If intRet = 0 Then
                        Throw New Exception(Err.LastDllError & " unable to SetPrinter #1")
                        Return False
                    End If
                Else
                    Marshal.FreeHGlobal(ptBuf)
                    ClosePrinter(hDestination)
                    Throw New Exception(Err.LastDllError & " unable to GetPrinter #3 " & strFullPrinterPath)
                    Return False
                End If
            Else
                Throw New Exception(Err.LastDllError & " BytesWritten #2 " & BytesWritten)
                Return False
            End If
        End If
        Call ClosePrinter(hDestination)
        Marshal.FreeHGlobal(hdmIn)
        Dim lvItem As New ListViewItem
        lvItem = lvDestination.Items.Add(sPrinter)
        lvItem.SubItems.Add(PI2In.pDriverName)
        lvItem.SubItems.Add(PI2In.pShareName)
        lvDestination.Refresh()
        Me.Refresh()
        pi2 = Nothing
        PI2In = Nothing
        dmIn = Nothing
        dmOut = Nothing
        Return True
    End Function

bin dankbar für jegliche Art von Hilfe...

[bnaumer]

Hallo,

genau dieses Problem (ERROR_INSUFFICIENT_BUFFER) habe ich auch. Wäre auch an Hilfe interessiert!

Vielen Dank

Birgit