Option Explicit On Error Resume Next Implements IObjectSafety Dim Device As Long Dim IsReading As Boolean Dim MyList As String '鑒定計(jì)劃中包含的所有準(zhǔn)考證號(hào)碼 Dim MyListed As String '已經(jīng)讀取過(guò)的準(zhǔn)考證號(hào)碼 Dim MyCount As Integer '讀卡記數(shù) Dim MyText As String '設(shè)備讀取字符 Dim strlen As Long'控件初始化 Private Sub UserControl_Initialize()Device = 0IsReading = FalseMyTimer.Interval = 50MyCount = 0MyText = ""getMyList ("") End Sub '取得控件版本 Public Sub getVersion()MsgBox "光標(biāo)閱讀機(jī)控件V 1.0.1" End Sub Private Sub cmdRead_Click()If IsReading ThenOMR_StopReadOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalseElseIf OMR_ReadNoWait() = 0 Then 'OKcmdRead.Caption = "停止閱讀"MyTimer.Enabled = TrueIsReading = TrueElsetxtResult.Text = Space(100)strlen = OMR_CRetMess(OMR_GetLastError(), txtResult.Text)MsgBox txtResult.Text, vbCritical, "閱讀失敗"End IfEnd If End Sub '-----------讀卡設(shè)備斷開(kāi)-------------- Private Sub Command1_Click()cmdInstall.Enabled = TrueCommand1.Enabled = FalsecmdRead.Enabled = FalseOMR_StopReadOMR_StopMotorOMR_ClosetxtResult.Text = txtResult.Text & Chr(13) & Chr(10) & "讀卡設(shè)備斷開(kāi)！"txtResult.SelStart = Len(txtResult) End Sub Private Sub MyTimer_Timer()Dim sResultStr As StringDim lResultNum As LongDim sUserID As String '準(zhǔn)考證號(hào)碼MyTimer.Enabled = FalseSelect Case OMR_IsReading()Case 0: '閱讀完畢sResultStr = Space(1000)lResultNum = OMR_GetResult(sResultStr, True)MyText = Mid(sResultStr, 1, 300) '取得有效文本If Check1 = Checked ThenOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsetxtResult.Text = txtResult.Text & "【" & MyTexttxtResult.Text = txtResult.Text & "】正確答案讀取成功！"txtResult.SelStart = Len(txtResult)If (Option1.Value = True) Then '理論回調(diào)UserControl.Parent.Script.setRightRecord (MyText)ElseIf (Option2.Value = True) Then '實(shí)操回調(diào)UserControl.Parent.Script.setRightRecord1 (MyText)ElseIf (Option3.Value = True) Then '外語(yǔ)回調(diào)UserControl.Parent.Script.setRightRecord2 (MyText)End IfElsesUserID = Mid(sResultStr, 2, 19) '取得準(zhǔn)考證號(hào)碼txtResult.Text = txtResult.Text & Chr(13) & Chr(10) & "【" & sUserIDtxtResult.Text = txtResult.Text & "】"txtResult.SelStart = Len(txtResult)'----------判斷是否是正確的準(zhǔn)考證----------If (InStr(sUserID, " ") > 0) ThenOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsetxtResult.Text = txtResult.Text & "ERROR 1：準(zhǔn)考證填寫(xiě)錯(cuò)誤！"txtResult.SelStart = Len(txtResult)UserControl.Parent.Script.myAlert ("ERROR 1：準(zhǔn)考證填寫(xiě)錯(cuò)誤！")ElseIf (InStr(MyList, sUserID) <= 0) ThenOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsetxtResult.Text = txtResult.Text & "ERROR 2：準(zhǔn)考證不存在！"txtResult.SelStart = Len(txtResult)UserControl.Parent.Script.myAlert ("ERROR 2：準(zhǔn)考證不存在！")ElseIf (InStr(MyListed, sUserID) > 0) ThenOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsetxtResult.Text = txtResult.Text & "ERROR 3：準(zhǔn)考證號(hào)碼重復(fù)！"txtResult.SelStart = Len(txtResult)UserControl.Parent.Script.myAlert ("ERROR 3：準(zhǔn)考證號(hào)碼重復(fù)！")ElseMyListed = MyListed & "," & sUserID '記錄已經(jīng)讀取的準(zhǔn)考證號(hào)碼MyCount = MyCount + 1 '累計(jì)讀取卡片數(shù)Label2.Caption = MyCount '顯示讀卡數(shù)If Left(sResultStr, 1) = "O" ThenIf OMR_ReadNoWait() = 0 Then 'OKcmdRead.Caption = "停止閱讀"MyTimer.Enabled = TrueIsReading = True'-------------------回調(diào)js--------------If (Option1.Value = True) Then '理論回調(diào)UserControl.Parent.Script.setReadText (sResultStr)ElseIf (Option2.Value = True) Then '實(shí)操回調(diào)UserControl.Parent.Script.setReadText1 (sResultStr)ElseIf (Option3.Value = True) Then '外語(yǔ)回調(diào)UserControl.Parent.Script.setReadText2 (sResultStr)End IfElseMsgBox "閱讀失敗", vbCritical, "警告"End IfElseOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsesResultStr = Space(100)strlen = OMR_CRetMess(OMR_GetLastError(), sResultStr)txtResult.Text = sResultStrEnd IfEnd IfEnd IfCase -1: '閱讀失敗cmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsesResultStr = Space(100)strlen = OMR_CRetMess(OMR_GetLastError(), sResultStr)txtResult.Text = sResultStrMsgBox sResultStr, vbCritical, "閱讀失敗"Case 1: '正在閱讀End Select'-----------------IsReading時(shí)啟動(dòng)timer----------------If IsReading ThenMyTimer.Enabled = TrueEnd If End Sub '-----------------取得所有的準(zhǔn)考證號(hào)碼----------------- Public Sub getMyList(str)If Len(str) > 0 ThenMyList = strElseMyList = Text1.TextEnd If End Sub '-----------------初始化設(shè)備并加載格式文件------------------- Public Sub cmdInstall_Click()cmdInstall.Enabled = FalseDevice = OMR_Installed(0)Select Case DeviceCase Is = 0:'MsgBox "初始化失敗", vbInformationtxtResult.Text = "連接讀卡設(shè)備失敗！"cmdInstall.Enabled = TrueCase Is > 0:'MsgBox "OMR初始化成功", vbInformationtxtResult.Text = "連接讀卡設(shè)備成功！"OMR_Clear '需調(diào)用多個(gè)格式文件時(shí)，僅在第一次時(shí)調(diào)用 OMR_ClearIf OMR_LoadForm("C:\KSCJ200.sht", "") <> 0 ThenMsgBox "不能裝載格式文件--C:\KSCJ200.sht", vbCritical, "警告"cmdInstall.Enabled = TrueElse'MsgBox "裝載格式文件成功", vbInformation, "提示"txtResult.Text = txtResult.Text & Chr(13) & Chr(10) & "加載格式文件成功！"cmdRead.Enabled = TrueCommand1.Enabled = TruecmdInstall.Enabled = FalseEnd IfCase Else:MsgBox "請(qǐng)?jiān)O(shè)置您的OMR設(shè)備類型", vbInformationcmdInstall.Enabled = TrueEnd Select End Sub Public Function Script(code As String) As StringDim obj As ObjectSet obj = CreateObject("MSScriptControl.ScriptControl")obj.AllowUI = Trueobj.Language = "JavaScript"Script = obj.Eval(code) End Function Private Sub IObjectSafety_GetInterfaceSafetyOptions(ByVal riid As _Long, pdwSupportedOptions As Long, pdwEnabledOptions As Long)Dim Rc As LongDim rClsId As udtGUIDDim IID As StringDim bIID() As BytepdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or _INTERFACESAFE_FOR_UNTRUSTED_DATAIf (riid <> 0) ThenCopyMemory rClsId, ByVal riid, Len(rClsId)bIID = String$(MAX_GUIDLEN, 0)Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)Rc = InStr(1, bIID, vbNullChar) - 1IID = Left$(UCase(bIID), Rc)Select Case IIDCase IID_IDispatchpdwEnabledOptions = IIf(m_fSafeForScripting, _INTERFACESAFE_FOR_UNTRUSTED_CALLER, 0)Exit SubCase IID_IPersistStorage, IID_IPersistStream, _IID_IPersistPropertyBagpdwEnabledOptions = IIf(m_fSafeForInitializing, _INTERFACESAFE_FOR_UNTRUSTED_DATA, 0)Exit SubCase ElseErr.Raise E_NOINTERFACEExit SubEnd SelectEnd If End Sub Private Sub IObjectSafety_SetInterfaceSafetyOptions(ByVal riid As _Long, ByVal dwOptionsSetMask As Long, ByVal dwEnabledOptions As Long)Dim Rc As LongDim rClsId As udtGUIDDim IID As StringDim bIID() As ByteIf (riid <> 0) ThenCopyMemory rClsId, ByVal riid, Len(rClsId)bIID = String$(MAX_GUIDLEN, 0)Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)Rc = InStr(1, bIID, vbNullChar) - 1IID = Left$(UCase(bIID), Rc)Select Case IIDCase IID_IDispatchIf ((dwEnabledOptions And dwOptionsSetMask) <> _INTERFACESAFE_FOR_UNTRUSTED_CALLER) ThenErr.Raise E_FAILExit SubElseIf Not m_fSafeForScripting ThenErr.Raise E_FAILEnd IfExit SubEnd IfCase IID_IPersistStorage, IID_IPersistStream, _IID_IPersistPropertyBagIf ((dwEnabledOptions And dwOptionsSetMask) <> _INTERFACESAFE_FOR_UNTRUSTED_DATA) ThenErr.Raise E_FAILExit SubElseIf Not m_fSafeForInitializing ThenErr.Raise E_FAILEnd IfExit SubEnd IfCase ElseErr.Raise E_NOINTERFACEExit SubEnd SelectEnd If End Sub

?

總結(jié)

以上是生活随笔為你收集整理的ActiveX(VB6)+JavaScript让ＩＥ浏览器与光标阅读器交互的全部?jī)?nèi)容，希望文章能夠幫你解決所遇到的問(wèn)題。

如果覺(jué)得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。