📄 unit1.pas
字号:
Oid.ids :=@UdpIdentifiers;
SnmpUtilOidAppend(@VarBind.name, @Oid);
VarBind.value.asnType :=ASN_NULL;
VarBindList.list :=@VarBind;
VarBindList.len :=1;
FillChar(UdpInfoTable, SizeOf(UdpInfoTable), 0);
UdpInfoTable.prev :=@UdpInfoTable;
UdpInfoTable.next :=@UdpInfoTable;
currentIndex :=1;
currentEntry :=@UdpInfoTable;
while True do
begin
if not SnmpExtensionQuery(SNMP_PDU_GETNEXT,
@VarBindList,
@errorStatus,
@errorIndex) then Exit;
if VarBind.name.idLength < 10 then Break;
if currentIndex <> PIds(VarBind.name.ids)^[9] then
begin
currentEntry :=UdpInfoTable.next;
currentIndex :=PIds(VarBind.name.ids)^[9];
end;
case currentIndex of
1: begin
newEntry :=PTcpInfo(AllocMem(SizeOf(TTcpInfo)));
newEntry^.prev :=currentEntry;
newEntry^.next :=@UdpInfoTable;
currentEntry^.next :=newEntry;
currentEntry :=newEntry;
currentEntry^.localip :=(PUINT(VarBind.value.address.stream))^;
end;
2: begin
currentEntry^.localport :=VarBind.value.number;
currentEntry :=currentEntry^.next;
end;
end;
end;
currentEntry :=UdpInfoTable.next;
while currentEntry <> @UdpInfoTable do
begin
localaddr :=Format('%s',
[GetHost(True, currentEntry^.localip)]);
localport :=Format('%s', [GetPort(currentEntry^.localport, 'udp')]);
remoteaddr :='*.*.*.*: *';
with tvtcpudp.Items.Add do
begin
ImageIndex :=8;
Caption :='UDP';
SubItems.Add(localaddr);
SubItems.Add(localport);
SubItems.Add(remoteaddr);
SubItems.Add('*');
SubItems.Add('');
end;
currentEntry :=currentEntry^.next;
end;
/// sbStatus.Panels[0].Text :=M_TCPUDP;
end;
function TForm1.GetHost(local: Boolean; ipaddr: UINT): string;
var
HostEnt: PHostEnt;
InAddr: TInAddr;
begin
if ipaddr=0 then
begin
if (local) then
Result :=FHostName
else
Result :='0.0.0.0';
end
else
if ipaddr=16777343 then
begin
if local then Result :=FHostName else Result :='localhost';
end
else
begin
if local then
Result :=FHostName
else
begin
Application.ProcessMessages;
HostEnt :=GetHostByAddr(@ipaddr, 4, PF_INET);
if HostEnt <> nil then
Result :=HostEnt^.h_name
else
begin
InAddr.S_addr :=ipaddr;
Result :=Format('%d.%d.%d.%d',
[Byte(InAddr.s_un_b.s_b1),
Byte(InAddr.s_un_b.s_b2),
Byte(InAddr.s_un_b.s_b3),
Byte(InAddr.s_un_b.s_b4)]);
end;
end;
end;
end;
function TForm1.GetPort(port: UINT; proto: PChar): string;
var
ServEnt: PServEnt;
begin
Application.ProcessMessages;
ServEnt :=GetServByPort(htons(port), proto);
if ServEnt <> nil then Result :=ServEnt^.s_name else Result :=IntToStr(port);
end;
procedure TForm1.GetProcessInfo; //Get the Process info
var
i:integer;
begin
with lvProcess.Items do
begin
BeginUpdate;
Clear;
EndUpdate;
end;
GetProcessList;
for i:=0 to Length(ProcessInfo)-1 do
begin
with lvProcess.Items.Add do
begin
ImageIndex :=4;
Caption :=inttostr(ProcessInfo[i].PID);
SubItems.Add(inttostr(ProcessInfo[i].ThreadID));
SubItems.Add(ProcessInfo[i].FileName);
SubItems.Add(ProcessInfo[i].Caption);
SubItems.Add(inttostr(ProcessInfo[i].Handle));
SubItems.Add(ProcessInfo[i].PClass);
if (ProcessInfo[i].Visible) then SubItems.Add('YES') else SubItems.Add('NO');
end;
end;
/// sbStatus.Panels[0].Text :=M_PROCESS;
end;
procedure TForm1.WriteTCPUDPToFile(Paper: TListview; const FileName: string);
var
F: TextFile;
i: Integer;
begin
AssignFile(F, FileName);
ReWrite(F);
Writeln(F, Format('%-18s%-18s%-18s%-18s%-18s%-18s', [Paper.Columns[0].Caption,
Paper.Columns[1].Caption,
Paper.Columns[2].Caption,
Paper.Columns[3].Caption,
Paper.Columns[4].Caption,
Paper.Columns[5].Caption]));
Writeln(F, '----------------------------------------------');
for i :=0 to Paper.Items.Count - 1 do
Writeln(F, Format('%-18s%-18s%-18s%-18s%-18s%-18s', [Paper.Items[i].Caption,
Paper.Items[i].SubItems[0],
Paper.Items[i].SubItems[1],
Paper.Items[i].SubItems[2],
Paper.Items[i].SubItems[3],
Paper.Items[i].SubItems[4]]));
CloseFile(F);
end;
procedure TForm1.WriteServiceToFile(Paper: TListview; const FileName: string);
var
F: TextFile;
i: Integer;
begin
AssignFile(F, FileName);
ReWrite(F);
Writeln(F, Format('%-50s%-50s%-50s', [Paper.Columns[0].Caption,Paper.Columns[1].Caption,Paper.Columns[2].Caption]));
Writeln(F, '----------------------------------------------');
for i :=0 to Paper.Items.Count - 1 do
Writeln(F, Format('%-50s%-50s%-50s', [Paper.Items[i].Caption,Paper.Items[i].SubItems[0],Paper.Items[i].SubItems[1]]));
CloseFile(F);
end;
procedure TForm1.WriteProcessToFile(Paper: TListview; const FileName: string);
var
F: TextFile;
i: Integer;
begin
AssignFile(F, FileName);
ReWrite(F);
Writeln(F, Format('%-18s%-18s%-18s%-18s%-18s%-18s%-18s', [Paper.Columns[0].Caption,
Paper.Columns[1].Caption,
Paper.Columns[2].Caption,
Paper.Columns[3].Caption,
Paper.Columns[4].Caption,
Paper.Columns[5].Caption,
Paper.Columns[6].Caption]));
Writeln(F, '----------------------------------------------');
for i :=0 to Paper.Items.Count - 1 do
Writeln(F, Format('%-18s%-18s%-18s%-18s%-18s%-18s%-18s', [Paper.Items[i].Caption,
Paper.Items[i].SubItems[0],
Paper.Items[i].SubItems[1],
Paper.Items[i].SubItems[2],
Paper.Items[i].SubItems[3],
Paper.Items[i].SubItems[4],
Paper.Items[i].SubItems[5]]));
CloseFile(F);
end;
procedure TForm1.GetServicesInfo; //Get the services info
var
tmpDisplayList: TStrings;
i:integer;
tmpStr:String;
begin
tmpDisplayList :=TStringList.Create;
ServiceGetList('',SERVICE_WIN32, SERVICE_STATE_ALL, tmpDisplayList );
with lvService.Items do
begin
BeginUpdate;
Clear;
EndUpdate;
end;
for i:=0 to tmpDisplayList.Count -1 do
begin
with lvService.Items.Add do
begin
Caption :=tmpDisplayList[i]; //（服务）显示的名称
tmpStr := ServiceGetKeyName('',tmpDisplayList[i]);
SubItems.Add(tmpStr);//服务名
if (ServiceStopped('',tmpStr)) then
begin ImageIndex :=10; SubItems.Add('停用'); end
else
begin ImageIndex :=9; SubItems.Add('启用'); end;
end;
end;
tmpDisplayList.free;
/// sbStatus.Panels[0].Text :=M_SERVICE;
end;
Function TForm1.GetSaveName(DefaultFileName:string='ViewList'):string;
var
FileExt: string;
begin
Application.ProcessMessages;
with TSaveDialog.Create(Self) do
try
Options :=[ofHideReadOnly, ofEnableSizing, ofOverwritePrompt];
DefaultExt:='.txt';
FileName :=DefaultFileName+'.txt';
Filter :='TXT Files (*.txt)|*.txt|';
if Execute then result:=Filename else exit;
finally
Free;
end;
end;
///////////////////////////////////////////////////////////////////////////////////////////////
procedure TForm1.tmStartserviceClick(Sender: TObject);
begin
Screen.Cursor :=crHourGlass;
ServiceStart('', lvService.Selected.SubItems[0]);
// tmRefreshClick(Sender);
Screen.Cursor :=crDefault;
end;
procedure TForm1.tmstopServiceClick(Sender: TObject);
begin
Screen.Cursor :=crHourGlass;
ServiceStop('', lvService.Selected.SubItems[0]);
// tmRefreshClick(Sender);
Screen.Cursor :=crDefault;
end;
procedure TForm1.ClosebyPIDClick(Sender: TObject);
begin
KillProcessByPID(strtoint(lvProcess.Selected.Caption));
FlatButton2Click(Sender);
end;
procedure TForm1.closebyNameClick(Sender: TObject);
begin
KillProcessByFileName(lvProcess.Selected.Subitems[1], TRUE);
FlatButton2Click(Sender);
end;
procedure TForm1.FlatButton2Click(Sender: TObject);
begin
Screen.Cursor :=crHourGlass;
GetProcessInfo();
Screen.Cursor :=crDefault;
end;
procedure TForm1.FlatSpeedButton4Click(Sender: TObject);
begin
Screen.Cursor :=crHourGlass;
GetServicesInfo();
Screen.Cursor :=crDefault;
end;
procedure TForm1.FlatSpeedButton12Click(Sender: TObject);
begin
Screen.Cursor :=crHourGlass;
GetTcpUdpInfo();
Screen.Cursor :=crDefault;
end;
procedure TForm1.lvServiceColumnClick(Sender: TObject;Column: TListColumn);
begin
if FPrevIndex[2] <> Column.Index then FAscending[2] :=True;
lvService.CustomSort(nil, Column.Index - 1);
FAscending[2] :=not FAscending[2];
FPrevIndex[2] :=Column.Index;
end;
procedure TForm1.lvServiceCompare(Sender: TObject; Item1, Item2: TListItem;Data: Integer; var Compare: Integer);
var
SortFlag: Integer;
begin
if FAscending[2] then SortFlag :=1 else SortFlag :=-1;
case Data of
-1: Compare :=SortFlag * AnsiCompareText(Item1.Caption, Item2.Caption);
0, 1: begin
Compare :=SortFlag * AnsiCompareText(Item1.SubItems[Data], Item2.SubItems[Data])
end;
2: Compare :=SortFlag * AnsiCompareText(Item1.SubItems[Data], Item2.SubItems[Data]);
end;
end;
procedure TForm1.lvProcessColumnClick(Sender: TObject;Column: TListColumn);
begin
if FPrevIndex[1] <> Column.Index then FAscending[1] :=True;
lvProcess.CustomSort(nil, Column.Index - 1);
FAscending[1] :=not FAscending[1];
FPrevIndex[1] :=Column.Index;
end;
procedure TForm1.lvProcessCompare(Sender: TObject; Item1, Item2: TListItem;Data: Integer; var Compare: Integer);
var
SortFlag: Integer;
begin
if FAscending[1] then SortFlag :=1 else SortFlag :=-1;
case Data of
-1: Compare :=SortFlag * AnsiCompareText(Item1.Caption, Item2.Caption);
0, 1: begin
Compare :=SortFlag * AnsiCompareText(Item1.SubItems[Data], Item2.SubItems[Data])
end;
2: Compare :=SortFlag * AnsiCompareText(Item1.SubItems[Data], Item2.SubItems[Data]);
end;
end;
procedure TForm1.FlatButton3Click(Sender: TObject);
var FileName:string;
begin
FileName:=GetSaveName('ProcessList');
if FileName<>'' then WriteProcessToFile(lvProcess,FileName);
end;
procedure TForm1.FlatButton4Click(Sender: TObject);
var FileName:string;
begin
FileName:=GetSaveName('ServiceList');
if FileName<>'' then WriteServiceToFile(lvService,FileName);
end;
procedure TForm1.FlatButton5Click(Sender: TObject);
var FileName:string;
begin
FileName:=GetSaveName('TcpUdpList');
if FileName<>'' then WriteTCPUDPToFile(tvtcpudp,FileName);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -