为什么这个 FillPaperSize() 函数执行过程中容易 崩溃

Question

Private   Sub   FillPaperSize() 
'根据当前使用的打印机取得所有打印纸张和大小填充到ComBoBox显示控件中(cboPaper)。 
On   Error   Resume   Next 
Dim   devname   As   String 
Dim   devoutput   As   String 
Dim   papercount   As   Long 
Dim   bytepapernames()   As   Byte 
Dim   bytepapersizes()   As   Byte 
Dim   sinfo   As   String 
Dim   x   As   Long 
Dim   di   As   Long 
Dim   spapersizes   As   String 
Dim   dv   As   DEVMODE Screen.MousePointer   =   vbHourglass devname   =   Printer.DeviceName 
'当前打印机的名称 devoutput   =   Printer.Port 
'当前打印机的输出端口名称得到当前打印机的打印纸张数? papercount   =   DeviceCapabilities(devname,   devoutput,   DC_PAPERNAMES,   0&,   dv)    '总是在此处崩溃。
If   papercount   =   0   Then 
      MsgBox   "打印机纸张无效 ",   vbInformation,   "打印机错误 ":   Exit   Sub 
End   If '为保存打印用纸名称申请空间 
ReDim   bytepapernames(1   To   64   *   papercount) '纸张名称需要64个字符空间来存储 '取出打印机上的所有用纸名称 DeviceCapabilities   devname,   devoutput,   DC_PAPERNAMES,   VarPtr(bytepapernames(1)),   dv 
'为保存打印用纸所对应的PaperSize的字符串申请空间 
ReDim   bytepapersizes(1   To   2   *   papercount) 
'一个PaperSize需要2   个字符空间来存储取出打印机上的所有用纸所对应的PaperSize 
DeviceCapabilities   devname,   devoutput,   DC_PAPERS,   VarPtr(bytepapersizes(1)),   dv cboPaper.Clear '为了正确的取汉字?用StrConv方法对PaperName进行转换?         For   x   =   1   To   papercount   -   1         '一次取出一个打印用纸的名称         sinfo   =   StrConv(MidB(bytepapernames,   (x   -   1)   *   64   +   1,   64),   vbUnicode)         cboPaper.AddItem   Left(sinfo,   InStr(sinfo,   Chr(0))   -   1)     '纸张名称         cboPaper.ItemData(cboPaper.NewIndex)   =   bytepapersizes((x   -   1)   *   2   +   1)     '纸张大小         Next   x 
        
        Dim   zhi   As   Integer 
        zhi   =   Printer.PaperSize   '默认纸张 
        Dim   i   As   Integer       '循环变量 
        Dim   dez   As   Integer 
        
        For   i   =   0   To   cboPaper.ListCount   -   1     '找出默认纸张 
        If   cboPaper.ItemData(i)   =   zhi   Then 
              dez   =   i 
        Exit   For 
        End   If 
        Next   i       If   cboPaper.ListCount   >   0   Then   cboPaper.ListIndex   =   dez         Screen.MousePointer   =   vbDefault End   Sub全部代码如下：Option Explicit    Const dc_papers = 2    '表示要读取打印纸张大小    Const dc_papernames = 16    '表示要读取打印纸张名称   ' 打印机的设备结构Private Type devmode
    dmdevicename As String * 64
    dmspecversion As Integer
    dmdriverversion As Integer
    dmsize As Integer
    dmdriverextra As Integer
    dmfields As Long
End Type
'api函数的声明?
Private Declare Function DeviceCapabilities Lib "winspool.drv" (ByVal lpDeviceName As String, ByVal lpPort As String, ByVal iIndex As Long, ByVal lpOutput As String, lpDevMode As devmode) As LongPrivate Declare Function VarPtr Lib "msvbvm60.dll " (Ptr As Any) As Long
Private Sub fillprinter()    '该子程序用来将所有的打印机名称填充到combobox显示控件中(cboprinter)。
On Error GoTo Errc
Dim x As Printer
Dim defprnindex As Integer'当前缺省的打印机 IndexOn Error Resume NextWith cboprinter
    .Clear
    For Each x In Printers
       .AddItem x.DeviceName
    Next
    If .ListCount > 0 Then .ListIndex = defprnindex
 End With
Exit Sub
Errc:
    MsgBox Err.Description
