Win2000下打印设定

转载 2004年07月13日 15:44:00

'*************************************************************************
'**模 块 名:mdlPrint
'**创 建 人:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**描    述:打印机设置
'**版    本:V1.0
'*************************************************************************

Option Explicit

Public Declare Function EnumForms Lib "winspool.drv" Alias "EnumFormsA" (ByVal hPrinter As Long, ByVal Level As Long, ByRef pForm As Any, ByVal cbBuf As Long, ByRef pcbNeeded As Long, ByRef pcReturned As Long) As Long
Public Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" (ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As Long
Public Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" (ByVal hPrinter As Long, ByVal pFormName As String) As Long
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 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 Long
Public Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" (ByVal hdc As Long, lpInitData As Any) 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
Public Declare Function SetForm Lib "winspool.drv" Alias "SetFormA" (ByVal hPrinter As Long, ByVal pFormName As String, ByVal Level As Long, pForm As Byte) As Long

'DEVMODE 相关的参数
Public Const CCHFORMNAME = 32
Public Const CCHDEVICENAME = 32
Public Const DM_FORMNAME As Long = &H10000
Public Const DM_ORIENTATION = &H1&

'for PRINTER_DEFAULTS.DesiredAccess  相关的参数
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
 
'DocumentProperties() 的返回值
Public Const DM_MODIFY = 8
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_COPY = 2
Public Const DM_OUT_BUFFER = DM_COPY

'格式添加信息
Public Const FORM_NOT_SELECTED = 0
Public Const FORM_SELECTED = 1
Public Const FORM_ADDED = 2

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 SECURITY_DESCRIPTOR
        Revision As Byte
        Sbz1 As Byte
        Control As Long
        Owner As Long
        Group As Long
        Sacl As Long  ' ACL
        Dacl As Long  ' ACL
End Type

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

'字符串
Public Type sFORM_INFO_1
        Flags As Long
        pName As String
        Size As SIZEL
        ImageableArea As RECTL
End Type

Public Type DEVMODE
        dmDeviceName As String * CCHDEVICENAME
        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 * CCHFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Long
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End Type

Public Type PRINTER_DEFAULTS
        pDatatype As String
        pDevMode As Long    ' DEVMODE
        DesiredAccess As Long
End Type

Public Type PRINTER_INFO_2
        pServerName As String
        pPrinterName As String
        pShareName As String
        pPortName As String
        pDriverName As String
        pComment As String
        pLocation As String
        pDevMode As DEVMODE
        pSepFile As String
        pPrintProcessor As String
        pDatatype As String
        pParameters As String
        pSecurityDescriptor As SECURITY_DESCRIPTOR
        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

'*************************************************************************
'**函 数 名:GetFormName
'**输    入:ByVal PrinterHandle(Long) - 打印机句柄
'**        :FormSize(SIZEL)           - 格式大小
'**        :FormName(String)          - 格式名称
'**输    出:(Integer) -
'**功能描述:返回预查找的格式序号,0 为没找到
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Public Function GetFormName(ByVal PrinterHandle As Long, FormSize As SIZEL, FormName As String) As Integer
    Dim NumForms As Long, i As Long
    Dim FI1 As FORM_INFO_1
    Dim aFI1() As FORM_INFO_1           ' Working FI1 array
    Dim Temp() As Byte                  ' Temp FI1 array
    Dim FormIndex As Integer
    Dim BytesNeeded As Long
    Dim RetVal As Long
       
    FormIndex = 0
    ReDim aFI1(1)
    RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, NumForms)
    ReDim Temp(BytesNeeded)
    ReDim aFI1(BytesNeeded / Len(FI1))
    RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, BytesNeeded, NumForms)
    Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
    For i = 0 To NumForms - 1
        With aFI1(i)
            'If .Size.cx = FormSize.cx And .Size.cy = FormSize.cy And FormName = PtrCtoVbString(.pName) Then
            If FormName = PtrCtoVbString(.pName) Then
                FormIndex = i + 1
                Exit For
            End If
        End With
    Next
    GetFormName = FormIndex
End Function

