查看正在运行进程中的消息?>???难呀！(100分)

查看正在运行进程中的消息?>???难呀！ 难呀兄弟，们多多帮帮我！
我想列举系统中正在运行的进程，所有消息！

[?][?][?] ????

delphi自带的工具winsight32就可以呀

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,WinSvc,TlHelp32, Menus, PsApi, StdCtrls;

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

gbCanClose: Boolean;
SvcHandle: SC_HANDLE;
porFile: String;
ESS: Array of TEnumServiceStatus;
nBytesNeeded,nServices,nResumeHandle: Cardinal;
i: Integer;
pList1,pList2,pList3 : TStringList;

implementation

{$R *.dfm}

function GetProcessFullFileName(pID:Integer):String;
var s:String;
hProcess:THandle;
begin
Result:='';
SetLength(s,256);
hProcess:=OpenProcess(PROCESS_ALL_ACCESS or PROCESS_QUERY_INFORMATION ,FALSE,pID);
if(hProcess>0) then
begin
if(GetModuleFileNameEx(hProcess,0,PChar(s),255)>0) then
begin
SetLength(s, StrLen(PCHAR(s)));
Result:=s;
end;

end;
CloseHandle(hProcess);
end;


procedure EnumProcess(List: TListBox);
//枚举进程
var
ContinueLoop : BOOL;
FSnapshotHandle : THandle;
FProcessEntry32 : TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
try
List.Clear;
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);

while integer(ContinueLoop)<>0 do
begin
//进程名称
List.Items.Add(FProcessEntry32.szExeFile);
List.Items.Add('-');
//包含全路经的进程名称
// 但不知道为何返回空？ 请指教
List.Items.add(GetProcessFullFileName(FProcessEntry32.th32ProcessID) );

ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
end;
finally
CloseHandle(FSnapshotHandle);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
EnumProcess(ListBox1);

end;

end.

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,TLHelp32;

type
TfrmMain = class(TForm)
ListBox1: TListBox;
btnRefresh: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnRefreshClick(Sender: TObject);
procedure ViewProgress;
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
lstProgress:TList;

type
TProcessInfo = Record
ExeFile : String;
ProcessID : DWORD;
end;
pProcessInfo = ^TProcessInfo;

implementation
{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
lstProgress:= TList.Create;
lstProgress.Clear;
ViewProgress;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
lstProgress.Free;
end;

procedure TfrmMain.btnRefreshClick(Sender: TObject);
begin
ViewProgress;
end;

procedure TfrmMain.ViewProgress;
var
PIProcessInfo;
ContinueLoop:BOOL;
FSnapshotHandle:THandle;
FProcessEntry32:TProcessEntry32;
begin
ListBox1.Items.Clear;
lstProgress.Clear;

FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32);
while integer(ContinueLoop)<>0 do
begin
New(PI);
PI.ExeFile := FProcessEntry32.szExeFile;
PI.ProcessID := FProcessEntry32.th32ProcessID;
lstProgress.Add(PI);
ListBox1.Items.Add(PI.ExeFile);
ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

end.

谢谢楼上的兄弟。
但是上面的代码都是显示，进程，与进程名，进程程序名，就是没有显示进程中的消息呀？

哪位路过英雄能拨刀相助于小弟，不甚感激，因为这个问题，涉及于小弟的，饭碗呀！！！
急救于我！！谢谢

不清楚你到底要什么，希望对你有帮助
进程、窗口句柄、文件属性、程序运行状态
uses TLHelp32,PsAPI;

(1)显示进程列表：
procedure TForm1.Button2Click(Sender: TObject);
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
PWORD;
s:string;
begin
ListBox1.Items.Clear ;
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found := Process32First(Hand,lppe);
while found do
begin
s := StrPas(lppe.szExeFile);
if lppe.th32ProcessID>0 then
p := lppe.th32ProcessID
else
p := 0;
ListBox1.Items.AddObject(s,pointer(p));//列出所有进程。
found := Process32Next(Hand,lppe);
end;
end;

(2)杀死某进程：
procedure TForm1.Button3Click(Sender: TObject);
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
PWORD;
sExeFile,sSelect:string;
killed:boolean;
begin
p :=DWORD(ListBox1.Items.Objects[ListBox1.itemindex]);
if P<>0 then
begin
killed := TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF);
if not killed then
messagebox(self.handle,pchar(sExeFile+'无法杀死！'),'提示',MB_OK or MB_ICONWARNING)
else
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end;

