自定义打印，不能执行 setprinter 函数

Question

头两天发了一个帖子，但问题还是没有解决
现在我发现，我的程序打印的主要问题，是setprinter 这个API函数不能正确执行
  有人帮我不？
 
设置打印机纸张代码';;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
'*Constants used in the DevMode structure
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32'*Constants for NT security
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)'*Constants used to make changes to the values contained in the DevMode
Private Const DM_MODIFY = 8
Private Const DM_COPY = 2
Private Const DM_DUPLEX = &H1000&
Private Const DMDUP_SIMPLEX = 1
Private Const DMDUP_VERTICAL = 2
Private Const DMDUP_HORIZONTAL = 3Private Const DM_IN_BUFFER As Long = 8
Private Const DM_OUT_BUFFER As Long = 2
Private Const DM_ORIENTATION As Long = &H1
Private Const DM_PAPERSIZE = &H2&
Private Const DM_PAPERWIDTH = &H8&
Private Const DM_PAPERLENGTH = &H4&Public Enum typeOrient
        orient0 = 0
        OrientPortrait = 1
        OrientLandscape = 2
End EnumPrivate Type DEVMODE
    dmDeviceName        As String * 32
    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          As String * 32
    dmUnusedPadding     As Integer
    dmBitsPerPel        As Integer
    dmPelsWidth         As Long
    dmPelsHeight        As Long
    dmDisplayFlags      As Long
    dmDisplayFrequency  As Long
End TypePrivate Type PRINTER_DEFAULTS
    pDataType           As String
    pDevMode            As Long
    DesiredAccess       As Long
End TypePrivate Type PRINTER_INFO_2
    pServerName         As Long
    pPrinterName        As Long
    pShareName          As Long
    pPortName           As Long
    pDriverName         As Long
    pComment            As Long
    pLocation           As Long
    pDevMode            As Long
    pSepFile            As Long
    pPrintProcessor     As Long
    pDataType           As Long
    pParameters         As Long
    pSecurityDescriptor As Long
    Attributes          As Long
    Priority            As Long
    DefaultPriority     As Long
    StartTime           As Long
    UntilTime           As Long
    status              As Long
    cJobs               As Long
    AveragePPM          As Long
