module1.bas

OpenPlayer代码

Attribute VB_Name = "Module1"
Option Explicit
'==============================
'设置窗体总在最前面用到
' SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3   '设置
' SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3   '取消
'==============================
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long


'==============================
'移动窗体
'ReleaseCapture
'SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
'==============================
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1

'=============================
'shell 打开
'=============================
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long




'==============================
'取得鼠标的当前位置
'及取得鼠标当前位置下窗体名柄
'getcursorpos(mouse)
'==============================
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
   X As Long
   Y As Long
End Type



'==============================
'查找父、子窗口的名柄
'==============================
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

'==============================
'HOOK 钩！
'回调函数
'==============================
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'====================
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long




    Public Const WM_LOOK = "SuperScreenSaver1.0 预览"
    Public Const WM_SET = "SuperScreenSaver1.0 设置"
    Public Const WM_RUN = "SuperScreenSaver1.0"
    Public Const HWND_TOP = 0&
    Public Const WS_CHILD = &H40000000
    Public Const GWL_STYLE = (-16)
    
    Public Const SWP_NOZORDER = &H4
    Public Const SWP_NOACTIVATE = &H10
    Public Const SWP_SHOWWINDOW = &H40
   
    Public Const WM_CLOSE = &H10
    
    
    Type RECT
     Left As Long
     Top As Long
     Right As Long
     Bottom As Long
    End Type

Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)


Global isFullScreen As Boolean


Global Filename As String
Global oldX, oldY As Long


'=================================
'SWF文件头部信息
'=================================
Global colorR As Byte, colorB As Byte, colorG As Byte, MFPS As Byte
Global mWidth As Integer, mHeight As Integer, MTotalFrames As Integer
Global fso As New FileSystemObject
Global Author  As String

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const WH_KEYBOARD = 2

Global hHook As Long

Global PassWordIn As Boolean
Global mouse As POINTAPI
Global beEnd As Boolean

Global hFlashhwnd1 As Long


Public lpPrevWndProc As Long
Public lngHWnd As Long



Function KeyboardProc(ByVal idHook As Long, ByVal lParam As Long, ByVal wParam As Long) As Long
    Debug.Print lParam & "     " & wParam
    If lParam <> 116 And Form5.Visible = False Then
        '退出程序
        '由于在Hook里面无法用End直接结束程序，那样会出现非法操作，所以这里通用改变一个变量的值，
        '用Timer结束程序
        beEnd = True
    End If
End Function