自己写插件!源码!

冷月无痕

貌似现在都没人写TC的专用插件?发个NNN年前的插件源码,有兴趣学插件的朋友可以参考下!

运行环境：VB6.0

测试环境：xp sp2 + vb6.0

测试结果：功能全部可用

DLL 声明部分的全部代码：

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) 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 GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String)
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long
Private Declare Function WindowFromPoint& Lib "user32" (ByVal X As Long, ByVal Y As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private 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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As rect) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) 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
Private Type rect
top As Long
left As Long
endtop As Long
endleft As Long
End Type
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024
End Type
Private Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Byte
modBaseSize   As Long
hModule As Long
szModule As String * 256
szExePath As String * 1024
End Type
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPMODULE = &H8
Private Type POINTAPI
X As Long
Y As Long
End Type


这里是所有过程的代码：

Public Function KeyDown(jm) '按下某键
keybd_event jm, 0, 0, 0
End Function
Public Function KeyUp(jm) '弹起某键
keybd_event jm, 0, &H2, 0
End Function
Public Function KeyPress(jm, cs)  '按某键
For c = 1 To cs
keybd_event jm, 0, &H1, 0
Next
End Function
Public Function MouseMove(X, Y)        '移动鼠标
mouse_event &H8000 Or &H1, 0, 0, 0, 0
mouse_event &H1, X, Y, 0, 0
End Function
Public Function MousePressL(cs)        '按鼠标左键
For c = 1 To cs
mouse_event &H2 Or &H4, 0, 0, 0, 0
Next
End Function
Public Function MouseDownL()   '按下鼠标左键
mouse_event &H2, 0, 0, 0, 0
End Function
Public Function MouseUpL()    '弹起鼠标左键
mouse_event &H4, 0, 0, 0, 0
End Function
Public Function MousePressR(cs)          '按鼠标右键
For c = 1 To cs
mouse_event &H8 Or &H10, 0, 0, 0, 0
Next
End Function
Public Function MouseDownR()   '按下鼠标右键
mouse_event &H8, 0, 0, 0, 0
End Function
Public Function MouseUpR()  '弹起鼠标右键
mouse_event &H10, 0, 0, 0, 0
End Function
Public Function MousePressM(cs)        '按鼠标中键
For c = 1 To cs
mouse_event &H20 Or &H40, 0, 0, 0, 0
Next
End Function
Public Function MouseDownM()   '按下鼠标中键
mouse_event &H20, 0, 0, 0, 0
End Function
Public Function MouseUpM()  '弹起鼠标中键
mouse_event &H40, 0, 0, 0, 0
End Function
Public Function MouseXY() '返回现在鼠标位置
Dim p As POINTAPI
GetCursorPos p
MouseXY = p.X & "/" & p.Y
End Function
Public Function Delay(sj) '等待一定时间
Sleep sj
End Function
Public Function DLGetPixel(X, Y) '返回指定坐标的16进制颜色
DLGetPixel = GetPixel(GetDC(0), X, Y)
DLGetPixel = Hex(DLGetPixel)
End Function
Public Function HMouseClickL(hwnd, X, Y) '后台发送鼠标左键命令
Dim lParam As Long
lParam = (Y * &H10000) + X
PostMessage hwnd, &H201, 0&, ByVal lParam
  PostMessage hwnd, &H202, 0&, ByVal lParam
End Function
Public Function HMouseClickR(hwnd, X, Y) '后台发送鼠标右键命令
Dim lParam As Long
lParam = (Y * &H10000) + X
PostMessage hwnd, &H204, 0&, ByVal lParam
  PostMessage hwnd, &H205, 0&, ByVal lParam
End Function
Public Function HMouseClickM(hwnd, X, Y) '后台发送鼠标中命令
Dim lParam As Long
lParam = (Y * &H10000) + X
PostMessage hwnd, &H207, 0&, ByVal lParam
  PostMessage hwnd, &H208, 0&, ByVal lParam
