Imports CefSharp Imports CefSharp.Handler Imports CefSharp.WinForms Imports System.Runtime.InteropServices Imports System.Reflection Imports System.Security.Permissions Imports System.Threading Public Class Form1 Public cefWeb As ChromiumWebBrowser Private fullnow As Boolean = False '标记当前窗体是否为全屏状态 Private rect As New Rectangle '保存的全屏前的装提，退出全屏时恢复到此状况 Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 'Label2.BackColor = Color.FromArgb(0, Color.Transparent) Control.CheckForIllegalCrossThreadCalls = False 'Me.AllowTransparency = True 'Me.Opacity = 0 'Me.FormBorderStyle = FormBorderStyle.None 'Me.WindowState = FormWindowState.Maximized 'Me.Location = New Point(0, 0) 'Me.Size = SystemInformation.PrimaryMonitorSize 'SetFullScreen(False, rect) 'ChangeFullScreen() readTxt() 'HookKeyboard() ChangeFullScreen() 'Dim rec As Rectangle = Screen.PrimaryScreen.Bounds 'Me.Width = rec.Width 'Me.WindowState = FormWindowState.Maximized 'Me.Height = rec.Height 'Debug.Print("屏幕区域：") 'Me.FormBorderStyle = 0 'Me.TopMost = True Dim setting As CefSettings = New CefSettings() '设置可以跨域，不同源策略 setting.CefCommandLineArgs.Add("--disable-web-security", "") Cef.Initialize(setting) CefSharpSettings.LegacyJavascriptBindingEnabled = True 'cefWeb = New ChromiumWebBrowser("https://zb.xmtyw.cn/medicine/intelligent-medicine-abinet/machine/index?deviceNum=14912202111000000600000000000000&VNK=7f55e28b") 'cefWeb = New ChromiumWebBrowser("http://192.168.131.111:8080/machine/index?deviceNum=14912202111000001000000000000000&VNK=4c8b6ff0") 'remoteUrl = "https://ehr.yihu.com/hlwyy/zjxl/healthMonitoring/demo/index.html" cefWeb = New ChromiumWebBrowser(remoteUrl) Dim ContextMenuHandlerB = New ContextMenuHandler() ContextMenuHandlerB.Form1Instance = Me cefWeb.MenuHandler = ContextMenuHandlerB Dim jsEvent = New JsEvent() jsEvent.Form1Instance = Me cefWeb.JavascriptObjectRepository.Register("jsApp", jsEvent, True) cefWeb.RenderProcessMessageHandler = New RenderProcessMessageHandler() cefWeb.LoadHandler = New LoadHandler() Me.Controls.Add(cefWeb) AddHandler cefWeb.Click, AddressOf CefClick Panel1.Visible = True Panel1.Visible = False End Sub '全屏切换 Private Sub ChangeFullScreen() fullnow = Not fullnow 'Me.WindowState = FormWindowState.Normal '这一句是我自己加的，全屏最大化前恢复到默认状态（可能与我用的用户界面有关，不写也可以） 'SetFullScreen(fullnow, rect) If fullnow Then Me.FormBorderStyle = FormBorderStyle.None 'Me.ControlBox = False'还是与我用的界面控件有关 Me.WindowState = FormWindowState.Maximized 'notify.ShowBalloonTip(2000, "注意", "应用正在以全屏模式运行。", ToolTipIcon.Info) Me.Location = New Point(0, 0) Me.Size = SystemInformation.PrimaryMonitorSize Else Me.FormBorderStyle = FormBorderStyle.Sizable 'Me.ControlBox = True Me.WindowState = FormWindowState.Normal End If End Sub '当窗体退出时检查全屏状态，如果是全屏则恢复（主要是任务栏） Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed If fullnow Then SetFullScreen(False, rect) End If End Sub Public Sub CheckShowPwd2() Dim t As Thread t = New Thread(AddressOf Me.CheckShowPwd1) t.Start() t.Join() End Sub Public Sub CheckShowPwd1() If fullnow Then Panel1.Visible = True Else pwd = "" Label1.Text = pwd ChangeFullScreen() End If End Sub Public KeyHandle As Integer Public CurTimes As Integer = 5 Public NeedTimes As Integer = 15 Public LastClickTime As Long = 0 Public Function MouseHook(ByVal nCode As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Dim clickTime As Long = Now.Ticks If wParam = WM_LBUTTONDOWN Then 'CheckShowPwd() LastClickTime = clickTime Debug.Print("左键单击down 坐标:") End If If wParam = WM_LBUTTONUP Then Dim diff As Long = clickTime - LastClickTime If clickTime - LastClickTime >= 50000000 Then If fullnow Then Panel1.Visible = True Else pwd = "" Label1.Text = pwd ChangeFullScreen() End If End If Debug.Print("左键单击 up 坐标:" & diff) End If Return CallNextHookEx(KeyHandle, nCode, wParam, lParam) End Function Public Sub CheckShowPwd(parameters As IContextMenuParams) If parameters.XCoord < 3000 Then If parameters.YCoord < 2000 Then Debug.Print(parameters.XCoord & "") Debug.Print(parameters.YCoord & "") Dim clickTime As Long = Now.Ticks Dim diff As Long = clickTime - LastClickTime If LastClickTime = 0 Then ElseIf clickTime - LastClickTime < 10000000 Then CurTimes -= 1 If CurTimes = 0 Then CurTimes = NeedTimes If fullnow Then Panel1.Visible = True Else pwd = "" Label1.Text = pwd ChangeFullScreen() End If End If Else CurTimes = NeedTimes End If LastClickTime = clickTime Debug.Print("左键单击 坐标:" & clickTime & " : " & CurTimes & " : " & diff) Return End If End If CurTimes = NeedTimes End Sub Public Sub HookKeyboard() Dim hins As IntPtr = IntPtr.Zero hins = GetModuleHandle(Process.GetCurrentProcess.MainModule.ModuleName) KeyHandle = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseHook, hins, 0) End Sub Public Sub UnhookKeyboard() Call UnhookWindowsHookEx(KeyHandle) '停止钩子 End Sub Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click End Sub '确定按钮 Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click If pwd = password Then Panel1.Visible = False ChangeFullScreen() End If End Sub '取消按钮 Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click pwd = "" Label1.Text = "" Panel1.Visible = False End Sub Private Sub Panel1_Click(sender As Object, e As EventArgs) Handles Panel1.Click 'SendToBack() End Sub Private Sub Panel1_Paint(sender As Object, e As PaintEventArgs) Handles Panel1.Paint 'Panel1.BackColor = Color.Transparent 'AddHandler Button1.Click, AddressOf EnterPwd 'AddHandler Button2.Click, AddressOf EnterPwd 'AddHandler Button3.Click, AddressOf EnterPwd 'AddHandler Button4.Click, AddressOf EnterPwd 'AddHandler Button5.Click, AddressOf EnterPwd 'AddHandler Button6.Click, AddressOf EnterPwd 'AddHandler Button8.Click, AddressOf EnterPwd 'AddHandler Button9.Click, AddressOf EnterPwd 'AddHandler Button10.Click, AddressOf EnterPwd End Sub Dim pwd As String = "" Public Sub EnterPwd(sender As Object, e As EventArgs) pwd = pwd & sender.Text Label1.Text = pwd End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click EnterPwd(sender, e) End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click EnterPwd(sender, e) End Sub Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click EnterPwd(sender, e) End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click EnterPwd(sender, e) End Sub Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click EnterPwd(sender, e) End Sub Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click EnterPwd(sender, e) End Sub Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click EnterPwd(sender, e) End Sub Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click EnterPwd(sender, e) End Sub Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click EnterPwd(sender, e) End Sub Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click If pwd.Length > 0 Then pwd = pwd.Substring(0, pwd.Length - 1) Label1.Text = pwd End If End Sub Private Sub CefClick(sender As Object, e As EventArgs) Debug.Print("3333") End Sub Private Sub Form1_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick Debug.Print("222") End Sub Private Sub Label2_Click(sender As Object, e As EventArgs) Handles Label2.Click End Sub End Class Module TxtRead Public remoteUrl As String Public equNumFilePath As String Public password As String Public equNum As String Public clickTimes As String Public clickTime As String Public Function readTxt() Dim app As String = Assembly.GetAssembly(GetType(Form1)).Location Dim AssemPath As String = System.IO.Path.GetDirectoryName(app) 'Dim assem As Assembly = GetType(Form1).Assembly 'Dim AssemPath As String = assem.CodeBase Debug.Print("1111111:" & AssemPath) Dim arr Dim str Dim i As Long arr = Split(CreateObject("scripting.filesystemobject").opentextfile(AssemPath & "\config.txt").readall, vbNewLine) For i = 0 To UBound(arr) str = Split(arr(i), "=") If str(0) = "remoteUrl" Then remoteUrl = str(1) End If If str(0) = "equNumFilePath" Then equNumFilePath = str(1) End If If str(0) = "password" Then password = str(1) End If If str(0) = "clickTimes" Then clickTimes = str(1) End If If str(0) = "clickTime" Then clickTime = str(1) End If Next If clickTimes = "" Then clickTimes = 5 End If If clickTime = "" Then clickTime = 2000 End If If equNumFilePath <> "" Then arr = Split(CreateObject("scripting.filesystemobject").opentextfile(equNumFilePath).readall, vbNewLine) equNum = arr(0) If equNum <> "" Then If remoteUrl.IndexOf("?") <> -1 Then remoteUrl &= "&" Else remoteUrl &= "?" End If remoteUrl &= "deviceNum=" & equNum End If End If Debug.Print(remoteUrl) End Function End Module '全屏方法 Module FullScreen Public Declare Auto Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer Public Declare Auto Function ShowWindow Lib "user32.dll" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer Public Declare Auto Function SystemParametersInfo Lib "user32.dll" (ByVal uAction As Integer, ByVal uParam As Integer, ByRef lpvParam As Rectangle, ByVal fuWinIni As Integer) As Integer Public Const SPIF_UPDATEINIFILE As Integer = &H1 Public Const SPI_SETWORKAREA As Integer = 47 Public Const SPI_GETWORKAREA As Integer = 48 Public Const SW_SHOW As Integer = 5 Public Const SW_HIDE As Integer = 0 Public Function SetFullScreen(ByVal fullscreen As Boolean, ByRef rectOld As Rectangle) As Boolean Dim Hwnd As Integer = FindWindow("Shell_TrayWnd", Nothing) If Hwnd = 0 Then Return False End If If fullscreen Then ShowWindow(Hwnd, SW_HIDE) Dim rectFull As Rectangle = Screen.PrimaryScreen.Bounds SystemParametersInfo(SPI_GETWORKAREA, 0, rectOld, SPIF_UPDATEINIFILE) 'Get SystemParametersInfo(SPI_SETWORKAREA, 0, rectFull, SPIF_UPDATEINIFILE) 'Set Else ShowWindow(Hwnd, SW_SHOW) SystemParametersInfo(SPI_SETWORKAREA, 0, rectOld, SPIF_UPDATEINIFILE) End If Return True End Function End Module '鼠标钩子 Module Module1 Public Function SetWindowsHookEx(ByVal idHook As Integer, ByVal HookProc As KeyHook, ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer End Function Public Function CallNextHookEx(ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer End Function Public Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean End Function Public Function GetModuleHandle(ByVal name As String) As IntPtr End Function Public Structure KBDLLHOOKSTRUCT Public vkCode As Keys Public scanCode As Keys Public flags As Integer Public time As Integer Public dwExtraInfo As Integer End Structure Public Const HC_ACTION As Integer = 0 Public Const WH_KEYBOARD_LL As Integer = 13 Public Const WH_MOUSE_LL = 14 Public Const WH_MOUSE = 7 Public Const WM_LBUTTONUP = &H202 Public Const WM_LBUTTONDOWN = &H201 Public Delegate Function KeyHook(ByVal Code As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer ' Public callback As KeyHook End Module Public Class ContextMenuHandler Implements CefSharp.IContextMenuHandler Public Form1Instance Public Sub OnBeforeContextMenu1(chromiumWebBrowser As IWebBrowser, browser As IBrowser, frame As IFrame, parameters As IContextMenuParams, model As IMenuModel) Implements IContextMenuHandler.OnBeforeContextMenu 'Debug.Print(parameters.XCoord & "") 'Debug.Print(parameters.YCoord & "") Debug.Print("OnBeforeContextMenu1") 'Form1Instance.CheckShowPwd(parameters) 'model.Clear() End Sub Public Function OnContextMenuCommand1(chromiumWebBrowser As IWebBrowser, browser As IBrowser, frame As IFrame, parameters As IContextMenuParams, commandId As CefMenuCommand, eventFlags As CefEventFlags) As Boolean Implements IContextMenuHandler.OnContextMenuCommand Debug.Print("aa") Return False End Function Public Sub OnContextMenuDismissed1(chromiumWebBrowser As IWebBrowser, browser As IBrowser, frame As IFrame) Implements IContextMenuHandler.OnContextMenuDismissed Debug.Print("cc") End Sub Public Function RunContextMenu1(chromiumWebBrowser As IWebBrowser, browser As IBrowser, frame As IFrame, parameters As IContextMenuParams, model As IMenuModel, callback As IRunContextMenuCallback) As Boolean Implements IContextMenuHandler.RunContextMenu Debug.Print("bbb") model.Clear() Return False End Function End Class Public Class RenderProcessMessageHandler Implements CefSharp.IRenderProcessMessageHandler Public Form1Instance Public Sub OnContextCreated(chromiumWebBrowser As IWebBrowser, browser As IBrowser, frame As IFrame) Implements IRenderProcessMessageHandler.OnContextCreated 'chromiumWebBrowser.ExecuteScriptAsync("document.addEventListener('touchstart', function(){ window._touchstart_time = Date.now() }); document.addEventListener('touchend', function(){ if(Date.now() - window._touchstart_time > 5000) { jsApp.toggleFull() } })") chromiumWebBrowser.ExecuteScriptAsync("window._click_tiems = 0; window._click_time = 0; document.addEventListener('click', function(e){ if(e.clientY < 500 && e.clientX < 500){ console.log(window._click_tiems); if(window._click_tiems >= " & clickTimes & "){ window._click_tiems = 0; window._click_time = 0; jsApp.toggleFull(); return; } var cur = Date.now(); if(window._click_time){ if(cur - window._click_time < " & clickTime & "){ window._click_tiems++ } else { window._click_tiems = 0 } } else { window._click_tiems = 1 } window._click_time = cur;} else { window._click_tiems = 0; window._click_time = 0; } });") Debug.WriteLine("OnContextCreated") 'Debug.Print("OnContextCreated" & chromiumWebBrowser.CanExecuteJavascriptInMainFrame) End Sub Public Sub OnContextReleased(chromiumWebBrowser As IWebBrowser, browser As IBrowser, frame As IFrame) Implements IRenderProcessMessageHandler.OnContextReleased 'Debug.Print("OnContextReleased" & chromiumWebBrowser.CanExecuteJavascriptInMainFrame) 'chromiumWebBrowser.ExecuteScriptAsync("window._click_tiems = 0; window._click_time = 0; document.addEventListener('click', function(e){ if(e.clientY < 500 && e.clientX < 500){ console.log(window._click_tiems); if(window._click_tiems >= " & clickTimes & "){ window._click_tiems = 0; window._click_time = 0; jsApp.toggleFull(); return; } var cur = Date.now(); if(window._click_time){ if(cur - window._click_time < " & clickTime & "){ window._click_tiems++ } else { window._click_tiems = 0 } } else { window._click_tiems = 1 } window._click_time = cur;} else { window._click_tiems = 0; window._click_time = 0; } });") Debug.WriteLine("OnContextReleased") End Sub Public Sub OnFocusedNodeChanged(chromiumWebBrowser As IWebBrowser, browser As IBrowser, frame As IFrame, node As IDomNode) Implements IRenderProcessMessageHandler.OnFocusedNodeChanged 'chromiumWebBrowser.ExecuteScriptAsync("window._click_tiems = 0; window._click_time = 0; document.addEventListener('click', function(e){ if(e.clientY < 500 && e.clientX < 500){ console.log(window._click_tiems); if(window._click_tiems >= " & clickTimes & "){ window._click_tiems = 0; window._click_time = 0; jsApp.toggleFull(); return; } var cur = Date.now(); if(window._click_time){ if(cur - window._click_time < " & clickTime & "){ window._click_tiems++ } else { window._click_tiems = 0 } } else { window._click_tiems = 1 } window._click_time = cur;} else { window._click_tiems = 0; window._click_time = 0; } });") Debug.WriteLine("OnFocusedNodeChanged") End Sub Public Sub OnUncaughtException(chromiumWebBrowser As IWebBrowser, browser As IBrowser, frame As IFrame, exception As JavascriptException) Implements IRenderProcessMessageHandler.OnUncaughtException 'chromiumWebBrowser.ExecuteScriptAsync("window._click_tiems = 0; window._click_time = 0; document.addEventListener('click', function(e){ if(e.clientY < 500 && e.clientX < 500){ console.log(window._click_tiems); if(window._click_tiems >= " & clickTimes & "){ window._click_tiems = 0; window._click_time = 0; jsApp.toggleFull(); return; } var cur = Date.now(); if(window._click_time){ if(cur - window._click_time < " & clickTime & "){ window._click_tiems++ } else { window._click_tiems = 0 } } else { window._click_tiems = 1 } window._click_time = cur;} else { window._click_tiems = 0; window._click_time = 0; } });") Debug.WriteLine("OnUncaughtException") End Sub End Class Public Class JsEvent Public Form1Instance Public Sub update() Shell("Update.exe") Debug.Print("444444") End Sub Public Sub toggleFull() Debug.Print("55555") 'Dim t As New Thread(AddressOf Form1Instance.CheckShowPwd1) 'Dim t As New Thread() 't.Start() 'Thread1.Invoke() 'Thread1.DynamicInvoke() 'Tasks.StrArg = "參数A" ' 设置用作參数的字段。 'Thread1.Start() ' 启动新线程。 'Thread1.Join() ' 等待线程 1 执行结束。 Form1Instance.CheckShowPwd2() End Sub End Class Public Class LoadHandler Implements CefSharp.ILoadHandler Public Form1Instance Public Sub OnFrameLoadEnd(chromiumWebBrowser As IWebBrowser, frameLoadEndArgs As FrameLoadEndEventArgs) Implements ILoadHandler.OnFrameLoadEnd End Sub Public Sub OnFrameLoadStart(chromiumWebBrowser As IWebBrowser, frameLoadStartArgs As FrameLoadStartEventArgs) Implements ILoadHandler.OnFrameLoadStart Debug.WriteLine("OnFrameLoadStart") End Sub Public Sub OnLoadError(chromiumWebBrowser As IWebBrowser, loadErrorArgs As LoadErrorEventArgs) Implements ILoadHandler.OnLoadError Debug.WriteLine("OnLoadError") End Sub Public Sub OnLoadingStateChange(chromiumWebBrowser As IWebBrowser, loadingStateChangedArgs As LoadingStateChangedEventArgs) Implements ILoadHandler.OnLoadingStateChange Debug.WriteLine("OnLoadingStateChange: isLoading" & loadingStateChangedArgs.IsLoading) End Sub End Class