(3)取得某进程EXE路径：
procedure TForm1.Button8Click(Sender: TObject); //uses PSAPI;
var
h:THandle; fileName:string; iLen:integer; hMod:HMODULE;cbNeeded,pWORD;
begin
p :=DWORD(ListBox1.Items.Objects[ListBox1.itemindex]);
h := OpenProcess(PROCESS_ALL_ACCESS, false, p); //p 为 进程ID
if h > 0 then
begin
if EnumProcessModules( h, @hMod, sizeof(hMod), cbNeeded) then
begin
SetLength(fileName, MAX_PATH);
iLen := GetModuleFileNameEx(h, hMod, PCHAR(fileName), MAX_PATH);
if iLen <> 0 then
begin
SetLength(fileName, StrLen(PCHAR(fileName)));
ShowMessage(fileName);
end;
end;
CloseHandle(h);
end;
end;

(4)取得窗口列表
begin
ListBox1.Items.Clear ;
EnumWindows(@EnumWindowsProc, 0);
end;

(5)杀死窗口进程
procedure TForm1.Button6Click(Sender: TObject);
var
H:THandle;
PWORD;
s:string;
killed:boolean;
begin
s := ListBox1.Items[ListBox1.ItemIndex];
H:=FindWindow(nil,pchar(s));
if H<>0 then
begin
GetWindowThreadProcessId(H,@P);
if P<>0 then
killed:=TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF);
if not killed then
messagebox(self.handle,pchar(s+'无法杀死！'),'提示',MB_OK or MB_ICONWARNING)
else
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end;

(6)取得窗口进程路径：
procedure TForm1.Button9Click(Sender: TObject);
var
H:THandle; P,cbNeeded: DWORD; s,fileName:string;
iLen:integer; hMod:HMODULE;
begin
s := ListBox1.Items[ListBox1.ItemIndex];
H:=FindWindow(nil,pchar(s));

if H<>0 then
begin
GetWindowThreadProcessId(H,@P);
if P<>0 then
begin
h := OpenProcess(PROCESS_ALL_ACCESS, false, p); //p 为 进程ID
if h > 0 then
begin
if EnumProcessModules( h, @hMod, sizeof(hMod), cbNeeded) then
begin
SetLength(fileName, MAX_PATH);
iLen := GetModuleFileNameEx(h, hMod, PCHAR(fileName), MAX_PATH);
if iLen <> 0 then
begin
SetLength(fileName, StrLen(PCHAR(fileName)));
ShowMessage(fileName);
end;
end;
CloseHandle(h);
end;
end;
end;
end;

(7)文件属性：
procedure TForm1.Button1Click(Sender: TObject);
var
SR: TSearchRec;
V1, V2, V3, V4: integer ;
const
dtFmt:string = 'YYYY-MM-DD HH:NN:SS';
begin
// ============== 方法一 ==================== //
if FindFirst(sFileName, faAnyFile, SR) = 0 then
begin
Edit1.Text := intToStr(SR.Attr); //文件属性
Edit2.Text := intToStr(SR.Size); //文件大小
Edit3.Text := FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftCreationTime)); //创建时间
Edit4.Text := FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftLastWriteTime)); //最后修改时间
Edit5.Text := FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftLastAccessTime)); //最后访问时间

if SR.Attr and faHidden <> 0 then
FileSetAttr(sFileName, SR.Attr-faHidden);

FindClose(SR);
end;

if GetFileVersion(sFileName,V1, V2, V3, V4) then
Edit7.Text := intToStr(v1)+'.'+intToStr(v2)+'.'+intToStr(v3)+'.'+intToStr(v4);

// ============== 方法二 ==================== //
{
var
Attrs: Word;
f: file of Byte; // 文件大小 必须要 定义为" file of byte" ,这样才能取出 bytes
size: Longint;

//文件属性
Attrs := FileGetAttr(sFileName);

Edit1.Text := intToStr(Attrs);

//文件大小
AssignFile(f, OpenDialog1.FileName);
Reset(f);
try
AssignFile(f, sFileName);
Reset(f);
size := FileSize(f);
Edit2.Text := intToStr(size);
finally
CloseFile(f);
end;
}
end;

(8)判断程序是否在运行：
procedure TForm1.Button5Click(Sender: TObject);
var PrevInstHandle:Thandle;
AppTitlechar;
begin
AppTitle := pchar('test');
PrevInstHandle := FindWindow(nil, AppTitle);
if PrevInstHandle <> 0 then begin
if IsIconic(PrevInstHandle) then
ShowWindow(PrevInstHandle, SW_RESTORE)
else
BringWindowToTop(PrevInstHandle);
SetForegroundWindow(PrevInstHandle);
end;
end;




Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=514259


2005-11-15 15:17:55
查看评语 ?

2005-11-19 8:51:05 unit Unit1;

