Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
gfx	[ DIR ]	drwxrwxrwx
locale	[ DIR ]	drwxrwxrwx
VersInfo.pas	42.97 KB	-rw-rw-rw-
default.po	32.22 KB	-rw-rw-rw-
ggexclude.cfg	227 B	-rw-rw-rw-
gnugettext.pas	114.84 KB	-rw-rw-rw-
ignore.po	7.28 KB	-rw-rw-rw-
sonar-project.properties	464 B	-rw-rw-rw-
uApache.pas	15.79 KB	-rw-rw-rw-
uBaseModule.pas	2.25 KB	-rw-rw-rw-
uConfig.dfm	14.81 KB	-rw-rw-rw-
uConfig.pas	4.43 KB	-rw-rw-rw-
uConfigUserDefined.dfm	14.73 KB	-rw-rw-rw-
uConfigUserDefined.pas	3.36 KB	-rw-rw-rw-
uExceptionDialog.dcu	32.71 KB	-rw-rw-rw-
uExceptionDialog.dfm	2.08 KB	-rw-rw-rw-
uExceptionDialog.pas	27.37 KB	-rw-rw-rw-
uFileZilla.pas	14.85 KB	-rw-rw-rw-
uGetWinVersionInfo.dcu	8.09 KB	-rw-rw-rw-
uGetWinVersionInfo.pas	11.13 KB	-rw-rw-rw-
uHelp.dfm	3.18 KB	-rw-rw-rw-
uHelp.pas	1.81 KB	-rw-rw-rw-
uJclSysInfo.pas	22.05 KB	-rw-rw-rw-
uLanguage.dfm	12.95 KB	-rw-rw-rw-
uLanguage.pas	2 KB	-rw-rw-rw-
uLogOptions.dfm	6.42 KB	-rw-rw-rw-
uLogOptions.pas	2.1 KB	-rw-rw-rw-
uMain.dfm	217.14 KB	-rw-rw-rw-
uMain.pas	39.26 KB	-rw-rw-rw-
uMercury.pas	11.42 KB	-rw-rw-rw-
uMySQL.pas	13.95 KB	-rw-rw-rw-
uNetstat.dfm	3.53 KB	-rw-rw-rw-
uNetstat.pas	7.95 KB	-rw-rw-rw-
uNetstatTable.pas	7.58 KB	-rw-rw-rw-
uProcesses.pas	6.25 KB	-rw-rw-rw-
uProcesses_new.pas	2.14 KB	-rw-rw-rw-
uServiceSettings.dfm	16.89 KB	-rw-rw-rw-
uServiceSettings.pas	8.26 KB	-rw-rw-rw-
uServices.pas	6.14 KB	-rw-rw-rw-
uTomcat.pas	15.9 KB	-rw-rw-rw-
uTools.pas	26.61 KB	-rw-rw-rw-
xampp_control3.dpr	2.21 KB	-rw-rw-rw-
xampp_control3.dproj	30.02 KB	-rw-rw-rw-
xampp_control3.dproj.local	38.45 KB	-rw-rw-rw-
xampp_control3.drc	78.46 KB	-rw-rw-rw-
xampp_control3.dres	37.08 KB	-rw-rw-rw-
xampp_control3.identcache	1.29 KB	-rw-rw-rw-
xampp_control3.stat	170 B	-rw-rw-rw-
xampp_control3Resource.rc	341 B	-rw-rw-rw-
xampp_control3_project.tvsconf...	72 B	-rw-rw-rw-

Code Editor : uNetstat.pas

unit uNetstat;

interface

uses
  GnuGettext, Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons, uNetstatTable, uTools, ExtCtrls,
  uProcesses_new;

type
  tNetState = (nsActive, nsOld, nsNew, nsUpdatingActive, nsUpdatingNew);

tNetEntry = class
    AddrStr: string;
    AddrR: Cardinal;
    Port: integer;
    PID: integer;
    ProcName: string;
    State: tNetState;
  end;

