在浏览器中通过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