interface

uses
windows,Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Tlhelp32,ShellAPI, PSAPI, CommCtrl,winsock;

const
SYSTEMTIMEINFORMATION = 3;
NT_HANDLE_LIST = 16;
OBJECT_TYPE_SOCKET = 28;
MAX_HANDLE_LIST_BUF = $200000;

// 定义HanleInfo数据结构
type
pHandleInfo = ^HandleInfo;
HandleInfo = record
dwPid : SHORT;
CreatorBackTraceIndex : SHORT;
ObjType : BYTE ;
HandleAttributes : BYTE ;
HndlOffset : SHORT;
dwKeObject : DWORD ;
GrantedAccess : ULONG ;
end;

PTSystemTimeInfo = ^TSystemTimeInfo;
TSystemTimeInfo = record
liKeBootTime : TLargeInteger;
liKeSystemTime : TLargeInteger;
liExpTimeZoneBias : TLargeInteger;
uCurrentTimeZoneId : ULONG;
dwReserved : DWORD;
end;

TNTQUERYSYSTEMINFORMATION = function(dwRecordType: DWORD; pdwHandleList: pDWORD;
dwNumBytes: DWORD; pdwNumBytesRet: pDWORD): DWORD; stdcall;
const
szSockType : Array[0..5] of string[4] =('NUL','TCP','UDP','RAW','RDM','SEQ');


type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;

implementation

{$R *.dfm}

// GetProcessPath 根据进程ID得到进程全路径名称
function GetProcessPath(PID : Integer): String;
var hProcess: THandle;
hMod : hModule;
cbNeeded: DWORD;
szProcessName: array[0..1024] of Char;
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION OR PROCESS_VM_READ,
FALSE, PID );

szProcessName := 'unknown';
if (hProcess<>0) then begin
if(EnumProcessModules(hProcess,@hMod,sizeof(hMod),cbNeeded)) then begin
GetModuleFileNameEx(hProcess,hMod,szProcessName,sizeof(szProcessName));
Result := StrPas(szProcessName);
end;
end;
CloseHandle(hProcess);
end;


// SetPrivilege 函数用来提升本进程的特权
function SetPrivilege():BOOL;
const
ADJUST_PRIV = TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES;
PRIV_SIZE = SizeOf(TTokenPrivileges);
var
Len : DWORD;
TokenPriv, Dummy : TTokenPrivileges;
Token : THandle;
begin
Result:=False;
try
if not OpenProcessToken(GetCurrentProcess(), ADJUST_PRIV, Token) then Exit;
if not LookupPrivilegeValue(nil,
'SeDebugPrivilege',
TokenPriv.Privileges[0].Luid) then exit;
TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TokenPriv.PrivilegeCount := 1;
if not AdjustTokenPrivileges(Token, False, TokenPriv, PRIV_SIZE,Dummy, Len) then Exit;
Result:=True;
except
end;
end;


// AdjustDacl用来调整目标进程的DACL
procedure AdjustDacl(hProcess: THANDLE);
{var
world : SID;
ptstrName : pChar;
ea : EXPLICIT_ACCESS;
pdacl : PACL;}
begin
{ world.Revision :=SID_REVISION;
world.SubAuthorityCount:= 1;
world.IdentifierAuthority := SECURITY_WORLD_SID_AUTHORITY;
world.SubAuthority[0] := 0;

ptstrName := @world;
ea.grfAccessPermissions:= STANDARD_RIGHTS_ALL+SPECIFIC_RIGHTS_ALL;
ea.grfAccessMode := SET_ACCESS;
ea.grfInheritance := NO_INHERITANCE;
ea.Trustee.pMultipleTrustee := nil;
ea.Trustee.MultipleTrusteeOperation := NO_MULTIPLE_TRUSTEE;
ea.Trustee.TrusteeForm := TRUSTEE_IS_SID;
ea.Trustee.TrusteeType := TRUSTEE_IS_USER;
ea.Trustee.ptstrName := ptstrName;

pdacl := nil; }
{
function SetEntriesInAcl(cCountOfExplicitEntries: ULONG;
pListOfExplicitEntries: PEXPLICIT_ACCESS_A; OldAcl: PACL;
var NewAcl: PACL): DWORD; stdcall;

}
{ if ( SetEntriesInAcl(1, @ea, nil, pdacl) <> ERROR_SUCCESS ) then
begin
ShowMessage(format('SetEntriesInAcl Error:%d', [GetLastError]));
if ( SetSecurityInfo(hProcess,
SE_KERNEL_OBJECT,
DACL_SECURITY_INFORMATION,
nil , nil, pdacl, nil ) <> ERROR_SUCCESS ) then
ShowMessage(format('SetSecurityInfo Error:%d', [GetLastError]));
LocalFree(DWORD(pdacl));
end;}
end;//end of AdjustDacl