TfNetstat = class(TForm)
    lvSockets: TListView;
    bRefresh: TBitBtn;
    sbMain: TStatusBar;
    TimerUpdate: TTimer;
    pnlActiveExample: TPanel;
    pnlOldExample: TPanel;
    pnlNewExample: TPanel;
    procedure bRefreshClick(Sender: TObject);
    procedure lvSocketsColumnClick(Sender: TObject; Column: TListColumn);
    procedure FormCreate(Sender: TObject);
    procedure TimerUpdateTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure lvSocketsData(Sender: TObject; Item: TListItem);
    procedure lvSocketsCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure cbShowCSRSSClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    NetEntryList: tList;
    procedure ClearnetEntryList;
    function FindNetEntry(AddrR: Cardinal; Port, PID: integer; ProcName: string): tNetEntry;
  public
    procedure RefreshTable(ResetStates: Boolean);
  end;

var
  fNetstat: TfNetstat;

implementation

uses uMain;

const
  cModuleName = 'netstat';

var
  LastSortID: integer;

{$R *.dfm}

procedure TfNetstat.bRefreshClick(Sender: TObject);
begin
  RefreshTable(true);
end;

procedure TfNetstat.cbShowCSRSSClick(Sender: TObject);
begin
  RefreshTable(true);
end;

procedure TfNetstat.ClearnetEntryList;
var
  i: integer;
  NE: tNetEntry;
begin
  lvSockets.Items.Count := 0;
  for i := 0 to NetEntryList.Count - 1 do
  begin
    NE := NetEntryList[i];
    NE.Free;
  end;
  NetEntryList.Clear;
end;

function TfNetstat.FindNetEntry(AddrR: Cardinal; Port, PID: integer; ProcName: string): tNetEntry;
var
  i: integer;
  NE: tNetEntry;
begin
  for i := 0 to NetEntryList.Count - 1 do
  begin
    NE := NetEntryList[i];
    if (NE.AddrR = AddrR) and (NE.Port = Port) and (NE.PID = PID) and (NE.ProcName = ProcName) then
    begin
      result := NE;
      exit;
    end;
  end;
  result := nil;
end;

procedure TfNetstat.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ClearnetEntryList;
end;

procedure TfNetstat.FormCreate(Sender: TObject);
begin
  TranslateComponent(Self);
  NetEntryList := tList.Create;
  LastSortID := 0;
end;

procedure TfNetstat.FormDestroy(Sender: TObject);
begin
  NetEntryList.Free;
end;

procedure TfNetstat.FormShow(Sender: TObject);
begin
  TimerUpdate.Enabled := true;
end;

function smallnumber(i: Int64): integer;
begin
  if i > 0 then
    result := 1
  else if i < 0 then
    result := -1
  else
    result := 0;
end;

function CustomSortProc(Item1, Item2: Pointer): integer; // stdcall;
var
  NE1, NE2: tNetEntry;
begin
  NE1 := Item1;
  NE2 := Item2;

case LastSortID of
    0:
      result := smallnumber(Int64(NE1.AddrR) - Int64(NE2.AddrR)) * 4 + smallnumber(NE1.Port - NE2.Port) * 2 + smallnumber(NE1.PID - NE2.PID) * 1;
    1:
      result := smallnumber(Int64(NE1.AddrR) - Int64(NE2.AddrR)) * 2 + smallnumber(NE1.Port - NE2.Port) * 4 + smallnumber(NE1.PID - NE2.PID) * 1;
    2:
      result := smallnumber(Int64(NE1.AddrR) - Int64(NE2.AddrR)) * 2 + smallnumber(NE1.Port - NE2.Port) * 1 + smallnumber(NE1.PID - NE2.PID) * 4;
    3:
      result := smallnumber(CompareText(NE1.ProcName, NE2.ProcName)) * 8 + smallnumber(Int64(NE1.AddrR) - Int64(NE2.AddrR)) * 4 +
        smallnumber(NE1.Port - NE2.Port) * 2 + smallnumber(NE1.PID - NE2.PID) * 1;
  else
    result := 0;
  end;
end;

procedure TfNetstat.lvSocketsColumnClick(Sender: TObject; Column: TListColumn);
begin
  LastSortID := Column.Index;
  NetEntryList.Sort(CustomSortProc);
  lvSockets.Refresh;
end;

procedure TfNetstat.lvSocketsCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  NE: tNetEntry;
begin
  NE := NetEntryList[Item.Index];

