TCP+UDP+PROCESS

来源:互联网 发布:网络订餐监管 编辑:程序博客网 时间:2024/06/06 01:35

DELPHI+TCP+UDP+PROCESS......

 

 

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, WinSkinStore,
  WinSkinData;

type
  TMain = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    tmSaveto: TMenuItem;
    tmExit: TMenuItem;
    View1: TMenuItem;
    tmNetstat: TMenuItem;
    tmProcess: TMenuItem;
    tmService: TMenuItem;
    tmTransparent: 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;
    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;
    sd1: TSkinData;
    SkinStore1: TSkinStore;
    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;
  root:string;

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);
  root:=ExtractFilepath(paramStr(0));
  Sd1.LoadFromCollection(skinstore1,1);
  if not sd1.active then sd1.active:=true;
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;
                         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;
      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.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
                    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;
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;
             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;
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.

 

 

 

 

 

原创粉丝点击