VB生成WORD问题
这里有个电脑操作记录的VB程序窗台代码如下：Option Explicit
Private Sub Form_Load()
StartHook Me.Hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook Me.Hwnd
End Sub
Private Sub Form_Resize()
List1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub List1_Click()
MsgBox List1.Text
End Sub
模块代码如下：
Option Explicit
Private 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
Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal Hwnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias _
"RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function RegisterShellHook Lib "Shell32" Alias "#181" _
(ByVal Hwnd As Long, ByVal nAction As Long) As Long
Private Declare Function RegisterShellHookWindow Lib "user32" _
(ByVal Hwnd As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal Hwnd As Long, _
lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" ( _
ByVal hProcess As Long, _
ByRef lphModule As Long, _
ByVal cb As Long, _
ByRef lpcbNeeded As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi.dll" _
Alias "GetModuleFileNameExA" ( _
ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpFilename As String, _
ByVal nSize As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const HSHELL_WINDOWCREATED = 1
Private Const HSHELL_WINDOWDESTROYED = 2
Private Const HSHELL_ACTIVATESHELLWINDOW = 3
Private Const HSHELL_WINDOWACTIVATED = 4
Private Const HSHELL_GETMINRECT = 5
Private Const HSHELL_REDRAW = 6
Private Const HSHELL_TASKMAN = 7
Private Const HSHELL_LANGUAGE = 8
Private Const WM_NCDESTROY = &H82
Private Const GWL_WNDPROC = -4
Private Const WH_SHELL = 10
Private Const WH_CBT As Long = 5
Private Const GW_OWNER = 4
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOOLWINDOW = &H80
Private Const WS_EX_APPWINDOW = &H40000
Private Const RSH_DEREGISTER = 0
Private Const RSH_REGISTER = 1
Private Const RSH_REGISTER_PROGMAN = 2
Private Const RSH_REGISTER_TASKMAN = 3
Private lpPrevWndProc As Long
Public msgShellHook As Long
Public Sub Unhook(Hwnd As Long)
'Call RegisterShellHook(Hwnd, RSH_DEREGISTER)
SetWindowLong Hwnd, GWL_WNDPROC, lpPrevWndProc
End Sub
Public Sub StartHook(Hwnd As Long)
msgShellHook = RegisterWindowMessage("SHELLHOOK")
Dim hLibShell As Long
RegisterShellHookWindow Hwnd
'Call RegisterShellHook(Hwnd, RSH_REGISTER Or RSH_REGISTER_TASKMAN Or RSH_REGISTER_PROGMAN)
lpPrevWndProc = SetWindowLong(Hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Function WindowProc(ByVal Hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_NCDESTROY
Unhook Hwnd
Case msgShellHook
Select Case wParam
Case HSHELL_WINDOWCREATED
AddCREATEDstr lParam
'Case HSHELL_WINDOWDESTROYED
'这里没有用，想用的话，添加你的代码
'Case HSHELL_REDRAW
'这里没有用，想用的话，添加你的代码
'Case HSHELL_WINDOWACTIVATED
'这里没有用，想用的话，添加你的代码
'Case HSHELL_GETMINRECT
'这里没有用，想用的话，添加你的代码
'Case HSHELL_REDRAW
'这里没有用，想用的话，添加你的代码
'Case HSHELL_TASKMAN
'这里没有用，想用的话，添加你的代码
'Case HSHELL_LANGUAGE
'这里没有用，想用的话，添加你的代码
End Select
End Select
WindowProc = CallWindowProc(lpPrevWndProc, Hwnd, uMsg, wParam, lParam)
End Function
Private Function GetEXEFromHandle(Optional ByVal nHWnd As Long = 0) As String
Dim nProcID As Long
Dim nResult As Long
Dim nTemp As Long
Dim lModules(1 To 200) As Long
Dim sFile As String
Dim hProcess As Long '
If nHWnd = 0 Then nHWnd = GetForegroundWindow()
If GetWindowThreadProcessId(nHWnd, nProcID) <> 0 Then
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or _
PROCESS_VM_READ, 0, nProcID)
If hProcess <> 0 Then
nResult = EnumProcessModules(hProcess, lModules(1), _
200, nTemp)
If nResult <> 0 Then
sFile = Space$(260)
nResult = GetModuleFileNameEx(hProcess, 0, sFile, Len(sFile))
sFile = LCase$(Left$(sFile, nResult))
GetEXEFromHandle = sFile
End If
CloseHandle hProcess
End If
End If
End Function
Private Function GetWindowCaption(ByVal Hwnd As Long) As String
Dim MyStr As String
MyStr = String(256, Chr$(0)) '
GetWindowText Hwnd, MyStr, 256
MyStr = Left$(MyStr, InStr(MyStr, Chr$(0)) - 1)
GetWindowCaption = MyStr
End Function
Private Sub AddCREATEDstr(ByVal Hwnd As Long)
If Hwnd = 0 Then Exit Sub
Dim s As String
s = Format(Now, "YYYY年MM月DD日 HH:MM:SS")
Dim mCaption As String
mCaption = GetWindowCaption(Hwnd)
Dim exename As String
exename = GetEXEFromHandle(Hwnd)
If mCaption <> "" And exename <> "" Then
s = s + " 句柄为：" + CStr(Hwnd) + " 的窗口被创建，标题为：" + mCaption + " 对应程序路径为：" + exename
ElseIf mCaption = "" And exename <> "" Then
s = s + " 句柄为：" + CStr(Hwnd) + " 的窗口被创建，对应程序路径为：" + exename
ElseIf mCaption <> "" And exename = "" Then
s = s + " 句柄为：" + CStr(Hwnd) + " 的窗口被创建，标题为：" + mCaption
ElseIf mCaption = "" And exename = "" Then
s = s + " 句柄为：" + CStr(Hwnd) + " 的窗口被创建"
End If
Form1.List1.AddItem s
End Sub
我想问的的是在这程序里面加点代码把这些记录保存到WORD文挡里面 --------------------编程问答-------------------- 急需用啊，有没有知道啊。。。希望指点啊。。 --------------------编程问答-------------------- 必须放到 word 文档里面吗？word 文件不好做，太复杂，得慢慢查查相关资料。还是建议你搞成 txt 文档吧。 --------------------编程问答-------------------- 不用WORD也行啊，那TXT该怎么弄啊？ --------------------编程问答-------------------- dim i as integer
open app.path & "\record.txt" for append as #1
for i=0 to list1.listcount-1
print #1,list1.list(i)
next i
close #1
补充：VB , 基础类