'*************************************************************************
'**函 数 名:AddNewForm
'**输    入:PrinterHandle(Long) - 打印机句柄
'**        :FormSize(SIZEL)     - 格式大小
'**        :FormName(String)    - 格式名称
'**输    出:(long) - 0 添加成功 1 不允许添加 2 添加失败
'**功能描述:添加新的打印格式
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Public Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, FormName As String) As Long
    Dim FI1 As sFORM_INFO_1
    Dim aFI1() As Byte
    Dim RetVal As Long
   
    With FI1
        .Flags = 0
        .pName = FormName
        With .Size
            .cx = FormSize.cx
            .cy = FormSize.cy
        End With
        With .ImageableArea
            .Left = 0
            .Top = 0
            .Right = FI1.Size.cx
            .Bottom = FI1.Size.cy
        End With
    End With
    ReDim aFI1(Len(FI1))
    Call CopyMemory(aFI1(0), FI1, Len(FI1))
    RetVal = AddForm(PrinterHandle, 1, aFI1(0))
   
    If RetVal = 0 Then  '设置失败
        If Err.LastDllError = 5 Then
            '不允许设置打印格式
            AddNewForm = 1
        Else
            'Err.LastDllError
            AddNewForm = 2
        End If
    Else
        AddNewForm = 0
    End If
End Function

'*************************************************************************
'**函 数 名:PtrCtoVbString
'**输    入:ByVal Add(Long) - 字符地址
'**输    出:(String) - 字符串
'**功能描述:返回指定地址的字符串
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Public Function PtrCtoVbString(ByVal Add As Long) As String
    Dim sTemp As String * 512, x As Long
   
    x = lstrcpy(sTemp, ByVal Add)
    If (InStr(1, sTemp, Chr(0)) = 0) Then
         PtrCtoVbString = ""
    Else
         PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
    End If
End Function

'*************************************************************************
'**函 数 名:SetPrintForm
'**输    入:ByVal MyhWnd(Long) - 窗体句柄
'**        :FormName(String)   - 格式的名称
'**        :lngPageX(Long)     - 宽度值(mm)
'**        :lngPageY(Long)     - 高度值(mm)
'**输    出:(Integer) - 0 格式无法添加 1 格式已添加 2 格式添加成功
'**功能描述:自定义打印格式
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Public Function SetPrintForm(ByVal MyhWnd As Long, FormName As String, lngPageX As Long, lngPageY As Long) As Integer
    Dim nSize As Long
    Dim pDevMode As DEVMODE
    Dim PrinterHandle As Long
    Dim hPrtDC As Long
    Dim PrinterName As String
    Dim aDevMode() As Byte
    Dim FormSize As SIZEL
   
    PrinterName = Printer.DeviceName
    hPrtDC = Printer.hdc
    SetPrintForm = FORM_NOT_SELECTED    '预设格式无法添加
 
    If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, 0&, 0&)
        ReDim aDevMode(1 To nSize)
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, aDevMode(1), 0&, DM_OUT_BUFFER)
        Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))
       
        '设置大小
        With FormSize
            .cx = lngPageX * 1000  '纸张宽度
            .cy = lngPageY * 1000  '纸张高度
        End With
       
        '该格式是否定义
        If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then  '不存在这个格式
            '添加该格式
            AddNewForm PrinterHandle, FormSize, FormName
            If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
                ClosePrinter (PrinterHandle)
                SetPrintForm = FORM_NOT_SELECTED   '格式无法添加
                Exit Function
            Else
                SetPrintForm = FORM_ADDED          '格式添加成功
            End If
        End If
       
        '设置格式的名称
        pDevMode.dmFormName = FormName & Chr(0)
        pDevMode.dmFields = DM_FORMNAME
   
        '设置改变
        Call CopyMemory(aDevMode(1), pDevMode, Len(pDevMode))
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)
        nSize = ResetDC(hPrtDC, aDevMode(1))
   
        ClosePrinter (PrinterHandle)
        If SetPrintForm <> FORM_ADDED Then
           SetPrintForm = FORM_SELECTED            '格式已添加
        End If
    Else
        SetPrintForm = FORM_NOT_SELECTED           '格式无法添加
    End If
End Function

