Imports System.Runtime.InteropServices
Imports System.Text
Public Class Form1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Byte()) As Integer
Private Declare Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As Integer
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Integer) As Integer
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As String, ByVal cch As Integer) As Integer
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Integer, ByVal lpSource As Byte(), ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, ByVal lpBuffer As String, ByVal nSize As Integer, ByVal Arguments As Integer) As Integer
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Integer, ByVal lpText As String, ByVal lpCaption As String, ByVal wStructure As Integer) As Integer
Private Structure RECT
Dim Left As Integer
Dim Top As Integer
Dim Right As Integer
Dim Bottom As Integer
End Structure
Private Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Integer, ByVal lpRect As RECT) As Integer
Private Declare Function WindowFromPoint Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Integer, ByVal yPoint As Integer) As Integer
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer, ByVal fuFlags As Integer, ByVal uTimeout As Integer, ByVal lpdwResult As Integer) As Integer
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Integer
'測試語句
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Private Sub GroupBox1_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GroupBox1.Enter
End Sub
Private Sub GroupBox2_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GroupBox2.Enter
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Dim hwnd1 As Long
Dim hwnd2 As Long
Dim hwnd3 As Long
Dim leng As String
Dim b As Long
hwnd2 = FindWindowEx(0, 0, "CConvWndBase", vbNullString) '(YSearchMenuWndClass)<<即時通對發話窗口類名
Dim textLength As Integer = GetWindowTextLength(hwnd2)
If textLength > 0 Then
Dim textBuilder As New StringBuilder(textLength)
Dim result As Integer = GetWindowText(hwnd2, textBuilder, textLength)
If result > 0 Then
RichTextBox1.Text = leng '印出抓到的即時通帳號
hwnd1 = FindWindow(vbNullString, leng)
'抓出YIMInputWindow控制代碼
b = FindWindow("IM Input Window", leng)
hwnd1 = FindWindow(vbNullString, leng)
'抓出YIMInputWindow控制代碼
b = FindWindowEx(hwnd1, 0, "YIMInputWindow", vbNullString)
'MsgBox b '印出抓到的窗名視窗控制碼 0代表沒有抓到
'送出要發送的話語
'Text2.Text = ""
'ss = Text2.Text
SendMessage(b, WM_SETTEXT, 0, RichTextBox2.Text)
RichTextBox2.Text = ""
'即時通發送按鈕
hwnd3 = FindWindowEx(hwnd1, 0, "Button", vbNullString)
SendMessage(hwnd3, BM_CLICK, 0, 0)
End If
End If
End Sub
Private Function GetWindowText(ByVal hwnd2 As Long, ByVal textBuilder As StringBuilder, ByVal textLength As Integer) As Integer
' Throw New NotImplementedException
End Function
Private Sub RichTextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox2.TextChanged
'RichTextBox2.SelectionStart = RichTextBox2.TextLength
'RichTextBox2.ScrollToCaret()
End Sub
End Class
End Class
----------------------------------------------------------------
而現在要讓這個程式視窗,在標題上的點右鍵時,的彈出選單裡的關閉無效,及ALT+F4(快速關閉)無效,請問要怎麼做才好呢?
Const MF_BYPOSITION = &H400&
Const MF_REMOVE = &H1000&
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Sub Form_Load()
Dim H As Long, I As Long
H = GetSystemMenu(Me.hwnd, False)
If H Then
I = GetMenuItemCount(H)
If I Then
RemoveMenu H, I - 1, MF_BYPOSITION Or MF_REMOVE
RemoveMenu H, I - 2, MF_BYPOSITION Or MF_REMOVE
DrawMenuBar Me.hwnd
End If
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then Cancel = True
End Sub |