case NE.State of
    nsActive:
      begin
        lvSockets.Canvas.Font.Color := clWindowText;
        lvSockets.Canvas.Brush.Color := clWindow;
      end;
    nsOld:
      begin
        lvSockets.Canvas.Font.Color := clWhite;
        lvSockets.Canvas.Brush.Color := clMaroon;
      end;
    nsNew:
      begin
        lvSockets.Canvas.Font.Color := clWindowText;
        lvSockets.Canvas.Brush.Color := clLime;
      end;
    nsUpdatingActive, nsUpdatingNew:
      begin
        lvSockets.Canvas.Font.Color := clGrayText;
        lvSockets.Canvas.Brush.Color := clBlue;
      end;
  end;

end;

procedure TfNetstat.lvSocketsData(Sender: TObject; Item: TListItem);
var
  NE: tNetEntry;
begin
  NE := NetEntryList[Item.Index];
  Item.Caption := NE.AddrStr;
  Item.SubItems.Add(IntToStr(NE.Port));
  Item.SubItems.Add(IntToStr(NE.PID));
  Item.SubItems.Add(NE.ProcName);
end;

procedure TfNetstat.RefreshTable(ResetStates: Boolean);
var
  i: integer;
  NE: tNetEntry;
  PID, Addr, AddrR, Port: Cardinal;
  PIDName: string;
  AddrStr: string;
  name: string;
begin
  //NetStatTable.UpdateTable;

if NetStatTable.updating = 1 then
    exit;

lvSockets.Items.BeginUpdate;

//fMain.updateTimerNetworking(False);

NetStatTable.updating_table := 1;

if ResetStates then
    ClearnetEntryList;

for i := 0 to NetEntryList.Count - 1 do
  begin
    NE := NetEntryList[i];
    if NE.State = nsActive then
      NE.State := nsUpdatingActive;
    if NE.State = nsNew then
      NE.State := nsUpdatingNew;
  end;

for i := 0 to NetStatTable.pTcpTable.dwNumEntries - 1 do
  begin
    if NetStatTable.pTcpTable.table[i].dwOwningPid <> 0 then
    begin
      PID := NetStatTable.pTcpTable.table[i].dwOwningPid;
      Addr := NetStatTable.pTcpTable.table[i].dwLocalAddr;
      AddrR := ((Addr and $FF000000) shr 24) or ((Addr and $00FF0000) shr 08) or ((Addr and $0000FF00) shl 08) or ((Addr and $000000FF) shl 24);

AddrStr := Cardinal2IP(Addr);
      Port := NetStatTable.pTcpTable.table[i].dwLocalPort;
      name := Processes.GetProcessName(PID);
      if name <> '' then
      begin
        PIDName := name;
        NE := FindNetEntry(AddrR, Port, PID, PIDName);
        if NE = nil then
        begin
          NE := tNetEntry.Create;
          NE.AddrStr := AddrStr;
          NE.AddrR := AddrR;
          NE.Port := Port;
          NE.PID := PID;
          NE.ProcName := PIDName;
          NE.State := nsNew;
          NetEntryList.Add(NE);
          lvSockets.Items.Count := lvSockets.Items.Count + 1;

fMain.AddLog(cModuleName, Format(_('New listening socket: %s:%d'), [NE.AddrStr, NE.Port]), ltDebug);
        end
        else
        begin
          if NE.State = nsUpdatingActive then
            NE.State := nsActive;
          if NE.State = nsUpdatingNew then
            NE.State := nsNew;
        end;
      end;
    end;
  end;

for i := 0 to NetEntryList.Count - 1 do
  begin
    NE := NetEntryList[i];
    if ResetStates then
      NE.State := nsActive;
    if (NE.State = nsUpdatingActive) or (NE.State = nsUpdatingNew) then
    begin
      NE.State := nsOld;
      fMain.AddLog(cModuleName, Format(_('Listening socket closed: %s:%d'), [NE.AddrStr, NE.Port]), ltDebug);
    end;
  end;

NetStatTable.updating_table := 0;

//fMain.updateTimerNetworking(True);

NetEntryList.Sort(CustomSortProc);
  lvSockets.Items.EndUpdate;
  lvSockets.Refresh;
end;

procedure TfNetstat.TimerUpdateTimer(Sender: TObject);
begin
  if Visible then
  begin
    RefreshTable(false);
  end
  else
  begin
    TimerUpdate.Enabled := false;
  end;
end;

end.

${this.title}

Code Editor : uNetstat.pas