'*************************************************************************
'**函 数 名:DelForm
'**输    入:FormName(String) - 格式名称
'**输    出:(Long) - 0 删除成功 1 删除失败
'**功能描述:
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Public Function DelForm(FormName As String) As Long
    Dim RetVal As Long
    Dim PrinterHandle As Long
    Dim PrinterName As String
    Dim Continue As Long
  
    '当前打印机
    PrinterName = Printer.DeviceName
    DelForm = 1
    If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
        RetVal = DeleteForm(PrinterHandle, FormName & Chr(0))
        If RetVal <> 0 Then
           DelForm = 0     '删除成功
        Else
           DelForm = 1     '删除失败
        End If
        ClosePrinter (PrinterHandle)
    End If
End Function

'*************************************************************************
'**函 数 名:EnumPrintForm
'**输    入:strFormName()(String) - 格式名称
'**        :szFormXY()(SIZEL)     - 格式的大小
'**输    出:(Long) - 可用格式的个数
'**功能描述:枚举可用的打印格式
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Public Function EnumPrintForm(strFormName() As String, szFormXY() As SIZEL) As Long
   '打开错误处理陷阱
   On Error GoTo ErrGoto
   '----------------------------------------------------
    Dim lngNumForms As Long, i As Long
    Dim FI1 As FORM_INFO_1
    Dim aFI1() As FORM_INFO_1
    Dim Temp() As Byte
    Dim BytesNeeded As Long
    Dim PrinterName As String
    Dim PrinterHandle As Long
    Dim strFormItem As String
    Dim RetVal As Long
          
    PrinterName = Printer.DeviceName
    If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
        ReDim aFI1(1)
        RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, lngNumForms)
        ReDim Temp(BytesNeeded)
        ReDim aFI1(BytesNeeded / Len(FI1))
        RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, BytesNeeded, lngNumForms)
        Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
       
        ReDim strFormName(1 To lngNumForms)
        ReDim szFormXY(1 To lngNumForms)
       
        For i = 0 To lngNumForms - 1
            With aFI1(i)
                '返回可打印的纸张名称和可打印大小
                strFormName(i + 1) = PtrCtoVbString(.pName)
                szFormXY(i + 1).cx = .Size.cx / 1000
                szFormXY(i + 1).cy = .Size.cy / 1000
            End With
        Next i
        ClosePrinter (PrinterHandle)
        EnumPrintForm = lngNumForms
    Else
        EnumPrintForm = 0
    End If

   '----------------------------------------------------
   Exit Function
   '-----------------------------
ErrGoto:
   EnumPrintForm = -1
End Function

'*************************************************************************
'**函 数 名:EnumUseForm
'**输    入:lngFormNo()(Long)     - 格式号
'**        :strFormName()(String) - 格式名称
'**        :szFormXY()(SIZEL)     - 格式的大小
'**输    出:(Long) - 可用格式的个数
'**功能描述:枚举用户可用的打印格式
'**功能描述:
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Public Function EnumUseForm(lngFormNo() As Long, strFormName() As String, szFormXY() As SIZEL) As Long
   Dim strFormName1() As String
   Dim szFormXY1() As SIZEL
   Dim i As Long, j As Long
   Dim lngValue As Long
  
   lngValue = EnumPrintForm(strFormName1, szFormXY1)
   j = 0
   If lngValue > 0 Then
       For i = 1 To lngValue
          If SetSize(i) = 0 Then
                j = j + 1
                ReDim Preserve lngFormNo(1 To j)
                ReDim Preserve strFormName(1 To j)
                ReDim Preserve szFormXY(1 To j)
               
                lngFormNo(j) = i
                strFormName(j) = strFormName1(i)
                szFormXY(j).cx = szFormXY1(i).cx
                szFormXY(j).cy = szFormXY1(i).cy
          End If
       Next
   End If
  
   EnumUseForm = j
 End Function

'*************************************************************************
'**函 数 名:SetSize
'**输    入:lngNo(Long) - 可用的格式号
'**输    出:(Long) - 0 可用 1 不可用
'**功能描述:判断打印格式是否可用
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Private Function SetSize(lngNo As Long) As Long
  On Error GoTo ErrExit
  Printer.PaperSize = lngNo
  SetSize = 0
  Exit Function
ErrExit:
  SetSize = 1
End Function

