poscontrol.ctl

windows下测试打印机源码

VERSION 5.00
Begin VB.UserControl POSControl 
   BackColor       =   &H00C0FFC0&
   ClientHeight    =   1320
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3120
   ScaleHeight     =   1320
   ScaleMode       =   0  'User
   ScaleWidth      =   29.885
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   960
      TabIndex        =   0
      Top             =   720
      Width           =   1095
   End
End
Attribute VB_Name = "POSControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Public ESC As String
Public LF As String
Public GS As String
Public SEND As String

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, _
                                                                        ByVal ByteLen As Long)


Public Function openpos(Optional portname As String = "\Device\Serial0") As Boolean
    
    On Error GoTo errorhandle
    If h = INVALID_HANDLE_VALUE Then
        IsNT = False
        
        'NT/2000/XP
        Dim OsInfo As OSVERSIONINFO
        OsInfo.dwOSVersionInfoSize = Len(OsInfo)
        r = GetVersionEx(OsInfo)

        If OsInfo.dwPlatformId = 2 Then        'NT
            If OsInfo.dwMajorVersion >= 4 Then '4.0
                IsNT = True
            Else
                IsNT = False
            End If
        Else
            IsNT = False
        End If
        
        
        If IsNT = True Then
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            'WinNT/2000/XP
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            'Open port(lpt/com)
            Dim si As STARTUPINFO
            Dim pi As PROCESS_INFORMATION
            Dim pa As SECURITY_ATTRIBUTES
            Dim sa As SECURITY_ATTRIBUTES
            Dim strCurrentDriectory As String
            si.cb = Len(si)
            si.dwFlags = si.dwFlags + STARTF_USESHOWWINDOW
            si.wShowWindow = 0
            pa.nLength = Len(pa)
            sa.nLength = Len(sa)
            a = CreateProcess(vbNullString, "net stop spooler", pa, sa, False, CREATE_DEFAULT_ERROR_MODE, ByVal vbNullString, strCurrentDriectory, si, pi)
            b = WaitForSingleObject(pi.hProcess, 10000)
               
            'DefineDosDevice
            'r = DefineDosDevice(DDD_RAW_TARGET_PATH, "LptPortName", "\Device\Parallel0")
            r = DefineDosDevice(DDD_RAW_TARGET_PATH, "LptPortName", "\Device\Serial0")
            h = CreateFile("\\.\LptPortName", _
                            GENERIC_WRITE + GENERIC_READ, _
                            0, _
                            0, _
                            OPEN_EXISTING, _
                            FILE_ATTRIBUTE_NORMAL, _
                            0)
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Else
            'Win95/98/ME  "LPT1"
            'Bruce modified LPT1 TO COM1
            h = CreateFile("COM1", _
                            GENERIC_WRITE + GENERIC_READ, _
                            0, _
                            0, _
                            OPEN_EXISTING, _
                            FILE_ATTRIBUTE_NORMAL, _
                            0)
        
        End If
        

        If h <> INVALID_HANDLE_VALUE Then
            Memo.Text = Memo.Text & "Open LPT1" & vbCrLf
            Memo.SelStart = Len(Memo.Text) + 1
        
            Dim Timeouts As COMMTIMEOUTS
            Timeouts.ReadIntervalTimeout = 1
            Timeouts.ReadTotalTimeoutMultiplier = 5
            Timeouts.ReadTotalTimeoutConstant = 50
            Timeouts.WriteTotalTimeoutMultiplier = 5
            Timeouts.WriteTotalTimeoutConstant = 2000
            res = SetCommTimeouts(h, Timeouts)
        
            If res <> 1 Then
                Memo.Text = Memo.Text & "SetCommTimeouts false" & vbCrLf
                Memo.SelStart = Len(Memo.Text) + 1
                CloseHandle (h)
                h = INVALID_HANDLE_VALUE
           '     ReadTimer.Enabled = False
            Else
            '    ReadTimer.Enabled = True
            End If
            
        Else
            MsgBox "", vbCritical,
            
        End If
    End If
    openpos = True
    Exit Function
errorhandle:
    openpos = False

End Function

Private Sub Command10_Click()
    
    Dim buf() As Byte
    Dim m As Long
    Dim i As Integer
    
    GS = Chr(29)
    ESC = Chr(27)
    LF = Chr(10)
    FS = Chr(28)
    
