我的程式需要使用80埠,但某些序占用該埠。比如IIS 訊雷等等 有沒辦法直接把80埠關掉,我的程式用呢!
求段代碼哈。。。。
uj5u.com熱心網友回復:
樓主可以呼叫DOS命令通過netstat -a獲取到埠占用情況和行程,然后找到該行程殺死應該就可以了吧呼叫dos視窗獲取回傳內容函式;needClose可以自己去掉
function getCMD(cmd: String; needClose: boolean=true): String;
var
readhdl,writehdl : DWORD;
sa : TSecurityAttributes;
stifo : _STARTUPINFOA;
pinfo : _PROCESS_INFORMATION;
tmbuff : array [0..254] of char;
readlen : DWORD;
ExitCode: dword;
nCount, MaxCount: integer;
begin
Result := '';
sa.nLength := sizeof(TSecurityAttributes);
sa.bInheritHandle := TRUE;
sa.lpSecurityDescriptor := nil;
if not CreatePipe(readhdl,writehdl,@sa,0) then exit;
GetStartupInfo(stifo);
stifo.hStdOutput := writehdl;
stifo.hStdError := writehdl;
if needClose then stifo.wShowWindow := SW_Hide
else stifo.wShowWindow := SW_SHOWNORMAL;
stifo.dwFlags := STARTF_USESHOWWINDOW + STARTF_USESTDHANDLES;
MaxCount := 120;
nCount := 0;
if CreateProcess(nil,PChar('cmd.exe /C ' + cmd),nil,nil,true,0,nil,nil,stifo,pinfo) then
begin
while (GetExitCodeProcess(pinfo.hProcess,ExitCode))and(ExitCode=STILL_ACTIVE)and(nCount < MaxCount) do
begin
Sleep(500);
inc(nCount);
application.ProcessMessages;
end;
if needClose then
begin
if not(GetExitCodeProcess(pinfo.hProcess,ExitCode)) or (ExitCode=STILL_ACTIVE) then //time out , mannualy close process
TerminateProcess(pinfo.hProcess,0);
end;
WriteFile(writehdl,'@#@#@',5,readlen,nil);
CloseHandle(writehdl);
readlen := 254;
while readlen = 254 do
begin
ReadFile(readhdl,tmbuff,254,readlen,nil);
if readlen <> 254 then tmbuff[readlen-5] := Chr(0)
else tmbuff[readlen-1] := Chr(0);
Result := Result + String(tmbuff);
end;
end;
CloseHandle(readhdl);
end;
殺死行程函式:
function FindAndKillTask(aName: String; aFlag: Boolean=false): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOLean;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
lName1, lName2: String;
begin
Result := -1;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
try
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
lName1 := UpperCase(ExtractFileName(FProcessEntry32.szExeFile));
lName2 := UpperCase(FProcessEntry32.szExeFile);
if ((pos(UpperCase(aName), lName1) > 0) or (pos(UpperCase(aName), lName2) > 0)) then
begin
if aFlag then
begin
if messagebox(application.handle,'確認要退出程式嗎?','確認',MB_OKCANCEL+MB_ICONQUESTION+MB_SYSTEMMODAL) = IDOK then
begin
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
end;
end
else
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
sleep(1000);
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
finally
CloseHandle(FSnapshotHandle);
end;
end;
function KillTaskByPId(pId: integer): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOLean;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := -1;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
try
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if (FProcessEntry32.th32ProcessID = pId) then
begin
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
if result = 0 then FLog.Add('殺死行程' + inttostr(pId) + '成功')
else FLog.Add('行程' + inttostr(pId) + '未能成功殺死');
sleep(1000);
break;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
finally
CloseHandle(FSnapshotHandle);
end;
end;
uj5u.com熱心網友回復:
學習!
uj5u.com熱心網友回復:
這作業效率太低
轉載請註明出處,本文鏈接:https://www.uj5u.com/houduan/123451.html
下一篇:資源更新及讀取問題
