frmmain.pas

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

//The Main Segment
unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ComCtrls, ToolWin, Registry, Snmp, WinSock, ShellApi, ExtCtrls,
  ImgList,UProcessService,WinSvc,UOperateProcess,UShowHTML;

type
  TMain = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    tmSaveto: TMenuItem;
    tmExit: TMenuItem;
    View1: TMenuItem;
    tmNetstat: TMenuItem;
    tmProcess: TMenuItem;
    tmService: TMenuItem;
    tmTransparent: TMenuItem;
    tmHelp: TMenuItem;
    tmAbout: TMenuItem;
    ImageList: TImageList;
    ToolBar: TToolBar;
    tbSave: TToolButton;
    ToolButton1: TToolButton;
    tbRefresh: TToolButton;
    ToolButton2: TToolButton;
    tbtcpudp: TToolButton;
    tbprocess: TToolButton;
    nbBase: TNotebook;
    tvtcpudp: TListView;
    tbService: TToolButton;
    tbExit: TToolButton;
    tbAbout: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    tbTransparent: TToolButton;
    ToolButton8: TToolButton;
    tmRefresh: TMenuItem;
    lvService: TListView;
    pmService: TPopupMenu;
    tmStartservice: TMenuItem;
    tmstopService: TMenuItem;
    sbStatus: TStatusBar;
    tmSave: TMenuItem;
    lvProcess: TListView;
    pmProcess: TPopupMenu;
    ClosebyPID: TMenuItem;
    closebyName: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure tmExitClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure tmTransparentClick(Sender: TObject);
    procedure tmNetstatClick(Sender: TObject);
    procedure tmProcessClick(Sender: TObject);
    procedure tmServiceClick(Sender: TObject);
    procedure tbExitClick(Sender: TObject);
    procedure tbtcpudpClick(Sender: TObject);
    procedure tbprocessClick(Sender: TObject);
    procedure tbServiceClick(Sender: TObject);
    procedure tbTransparentClick(Sender: TObject);
    procedure tbRefreshClick(Sender: TObject);
    procedure tmRefreshClick(Sender: TObject);
    procedure tvtcpudpDblClick(Sender: TObject);
    procedure lvServiceColumnClick(Sender: TObject; Column: TListColumn);
    procedure lvServiceCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure pmServicePopup(Sender: TObject);
    procedure tmStartserviceClick(Sender: TObject);
    procedure tmstopServiceClick(Sender: TObject);
    procedure tmSavetoClick(Sender: TObject);
    procedure tmSaveClick(Sender: TObject);
    procedure tbSaveClick(Sender: TObject);
    procedure lvProcessColumnClick(Sender: TObject; Column: TListColumn);
    procedure lvProcessCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure pmProcessPopup(Sender: TObject);
    procedure ClosebyPIDClick(Sender: TObject);
    procedure closebyNameClick(Sender: TObject);
    procedure tmAboutClick(Sender: TObject);

  private
    { Private declarations }
    FHostName: array[0..255] of Char;
    FAscending: array[0..2] of Boolean;
    FPrevIndex: array[0..2] of Integer;
    FFileName: string;
  public
    { Public declarations }
    Procedure InitSystem();     //init the whole project
    Procedure FreeSystem();     //free the resources
    procedure GetTcpUdpInfo;    //Get the tcp/udp info
    procedure GetServicesInfo;   //Get the services info
    procedure GetProcessInfo;    //Get the Process info
    function GetPort(port: UINT; proto: PChar): string;
    function GetHost(local: Boolean; ipaddr: UINT): string;
    procedure WriteTCPUDPToFile(Paper: TListview;const FileName: string);
    procedure WriteProcessToFile(Paper: TListview; const FileName: string);    
    procedure WriteServiceToFile(Paper: TListview; const FileName: string);
  end;

  type
  PTcpInfo = ^TTcpInfo;
  TTcpInfo = packed record
    prev: PTcpInfo;
    next: PTcpInfo;
    state: UINT;
    localip: UINT;
    localport: UINT;
    remoteip: UINT;
    remoteport: UINT;
  end;

  PIds = ^TIds;
  TIds = array[0..9] of UINT;
