intelligent-medicine-abinet-exe/intelligent-medicine-abinet/Form1.vb

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
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Function SetWindowsHookEx(ByVal idHook As Integer, ByVal HookProc As KeyHook, ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
    End Function
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Function CallNextHookEx(ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
    End Function
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean
    End Function
    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Function GetModuleHandle(ByVal name As String) As IntPtr
    End Function

    <StructLayout(LayoutKind.Sequential)>
    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

    '<MarshalAs(UnmanagedType.FunctionPtr)>
    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