有个朋友很喜欢玩《帝国时代》,但他技术很差,打不过时就用秘籍造“眼镜蛇车”:按回车后输入“how to you turn this on”。为了方便造车,他把这几个单词“复制”后反复粘贴,一次造一大堆车。^_^
  于是,我赶制了一个小程序,当他复制了那个句子后,我的程序立刻打开剪贴板,把剪贴板中的内容改为“11 不许造车!那是作弊,明白吗!”,看着他造车时的一脸茫然,滇狐窃笑。
  即使不玩《帝国时代》,这样的剪贴板恶作剧也是很好玩的,和我一起做这个有趣的工程吧!
  首先,打开“记事本”,写一个“文字替换表”: cheese steak jimmy's 11 农业是立国之本,好好种田! lumberjack 11 砍柴,砍柴,快砍柴!! rock on 11 大石头滚下来啦!哈哈哈! robin hood 11 罗宾汉说他暂时没有钱。 how do you turn this on 11 不许造车!那是作弊,明白吗! to smithereens 11 本·拉登的手下都去办事了,没空帮你破坏。 i love the monkey head 11 都什么年代了,你还相信“草上飞”?   写完以后,把文件保存到你的VB工程路径下,命名为“BadClip.txt”。我只是举个例子,你完全可以根据你自己的需要写你的文字替换表。
  然后,打开VB,新建一个工程,并添加一个模块,写入以下API声明: 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 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 Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function ChangeClipboardChain Lib "user32" (ByVal hwnd As Long, ByVal hWndNext As Long) As Long Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal nFlag As Integer) As Long Public Const GWL_WNDPROC = (-4) Public Const WM_DRAWCLIPBOARD = &H308 Public Const WM_CHANGECBCHAIN = &H30D   注意:RegisterServiceProcess是一个前几期用过的Api,VB的API查看器中没有这个函数,请到这儿“复制粘贴”。
  然后就可以写程序了,先在模块中写入以下代码: Public hNext As Long Public lpPrevWndProc As Long Public Type Table sFrom As String sTo As String End Type '剪贴板数据替换表 Public aList(1000) As Table Public TableCount As Integer '修改剪贴板数据 Public Sub ChangeClip() For i% = 0 To TableCount If LCase$(Clipboard.GetText()) = aList(i%).sFrom Then Clipboard.SetText aList(i%).sTo End If Next i% End Sub '窗体过程 Public Function WndProc(ByVal hwnd As Long, ByVal uMessage As Long, ByVal wparam As Long, ByVal lparam As Long) As Long Select Case uMessage '剪贴板数据被改动 Case WM_DRAWCLIPBOARD SendMessage hNext, WM_DRAWCLIPBOARD, 0, 0 ChangeClip WndProc = 0 '剪贴板链被改动 Case WM_CHANGECBCHAIN If hNext = wparam Then hNext = lparam End If WndProc = 0 '其它情况调用原有窗体过程 Case Else WndProc = CallWindowProc(lpPrevWndProc, hwnd, uMessage, wparam, lparam) End Select End Function Public Sub hook(hwnd As Long) '子类化窗体 lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc) '设置剪贴板监视 hNext = SetClipboardViewer(hwnd) End Sub Public Sub unhook(hwnd As Long) '解除窗体子类化 SetWindowLong hwnd, GWL_WNDPROC, lpPrevWndProc '解除对剪贴板的监视 ChangeClipboardChain hwnd, hNext End Sub   然后,双击窗体,为窗体写入以下代码: Private Sub Form_Load() '将程序从“关闭程序”列表中去掉 RegisterServiceProcess GetCurrentProcessId, 1 '隐藏窗体 Me.Hide '读取“文字替换表” Open App.Path & "\BadClip.txt" For Input As 1 While Not EOF(1) Line Input #1, aList(TableCount).sFrom If Not EOF(1) Then Line Input #1, aList(TableCount).sTo aList(TableCount).sFrom = Trim$(LCase$(aList(TableCount).sFrom)) aList(TableCount).sTo = Trim$(LCase$(aList(TableCount).sTo)) TableCount = TableCount + 1 End If Wend Close #1 '设置子类化和剪贴板监视 hook Me.hwnd End Sub '为了调试而写的,实际使用中这个函数的不到执行 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) unhook Me.hwnd End Sub   运行一下,怎样?由于这个程序使用了窗体子类化技术,因此比一般的程序危险许多。如果程序录入错误不能正常运行的话,整个VB都会崩溃,一定要小心!
  为了方便你捣乱,我特意提供免安装版,下载去干坏事吧!