// GetBootTime 得到系统启动时间
function GetBootTime: string;
var
iRet : integer;
dwNumBytesRet : DWORD;
hCurrentProc,hToken : THANDLE;
hNtdll : HMODULE;
NtQuerySystemInformation : TNTQUERYSYSTEMINFORMATION;
Sti: TSystemTimeInfo;
ftSystemBoot: FILETIME;
stSystemBoot: SYSTEMTIME;
begin
hCurrentProc := GetCurrentProcess;
if ( not OpenProcessToken( hCurrentProc,
TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES,
hToken )) then
begin
Result := Result + format('OpenProcessToken Error:%d', [GetLastError]);
WsaCleanUp;
exit;
end else
if ( not SetPrivilege( )) then
begin
Result := Result + format('SetPrivleges SE_DEBUG_NAME Error:%d', [GetLastError]);
exit;
end;

if hToken <> 0 then
CloseHandle( hToken );

if hCurrentProc <> 0 then
CloseHandle( hCurrentProc );

hNtdll := LoadLibrary( 'ntdll.dll' );

if (hNtdll = 0) then
begin
Result := Result + format('LoadLibrary( NTDLL.DLL ) Error:%d', [GetLastError]);
exit;
end;

NtQuerySystemInformation := TNTQUERYSYSTEMINFORMATION(
GetProcAddress( hNtdll, 'NtQuerySystemInformation'));
if not Assigned(NtQuerySystemInformation)then
begin
Result := Result + format('GetProcess( NtQuerySystemInformation ) Error:%d', [GetLastError]);
exit;
end;

dwNumBytesRet := 0;
iRet := NtQuerySystemInformation(SYSTEMTIMEINFORMATION,
@Sti,
SizeOf(Sti),
@dwNumBytesRet);
if iRet <> 0 then
begin
Result := Result + format('NtQuerySystemInformation return %d, Error:%d'#13#10,
[dwNumBytesRet, GetLastError]);
end else begin
ftSystemBoot := FILETIME((@Sti.liKeBootTime)^);

FileTimeToLocalFileTime(ftSystemBoot,ftSystemBoot);
FileTimeToSystemTime(ftSystemBoot,stSystemBoot);

Result := Result + format(' %04d年%02d月%02d日'#9' %02d:%02d:%02d',
[stSystemBoot.wYear,stSystemBoot.wMonth,stSystemBoot.wDay,
stSystemBoot.wHour,stSystemBoot.wMinute,stSystemBoot.wSecond]);

end;

if hNtdll <> 0 then
freeLibrary(hNtdll);

end;

// GetPortInfo 将SOCK端口与程序对应起来
function GetPortInfo: string;
var
iRet: integer;
wsaData: Winsock.WSADATA;
hCurrentProc,hToken : THANDLE;
hNtdll : HMODULE;
NtQuerySystemInformation : TNTQUERYSYSTEMINFORMATION;
dwNumBytes : DWORD;
pdwHandleList DWORD;
dwNumBytesRet : DWORD;
dwNumEntries: DWORD;
pHInfo: PHANDLEINFO;
hProc: THANDLE;
i : DWORD;
hMyHandle : THandle;
name,remote : sockaddr_in;
s : TSOCKET;
namelen : integer;
sockType : integer;
optlen : integer;
begin
iRet := WSAStartup(MAKEWORD(1,1), wsaData );
if iRet<>0 then
begin
Result := format('WSAStartup Error:%d', [GetLastError]);
exit;
end;

hCurrentProc := GetCurrentProcess;
if (not OpenProcessToken( hCurrentProc,
TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES,
hToken )) then
begin
Result := Result + format('OpenProcessToken Error:%d', [GetLastError]);
WsaCleanUp;
exit;
end else
if ( not SetPrivilege()) then
begin
Result := Result + format('SetPrivleges SE_DEBUG_NAME Error:%d', [GetLastError]);
WsaCleanUp;
exit;
end;


if hToken <> 0 then
CloseHandle( hToken );

hNtdll := LoadLibrary( 'ntdll.dll' );

if (hNtdll = 0) then
begin
Result := Result + format('LoadLibrary( NTDLL.DLL ) Error:%d', [GetLastError]);
WSACleanup;
exit;
end;

NtQuerySystemInformation := TNTQUERYSYSTEMINFORMATION(
GetProcAddress( hNtdll, 'NtQuerySystemInformation'));
if not Assigned(NtQuerySystemInformation)then
begin
Result := Result + format('GetProcess( NtQuerySystemInformation ) Error:%d', [GetLastError]);
WSACleanup;
exit;
end;