End Type'*------DECLARATIONS
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (hpvDest As Any, hpvSource As Any, _
        ByVal cbCopy As Long)Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _
        (ByVal pPrinterName As String, _
        phPrinter As Long, pDefault As Any) As LongPrivate Declare Function ClosePrinter Lib "winspool.drv" _
        (ByVal hPrinter As Long) As LongPrivate Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" _
        (ByVal hWnd As Long, ByVal hPrinter As Long, _
        ByVal pDeviceName As String, pDevModeOutput As Any, _
        pDevModeInput As Any, ByVal fMode As Long) As LongPrivate Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" _
        (ByVal hPrinter As Long, ByVal level As Long, _
        pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As LongPrivate Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" _
        (ByVal hPrinter As Long, ByVal level As Long, _
        pPrinter As Any, ByVal Command As Long) As Long
Private Function mySetPrinter(prnName As String, _
                              Optional eOrientation As typeOrient = 0, _
                              Optional iDmpaper As Integer = 0, _
                              Optional iDmpaperLength As Single = 0, _
                              Optional iDmpaperWidth As Single = 0) _
    As BooleanDim bDevMode()          As Byte
Dim bPrinterInfo2()     As Byte
Dim hPrinter            As Long
Dim lResult             As Long
Dim nSize               As Long
Dim sPrnName            As StringDim dm          As DEVMODE
Dim olddm       As DEVMODE
Dim pd          As PRINTER_DEFAULTS
Dim pi2         As PRINTER_INFO_2    On Error GoTo err_proc
    
    '*»ñÈ¡´òÓ¡»úµÄÉ豸Ãû³Æ
    sPrnName = prnName
    '*ÓÉÓÚÒªµ÷ÓÃSetPrinter£¬ËùÒÔ
    '*Èç¹ûÊÇÔÚNTϾÍÒªÇóPRINTER_ALL_ACCESS
    pd.DesiredAccess = PRINTER_ALL_ACCESS
    
    '*»ñÈ¡´òÓ¡»ú¾ä±ú , pd
    If OpenPrinter(sPrnName, hPrinter, 0&) Then
    
    '*»ñÈ¡PRINTER_INFO_2½á¹¹ÒªÇóµÄ×Ö½ÚÊý
    
        Call GetPrinter(hPrinter, 2&, 0&, 0&, nSize)
        ReDim bPrinterInfo2(1 To nSize) As Byte
        lResult = GetPrinter(hPrinter, 2, bPrinterInfo2(1), nSize, nSize)
        Call CopyMemory(pi2, bPrinterInfo2(1), Len(pi2))
        nSize = DocumentProperties(0&, hPrinter, sPrnName, 0&, 0&, 0)
        ReDim bDevMode(1 To nSize)
        
        If pi2.pDevMode Then
            Call CopyMemory(bDevMode(1), ByVal pi2.pDevMode, Len(dm))
        Else
            Call DocumentProperties(0&, hPrinter, sPrnName, bDevMode(1), 0&, DM_OUT_BUFFER)
        End If
        
        Call CopyMemory(dm, bDevMode(1), Len(dm))
        Call CopyMemory(olddm, bDevMode(1), Len(olddm))
        
        With dm
            If eOrientation <> 0 Then       '*&Eacute;è&Ouml;&Atilde;&ETH;&Acirc;&micro;&Auml;×&szlig;&Iuml;ò
                .dmOrientation = eOrientation
                .dmFields = DM_ORIENTATION
            End If
            If iDmpaper <> 0 And iDmpaper <> vbPRPSUser Then    '*&Eacute;è&Ouml;&frac12;&Otilde;&Aring;&acute;ó&ETH;&iexcl;
                .dmPaperSize = iDmpaper
                .dmFields = DM_PAPERSIZE
            End If
            If iDmpaper = vbPRPSUser Then   '*&Oacute;&Atilde;&raquo;§×&Ocirc;&para;¨&Ograve;&aring;
                .dmFields = DM_PAPERLENGTH Or DM_PAPERWIDTH
                .dmPaperLength = iDmpaperLength
                .dmPaperWidth = iDmpaperWidth
            End If
        End With
    
        Call CopyMemory(bDevMode(1), dm, Len(dm))
        
        Call DocumentProperties(0&, hPrinter, sPrnName, _
                                bDevMode(1), bDevMode(1), DM_IN_BUFFER Or _
                                DM_OUT_BUFFER)
    
        pi2.pDevMode = VarPtr(bDevMode(1))
        
        lResult = SetPrinter(hPrinter, 2, pi2, 0&)
        
        Call ClosePrinter(hPrinter)
        mySetPrinter = True
    Else
        mySetPrinter = False
    End If
    
    Exit Function
    
err_proc:
    mySetPrinter = False
End Function';;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Answer 1

问题是出在DEVMODE的定义上
VB的String是基于Unicode的，每个字符两字节
可你调用的是ANSI版API，每个字符一字节

Answer 2

Private Type DEVMODE
    dmDeviceName(0 to 32 - 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 32 - 1) as byte
    dmUnusedPadding     As Integer
    dmBitsPerPel        As Integer
    dmPelsWidth         As Long
    dmPelsHeight        As Long
    dmDisplayFlags      As Long
    dmDisplayFrequency  As Long
End TypePrivate Type PRINTER_DEFAULTS
    pDataType           As Long
    pDevMode            As Long
    DesiredAccess       As Long
End Type

Answer 3

我按照ZY1910的办法，
  把有问题的定义替换了
可还是不能正确执行
另外
  OpenPrinter(sPrnName, hPrinter, pd)
   这个函数也是
最后一个参数，如果不设置为0&,也是不能正确执行
不知道这两个是不是一个问题，希望能得到解决！！！

Answer 4

对于OpenPrinter，要填充正确的PRINTER_DEFAULTS结构
但是它也允许为NULL，使用默认打印机设置
Call OpenPrinter(sPrnName, hPrinter, ByVal 0&)

Answer 5

程序流程基本上没有问题
问题主要出在API调用代码上得在具体环境慢慢调试