'*************************************************************************
'**函 数 名:GetUsePageNo
'**输    入:strFormName(String) - 打印格式的名称
'**        :Optional lngNo(Long = -1) - 判断打印号是否可用
'**输    出:(Long) - 0 指定的格式不可用 非零 为打印格式号
'**功能描述:获取指定的打印格式号
'**全局变量:
'**调用模块:
'**作    者:叶帆
'**日    期:2004年04月02日
'**修 改 人:
'**日    期:
'**版    本:V1.0
'*************************************************************************
Public Function GetUsePageNo(Optional strFormName As String, Optional lngNo As Long = -1) As Long
   Dim strFormName1() As String
   Dim szFormXY1() As SIZEL
   Dim lngFormNo() As Long
   Dim lngNum As Long
   Dim i As Long
  
   lngNum = EnumUseForm(lngFormNo, strFormName1, szFormXY1)
   If lngNo = -1 Then
        For i = 0 To lngNum - 1
           If strFormName1(i + 1) = strFormName Then
              GetUsePageNo = lngFormNo(i + 1)
              Exit Function
           End If
        Next
   Else
        For i = 0 To lngNum - 1
           If lngFormNo(i + 1) = lngNo Then
              GetUsePageNo = lngNo
              Exit Function
           End If
        Next
   End If
   GetUsePageNo = 0
End Function

Win2000下打印设定

2004年07月13日 12:02:00 ***************************************************************************模 块 ...
  • softart
  • softart
  • 2007年10月27日 11:59
  • 190

Win2000下打印设定

***************************************************************************模 块 名:mdlPrint**创 建 人:叶帆*...
  • yefanqiu
  • yefanqiu
  • 2004年07月13日 12:02
  • 2913

Win2000下打印设定

***************************************************************************模 块 名:mdlPrint**创 建 人:叶帆*...
  • gzhoney
  • gzhoney
  • 2006年11月30日 15:56
  • 584

解决WIN7无法访问WIN2000的共享

症状:在WIN7下的网络里面找到局域网下的WIN2000计算机,连接之后提示:用户名和密码不正确,但用户名和密码是对的。解决方法:WIN7和win2000设置相同的策略 具体操作方法:在WIN7计算机...
  • CNHDJ
  • CNHDJ
  • 2011年04月19日 11:15
  • 4785

让VS2010支持Windows2000

用Visual Studio 2010编译的程序无法在Windows 2000,Windows XP SP1上运行,经分析主要原因是VS2010的运行库调用了kernel32.dll的DecodePo...
  • pb8
  • pb8
  • 2015年10月20日 14:21
  • 1091

WIN2000系统文件访问权限默认设定。

除 hisecws.inf 模板提供的访问控制列表以外,还有“成员服务器基准策略”保护的文件。文件 基准权限 %SystemDrive%/Boot.ini Administrators:完全控制Sys...
  • freexploit
  • freexploit
  • 2004年11月18日 11:35
  • 1357

Win2000/WinXP/Win2003双系统启动

Win98SE/WinME和Win2000/WinXP/Win2003双系统启动        首先简要分析(深入讨论请参阅此帖)因重装Win98SE/WinME导致双启动故障的原因: 那是因为你格式...
  • debren
  • debren
  • 2005年03月05日 16:06
  • 3192

《解决VirtualBox安裝Windows 2000失败》

VirtualBox下安装Windows2000,设置网络后进入最后一步,复制组件……然后就是重启。再试还是重启,百思不得其解。   在oracle网站上查了一下资料:http://www.virtu...
  • jiangdragon
  • jiangdragon
  • 2014年12月31日 13:51
  • 1647

共享一下我收藏的精简版系统(WIN2000、WIN2003、WINXP)

http://u.115.com/file/f4d78715d9# 118M_WIN9_FIX.rar http://u.115.com/file/f4cd0efcd4# 118M_Wind...
  • fuzhangpeng
  • fuzhangpeng
  • 2012年08月10日 22:17
  • 3724

Win2000蓝屏STOP故障现象解析

现在使用Win2000的朋友越来越多了(小遥:我一辈子死守Win ME!),大家都是冲着Win2000比Win98稳定的份上去使用这个多媒体和游戏性能都不怎么样的操作系统的。不过“是微软的就逃脱不了死...
  • luocheng104
  • luocheng104
  • 2007年09月26日 10:16
  • 682
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Win2000下打印设定
举报原因:
原因补充:

(最多只允许输入30个字)