dwNumBytes := MAX_HANDLE_LIST_BUF;

GetMem(pdwHandleList,dwNumBytes);
if not Assigned(pdwHandleList) then
begin
Result := Result + format('Malloc for Handle List Error:%d'#13#10, [GetLastError]);
WSACleanup;
exit;
end;

dwNumBytesRet := 0;
iRet := NtQuerySystemInformation(NT_HANDLE_LIST,
pdwHandleList,
dwNumBytes,
@dwNumBytesRet);

if iRet <> 0 then
begin
Result := Result + format('NtQuerySystemInformation return %d, Error:%d'#13#10,
[dwNumBytesRet, GetLastError]);
end else begin
dwNumEntries := pdwHandleList^;
pHInfo := PHANDLEINFO((DWORD(pdwHandleList) + sizeof(pdwHandleList) ));
for i := 0 to dwNumEntries -1 do
begin
//此进程含有SOCKET对象 OK
if phInfo^.dwPid=432 then
form1.Memo2.Lines.Add(inttostr(phInfo^.ObjType));


if (( phInfo^.ObjType = OBJECT_TYPE_SOCKET )
and ( phInfo^.dwPid <> 0 ) ) then
begin
hProc := OpenProcess(WRITE_DAC,
false,
phInfo.dwPid );
if hProc <> 0 then
begin
AdjustDacl( hProc );
CloseHandle( hProc );
end else
Result := Result + format('OpenProcess(WRITE_DAC) %d Error:%d'#13#10,
[phInfo^.dwPid,
GetLastError]);

hMyHandle := 0;

//根据 ProcessID 打开相应的进程
hProc := OpenProcess(PROCESS_DUP_HANDLE or PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
true,
phInfo.dwPid );


if hProc <>0 then
begin

//获取Socket句柄
DuplicateHandle(hProc, //源进程句柄
THANDLE(phInfo^.HndlOffset), //源SOCKET对象
hCurrentProc, //本进程句柄
@hMyHandle, //复制到这里
STANDARD_RIGHTS_REQUIRED,
true,
0 ); //使用 DUPLICATE_CLOSE_SOURCE 则关闭源socket
// DUPLICATE_SAME_ACCESS 象源进程一样操作SOCKET

CloseHandle( hProc );
end else
Result := Result + format( 'OpenProcess %d Error:%d'#13#10,
[phInfo.dwPid,
GetLastError]);


if hMyHandle = 0 then
begin
//form1.Memo1.Lines.Add(format('DuplicateHandle PID=%4d HANDLE:%4d Error:%d',
// [pHInfo^.dwPid, phInfo^.HndlOffset, GetLastError] ));
end else
begin
ZeroMemory(@name,sizeof(name));
name.sin_family := AF_INET;
namelen := sizeof(sockaddr_in);
s := TSOCKET(hMyHandle);
//获得SOCKET的本地名
iRet := getsockname(s, //SOCKET
name, //返回 name
namelen );


ZeroMemory(@remote,sizeof(remote));
remote.sin_family := AF_INET;
getpeername(s,
remote,
namelen);

//form1.Memo1.Lines.Add(inttostr(hMyHandle)+' '+inttostr(pHInfo^.dwPid)+' '+inttostr(phInfo^.HndlOffset)+' '+inttostr(iRet));
if iRet <> SOCKET_ERROR then
begin
sockType := 0;
optlen := 4;

//取得端口类型
getsockopt(s,
SOL_SOCKET,
SO_TYPE,
@sockType,
optlen );


Result := Result + format('ProcessID=%4d '#9+
GetProcessPath(pHInfo^.dwPid)+ #9+
'本地地址: %s'#9+
'本地端口: %5d'#9+
'远程地址: %s'#9+
'远程端口: %5d %s'#13#10,

[pHInfo^.dwPid,
inet_ntoa(name.sin_addr),
ntohs(name.sin_port),
inet_ntoa(remote.sin_addr),
ntohs(remote.sin_port),

(szSockType[sockType])]);


end;
end;
end;
pHInfo := PHANDLEINFO(DWORD(phInfo) +sizeOf(HANDLEINFO));
if s<>0 then
closesocket(s);
end;

end;

if Assigned(pdwHandleList) then
freeMem( pdwHandleList );
if hCurrentProc <> 0 then
CloseHandle( hCurrentProc );

freeLibrary(hNtdll);

WSACleanup;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
Memo1.Lines.Add(GetPortInfo);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Caption := GetBootTime;
end;

end.