'-----------------------------------------------------------------------------------------

    SEND = ESC & "@"
    SEND = SEND & FS & "&"

    SEND = SEND & GS & "B" & Chr(1)
    
    SEND = SEND & "字体反黑显示1" & LF
    SEND = SEND & "字体反黑显示2" & LF
         
'-----------------------------------------------------------------------------------------
'汉字的输出需要特别注意

    n = 0
    m = lstrlen(SEND)
    i = m - 1           '修改
     
    ReDim buf(m - 1) As Byte
    CopyMemory buf(0), ByVal SEND, m
    
    r = WriteFile(h, buf(0), i, n, 0)

End Sub

Public Function closepos() As Boolean
    If h <> INVALID_HANDLE_VALUE Then
        CloseHandle (h)
        h = INVALID_HANDLE_VALUE
        Memo.Text = Memo.Text & "Close LPT1" & vbCrLf
        Memo.SelStart = Len(Memo.Text) + 1
        ReadTimer.Enabled = False
        
        
        'close pos
        Dim si As STARTUPINFO
        Dim pi As PROCESS_INFORMATION
        Dim pa As SECURITY_ATTRIBUTES
        Dim sa As SECURITY_ATTRIBUTES
        Dim strCurrentDriectory As String
        si.cb = Len(si)
        si.dwFlags = si.dwFlags + STARTF_USESHOWWINDOW
        si.wShowWindow = 0
        pa.nLength = Len(pa)
        sa.nLength = Len(sa)
        a = CreateProcess(vbNullString, "net start spooler", pa, sa, False, CREATE_DEFAULT_ERROR_MODE, ByVal vbNullString, strCurrentDriectory, si, pi)
        b = WaitForSingleObject(pi.hProcess, 10000)
        
    End If
End Function

Public Function posprint(Optional posbuffer As String = "")

    Dim buf() As Byte
    Dim m As Long
    Dim i As Integer
        
        
    
'---FS - n (SHEET 149)--------------------------------------------------------------------
'汉字的输出需要特别注意

    n = 0
    m = lstrlen(posbuffer)
    i = m - 1           '修改
     
    ReDim buf(m - 1) As Byte
    CopyMemory buf(0), ByVal posbuffer, m
    
    r = WriteFile(h, buf(0), i, n, 0)

End Function


Public Function posinit() As Boolean

    Dim buf() As Byte
    Dim m As Long
    Dim i As Integer
    
    ESC = Chr(27)
    LF = Chr(10)
    FS = Chr(28)
        
    SEND = ESC & "@"
    SEND = SEND & FS & "&"
 
    
'---FS S n1 n2  (SHEET 153)--------------------------------------------------------------
'汉字的输出需要特别注意

    n = 0
    m = lstrlen(SEND)
    i = m - 1           '修改
     
    ReDim buf(m - 1) As Byte
    CopyMemory buf(0), ByVal SEND, m
    
    r = WriteFile(h, buf(0), i, n, 0)
       
End Function


Private Sub Command1_Click()
    openpos
    posinit
    posprint ("爱普生 EPSON" & Chr(10))
End Sub

Private Sub UserControl_Initialize()
    h = INVALID_HANDLE_VALUE
End Sub

Private Sub UserControl_Terminate()
     If h <> INVALID_HANDLE_VALUE Then
        CloseHandle (h)
        h = INVALID_HANDLE_VALUE
        
        'close pos
        Dim si As STARTUPINFO
        Dim pi As PROCESS_INFORMATION
        Dim pa As SECURITY_ATTRIBUTES
        Dim sa As SECURITY_ATTRIBUTES
        Dim strCurrentDriectory As String
        si.cb = Len(si)
        si.dwFlags = si.dwFlags + STARTF_USESHOWWINDOW
        si.wShowWindow = 0
        pa.nLength = Len(pa)
        sa.nLength = Len(sa)
        a = CreateProcess(vbNullString, "net start spooler", pa, sa, False, CREATE_DEFAULT_ERROR_MODE, ByVal vbNullString, strCurrentDriectory, si, pi)
        b = WaitForSingleObject(pi.hProcess, 10000)

    End If
End Sub