module1.bas

机房计时系统

Attribute VB_Name = "Module1"
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 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 PrevWndFunc As Long
Public Const WM_GETTEXT = &HD
Public Const EM_SETPASSWORDCHAR = &HCC
Public Const GWL_WNDPROC = (-4)

Public cheng As Boolean
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByValhBitmap As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long

Private bybits(1 To 16) As Byte
Private hBitmap As Long, hBrush As Long
Private hDesktopWnd As Long
Private Const BLACKNESS = &H42
Private Const PATINVERT = &H5A0049
Private Const DSTINVERT = &H550009

Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private 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
Dim lRecturned As Long
Const SPI_SCREENSAVERRUNNING = 97
Const WM_CLOSE = &H10
Const WM_QIOT = &H12
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Dim HANDLE As Integer, N As Integer
Public Function MessageFunc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'wMsg:被发送的消息
      Select Case wMsg
          Case WM_GETTEXT
          '发出警告
          MsgBox "有密码窃取工具在运行，请注意！截取消息：WM_GETTEXT。", vbExclamation, "机房自动计费计时系统—— 警告"
          Case EM_SETPASSWORDCHAR
          MsgBox "有密码窃取工具在运行，请注意！截取消息：EM_SETPASSWORDCHAR。", vbExclamation, "机房自动计费计时系统——警告"
          Case Else
            MessageFunc = CallWindowProc(PrevWndFunc, hwnd, wMsg, wParam, lParam)
      End Select
 End Function



Sub shubiao()
rectumed = ShowCursor(1)
End Sub

Sub noshow()


 Const GW_OWNER = 4
 Const SW_HIDE = 0
Dim CR As Long
Dim ownerhwnd  As Long
ownerhwnd = GetWindow(hwnd, GW_OWNER)
rc = ShowWindow(ownerhwnd, SW_HIDE)
End Sub

Sub guan()
Dim wintext As String
wintext = "注册表编辑器"

HANDLE = FindWindow(vbNullString, wintext)
PostMessage HANDLE, WM_CLOSE, 0, 0
End Sub
Sub Firstform()
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub



Sub Form_Load()
    If AnotherInstance() Then End
End Sub

Function AnotherInstance() As Integer
    Dim AppTitle$
    If App.PrevInstance Then
       MsgBox "谢谢你的使用，本程序正在运行"
        AppTitle$ = App.Title
        App.Title = "No longer want this app running..."
        AppActivate AppTitle$

        AnotherInstance = True
    Else
        AnotherInstance = False
    End If
End Function