const
  TcpIdentifiers: TIds = (1, 3, 6, 1, 2, 1, 6, 13, 1, 0);
  UdpIdentifiers: TIds = (1, 3, 6, 1, 2, 1, 7, 5, 1, 0);
  TcpState: array[0..11] of string[13] = ('未知状态',
                                          '已经结束',
                                          '监听状态',
                                          'SYN_SENT',
                                          'SEN_RECEIVED',
                                          '已经建立',
                                          'FIN_WAIT',
                                          'FIN_WAIT2',
                                          '结束等待',
                                          '正在结束',
                                          'LAST_ACK',
                                          '超时等待');
  M_CREATESOCKETERROR = '创建Socket失败!' ;
  M_TCPUDP = '双击获得详细信息' ;
  M_PROCESS = '右键选择结束进程' ;
  M_SERVICE = '右键选择启动和停止服务';
var
  Main: TMain;

implementation
uses UTransparent, frmTCPUDPinfo;
{$R *.DFM}
{$R Leaf.RES}

Procedure TMain.InitSystem();     //init the whole project
var
   WSAData: TWSAData;
begin
  if (WinVer = OS_WIN2k) then
  begin
     LoadWin2k();
     TransparentWind(Handle, 192, tmTransparent.Checked);
     tbTransparent.Down := tmTransparent.Checked;
  end
  else
  begin
     tmTransparent.Enabled:=False;
     tbTransparent.Enabled:=False;
  end;

  nbBase.PageIndex := 0;
     if WSAStartup($0101, WSAData) <> 0 then
     begin
          MessageDlg('不能初始化Socket!', mtError, [mbOK], 0);
          sbStatus.Panels[0].text := M_CREATESOCKETERROR;
          ToolBar.Enabled := False;
          View1.Enabled:=False;
          tmSave.Enabled:=False;
     end
     else
     GetHostName(FHostName, SizeOf(FHostName));
     Left := (Screen.Width - Width) div 2;
     Top := (Screen.Height - Height) div 2;
end;

Procedure TMain.FreeSystem();     //free the resources
begin
  if (WinVer = OS_WIN2k) then
  begin
     unLoadWin2k();
     TransparentWind(Handle, 192, False);
  end;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
         show;
        InitSystem();
        tmRefreshClick(Sender);        
end;

procedure TMain.tmExitClick(Sender: TObject);
begin
        Application.Terminate;
end;

procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
        FreeSystem();
end;

procedure TMain.FormDestroy(Sender: TObject);
begin
        FreeSystem();
end;

procedure TMain.tmTransparentClick(Sender: TObject);
begin
    tmTransparent.Checked:=Not tmTransparent.Checked;
    if (WinVer = OS_WIN2k) then
    begin
      LoadWin2k();
      TransparentWind(Handle, 192, tmTransparent.Checked);
    end;
    tbTransparent.Down:=tmTransparent.Checked;
end;

procedure TMain.tmNetstatClick(Sender: TObject);
begin
        if(nbBase.PageIndex<>0) then  GetTcpUdpInfo();
        tbtcpudp.Down:=True;
        tbprocess.Down:=False;
        tbService.Down:=False;
        nbBase.PageIndex := 0;
        tmNetstat.Checked := True;
end;

procedure TMain.tmProcessClick(Sender: TObject);
begin
        if(nbBase.PageIndex<>1) then GetProcessInfo();
        tbtcpudp.Down:=False;
        tbprocess.Down:=True;
        tbService.Down:=False;
        nbBase.PageIndex := 1;
        tmProcess.Checked := True;
end;

procedure TMain.tmServiceClick(Sender: TObject);
begin
        if(nbBase.PageIndex<>2) then  GetServicesInfo();
        tbtcpudp.Down:=False;
        tbprocess.Down:=False;
        tbService.Down:=True;
        nbBase.PageIndex := 2;
        tmService.Checked := True;
end;

procedure TMain.tbExitClick(Sender: TObject);
begin
        tmExitClick(Sender);
end;

procedure TMain.tbtcpudpClick(Sender: TObject);
begin

        tmNetstatClick(Sender);
end;

procedure TMain.tbprocessClick(Sender: TObject);
begin

        tmProcessClick(Sender);
end;

procedure TMain.tbServiceClick(Sender: TObject);
begin

        tmServiceClick(Sender);
end;

