1、在开始的时候没有注意到这一点，以为vb有编译不成功、编译成功两种情况，编译成功有运行成功、运行不成功两种情况，运行不成功也没有想到它们很在不受控制的弹出警告框，一开始的时候其实也注意到除数为零、数组越界、为声明变量等问题，感觉那是些逻辑上错误，挺多不会出现预期的结果，可是…… 郁闷。
开始的思路 编译->运行。这里的运行使用shell命令，直接调用的。到现在突然出现运行错误无法控制了。怎么办？？？Dim WindH As Long
Dim hWnd As Long
Dim hWndParent As Long '父窗体句柄
Dim ParentTitle As Long '父窗体标题
Dim ParentTitleBuffer As String
Dim CountControl As Double
CountControl = 0
shellval = Shell(ExeFile, vbHide) '如果编译成功调用shell运行学生程序
Sleep 1000
If shellval <> 0 Then
frmMain.RichTextBox1.Text = frmMain.RichTextBox1.Text & filestudent & "成功执行" & vbCrLf
End If
hWndParent = FindWindow(vbNullString, "Form1") '父窗体句柄
Sleep 100
ParentTitleBuffer = String(20, 0)
ParentTitle = GetWindowText(hWndParent, ParentTitleBuffer, 255) '父窗体标题
RichTextBox1.Text = RichTextBox1.Text & filestudent & Space(2) & "父窗体句柄:" & hWndParent & Space(2) & "窗体名称：" & ParentTitleBuffer & vbCrLf
RichTextBox1.Text = RichTextBox1.Text & "*******************************************************" & vbCrLf
If hWndParent <> 0 Then
ret = EnumChildWindows(hWndParent, AddressOf EnumChildProc, 0)
RichTextBox1.Text = RichTextBox1.Text & "*******************************************************" & vbCrLf
Sleep 1000
End If
AdodcFrmMainMessage.RecordSource = "select * from [Message] where wordId='" & wordid & "' "
'MsgBox "adodc" & AdodcFrmMainMessage.RecordSource
Dim i As Integer
AdodcFrmMainMessage.Refresh
For i = 0 To AdodcFrmMainMessage.Recordset.RecordCount - 1
Dim tempParent As Long '临时父句柄
Dim temp As Long '临时子窗体句柄
'MsgBox "ParentTitle" & Len(AdodcFrmMainMessage.Recordset.Fields("ParentTitle")) & Trim(AdodcFrmMainMessage.Recordset.Fields("ParentTitle")) & "voer"
If Mid$(AdodcFrmMainMessage.Recordset.Fields("ParentTitle"), 1) = "Form1" Then ' 判断是否是Form1的直接孩子窗体
temp = FindWindowEx(hWndParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("Caption"))
'MsgBox "temp" & temp & AdodcFrmMainMessage.Recordset.Fields("Caption")
Else
tempParent = FindWindowEx(hWndParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("ParentTitle"))
' MsgBox "tempParent" & tempParent & "hwndparent" & hWndParent
temp = FindWindowEx(tempParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("Caption"))
'MsgBox "标题" & AdodcFrmMainMessage.Recordset.Fields("Caption")
End If
If temp <> 0 Then
Dim tempClassBuffer As String
tempClassBuffer = Space(MAX_PATH)
' ret = RealGetWindowClass(hwnd, dwWindowClassBuffer, MAX_PATH)
retval = GetClassName(temp, tempClassBuffer, MAX_PATH)
ClassName = StrConv(LeftB(StrConv(tempClassBuffer, vbFromUnicode), retval), vbUnicode) '去掉不可打印的字符
ClassName = Trim(ClassName)
'MsgBox "classname" & Len(ClassName) & ClassName & "over"
If retval <> 0 Then
If ClassName = "ThunderRT6OptionButton" Or ClassName = "ThunderRT6CheckBox" Then
SendMessage temp, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)
End If
If ClassName = "ThunderRT6CommandButton" Then
SendMessage temp, WM_LBUTTONDOWN, 0, ByVal &H10001
Sleep 100
SendMessage temp, WM_LBUTTONUP, 0, ByVal &H10001
End If
End If
End If
AdodcFrmMainMessage.Recordset.MoveNext
Next
PostMessage hWndParent, WM_CLOSE, 0, 0 '关闭窗口
Call WordIdControlKey
Call WordIdkey
score = Round(wordM * WordIdControlKey * WordIdkey, 2) '四舍五入保留两位小数
Adodc2.Refresh ' adodc2先刷新 要不会覆盖上一条记录
Adodc2.Recordset.AddNew
Adodc2.Recordset.Fields("stuid") = stuid
Adodc2.Recordset.Fields("score") = Format(score, "0.00") '截取两位
Adodc2.Recordset.Update参考别人的论文中相关代码发现，他们说用createprocess启动VB6.0和用户程序，可以防止用户程序发生 运行错误，而且能控制不弹出警告框，可是，现在发送不了消息？不知道为什么，而且也不知道什么事createprocess的debug模式，惨 On Error Resume Next
Dim si As STARTUPINFO '该结构用于指定新进程的主窗口特性
Dim pi As PROCESS_INFORMATION '在创建进程时相关的数据结构之一，该结构返回有关新进程及其主线程的信息
Dim hReadPipe As Long ' 负责读取的管道
Dim hWritePipe As Long '负责Shell程序的标准输出和标准错误输出的管道
Dim sOutput As String '放返回的数据
Dim sa As SECURITY_ATTRIBUTES
Dim ret As Long
Dim retval As Long
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "createPipe failed"
'error: Err.LastDllError
Exit Sub
End If Dim strResult As String ''returned results of the command line
With sa
.nLength = Len(sa)
.bInheritHandle = 1& ''inherit, needed for this to work
.lpSecurityDescriptor = 0
End With
With si
.cb = Len(si)
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW ''tell it to use (not ignore) the values below
.wShowWindow = SW_HIDE
.hStdOutput = hWritePipe ''pass the write end of the pipe as the processes standard output
End With
Dim Hwind As Long
Dim FHandle As Long
Dim SM As Long
retval = CreateProcess(vbNullString, "D:\Tomcat 4.1\webapps\myexam\program\student\2220063892-w025\工程1.exe", sa, sa, 1&, DEBUG_PROCESS, ByVal 0&, vbNullString, si, pi)
' If retval = 0 Then
' MsgBox "retval " & retval
' End If
Dim WindH As Long
Dim hwnd As Long
Dim hWndParent As Long '父窗体句柄
Dim ParentTitle As Long '父窗体标题
Dim ParentTitleBuffer As String
hWndParent = FindWindow(vbNullString, "Form1") '父窗体句柄
Sleep 100
ParentTitleBuffer = String(20, 0)
ParentTitle = GetWindowText(hWndParent, ParentTitleBuffer, 255) '父窗体标题
MsgBox "hwndparent" & hWndParent & "标题" & ParentTitleBuffer
Sleep 1000
If hWndParent <> 0 Then
'---------------------查找对应的控件 8个---------------------------------
'MsgBox "hwndparent" & hWndParent
Dim tempHandleZiXing As Long
tempHandleZiXing = FindWindowEx(hWndParent, 0, "ThunderRT6Frame", "字型")
If tempHandleZiXing = 0 Then
MsgBox "字型" & tempHandleZiXing, vbOKCancel, "提示信息"
End If
Dim tempHandleZiTi As Long
tempHandleZiTi = FindWindowEx(hWndParent, 0, "ThunderRT6Frame", "字体")
If tempHandleZiTi <> 0 Then
'List2.AddItem tempHandleZiTi & "字体"
MsgBox "字体"
End If
Dim tempHandleSong As Long
tempHandleSong = FindWindowEx(tempHandleZiTi, 0, "ThunderRT6OptionButton", "宋体")
If tempHandleSong <> 0 Then
MsgBox "宋体"
' List2.AddItem tempHandleSong & "宋体"
End If
Dim tempHandleHeiTi As Long
tempHandleHeiTi = FindWindowEx(tempHandleZiTi, 0, "ThunderRT6OptionButton", "黑体")
If tempHandleHeiTi <> 0 Then
MsgBox "黑体"
' List2.AddItem tempHandleHeiTi & "黑体"
SendMessage tempHandleHeiTi, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)
End IfDim tempHandleFontUnderLine As Long
tempHandleFontUnderLine = FindWindowEx(tempHandleZiXing, 0, "ThunderRT6CheckBox", "下划线")
If tempHandleFontUnderLine <> 0 Then
'List2.AddItem tempHandleFontUnderLine & "下划线"
MsgBox "下划线"
SendMessage tempHandleFontUnderLine, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)End IfDim tempHandleFontItlic As Long
tempHandleFontItlic = FindWindowEx(tempHandleZiXing, 0, "ThunderRT6CheckBox", "斜体")
If tempHandleFontItlic <> 0 Then
'List2.AddItem tempHandleFontItlic & "斜体"
MsgBox "斜体" SendMessage tempHandleFontItlic, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)
End If
Dim tempHandleText As Long
tempHandleText = FindWindowEx(hWndParent, 0, vbNullString, "请选择字体和字型")
If tempHandleText <> 0 Then
MsgBox "请选择字体和字型"
'List2.AddItem tempHandleText & "请选择字体和字型"
End If
Dim tempHandleCommand '确定按钮 发送消息
tempHandleCommand = FindWindowEx(hWndParent, 0, "ThunderRT6CommandButton", "确定")
If tempHandleCommand <> 0 Then
MsgBox "确定" & tempHandleCommand
SendMessage tempHandleCommand, WM_LBUTTONDOWN, 0, ByVal &H10001
Sleep 100
SendMessage tempHandleCommand, WM_LBUTTONUP, 0, ByVal &H10001
End If
PostMessage hWndParent, WM_CLOSE, 0, 0
End If
End Sub
运行时，桌面上不会显示Form1这个窗体，但是可以检查到 Form1的句柄，但是Form1中控件就查找不到，为什么？？？
查找不到具体的控件怎么发送消息？？这些消息可能包括（Commandbutton的单击、CheckBox的选中、Option的选中、下拉列表的项目选中等）还有窗体(Form1)的关闭。
在后就是错误警告框怎么处理？？？不让它们弹出来，最好能放到一个文件中，或者一个表中的字段也行。
期待高手、老师、大侠们给出点指导。期限在即，完不成任务了
开始的思路 编译->运行。这里的运行使用shell命令，直接调用的。到现在突然出现运行错误无法控制了。怎么办？？？Dim WindH As Long
Dim hWnd As Long
Dim hWndParent As Long '父窗体句柄
Dim ParentTitle As Long '父窗体标题
Dim ParentTitleBuffer As String
Dim CountControl As Double
CountControl = 0
shellval = Shell(ExeFile, vbHide) '如果编译成功调用shell运行学生程序
Sleep 1000
If shellval <> 0 Then
frmMain.RichTextBox1.Text = frmMain.RichTextBox1.Text & filestudent & "成功执行" & vbCrLf
End If
hWndParent = FindWindow(vbNullString, "Form1") '父窗体句柄
Sleep 100
ParentTitleBuffer = String(20, 0)
ParentTitle = GetWindowText(hWndParent, ParentTitleBuffer, 255) '父窗体标题
RichTextBox1.Text = RichTextBox1.Text & filestudent & Space(2) & "父窗体句柄:" & hWndParent & Space(2) & "窗体名称：" & ParentTitleBuffer & vbCrLf
RichTextBox1.Text = RichTextBox1.Text & "*******************************************************" & vbCrLf
If hWndParent <> 0 Then
ret = EnumChildWindows(hWndParent, AddressOf EnumChildProc, 0)
RichTextBox1.Text = RichTextBox1.Text & "*******************************************************" & vbCrLf
Sleep 1000
End If
AdodcFrmMainMessage.RecordSource = "select * from [Message] where wordId='" & wordid & "' "
'MsgBox "adodc" & AdodcFrmMainMessage.RecordSource
Dim i As Integer
AdodcFrmMainMessage.Refresh
For i = 0 To AdodcFrmMainMessage.Recordset.RecordCount - 1
Dim tempParent As Long '临时父句柄
Dim temp As Long '临时子窗体句柄
'MsgBox "ParentTitle" & Len(AdodcFrmMainMessage.Recordset.Fields("ParentTitle")) & Trim(AdodcFrmMainMessage.Recordset.Fields("ParentTitle")) & "voer"
If Mid$(AdodcFrmMainMessage.Recordset.Fields("ParentTitle"), 1) = "Form1" Then ' 判断是否是Form1的直接孩子窗体
temp = FindWindowEx(hWndParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("Caption"))
'MsgBox "temp" & temp & AdodcFrmMainMessage.Recordset.Fields("Caption")
Else
tempParent = FindWindowEx(hWndParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("ParentTitle"))
' MsgBox "tempParent" & tempParent & "hwndparent" & hWndParent
temp = FindWindowEx(tempParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("Caption"))
'MsgBox "标题" & AdodcFrmMainMessage.Recordset.Fields("Caption")
End If
If temp <> 0 Then
Dim tempClassBuffer As String
tempClassBuffer = Space(MAX_PATH)
' ret = RealGetWindowClass(hwnd, dwWindowClassBuffer, MAX_PATH)
retval = GetClassName(temp, tempClassBuffer, MAX_PATH)
ClassName = StrConv(LeftB(StrConv(tempClassBuffer, vbFromUnicode), retval), vbUnicode) '去掉不可打印的字符
ClassName = Trim(ClassName)
'MsgBox "classname" & Len(ClassName) & ClassName & "over"
If retval <> 0 Then
If ClassName = "ThunderRT6OptionButton" Or ClassName = "ThunderRT6CheckBox" Then
SendMessage temp, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)
End If
If ClassName = "ThunderRT6CommandButton" Then
SendMessage temp, WM_LBUTTONDOWN, 0, ByVal &H10001
Sleep 100
SendMessage temp, WM_LBUTTONUP, 0, ByVal &H10001
End If
End If
End If
AdodcFrmMainMessage.Recordset.MoveNext
Next
PostMessage hWndParent, WM_CLOSE, 0, 0 '关闭窗口
Call WordIdControlKey
Call WordIdkey
score = Round(wordM * WordIdControlKey * WordIdkey, 2) '四舍五入保留两位小数
Adodc2.Refresh ' adodc2先刷新 要不会覆盖上一条记录
Adodc2.Recordset.AddNew
Adodc2.Recordset.Fields("stuid") = stuid
Adodc2.Recordset.Fields("score") = Format(score, "0.00") '截取两位
Adodc2.Recordset.Update参考别人的论文中相关代码发现，他们说用createprocess启动VB6.0和用户程序，可以防止用户程序发生 运行错误，而且能控制不弹出警告框，可是，现在发送不了消息？不知道为什么，而且也不知道什么事createprocess的debug模式，惨 On Error Resume Next
Dim si As STARTUPINFO '该结构用于指定新进程的主窗口特性
Dim pi As PROCESS_INFORMATION '在创建进程时相关的数据结构之一，该结构返回有关新进程及其主线程的信息
Dim hReadPipe As Long ' 负责读取的管道
Dim hWritePipe As Long '负责Shell程序的标准输出和标准错误输出的管道
Dim sOutput As String '放返回的数据
Dim sa As SECURITY_ATTRIBUTES
Dim ret As Long
Dim retval As Long
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "createPipe failed"
'error: Err.LastDllError
Exit Sub
End If Dim strResult As String ''returned results of the command line
With sa
.nLength = Len(sa)
.bInheritHandle = 1& ''inherit, needed for this to work
.lpSecurityDescriptor = 0
End With
With si
.cb = Len(si)
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW ''tell it to use (not ignore) the values below
.wShowWindow = SW_HIDE
.hStdOutput = hWritePipe ''pass the write end of the pipe as the processes standard output
End With
Dim Hwind As Long
Dim FHandle As Long
Dim SM As Long
retval = CreateProcess(vbNullString, "D:\Tomcat 4.1\webapps\myexam\program\student\2220063892-w025\工程1.exe", sa, sa, 1&, DEBUG_PROCESS, ByVal 0&, vbNullString, si, pi)
' If retval = 0 Then
' MsgBox "retval " & retval
' End If
Dim WindH As Long
Dim hwnd As Long
Dim hWndParent As Long '父窗体句柄
Dim ParentTitle As Long '父窗体标题
Dim ParentTitleBuffer As String
hWndParent = FindWindow(vbNullString, "Form1") '父窗体句柄
Sleep 100
ParentTitleBuffer = String(20, 0)
ParentTitle = GetWindowText(hWndParent, ParentTitleBuffer, 255) '父窗体标题
MsgBox "hwndparent" & hWndParent & "标题" & ParentTitleBuffer
Sleep 1000
If hWndParent <> 0 Then
'---------------------查找对应的控件 8个---------------------------------
'MsgBox "hwndparent" & hWndParent
Dim tempHandleZiXing As Long
tempHandleZiXing = FindWindowEx(hWndParent, 0, "ThunderRT6Frame", "字型")
If tempHandleZiXing = 0 Then
MsgBox "字型" & tempHandleZiXing, vbOKCancel, "提示信息"
End If
Dim tempHandleZiTi As Long
tempHandleZiTi = FindWindowEx(hWndParent, 0, "ThunderRT6Frame", "字体")
If tempHandleZiTi <> 0 Then
'List2.AddItem tempHandleZiTi & "字体"
MsgBox "字体"
End If
Dim tempHandleSong As Long
tempHandleSong = FindWindowEx(tempHandleZiTi, 0, "ThunderRT6OptionButton", "宋体")
If tempHandleSong <> 0 Then
MsgBox "宋体"
' List2.AddItem tempHandleSong & "宋体"
End If
Dim tempHandleHeiTi As Long
tempHandleHeiTi = FindWindowEx(tempHandleZiTi, 0, "ThunderRT6OptionButton", "黑体")
If tempHandleHeiTi <> 0 Then
MsgBox "黑体"
' List2.AddItem tempHandleHeiTi & "黑体"
SendMessage tempHandleHeiTi, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)
End IfDim tempHandleFontUnderLine As Long
tempHandleFontUnderLine = FindWindowEx(tempHandleZiXing, 0, "ThunderRT6CheckBox", "下划线")
If tempHandleFontUnderLine <> 0 Then
'List2.AddItem tempHandleFontUnderLine & "下划线"
MsgBox "下划线"
SendMessage tempHandleFontUnderLine, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)End IfDim tempHandleFontItlic As Long
tempHandleFontItlic = FindWindowEx(tempHandleZiXing, 0, "ThunderRT6CheckBox", "斜体")
If tempHandleFontItlic <> 0 Then
'List2.AddItem tempHandleFontItlic & "斜体"
MsgBox "斜体" SendMessage tempHandleFontItlic, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)
End If
Dim tempHandleText As Long
tempHandleText = FindWindowEx(hWndParent, 0, vbNullString, "请选择字体和字型")
If tempHandleText <> 0 Then
MsgBox "请选择字体和字型"
'List2.AddItem tempHandleText & "请选择字体和字型"
End If
Dim tempHandleCommand '确定按钮 发送消息
tempHandleCommand = FindWindowEx(hWndParent, 0, "ThunderRT6CommandButton", "确定")
If tempHandleCommand <> 0 Then
MsgBox "确定" & tempHandleCommand
SendMessage tempHandleCommand, WM_LBUTTONDOWN, 0, ByVal &H10001
Sleep 100
SendMessage tempHandleCommand, WM_LBUTTONUP, 0, ByVal &H10001
End If
PostMessage hWndParent, WM_CLOSE, 0, 0
End If
End Sub
运行时，桌面上不会显示Form1这个窗体，但是可以检查到 Form1的句柄，但是Form1中控件就查找不到，为什么？？？
查找不到具体的控件怎么发送消息？？这些消息可能包括（Commandbutton的单击、CheckBox的选中、Option的选中、下拉列表的项目选中等）还有窗体(Form1)的关闭。
在后就是错误警告框怎么处理？？？不让它们弹出来，最好能放到一个文件中，或者一个表中的字段也行。
期待高手、老师、大侠们给出点指导。期限在即，完不成任务了
e.g.
h=FindWindowEx(父窗体句柄, ByVal 0&, "BUTTON", "确定")
if h>0 then SendMessage h, WM_CLICK, ByVal 0&, ByVal 0&shell运行的程序有错已经不受本程序控制,如果要屏蔽这些错误,就捕捉这些错误窗口信息,然后关闭.
http://www.autohotkey.com
tempHandleZiXing = FindWindowEx(hWndParent, 0, "ThunderRT6Frame", "字型")
If tempHandleZiXing = 0 Then
MsgBox "字型" & tempHandleZiXing, vbOKCancel, "提示信息"
End If
窗体上的句柄控件就查找不到，忘记说一句 上面查找不到是不是因为用Createprocess()这个函数启用的，