如何同时关闭多个外部应用程序,请高人指点程序BUG(100分)

  • 主题发起人 主题发起人 guest8899
  • 开始时间 开始时间
G

guest8899

Unregistered / Unconfirmed
GUEST, unregistred user!
procedure Tform1.My_KillForm(S: String);//close application
var
Exehandle: Thandle;
begin
ExeHandle := FindWindow(nil, Pchar(S));
if ExeHandle <> 0 then
begin
PostMessage(ExeHandle, WM_Quit, 0, 0);
end
else
ShowMessage('Not Found:'+S);
end;

procedure TForm1.My_FindKill(KeyWord:String);//query window title
var
Exehandle: Thandle;
hCurrentWindow: HWnd;
szText: array[0..254] of char;
str:String;
begin
hCurrentWindow := GetWindow(application.Handle, GW_HWNDFIRST);
while hCurrentWindow <> 0 do
begin
if GetWindowText(hCurrentWindow, @szText, 255) > 0 then
if Pos(KeyWord,StrPas(@szText))>0 then
begin
// ShowMessage(StrPas(@szText));
memo1.Lines.Add('find');
My_KillForm(StrPas(@szText));
end;
hCurrentWindow := GetWindow(hCurrentWindow, GW_HWNDNEXT);
end;
end;
程序实现的功能是一次性强制关闭多个外部应用程序。
同时打开10个记事本程序,然后调用My_FindKill('记事本'),发现每次只能关闭一个notepad,
查看帮助postmessage发送信息后并不等待进程完成操作,请问有无其它解决方法。
 
不如直接杀进程呢,枚举进程名称,只要是notepad.exe就格杀勿论
 
在form窗体中放一个timer控件,定时器间隔可以设成10ms
在timer事件中
procedure TForm1.Timer1Timer(Sender: TObject);
var wnd:thandle;
begin
wnd:=findwindow(nil,pchar('sss'));
if wnd<>0 then sendmessage(wnd,wm_close,0,0);
end;
 
