Option Explicit On Error Resume Next Implements IObjectSafety Dim Device As Long Dim IsReading As Boolean Dim MyList As String '鑒定計劃中包含的所有準考證號碼 Dim MyListed As String '已經讀取過的準考證號碼 Dim MyCount As Integer '讀卡記數 Dim MyText As String '設備讀取字符 Dim strlen As Long'控件初始化 Private Sub UserControl_Initialize()Device = 0IsReading = FalseMyTimer.Interval = 50MyCount = 0MyText = ""getMyList ("") End Sub '取得控件版本 Public Sub getVersion()MsgBox "光標閱讀機控件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 '-----------讀卡設備斷開-------------- Private Sub Command1_Click()cmdInstall.Enabled = TrueCommand1.Enabled = FalsecmdRead.Enabled = FalseOMR_StopReadOMR_StopMotorOMR_ClosetxtResult.Text = txtResult.Text & Chr(13) & Chr(10) & "讀卡設備斷開！"txtResult.SelStart = Len(txtResult) End Sub Private Sub MyTimer_Timer()Dim sResultStr As StringDim lResultNum As LongDim sUserID As String '準考證號碼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 '理論回調UserControl.Parent.Script.setRightRecord (MyText)ElseIf (Option2.Value = True) Then '實操回調UserControl.Parent.Script.setRightRecord1 (MyText)ElseIf (Option3.Value = True) Then '外語回調UserControl.Parent.Script.setRightRecord2 (MyText)End IfElsesUserID = Mid(sResultStr, 2, 19) '取得準考證號碼txtResult.Text = txtResult.Text & Chr(13) & Chr(10) & "【" & sUserIDtxtResult.Text = txtResult.Text & "】"txtResult.SelStart = Len(txtResult)'----------判斷是否是正確的準考證----------If (InStr(sUserID, " ") > 0) ThenOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsetxtResult.Text = txtResult.Text & "ERROR 1：準考證填寫錯誤！"txtResult.SelStart = Len(txtResult)UserControl.Parent.Script.myAlert ("ERROR 1：準考證填寫錯誤！")ElseIf (InStr(MyList, sUserID) <= 0) ThenOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsetxtResult.Text = txtResult.Text & "ERROR 2：準考證不存在！"txtResult.SelStart = Len(txtResult)UserControl.Parent.Script.myAlert ("ERROR 2：準考證不存在！")ElseIf (InStr(MyListed, sUserID) > 0) ThenOMR_StopMotorcmdRead.Caption = "閱　讀"MyTimer.Enabled = FalseIsReading = FalsetxtResult.Text = txtResult.Text & "ERROR 3：準考證號碼重復！"txtResult.SelStart = Len(txtResult)UserControl.Parent.Script.myAlert ("ERROR 3：準考證號碼重復！")ElseMyListed = MyListed & "," & sUserID '記錄已經讀取的準考證號碼MyCount = MyCount + 1 '累計讀取卡片數Label2.Caption = MyCount '顯示讀卡數If Left(sResultStr, 1) = "O" ThenIf OMR_ReadNoWait() = 0 Then 'OKcmdRead.Caption = "停止閱讀"MyTimer.Enabled = TrueIsReading = True'-------------------回調js--------------If (Option1.Value = True) Then '理論回調UserControl.Parent.Script.setReadText (sResultStr)ElseIf (Option2.Value = True) Then '實操回調UserControl.Parent.Script.setReadText1 (sResultStr)ElseIf (Option3.Value = True) Then '外語回調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時啟動timer----------------If IsReading ThenMyTimer.Enabled = TrueEnd If End Sub '-----------------取得所有的準考證號碼----------------- Public Sub getMyList(str)If Len(str) > 0 ThenMyList = strElseMyList = Text1.TextEnd If End Sub '-----------------初始化設備并加載格式文件------------------- Public Sub cmdInstall_Click()cmdInstall.Enabled = FalseDevice = OMR_Installed(0)Select Case DeviceCase Is = 0:'MsgBox "初始化失敗", vbInformationtxtResult.Text = "連接讀卡設備失敗！"cmdInstall.Enabled = TrueCase Is > 0:'MsgBox "OMR初始化成功", vbInformationtxtResult.Text = "連接讀卡設備成功！"OMR_Clear '需調用多個格式文件時，僅在第一次時調用 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 "請設置您的OMR設備類型", 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

?

總結

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

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。