End Function
Public Function HKeyPress(hwnd, jm) '后台发送键盘命令
PostMessage hwnd, &H101, jm, 0
End Function
Public Function DLDir(path)    '判断文件或文件夹是否存在
If Dir(path) = "" Then
DLDir = 0
Else
DLDir = 1
End If
End Function
Public Function INIRead(xj As String, zhi As String, lj As String) '读INI
Dim zs As String * 255
INIRead = left(zs, GetPrivateProfileString(xj, zhi, "", zs, Len(zs), lj))
End Function
Public Function INIWhile(xj As String, zhi As String, nr As String, lj As String) As String '写INI
INIWhile = WritePrivateProfileString(xj, zhi, nr, lj)
End Function
Public Function DLMouseHwnd() '返回鼠标现在指向的窗口句柄
Dim lRet As Long
Dim ptAPI As POINTAPI
GetCursorPos ptAPI
lRet = WindowFromPoint(ptAPI.X, ptAPI.Y)
DLMouseHwnd = lRet
End Function
Public Function DLQTHwnd() '返回现在激活窗口的句柄
DLQTHwnd = GetForegroundWindow
End Function
Public Function FindWin(lei, name) As Long  '返回指定窗口标题或类名的窗口句柄
If lei = 0 Then
lei = vbNullString
End If
FindWin = FindWindow(lei, name)
End Function
Public Function FindWinEx(hWnd1, hWnd2, lei, name) As Long   '查找一个父窗口的子窗口句柄
If lei = 0 Then
lei = vbNullString
End If
If name = 0 Then
name = vbNullString
End If
FindWinEx = FindWindowEx(hWnd1, hWnd2, lei, name)
End Function
Public Function DLPdWin(name) As Long   '判断窗口是否存在
DLPdWin = FindWindow(vbNullString, name)
If DLPdWin = 0 Then
DLPdWin = "no"
Else
DLPdWin = "yes"
End If
End Function
Public Function GetText(ByVal hwnd As Long) As String     '得到指定句柄的标题
longs = SendMessage(hwnd, &HE, 0, 0)
Dim Data As String
Data = String(longs, 0)
SendMessage hwnd, &HD, longs + 1, ByVal Data
GetText = Data
End Function
Public Function GetCName(hwnd) As String '得到指定句柄的类名
Dim sf As String * 254
Dim zf As String
zf = GetClassName(hwnd, sf, 255)
GetCName = Trim$(sf)
End Function
Public Function GetPath(hwnd As Long) As String   '返回指定句柄的路径
hWindow = hwnd
GetWindowThreadProcessId ByVal hWindow, pidWindow
Dim process As PROCESSENTRY32
Dim module As MODULEENTRY32
Dim hpSnapshot As Long
Dim hmSnapshot As Long
hpSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hpSnapshot > 0 Then
process.dwSize = Len(process)
If Process32First(hpSnapshot, process) Then
Do
If process.th32ProcessID = pidWindow Then
hmSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, process.th32ProcessID)
If hmSnapshot > 0 Then
module.dwSize = Len(module)
If Module32First(hmSnapshot, module) Then
GetPath = left(module.szExePath, InStr(module.szExePath, Chr(0)) - 1)
End If
CloseHandle (hmSnapshot)
End If
Exit Do
End If
Loop Until (Process32Next(hpSnapshot, process) < 1)
End If
CloseHandle (hpSnapshot)
End If
End Function
Public Function GetDX(hwnd) &#39;返回指定窗口客服区大小
Dim dx As rect
Dim X
X = GetClientRect(hwnd, dx)
GetDX = dx.top & "\" & dx.left & "\" & dx.endtop & "\" & dx.endleft
End Function
Public Function DLActiveWindows(hwnd As Long)   &#39;激活后台窗口（不能激活最小化的窗口）
SetForegroundWindow hwnd
End Function
Public Function DLWindowMax(hwnd As Long)  &#39;把已经最小化的窗口最大话并激活
ShowWindow hwnd, 3
End Function
Public Function DLWindowMIX(hwnd As Long)  &#39;最小化一个窗口
ShowWindow hwnd, 6
End Function
Public Function DLHideWindow(hwnd As Long)    &#39;隐藏一个窗口
SetWindowPos hwnd, 0, 0, 0, 0, 0, &H80
End Function
Public Function DLShowWindow(hwnd As Long)     &#39;显示一个隐藏的窗口
SetWindowPos hwnd, 0, 0, 0, 0, 0, &H40
End Function
Public Function DLMoveWindow(hwnd As Long, X As Long, Y As Long)  &#39;保持大小移动一个窗口到指定坐标
SetWindowPos hwnd, 0, X, Y, 0, 0, &H1
End Function
Public Function DLCloseWindow(hwnd As Long)  &#39;关闭指定窗口
SendMessage hwnd, &H10, 0, 0
End Function


代码完了&#183;&#183;&#183;&#183;附件中有生成好的DLL

游客，如果您要查看本帖隐藏内容请回复

代码很简单,只起到抛砖引玉的作用,汗,欢迎大神们劈砖!

小西

:~都是英文，看不懂:~

梧桐树下雨

:D有没有 c 写的 vb 看着有点别扭

tclx

回复一下 看看

冷月无痕

回复 3楼梧桐树下雨的帖子

c 吖 都还给老师老 只怪当年教C语言的老师长得太漂亮 上课只顾看她了:P

stxuhong

简单是我的偶像，想你做我的师父

cylhb

为什么不早2天发呢-。-我前天百度了N久，就想知道怎么写插件。。
搞了一个通宵才搞定，早有这个就不用这么久了。。。

爱倩柔

kanzhe danteng

lyf1314

不错不错

q79985718

不懂哦