frmmain.pas

监听TCP、UDP端口,查看进程及服务.

                         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 TMain.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 TMain.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 TMain.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 TMain.tbRefreshClick(Sender: TObject);
begin
        tmRefreshClick(Sender);
end;

procedure TMain.tmRefreshClick(Sender: TObject);
begin

    Screen.Cursor := crHourGlass;
    FAscending[nbBase.PageIndex] := True;    
    Case nbBase.PageIndex of
       0:   GetTcpUdpInfo();

       1:   GetProcessInfo();
       2:   GetServicesInfo();
    end;
    Screen.Cursor := crDefault;
end;

procedure TMain.tvtcpudpDblClick(Sender: TObject);
begin
    if (tvtcpudp.SelCount = 0) then exit;
//    showmessage(tvtcpudp.Selected.SubItems[1]);
      Application.CreateForm(TTCPUDPinfo, TCPUDPinfo);
      TCPUDPinfo.edProtocol.Text :=tvtcpudp.Selected.Caption;
      TCPUDPinfo.edsa.Text :=tvtcpudp.Selected.SubItems[0];
      TCPUDPinfo.edsp.Text :=tvtcpudp.Selected.SubItems[1];
      TCPUDPinfo.edda.Text :=tvtcpudp.Selected.SubItems[2];
      TCPUDPinfo.eddp.Text :=tvtcpudp.Selected.SubItems[3];
      TCPUDPinfo.edstat.Text :=tvtcpudp.Selected.SubItems[4];
      if (tmTransparent.Checked ) then TransparentWind(TCPUDPinfo.Handle, 192, True);
//      TCPUDPinfo.Icon := Icon;
      TCPUDPinfo.ShowModal;
end;


procedure TMain.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
//                    ImageIndex := 9;
                    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;

procedure TMain.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 TMain.lvServiceCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);

var
   SortFlag: Integer;
//   s1, s2: string;
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 TMain.pmServicePopup(Sender: TObject);
begin
     if (lvService.SelCount=0) then exit;
     if (lvService.Selected.SubItems[1]='启用') then
     begin
         tmStartservice.Enabled := False;
         tmStopService.Enabled := True;
     end
     else
     begin
         tmStartservice.Enabled := True;
         tmStopService.Enabled := False;
     end;
end;

procedure TMain.tmStartserviceClick(Sender: TObject);
begin
    Screen.Cursor := crHourGlass;
    ServiceStart('', lvService.Selected.SubItems[0]);
    tmRefreshClick(Sender);
    Screen.Cursor := crDefault;
end;

procedure TMain.tmstopServiceClick(Sender: TObject);
begin
    Screen.Cursor := crHourGlass;
    ServiceStop('', lvService.Selected.SubItems[0]);
    tmRefreshClick(Sender);
    Screen.Cursor := crDefault;
end;

procedure TMain.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 TMain.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 TMain.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 TMain.tmSavetoClick(Sender: TObject);
var
   FileExt: string;
begin
     Application.ProcessMessages;
     with TSaveDialog.Create(Self) do
     try
        Options := [ofHideReadOnly, ofEnableSizing, ofOverwritePrompt];
        if FFileName = '' then FileName := '*.txt' else FileName := FFileName;
        Filter := 'TCPStat Files (*.txt)|*.txt|';
        if Execute then
        begin
             FFileName := Filename;
             FileExt := ExtractFileExt(FFileName);
             if AnsiLowerCase(FileExt) <> '.txt' then
             begin
                  Delete(FFileName, Pos('.', FFileName), Length(FileExt));
                  FFileName := FFileName + '.txt';
             end;
//             MkFile(FFileName);
             Case nbBase.PageIndex of
                0:    WriteTCPUDPToFile(tvtcpudp, FFileName);
                1:    WriteProcessToFile(lvProcess,FFileName);
                2:    WriteServiceToFile(lvService, FFileName);
             end;
        end;
     finally
        Free;
     end;
end;

procedure TMain.tmSaveClick(Sender: TObject);
begin
     if FFileName = '' then
        tmSaveto.Click
     else
             Case nbBase.PageIndex of
                0:    WriteTCPUDPToFile(tvtcpudp, FFileName);
                1:    WriteProcessToFile(lvProcess,FFileName);                
                2:    WriteServiceToFile(lvService, FFileName);
             end;
end;

procedure TMain.tbSaveClick(Sender: TObject);
begin
     tmSaveClick(Sender);
end;

procedure TMain.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 TMain.lvProcessCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
var
   SortFlag: Integer;
//   s1, s2: string;
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 TMain.pmProcessPopup(Sender: TObject);
begin

     if (lvProcess.SelCount=0) then exit;
     ClosebyPID.Caption := '结束所有PID为'+lvProcess.Selected.Caption+'的进程';
     ClosebyName.Caption := '结束所有名为'+lvProcess.Selected.Subitems[1]+'的进程';

end;

procedure TMain.ClosebyPIDClick(Sender: TObject);
begin
    KillProcessByPID(strtoint(lvProcess.Selected.Caption));
    tmRefreshClick(Sender);
end;

procedure TMain.closebyNameClick(Sender: TObject);
begin
    KillProcessByFileName(lvProcess.Selected.Subitems[1], TRUE);
    tmRefreshClick(Sender);
end;

procedure TMain.tmAboutClick(Sender: TObject);
begin
  ShowHTMLDialog(Handle, '', 'ABOUT');
end;

end.