End Sub
Private Sub FillPaperSize()
'根据当前使用的打印机取得所有打印纸张和大小填充到ComBoBox显示控件中(cboPaper)。
On Error Resume Next
Dim devname     As String
Dim devoutput     As String
Dim papercount     As Long
Dim bytepapernames()     As Byte
Dim bytepapersizes()     As Byte
Dim sinfo     As String
Dim x     As Long
Dim di     As Long
Dim spapersizes     As String
Dim dv     As devmodeScreen.MousePointer = vbHourglassdevname = Printer.DeviceName
'当前打印机的名称devoutput = Printer.Port
'当前打印机的输出端口名称得到当前打印机的打印纸张数?papercount = DeviceCapabilities(devname, devoutput, dc_papernames, 0&, dv)If papercount = 0 Then
      MsgBox "打印机纸张无效 ", vbInformation, "打印机错误 ":         Exit Sub
End If'为保存打印用纸名称申请空间
ReDim bytepapernames(1 To 64 * papercount)'纸张名称需要64个字符空间来存储'取出打印机上的所有用纸名称DeviceCapabilities devname, devoutput, dc_papernames, VarPtr(bytepapernames(1)), dv
'为保存打印用纸所对应的PaperSize的字符串申请空间
ReDim bytepapersizes(1 To 2 * papercount)
'一个PaperSize需要2   个字符空间来存储取出打印机上的所有用纸所对应的PaperSize
DeviceCapabilities devname, devoutput, dc_papers, VarPtr(bytepapersizes(1)), dvcbopaper.Clear'为了正确的取汉字?用StrConv方法对PaperName进行转换?        For x = 1 To papercount - 1        '一次取出一个打印用纸的名称        sinfo = StrConv(MidB(bytepapernames, (x - 1) * 64 + 1, 64), vbUnicode)
          
        Debug.Print Left(sinfo, InStr(sinfo, Chr(0)) - 1)               '纸张名称        cbopaper.AddItem Left(sinfo, InStr(sinfo, Chr(0)) - 1)               '纸张名称
        
                cbopaper.ItemData(cbopaper.NewIndex) = bytepapersizes((x - 1) * 2 + 1)                     '纸张大小        Next x
        
        Dim zhi     As Integer
        zhi = Printer.PaperSize       '默认纸张
        Dim i     As Integer         '循环变量
        Dim dez     As Integer
        
        For i = 0 To cbopaper.ListCount - 1                   '找出默认纸张
        If cbopaper.ItemData(i) = zhi Then
              dez = i
        Exit For
        End If
        Next i      If cbopaper.ListCount > 0 Then cbopaper.ListIndex = dez        Screen.MousePointer = vbDefaultEnd Sub
Private Sub cboprinter_Change()
On Error GoTo Errc
    Set Printer = Printers(cboprinter.ListIndex)    '设置当前打印机
    Call FillPaperSize
Exit Sub
Errc:
   MsgBox Err.Description
End SubPrivate Sub cmdprint_Change()End SubPrivate Sub cboprinter_Click()
On Error GoTo Errc
    Set Printer = Printers(cboprinter.ListIndex)    '设置当前打印机
    Call FillPaperSize
Exit Sub
Errc:
   MsgBox Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errc
   Call fillprinter
Exit Sub
Errc:
   MsgBox Err.Description
End Sub
Private Sub Command1_Click()
On Error GoTo Errc
    If Option1(0) Then
        Printer.Orientation = 1 '纵向
    Else
        Printer.Orientation = 2 '横向
    End If
    Printer.PaperSize = cbopaper.ItemData(cbopaper.ListIndex) '打印纸张打印处理部分
Exit Sub
Errc:
   MsgBox Err.Description
End Sub
'调用上面两个子程序的方法如下:
'
'　　1．在form—load事件程序中写以下代码：call fillprinter
'
'　　2．在cboprinter—click事件程序中写以下代码：
'
'    Set Printer = Printers(cboprinter.ListIndex)
'
'    '设置当前打印机
'
'    Call fillpapersize
'
'　　3．在cmdprint—click(打印命令框)事件程序中写以下代码：
'
'    If optori(0) Then
'
'　　printer.orientation=1 '纵向
'
'Else
'
'printer.orientation=2 '横向
'
'End If
'
'　　printer.papersize=cbopaper.itemdata(cbopaper.listindex) '打印纸张打印处理部分

Answer 1

lpOutput是字符串类型，怎么传的是0&?

Answer 2

这个字符串是用来输出的应该这样定义：
dim lpOutput as string *128
call DeviceCapabilities(...................,lpOutput ,dv)
'这样lpOutput才能返回。   

Answer 3

把DeviceCapabilities声明中 Alias 由 "DeviceCapabilitiesA" 改为 "DeviceCapabilitiesW" 
后，不再崩溃，但是 函数返回值均为-1  正常的值应为0 或大于0的整数，导致  无法获取到相关的信息。dim lpOutput as string *128
call DeviceCapabilities(...................,lpOutput ,dv) 用上了也没有用，Alias 为 "DeviceCapabilitiesW" 时返回值为-1，
                Alias 为 "DeviceCapabilitiesA" 时  崩溃。

Answer 4

改了几个地方，应该没问题了。只是家里面电脑没打印机，无法测试（不过，我还是用Microsoft Office Document Image Writer测试了一下不会再崩溃了）。下面红色部分是我改过的。
Option Explicit    Const dc_papers = 2    '表示要读取打印纸张大小    Const dc_papernames = 16    '表示要读取打印纸张名称   ' 打印机的设备结构Private Type devmode
    dmdevicename As String * 64
    dmspecversion As Integer
    dmdriverversion As Integer
    dmsize As Integer
    dmdriverextra As Integer
    dmfields As Long
End Type
'api函数的声明?
Private Declare Function DeviceCapabilities Lib "winspool.drv" (ByVal lpDeviceName As String, ByVal lpPort As String, ByVal iIndex As Long, ByRef lpOutput As Any, ByRef lpDevMode As Any) As LongPrivate Declare Function VarPtr Lib "msvbvm60.dll " (Ptr As Any) As Long
Private Sub fillprinter()    '该子程序用来将所有的打印机名称填充到combobox显示控件中(cboprinter)。
On Error GoTo Errc
Dim x As Printer
Dim defprnindex As Integer'当前缺省的打印机 IndexOn Error Resume NextWith cboprinter
    .Clear
    For Each x In Printers
       .AddItem x.DeviceName
    Next
    If .ListCount > 0 Then .ListIndex = defprnindex
 End With
Exit Sub
Errc:
    MsgBox Err.Description
End Sub
Private Sub FillPaperSize()
'根据当前使用的打印机取得所有打印纸张和大小填充到ComBoBox显示控件中(cboPaper)。
On Error Resume Next
Dim devname     As String
Dim devoutput     As String
Dim papercount     As Long
Dim bytepapernames()     As Byte
Dim bytepapersizes()     As Byte
Dim sinfo     As String
Dim x     As Long
Dim di     As Long
Dim spapersizes     As String
Dim dv     As devmodeScreen.MousePointer = vbHourglassdevname = Printer.DeviceName
'当前打印机的名称devoutput = Printer.Port
'当前打印机的输出端口名称得到当前打印机的打印纸张数?papercount = DeviceCapabilities(devname, devoutput, dc_papernames, ByVal 0&, ByVal 0&)
If papercount = 0 Then
      MsgBox "打印机纸张无效 ", vbInformation, "打印机错误 ":         Exit Sub
End If'为保存打印用纸名称申请空间
ReDim bytepapernames(1 To 64 * papercount)'纸张名称需要64个字符空间来存储'取出打印机上的所有用纸名称DeviceCapabilities devname, devoutput, dc_papernames, bytepapernames(1), dv'为保存打印用纸所对应的PaperSize的字符串申请空间
ReDim bytepapersizes(1 To 2 * papercount)
'一个PaperSize需要2   个字符空间来存储取出打印机上的所有用纸所对应的PaperSize
DeviceCapabilities devname, devoutput, dc_papers, bytepapersizes(1), dvcbopaper.Clear'为了正确的取汉字?用StrConv方法对PaperName进行转换?        For x = 1 To papercount - 1        '一次取出一个打印用纸的名称        sinfo = StrConv(MidB(bytepapernames, (x - 1) * 64 + 1, 64), vbUnicode)
          
        Debug.Print Left(sinfo, InStr(sinfo, Chr(0)) - 1)               '纸张名称        cbopaper.AddItem Left(sinfo, InStr(sinfo, Chr(0)) - 1)               '纸张名称
        
                cbopaper.ItemData(cbopaper.NewIndex) = bytepapersizes((x - 1) * 2 + 1)                     '纸张大小        Next x
        
        Dim zhi     As Integer
        zhi = Printer.PaperSize       '默认纸张
        Dim i     As Integer         '循环变量
        Dim dez     As Integer
        
        For i = 0 To cbopaper.ListCount - 1                   '找出默认纸张
        If cbopaper.ItemData(i) = zhi Then
              dez = i
        Exit For
        End If
        Next i      If cbopaper.ListCount > 0 Then cbopaper.ListIndex = dez        Screen.MousePointer = vbDefaultEnd Sub
