在浏览器中通过bartender，调用条码打印机的active控件代码的实现

 系统中需要在浏览器，直接调用条码打印机，打印出产品条码。

 

 现实中的条码打印机，品种繁多，很难在一个程序中实现， 于是我们用已经支持所有条码打印机的bartender软件

 

调用它的api ，来实现在浏览器中打印条码。

 

下面是 代码实现：

 

Private Sub UserControl_Initialize()
'On Error Resume Next
Dim app1 As BarTender.Application
    Set app1 = CreateObject("BarTender.Application")
      app1.Quit
     
    
    
     If Err.Number <> 0 Then
        MsgBox ("您还没有安装bartender,请点击《条码打印说明》中的下载链接下载安装。")
     End If
     Err.Clear
    
     'Dim fso As Object
     'Set fso = CreateObject("scripting.filesystemobject")
    
     Dim fso As New Scripting.FileSystemObject
     If fso.FileExists("c:\sun.btw") = True Then
        path = "c:\sunsky1.btw"
    Else
        If fso.FileExists("d:\sun.btw") = True Then
            path = "d:\sun.btw"
        Else
            On Error Resume Next
            Err.Clear
           
            DownNetFile "http://www.erwm.org/suns.btw", "c:\sun.btw"
             path = "c:\sunsky1.btw"
            If Err.Number <> 0 Then
            Err.Clear
           
            DownNetFile "http://www.erwm.org/sun.btw", "d:\sun.btw"
             path = "d:\sunsky1.btw"
             If Err.Number <> 0 Then
                MsgBox ("您还没有下载打印模版,请点击《条码打印说明》中的下载链接下载安装。")
            End If
            End If
        End If
    End If
End Sub

Public Sub printone(ordernumber As String, itemnumber As String, qty As String, barcode As String, isshow As String)

 
    Dim Format As BarTender.Format
     Set app = CreateObject("BarTender.Application")
    Set Format = app.Formats.Open(path)
 
    Format.SetNamedSubStringValue "barcode", barcode
    Format.SetNamedSubStringValue "ordernumber", ordernumber
    Format.SetNamedSubStringValue "qty", qty
    Format.SetNamedSubStringValue "itemnumber", itemnumber
    If isshow = "1" Then
    Format.PrintOut True, True
    Else
    Format.PrintOut
    End If
    Format.Close btDoNotSaveChanges
     app.Quit
End Sub

Public Function isgood() As String
    On Error Resume Next
   
       
    
    
End Function

Private Sub DownNetFile(ByVal nUrl As String, ByVal nFile As String)
     Dim XmlHttp, B() As Byte
     Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
     XmlHttp.Open "GET", nUrl, False
     XmlHttp.Send
     If XmlHttp.ReadyState = 4 Then
         B() = XmlHttp.ResponseBody
         Open nFile For Binary As #1
         Put #1, , B()
         Close #1
     End If
     Set XmlHttp = Nothing
End Sub