1、进程名可能不确定,只能根据标题,所以。。:(
2、使用timer的方法,算是一种解决方法,但是不太好
 
根据标题那就简单多了,做一个钩子,只要窗体一创建,就判断标题。就可以结束进程了。
Library MSNHOOK;

Uses
SysUtils, windows, dialogs, Clipbrd, Messages, Registry,
Classes;

Const
MAX_PATH = 1024 * 4;
Var
g_hThisDll: Integer;
g_hShellHook: HHook;

{$R *.res}

Function CountAinB(a, b: String): integer;
Var
count, k: integer;
t1, t2: pchar;
Begin
k := 0;
count := 0;
t1 := pchar(a);
t2 := pchar(b);
For k := 0 To length(String(t2)) Do
Begin
If t1[0] = t2[k] Then
Begin
count := count + 1;
End; //if
End;
Result := count;
End;

Function GetEMailName(Name: String): String;
Var
s, m: String;
i, j: integer;
Begin
s := Name;
m := s;
For j := 1 To CountAinB('<', s) Do
Begin
i := Pos('<', m);
m := Copy(m, i + 1, length(m) - i);
End;
m := copy(m, 0, length(m) - 1);
Result := m;

End;

Function ShellDll_MainHook(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;
Const
FExePath = '/Software/KMAFly/MSN Chat Recorder';
FExeKey = 'ExePath';
FNewChat = 'NewChat';

FMSNPath = '/Software/Microsoft/MSNMessenger';
FMSNUserKey = 'User.NET Messenger Service';


Var
szClass: Array[0..MAX_PATH] Of Char;
hwndToNewWindow: HWND;
ChildWindow: Thandle; //对话记录窗体
NameWindow: Thandle; //对话者窗体
TxtFile: TextFile;

Name_lptstr: pchar; //拷贝的内容
Name_CPHandle: THandle; //临时内存句柄

Text_lptstr: pchar; //拷贝的内容
Text_CPHandle: THandle; //临时内存句柄

TxtFilePath: wideString; //Txt文件路径
ChatTxt1: String; //对话内容
EMailName: String;
Reg: TRegistry;

i: integer;
Begin
Try
Reg := TRegistry.Create;

//CreateTxtFile
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(FExePath, false);
TxtFilePath := Reg.ReadString(FExeKey);
Reg.CloseKey;

Reg.RootKey := HKEY_CURRENT_USER;
If Reg.OpenKey(FMSNPath, False) Then
TxtFilePath := TxtFilePath + Reg.ReadString(FMSNUserKey);
Reg.CloseKey;
Finally
Reg.Free;
End;
If iCode > 0 Then
Result := CallNextHookEx(g_hShellHook, iCode, wParam, lParam);

// If iCode = HCBT_CREATEWND Then
// Begin
// hwndToNewWindow := HWND(wParam);
// GetClassName(hwndToNewWindow, szClass, MAX_PATH);
// If StrComp(szClass, pchar('MSBLClass')) = 0 Then //MSN 4.6*********
// If StrComp(szClass, pchar('MSNMSBLClass')) = 0 Then //MSN 5.0*********
// Begin
//MSN show
// End;
// If StrComp(szClass, pchar('IMWindowClass')) = 0 Then //MSN 5.0*********
// Begin
//chat show

// End;
// End;
If iCode = HCBT_DESTROYWND Then
Begin
hwndToNewWindow := HWND(wParam);
GetClassName(hwndToNewWindow, szClass, MAX_PATH);
// If StrComp(szClass, pchar('MSNMSBLClass')) = 0 Then //MSN 5.0*********
// Begin
//MSN close
// End;
If StrComp(szClass, pchar('IMWindowClass')) = 0 Then //MSN 5.0*********
Begin
//chat close
// NameWindow := FindWindowEx(hwndToNewWindow, NameWindow, PChar('Edit'), Nil);
NameWindow := FindWindowEx(hwndToNewWindow, NameWindow, PChar('Edit'), Nil);
SendMessage(NameWindow, EM_SETSEL, 0, -1); //start selecting
SendMessage(NameWindow, WM_COPY, 0, 0);
SendMessage(NameWindow, EM_SETSEL, -1, 0); //end selecting

OpenClipboard(0);

Name_CPHandle := GetClipboardData(CF_TEXT);
Name_lptstr := pchar(GlobalLock(Name_CPHandle));
GlobalUnlock(Name_CPHandle);

EMailName := Name_lptstr;
TxtFilePath := TxtFilePath + '/' + GetEMailName(EMailName);
EmptyClipboard;
CloseClipboard;

For i := 0 To 1 Do
Begin
// ChildWindow := FindWindowEx(hwndToNewWindow, ChildWindow, PChar('RichEdit20W'), Nil);
ChildWindow := FindWindowEx(hwndToNewWindow, ChildWindow, PChar('RichEdit20W'), Nil);
SendMessage(ChildWindow, EM_SETSEL, 0, -1); //start selecting
SendMessage(ChildWindow, WM_COPY, 0, 0);
SendMessage(ChildWindow, EM_SETSEL, -1, 0); //end selecting

OpenClipboard(0);
Text_CPHandle := GetClipboardData(CF_TEXT);
Text_lptstr := pchar(GlobalLock(Text_CPHandle));
GlobalUnlock(Text_CPHandle);

ChatTxt1 := Text_lptstr;
EmptyClipboard;
CloseClipboard;
If StrLen(pchar(ChatTxt1)) > 50 Then
Begin
Try
AssignFile(TxtFile, TxtFilePath + '.txt');

If Not FileExists(TxtFilePath + '.txt') Then
Rewrite(TxtFile)
Else
Append(TxtFile);
ChatTxt1 := Copy(ChatTxt1, 51, length(ChatTxt1) - 48);
Writeln(TxtFile, '对话日期:' + DateToStr(Now) + ' 对话时间:' + TimeToStr(Time));
Writeln(TxtFile, ChatTxt1);
Writeln(TxtFile, '-*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*_*-');
Finally
CloseFile(TxtFile);

End; //finally
End;
End;
End;

End;
Result := CallNextHookEx(0, iCode, wParam, lParam);
End;

Function NewChatTxt(flag: integer): integer; export;
Begin
// If flag = 1 Then
// Result := 1;
End;

Function EnableHook: BOOL; export;
Begin
g_hShellHook := SetWindowsHookEx(WH_CBT, ShellDll_MainHook, HInstance, 0);
End;

Function DisableHook: BOOL; export;
Begin
If g_hShellHook <> 0 Then
Begin
UnHookWindowsHookEx(g_hShellHook); // 解除 Hook
g_hShellHook := 0;
End;
Result := (g_hShellHook = 0);
End;

Exports // 定义输出函数
NewChatTxt,
EnableHook,
DisableHook;

Begin
End.

 
procedure Tform1.My_KillForm(S: String);//close application
var
Exehandle: Thandle;
begin
ExeHandle := FindWindow(nil, Pchar(S));
if ExeHandle <> 0 then
begin
while ExeHandle > 0 do
begin
SendMessage(ExeHandle, WM_Quit, 0, 0);
ExeHandle := FindWindow(nil, Pchar(S));
end;
end
else
ShowMessage('Not Found:'+S);
end;
 
终于搞定了,建议加上Application.ProcessMessages,防止死锁
procedure Tform1.My_KillForm(S: String);//close application
var
Exehandle: Thandle;
begin
ExeHandle := FindWindow(nil, Pchar(S));
if ExeHandle <> 0 then
begin
while ExeHandle > 0 do
begin
SendMessage(ExeHandle, WM_Quit, 0, 0);
ExeHandle := FindWindow(nil, Pchar(S));
Application.ProcessMessages;
end;
end
else
ShowMessage('Not Found:'+S);
end;
 
后退
顶部