procedure TMain.tbTransparentClick(Sender: TObject);
begin
        tmTransparentClick(Sender);
        
end;


procedure TMain.GetTcpUdpInfo();                //Get the tcp/udp info
var
   TcpInfoTable, UdpInfoTable: TTcpInfo;
   hTrapEvent: THandle;
   hIdentifier, Oid: TAsnObjectIdentifier;
   VarBindList: TSnmpVarBindList;
   VarBind: TSnmpVarBind;
   errorStatus, errorIndex: TAsnInteger32;
   currentEntry, newEntry: PTcpInfo;
   currentIndex: UINT;
   localaddr, localport, remoteaddr,remoteport: string;
begin
     if not SnmpExtensionInit(GetTickCount, @hTrapEvent, @hIdentifier) then Exit;
     { TCP connections }
     FillChar(Oid, SizeOf(Oid), 0);
     FillChar(VarBindList, SizeOf(VarBindList), 0);
     FillChar(VarBind, SizeOf(VarBind), 0);
     Oid.idLength := 10;
     Oid.ids := @TcpIdentifiers;
     SnmpUtilOidAppend(@VarBind.name, @Oid);
     VarBind.value.asnType := ASN_NULL;
     VarBindList.list := @VarBind;
     VarBindList.len := 1;
     FillChar(TcpInfoTable, SizeOf(TcpInfoTable), 0);
     TcpInfoTable.prev := @TcpInfoTable;
     TcpInfoTable.next := @TcpInfoTable;
     currentIndex := 1;
     currentEntry := @TcpInfoTable;
     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 := TcpInfoTable.next;
               currentIndex := PIds(VarBind.name.ids)^[9];
          end;
          case currentIndex of
            1: begin
                    newEntry := PTcpInfo(AllocMem(SizeOf(TTcpInfo)));
                    newEntry^.prev := currentEntry;
                    newEntry^.next := @TcpInfoTable;
                    currentEntry^.next := newEntry;
                    currentEntry := newEntry;
                    currentEntry^.state := VarBind.value.number;
               end;
            2: begin
                    currentEntry^.localip := (PUINT(VarBind.value.address.stream))^;
                    currentEntry := currentEntry^.next;
               end;
            3: begin
                    currentEntry^.localport := VarBind.value.number;
                    currentEntry := currentEntry^.next;
               end;
            4: begin
                    currentEntry^.remoteip := (PUINT(VarBind.value.address.stream))^;
                    currentEntry := currentEntry^.next;
               end;
            5: begin
                    currentEntry^.remoteport := VarBind.value.number;
                    currentEntry := currentEntry^.next;
               end;
          end;
     end;
     with tvtcpudp.Items do
     begin
          BeginUpdate;
          Clear;
          EndUpdate;
     end;
     currentEntry := TcpInfoTable.next;
     while currentEntry <> @TcpInfoTable do
     begin
//          if not TBtnEndp.Down then if currentEntry^.state <> 5 then
//          begin
//               currentEntry := currentEntry^.next;
//               Continue;
//          end;
          localaddr := Format('%s',
                             [GetHost(True, currentEntry^.localip)]);
          localport := Format('%s',
                              [GetPort(currentEntry^.localport, 'tcp')]);
          if currentEntry^.remoteip = 0 then
             remoteaddr := Format('%s: %s',
                                 [GetHost(False, currentEntry^.remoteip), '0'])
          else
             remoteaddr := Format('%s',
                                 [GetHost(False, currentEntry^.remoteip)]);

             remoteport := Format('%s',
                                  [GetPort(currentEntry^.remoteport, 'tcp')]);             
          with tvtcpudp.Items.Add do
          begin
               ImageIndex := 0;
               Caption := 'TCP';
               SubItems.Add(localaddr);
               SubItems.Add(localport);               
               SubItems.Add(remoteaddr);
               if (currentEntry^.state =2) then SubItems.Add('')
               else SubItems.Add(remoteport);
               SubItems.Add(TcpState[currentEntry^.state]);
          end;
          currentEntry := currentEntry^.next;
     end;
     { UDP connections }
          FillChar(Oid, SizeOf(Oid), 0);
          FillChar(VarBindList, SizeOf(VarBindList), 0);
          FillChar(VarBind, SizeOf(VarBind), 0);
          Oid.idLength := 10;
          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;