使用第三方库实现QRCode的识别

SET PATH TO SYS(2003)+"\netqr"
SET PROCEDURE TO SYS(2003)+"\netqr\netsuite.reg.prg"
m.oNetQR  = createobjects( "NetQR.ZxBarcode" )
?onetqr.readbarcode(GETFILE())

Clear

Local lcPath

If _vfp.StartMode = 0 Then
   m.lcPath = Justpath( _vfp.ActiveProject.Name  )
Else
   m.lcPath = Justpath( sys(16,0) )
Endif   

Set Default To ( m.lcPath )


*新建一个接口类到的VFP,直接从c++的MFC调用,不用Manifest
Procedure Createobjects( ClassName As String , DllPath As String )
         
          If !File("NetQR.dll" ) Then
                Messagebox("支持库“NetQR.dll”不存在" , 16 )
                Return null
          Endif
         
          DECLARE Integer SetClrVersion IN clrhost.dll string
          DECLARE Integer ClrCreateInstanceFrom IN clrhost.dll string, string, string@, integer@
         
          Local lnDispHandle ;
                , lcError      ;
                , lnSize          ;
                , loOb

          m.lcError = Space(512)
          m.lnSize  = 0
          SetClrVersion("v4.0.30319")
          m.lnDispHandle = ClrCreateInstanceFrom( Iif( Empty(m.DllPath ) , Fullpath( "NetQR.dll" ) , Fullpath( m.DllPath ) ),  ClassName , @lcError , @lnSize )
         
          *ClassName  注意类名大小写敏感
          If m.lnDispHandle < 1 Then

             m.lcError =  Alltrim( Strconv( Strconv( m.lcError , 5 ) , 6 )  )
             m.lcError =  strtran( m.lcError , Chr( 0 ) , "" )
               Messagebox( "实例化类:" + m.ClassName +"出错!原因:" +  Chr(13) + m.lcError , 16 )
               Return null
               
          Else
             m.loOb = SYS(3096, m.lnDispHandle)
                       SYS(3097, m.loOb)
             Return m.loOb
          Endif
Endproc


*从VFP释放一个接口类,7.28版修正类的引用强回收会崩溃的原因,因为某些接口的异步线程还正在运行;
不可能马上回收，这类就不回收，这样就造成实际接口没有释放。
Procedure UnCreateobjects()
          DECLARE Integer ClrUnload IN clrhost.dll   
          ClrUnload()
Endproc  

*新建一个接口类到的VFP,需要用Manifest或类注册
Procedure Createobjectf( ClassName As String , Manifest As String )

          Local loActCtx ;
                , loEx     ;
                , loOb
          Try
                 m.loActCtx = CreateObject("Microsoft.Windows.ActCtx")
                m.loActCtx.Manifest = Iif( Empty( m.Manifest ) , " , m.Manifest  )
                m.loOb = m.loActCtx.Createobject( ClassName  )
          Catch To loEx
          Endtry
         
          If  Type( "loEx.Message" ) == "C" Then
                Messagebox( "实例化类:" + m.ClassName +"出错!原因:" +  Chr(13) + m.loEx.Message , 16 )
                Return null
          Else
              Return m.loOb
          Endif

Endproc