Private Sub cboprinter_Change()
On Error GoTo Errc
    Set Printer = Printers(cboprinter.ListIndex)    '设置当前打印机
    Call FillPaperSize
Exit Sub
Errc:
   MsgBox Err.Description
End SubPrivate Sub cmdprint_Change()End SubPrivate Sub cboprinter_Click()
On Error GoTo Errc
    Set Printer = Printers(cboprinter.ListIndex)    '设置当前打印机
    Call FillPaperSize
Exit Sub
Errc:
   MsgBox Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errc
   Call fillprinter
Exit Sub
Errc:
   MsgBox Err.Description
End Sub
Private Sub Command1_Click()
On Error GoTo Errc
    If Option1(0) Then
        Printer.Orientation = 1 '纵向
    Else
        Printer.Orientation = 2 '横向
    End If
    Printer.PaperSize = cbopaper.ItemData(cbopaper.ListIndex) '打印纸张打印处理部分
Exit Sub
Errc:
   MsgBox Err.Description
End Sub
'调用上面两个子程序的方法如下:
'
'　　1．在form—load事件程序中写以下代码：call fillprinter
'
'　　2．在cboprinter—click事件程序中写以下代码：
'
'    Set Printer = Printers(cboprinter.ListIndex)
'
'    '设置当前打印机
'
'    Call fillpapersize
'
'　　3．在cmdprint—click(打印命令框)事件程序中写以下代码：
'
'    If optori(0) Then
'
'　　printer.orientation=1 '纵向
'
'Else
'
'printer.orientation=2 '横向
'
'End If
'
'　　printer.papersize=cbopaper.itemdata(cbopaper.listindex) '打印纸张打印处理部分

Answer 5

非常感谢chenjl1031，还有一个问题是，返回的papersize=120  是什么含义  ，这个120是怎么对应到纸张的HEIGHT 和 WIDTH 或 上下左右的边距的。

Answer 6

 sinfo = StrConv(MidB(bytepapernames, (x - 1) * 64 + 1, 64), vbUnicode)
 Debug.Print Left(sinfo, InStr(sinfo, Chr(0)) - 1) '纸张名称
 cbopaper.AddItem Left(sinfo, InStr(sinfo, Chr(0)) - 1) '纸张名称
 cbopaper.ItemData(cbopaper.NewIndex) = bytepapersizes((x - 1) * 2 + 1) '纸张大小
 Debug.Print bytepapersizes((x - 1) * 2 + 1)  执行后得到 以下值Tabloid
 3 
Legal
 5 
Executive
 7 
A3
 8 
A4
 9 ………（省略）自定义销售票据A4
 120 
PRC 32K(大)
 121 
………（省略）信封 B5
 150 
凭证纸
 151
这些个数值 与  对应纸张的  具体 HEIGHT 和WIDTH  是什么对应关系呢，  或者，不关心这些数值，  怎么能得到我想要到  自定义销售票据  这种自定义纸张的   HEIGHT 和WIDTH 

Answer 7

请问sinfo = StrConv(MidB(bytepapernames, (x - 1) * 64 + 1, 64), vbUnicode)
 Debug.Print Left(sinfo, InStr(sinfo, Chr(0)) - 1) '纸张名称
 cbopaper.AddItem Left(sinfo, InStr(sinfo, Chr(0)) - 1) '纸张名称
 cbopaper.ItemData(cbopaper.NewIndex) = bytepapersizes((x - 1) * 2 + 1) '纸张大小
 Debug.Print bytepapersizes((x - 1) * 2 + 1) 执行后得到 以下值Tabloid
 3  
Legal
 5  
Executive
 7  
A3
 8  
A4
 9  ………（省略）自定义销售票据A4
120 
PRC 32K(大)
 121  
………（省略）信封 B5
 150  
凭证纸
 151
这些个数值 与 对应纸张的 具体 HEIGHT 和WIDTH 是什么对应关系呢，   或者，不关心这些数值， 怎么能得到我想要到 自定义销售票据 这种自定义纸张的 HEIGHT 和WIDTH