Konuyu Oyla:
  • Derecelendirme: 5/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Program tarafından kullanılan portlar
#11
Teşekkürler elinize sağlık.
Bende 3 monitör var. Ortadaki monitörün ortasında Smile
Cevapla
#12
Uygulama icin tesekkurler.

Söyle bir eklenti eklenebilir. Bir edite portu yazıp o an hangi uygulana kullanıyor o gösterilebilir. Güncelleme yapmazsanız ben düzenleyip eklerim bir ara.
Cevapla
#13
Ellerinize sağlık.
"…De ki: "Hiç bilenlerle bilmeyenler bir olur mu? Şüphesiz, temiz akıl sahipleri öğüt alıp-düşünürler" (Zümer Suresi, 9)
Cevapla
#14
(30-08-2018, Saat: 08:24)frmman Adlı Kullanıcıdan Alıntı: Teşekkürler elinize sağlık.
Bende 3 monitör var. Ortadaki monitörün ortasında Smile
O zaman sorun yok demektir Big Grin


(31-08-2018, Saat: 01:33)SercanTEK Adlı Kullanıcıdan Alıntı: Uygulama icin tesekkurler.

Söyle bir eklenti eklenebilir. Bir edite portu yazıp o an hangi uygulana kullanıyor o gösterilebilir. Güncelleme yapmazsanız ben düzenleyip eklerim bir ara.

Bu tarz güncellemeler yapılabilsin diye GitHub'ta Wink
There's no place like 127.0.0.1
WWW
Cevapla
#15
Porta göre uygulama bulma işlemini yapıyor. 

Kod nasıl yazılmaz adlı çalışmam ektedir;


Main.pas
unit Main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
 TForm1 = class(TForm)
   pnlLeft: TPanel;
   pnlRight: TPanel;
   pnlCount: TPanel;
   btnRefresh: TButton;
   lvProcesses: TListView;
   lvPorts: TListView;
   btnBul: TButton;
   procedure btnRefreshClick(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure lvProcessesChange(Sender: TObject; Item: TListItem; Change:
       TItemChange);
   procedure btnBulClick(Sender: TObject);
 private
   procedure FillList;
   procedure GetPortListByPID(const pid: Cardinal);
   procedure UpdateCounterCaption(const tcp, udp: Integer);
   procedure PortFind(const Port: String);
 end;

 TMibTcpRowOwnerPid = packed record
   dwState     : DWORD;
   dwLocalAddr : DWORD;
   dwLocalPort : DWORD;
   dwRemoteAddr: DWORD;
   dwRemotePort: DWORD;
   dwOwningPid : DWORD;
 end;
 PMibTcpRowOwnerPid = ^TMibTcpRowOwnerPid;

 MIB_TCPTABLE_OWNER_PID = packed record
  dwNumEntries: DWord;
  table: array [0..0] of TMibTcpRowOwnerPid;
 end;
 PMIB_TCPTABLE_OWNER_PID  = ^MIB_TCPTABLE_OWNER_PID;

 TMibUdpRowOwnerPID = packed record
   dwLocalAddr: DWORD;
   dwLocalPort: DWORD;
   dwOwningPid: DWORD;
 end;
 PMibUdpRowOwnerPID = ^TMibUdpRowOwnerPID;

 MIB_UDPTABLE_OWNER_PID = packed record
   dwNumEntries: DWORD;
   table: Array[0..0] of TMibUdpRowOwnerPID;
 end;
 PMIB_UDPTABLE_OWNER_PID = ^MIB_UDPTABLE_OWNER_PID;

 function GetExtendedTcpTable(pTcpTable: Pointer; pdwSize: PDWORD; bOrder: BOOL; ulAf: LongWord;
   TableClass: Integer; Reserved: LongWord): DWORD; stdcall; external 'iphlpapi.dll';

 function GetExtendedUdpTable( pUdpTable: Pointer; pdwSize: PDWORD; bOrder: BOOL; ulAf: LongWord;
   TableClass: Integer; Reserved: LongWord): LongInt; stdcall; external 'iphlpapi.dll';

const
 AF_INET                 = 2; // WinSock
 TCP_TABLE_OWNER_PID_ALL = 5;
 UDP_TABLE_OWNER_PID     = 1;
 Counter_Caption         = 'TCP: %d,     UDP: %d';

var
 Form1: TForm1;

implementation

uses TlHelp32;

{$R *.dfm}


function GetPIDName(hSnapShot: THandle; PID: DWORD): string;
var
ProcInfo: TProcessEntry32;
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if not Process32First(hSnapShot, ProcInfo) then
   Result := 'Bilinmiyor'
else
repeat
  if ProcInfo.th32ProcessID = PID then
     Result := ProcInfo.szExeFile;
until not Process32Next(hSnapShot, ProcInfo);
end;


procedure TForm1.PortFind(const Port: String);
var
i: integer;
dllHandle : THandle;
 GetExtendedTcpTable: function(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL; lAf: ULONG; TableClass: Integer; Reserved: ULONG): DWord; stdcall;
PID, TableSize: DWORD;
Snapshot: THandle;
FExtendedTcpTable : PMIB_TCPTABLE_OWNER_PID;
AppName: string;
PortList: TMemo;
AppList: TMemo;
_Port: Cardinal;
Finded: Integer;
begin
dllHandle := LoadLibrary('iphlpapi.dll');
if dllHandle = 0 then exit;
GetExtendedTcpTable := GetProcAddress(dllHandle, 'GetExtendedTcpTable');
if not Assigned(GetExtendedTcpTable) then exit;

AppList := TMemo.Create(nil);
AppList.Visible := False;
AppList.Parent := Self;
AppList.Lines.BeginUpdate;
AppList.Clear;


PortList := TMemo.Create(nil);
PortList.Visible := False;
PortList.Parent := self;
PortList.Lines.BeginUpdate;
PortList.Lines.Clear;

try
  TableSize := 0;
  if GetExtendedTcpTable(nil, @TableSize, False, AF_INET, 5, 0) <> ERROR_INSUFFICIENT_BUFFER then
  exit;
  try
    GetMem(FExtendedTcpTable, TableSize);
    Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if GetExtendedTcpTable(FExtendedTcpTable, @TableSize, True, AF_INET, 5, 0) = NO_ERROR then
     for I := 0 to FExtendedTcpTable.dwNumEntries  - 1 do
       begin
         PID := FExtendedTcpTable.table[i].dwOwningPid;
         AppName := GetPidName(SnapShot, PID);
         _Port := FExtendedTcpTable.table[i].dwLocalPort;
         AppList.Lines.Add(AppName);
         PortList.Lines.Add(FloatToStr(_Port));
       end;
  finally
    Finded := PortList.Lines.IndexOf(Port);

    if Finded = -1 then
    begin
      ShowMessage('Port kullanılmıyor...');
    end
    else
    begin
      ShowMessage(AppList.Lines[Finded]);
    end;
    FreeMem(FExtendedTcpTable);
  end;
finally
  FreeAndNil(PortList);
  FreeAndNil(AppList);
end;



end;

procedure TForm1.FillList;
var
 Snapshot: THandle;
 ProcessEntry: TProcessEntry32;
 aItem: TListItem;
begin
 UpdateCounterCaption(0, 0);

 lvProcesses.Items.BeginUpdate;
 lvProcesses.Clear;
 Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 try
   ProcessEntry.dwSize := SizeOf(TProcessEntry32);
   if not Process32First(Snapshot, ProcessEntry) then Exit;
   repeat
     aItem := lvProcesses.Items.Add;
     aItem.Caption := ProcessEntry.szExeFile;
     aItem.SubItems.Add(IntToStr(ProcessEntry.th32ProcessID));
   until not Process32Next(Snapshot, ProcessEntry);
 finally
   CloseHandle(Snapshot);
   lvProcesses.Items.EndUpdate;
 end;
end;

procedure TForm1.btnBulClick(Sender: TObject);
var
_Port___: string;
begin
 _Port___ := InputBox('Aradığınız Portu Giriniz', 'Port', '');
 PortFind(_Port___);
end;

procedure TForm1.btnRefreshClick(Sender: TObject);
begin
 FillList;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 FillList;
end;

procedure TForm1.GetPortListByPID(const pid: Cardinal);
var
 i: integer;
 TableSize: DWORD;
 FExtendedTcpTable: PMIB_TCPTABLE_OWNER_PID;
 FExtendedUdpTable: PMIB_UDPTABLE_OWNER_PID;
 tcp_count, udp_count: Integer;
begin
 tcp_count := 0; udp_count := 0;
 lvPorts.Items.BeginUpdate;
 lvPorts.Clear;
 try
   TableSize := 0;
   if GetExtendedTcpTable(nil, @TableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) <> ERROR_INSUFFICIENT_BUFFER then
     Exit;

   GetMem(FExtendedTcpTable, TableSize);
   try
     if GetExtendedTcpTable(FExtendedTcpTable, @TableSize, TRUE, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
       for i := 0 to FExtendedTcpTable.dwNumEntries - 1 do
         if FExtendedTcpTable.Table[i].dwOwningPid = pid then
         begin
           Inc(tcp_count);
           with lvPorts.Items.Add do
           begin
             Caption :=  IntToStr(FExtendedTcpTable.Table[i].dwLocalPort);
             SubItems.Add(IntToStr(FExtendedTcpTable.Table[i].dwRemotePort));
             SubItems.Add('TCP');
           end;
         end;
   finally
     FreeMem(FExtendedTcpTable);
   end;

   TableSize := 0;
   if GetExtendedUdpTable(nil, @TableSize, False, AF_INET, UDP_TABLE_OWNER_PID, 0) <> ERROR_INSUFFICIENT_BUFFER then
     Exit;

   GetMem(FExtendedUdpTable, TableSize);
   try
     if GetExtendedUdpTable(FExtendedUdpTable, @TableSize, TRUE, AF_INET, UDP_TABLE_OWNER_PID, 0) = NO_ERROR then
       for i := 0 to FExtendedUdpTable.dwNumEntries - 1 do
         if FExtendedUdpTable.Table[i].dwOwningPid = pid then
         begin
           Inc(udp_count);
           with lvPorts.Items.Add do
           begin
             Caption :=  IntToStr(FExtendedUdpTable.Table[i].dwLocalPort);
             SubItems.Add('');
             SubItems.Add('UDP');
           end;
         end;
   finally
     FreeMem(FExtendedUdpTable);
   end;
 finally
   lvPorts.Items.EndUpdate;
 end;
 UpdateCounterCaption(tcp_count, udp_count);
end;

procedure TForm1.lvProcessesChange(Sender: TObject; Item: TListItem; Change:
   TItemChange);
begin
 if Item.SubItems.Count = 0 then
   Exit;
 UpdateCounterCaption(0, 0);
 GetPortListByPID(StrToInt(Item.SubItems[0]));
end;

procedure TForm1.UpdateCounterCaption(const tcp, udp: Integer);
begin
 pnlCount.Caption := Format(Counter_Caption, [tcp, udp]);
end;

end.



Main.dfm
object Form1: TForm1
 Left = 0
 Top = 0
 Caption = 'Kullan'#305'lan Portlar'#305' Listele'
 ClientHeight = 335
 ClientWidth = 402
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'Tahoma'
 Font.Style = []
 OldCreateOrder = False
 Position = poDesktopCenter
 OnShow = FormShow
 PixelsPerInch = 96
 TextHeight = 13
 object pnlLeft: TPanel
   Left = 0
   Top = 0
   Width = 227
   Height = 335
   Align = alClient
   TabOrder = 0
   object btnRefresh: TButton
     Left = 1
     Top = 309
     Width = 225
     Height = 25
     Align = alBottom
     Caption = 'Yenile'
     TabOrder = 0
     OnClick = btnRefreshClick
     ExplicitWidth = 152
   end
   object lvProcesses: TListView
     Left = 1
     Top = 1
     Width = 225
     Height = 283
     Align = alClient
     Columns = <
       item
         Caption = 'Ad'
         Width = 150
       end
       item
         Caption = 'PID'
         MaxWidth = 50
         MinWidth = 50
       end>
     ColumnClick = False
     ReadOnly = True
     RowSelect = True
     SortType = stText
     TabOrder = 1
     ViewStyle = vsReport
     OnChange = lvProcessesChange
     ExplicitHeight = 308
   end
   object btnBul: TButton
     Left = 1
     Top = 284
     Width = 225
     Height = 25
     Align = alBottom
     Caption = 'Portlu Filtre'
     TabOrder = 2
     OnClick = btnBulClick
     ExplicitTop = 309
     ExplicitWidth = 152
   end
 end
 object pnlRight: TPanel
   Left = 227
   Top = 0
   Width = 175
   Height = 335
   Align = alRight
   TabOrder = 1
   object pnlCount: TPanel
     Left = 1
     Top = 309
     Width = 173
     Height = 25
     Align = alBottom
     BevelInner = bvLowered
     Caption = 'TCP: 0     UDP: 0'
     TabOrder = 0
   end
   object lvPorts: TListView
     Left = 1
     Top = 1
     Width = 173
     Height = 308
     Align = alClient
     Columns = <
       item
         Caption = 'Kaynak'
       end
       item
         Caption = 'Hedef'
       end
       item
         Caption = 'Protokol'
         Width = 60
       end>
     ColumnClick = False
     ReadOnly = True
     RowSelect = True
     TabOrder = 1
     ViewStyle = vsReport
   end
 end
end


İyi çalışmalar Smile
kisisel_logo_dark.png
WWW
Cevapla
#16
(01-09-2018, Saat: 17:03)Halil Han Badem Adlı Kullanıcıdan Alıntı: Kod nasıl yazılmaz adlı çalışmam ektedir;

Hakikaten öyle olmuş  Big Grin

PortFind'da _Port'u bulduktan sonra Port ile karşılaştır. Eğer eşitse AppName'i alıp döngüden çık. Boşuna tüm portları neden tarıyorsun ki?
There's no place like 127.0.0.1
WWW
Cevapla
#17
(01-09-2018, Saat: 17:14)SimaWB Adlı Kullanıcıdan Alıntı:
(01-09-2018, Saat: 17:03)Halil Han Badem Adlı Kullanıcıdan Alıntı: Kod nasıl yazılmaz adlı çalışmam ektedir;

Hakikaten öyle olmuş  Big Grin

PortFind'da _Port'u bulduktan sonra Port ile karşılaştır. Eğer eşitse AppName'i alıp döngüden çık. Boşuna tüm portları neden tarıyorsun ki?

Merhaba,

@SimaWB hocam ilk aşamada hatalar dediğim gibi zaman darlığı; şimdi vakit buldum halletim. Olayı dediğin mantıkta yaptım. Fikir için ayrıca teşekkür ederim  Heart  .  Aklıma gelmesi lazımdı  Sad Blush

Hocam gerekli düzenlemeleri gerçekleştirdim ve Github üzerinden yayınlandım. Icon, ekran ayarlamaları ve port arama özelliklerini aktifleştirdim. Uygulamanın evrenselliği açısından ingilizce dil kullanmaya özen gösterdim. Umarım faydası olur. Ayrıca geliştirici ekibi olarak DelphiCan Team diye adlandırdım ve kullanıcı adlarını yazdım. Bence bu şekilde basit araçlar ile DelphiCan'ın ismi duyulması gerekiyor.

GitHub adres


Ekran görüntüleri:

sc2.png

sc3.png

sc4.png


İyi çalışmalar Smile
kisisel_logo_dark.png
WWW
Cevapla
#18
Tongue 
Çorbada Benimde Tuzum Bulunsun Dedim ve aşağıdaki Geliştirmeleri Hallettim.

GitHub > https://github.com/sercanca/Usedport-Free/tree/master

   

   


.zip   UsedPort-Src.zip (Dosya Boyutu: 91,24 KB / İndirme Sayısı: 8)

-> @Halil Han BADEM Port arama eklemiş. bende geliştirip ayrı bir Form oluşturup Detaylı, Detaysız arama yaptırdım. Sonuçları Stringgrid ile gösterdim.

-> @SimaWB Çalışan Uygulamaları listelerken hepsi gözüküyordu. Bende Sadece Port kullananları göstersin diye gerekli düzenlemeyi yaptım.

Main.pas

unit Main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, ComCtrls, System.ImageList, Vcl.ImgList,Vcl.Grids;

type
 TForm1 = class(TForm)
   pnlLeft: TPanel;
   pnlRight: TPanel;
   pnlCount: TPanel;
   lvProcesses: TListView;
   lvPorts: TListView;
   Panel1: TPanel;
   btnRefresh: TButton;
   btnPortFilter: TButton;
   imgBtn24x24: TImageList;
   btnAbout: TButton;
   img100x100: TImageList;
   imgBtn16x16: TImageList;
   procedure btnRefreshClick(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure lvProcessesChange(Sender: TObject; Item: TListItem; Change:
       TItemChange);
   procedure btnPortFilterClick(Sender: TObject);
   procedure btnAboutClick(Sender: TObject);
   procedure TCPPortFind(const Port: String;var List : TStringGrid);
   procedure UDPPortFind(const Port: String;var List : TStringGrid);
 private
   procedure FillList;
   function  GetPortListByPID(const pid: Cardinal):Boolean;
   procedure UpdateCounterCaption(const tcp, udp: Integer);
 end;

 TMibTcpRowOwnerPid = packed record
   dwState     : DWORD;
   dwLocalAddr : DWORD;
   dwLocalPort : DWORD;
   dwRemoteAddr: DWORD;
   dwRemotePort: DWORD;
   dwOwningPid : DWORD;
 end;
 PMibTcpRowOwnerPid = ^TMibTcpRowOwnerPid;

 MIB_TCPTABLE_OWNER_PID = packed record
  dwNumEntries: DWord;
  table: array [0..0] of TMibTcpRowOwnerPid;
 end;
 PMIB_TCPTABLE_OWNER_PID  = ^MIB_TCPTABLE_OWNER_PID;

 TMibUdpRowOwnerPID = packed record
   dwLocalAddr: DWORD;
   dwLocalPort: DWORD;
   dwOwningPid: DWORD;
 end;
 PMibUdpRowOwnerPID = ^TMibUdpRowOwnerPID;

 MIB_UDPTABLE_OWNER_PID = packed record
   dwNumEntries: DWORD;
   table: Array[0..0] of TMibUdpRowOwnerPID;
 end;
 PMIB_UDPTABLE_OWNER_PID = ^MIB_UDPTABLE_OWNER_PID;

 function GetExtendedTcpTable(pTcpTable: Pointer; pdwSize: PDWORD; bOrder: BOOL; ulAf: LongWord;
   TableClass: Integer; Reserved: LongWord): DWORD; stdcall; external 'iphlpapi.dll';

 function GetExtendedUdpTable( pUdpTable: Pointer; pdwSize: PDWORD; bOrder: BOOL; ulAf: LongWord;
   TableClass: Integer; Reserved: LongWord): LongInt; stdcall; external 'iphlpapi.dll';

const
 AF_INET                 = 2; // WinSock
 TCP_TABLE_OWNER_PID_ALL = 5;
 UDP_TABLE_OWNER_PID     = 1;
 Counter_Caption         = 'Total : %d [ TCP: %d, UDP: %d ]';

var
 Form1: TForm1;

implementation

uses TlHelp32,ScanPort;

{$R *.dfm}



function GetPIDName(hSnapShot: THandle; PID: DWORD): string;
var
ProcInfo: TProcessEntry32;
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if not Process32First(hSnapShot, ProcInfo) then
  Result := 'Unknown!'
else
repeat
 if ProcInfo.th32ProcessID = PID then
    Result := ProcInfo.szExeFile;
until not Process32Next(hSnapShot, ProcInfo);
end;



procedure TForm1.TCPPortFind(const Port: String;var List : TStringGrid);
var
i: integer;
dllHandle : THandle;
GetExtendedTcpTable: function(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL; lAf: ULONG; TableClass: Integer; Reserved: ULONG): DWord; stdcall;
PID, TableSize: DWORD;
Snapshot: THandle;
FExtendedTcpTable : PMIB_TCPTABLE_OWNER_PID;
AppName: string;
PortList: TMemo;
AppList: TMemo;
_SPort: Cardinal;
_DPort: Cardinal;
Finded: Integer;
begin
 dllHandle := LoadLibrary('iphlpapi.dll');
 if dllHandle = 0 then exit;

 GetExtendedTcpTable := GetProcAddress(dllHandle, 'GetExtendedTcpTable');
 if not Assigned(GetExtendedTcpTable) then exit;

  TableSize := 0;
  if GetExtendedTcpTable(nil, @TableSize, False, AF_INET, 5, 0) <> ERROR_INSUFFICIENT_BUFFER then
  exit;
  try
    GetMem(FExtendedTcpTable, TableSize);
    Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if GetExtendedTcpTable(FExtendedTcpTable, @TableSize, True, AF_INET, 5, 0) = NO_ERROR then
     for I := 0 to FExtendedTcpTable.dwNumEntries  - 1 do
      begin
        PID := FExtendedTCPTable.table[i].dwOwningPid;
        AppName := GetPidName(SnapShot, PID);

        _SPort := FExtendedTCPTable.table[i].dwLocalPort ;   //Source Port
        _DPort := FExtendedTCPTable.table[i].dwRemotePort;   //Destination Port

        if Strtoint(Port) = _SPort then
          Form2.ListAdd(Form2.ScanPortList,AppName,inttostr(PID),'TCP',Port,inttostr(_DPort));

        if Strtoint(Port) = _DPort then
          Form2.ListAdd(Form2.ScanPortList,AppName,inttostr(PID),'TCP',inttostr(_SPort),Port);
      end;
  finally
    FreeMem(FExtendedTcpTable);
  end;
end;

// Added SercanTEK 2018.09
procedure TForm1.UDPPortFind(const Port: String;var List : TStringGrid);
var
 i: integer;
 PID,TableSize: DWORD;
 FExtendedUdpTable: PMIB_UDPTABLE_OWNER_PID;
 Snapshot: THandle;
 AppName: string;
 _SPort: Cardinal;
 _DPort: Cardinal;
begin
   TableSize := 0;
   if GetExtendedUdpTable(nil, @TableSize, False, AF_INET, UDP_TABLE_OWNER_PID, 0) <> ERROR_INSUFFICIENT_BUFFER then
     Exit;

   GetMem(FExtendedUdpTable, TableSize);
   Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
   try
     if GetExtendedUdpTable(FExtendedUdpTable, @TableSize, TRUE, AF_INET, UDP_TABLE_OWNER_PID, 0) = NO_ERROR then
       for i := 0 to FExtendedUdpTable.dwNumEntries - 1 do
         begin
          PID := FExtendedUdpTable.table[i].dwOwningPid;
           AppName := GetPidName(SnapShot, PID);
           _SPort := FExtendedUdpTable.table[i].dwLocalPort ;   //Source Port

           if Strtoint(Port) = _SPort then
            Form2.ListAdd(Form2.ScanPortList,AppName,inttostr(PID),'UDP',Port,'-');

      end;
   finally
     FreeMem(FExtendedUdpTable);
   end;
end;


procedure TForm1.FillList;
var
 Snapshot: THandle;
 ProcessEntry: TProcessEntry32;
 aItem: TListItem;
begin
 UpdateCounterCaption(0, 0);

 lvProcesses.Items.BeginUpdate;
 lvProcesses.Clear;
 Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 try
   ProcessEntry.dwSize := SizeOf(TProcessEntry32);
   if not Process32First(Snapshot, ProcessEntry) then Exit;
   repeat

    // Added SercanTEK 2018.09
    if GetPortListByPID(ProcessEntry.th32ProcessID) then // PID Used Port ?
     begin
      aItem := lvProcesses.Items.Add;
      aItem.Caption := ProcessEntry.szExeFile;
      aItem.SubItems.Add(IntToStr(ProcessEntry.th32ProcessID));
     end;

   until not Process32Next(Snapshot, ProcessEntry);
 finally
   CloseHandle(Snapshot);
   lvProcesses.Items.EndUpdate;
 end;
end;

procedure TForm1.btnPortFilterClick(Sender: TObject);
begin
 Form2.ShowModal;
end;

procedure TForm1.btnRefreshClick(Sender: TObject);
begin
 FillList;
end;

procedure TForm1.btnAboutClick(Sender: TObject);
begin
MessageBox(handle, pChar('Developers by DelphiCan Team' +
                         sLineBreak + sLineBreak + 'Thanks: ' +
                         sLineBreak + 'SimaWB' + sLineBreak +
                         'Halil Han Badem'+ sLineBreak +
                         'SercanTEK'), 'Developers', MB_OK + MB_ICONINFORMATION);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 FillList;
end;

function TForm1.GetPortListByPID(const pid: Cardinal):Boolean;
var
 i: integer;
 TableSize: DWORD;
 FExtendedTcpTable: PMIB_TCPTABLE_OWNER_PID;
 FExtendedUdpTable: PMIB_UDPTABLE_OWNER_PID;
 tcp_count, udp_count: Integer;
begin
 tcp_count := 0; udp_count := 0;
 lvPorts.Items.BeginUpdate;
 lvPorts.Clear;
 result := false;
 try
   TableSize := 0;
   if GetExtendedTcpTable(nil, @TableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) <> ERROR_INSUFFICIENT_BUFFER then
     Exit;

   GetMem(FExtendedTcpTable, TableSize);
   try
     if GetExtendedTcpTable(FExtendedTcpTable, @TableSize, TRUE, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
       for i := 0 to FExtendedTcpTable.dwNumEntries - 1 do
         if FExtendedTcpTable.Table[i].dwOwningPid = pid then
         begin
           Inc(tcp_count);
           with lvPorts.Items.Add do
           begin
             Caption :=  IntToStr(FExtendedTcpTable.Table[i].dwLocalPort);
             SubItems.Add(IntToStr(FExtendedTcpTable.Table[i].dwRemotePort));
             SubItems.Add('TCP');
           end;
         end;
   finally
     FreeMem(FExtendedTcpTable);
   end;

   TableSize := 0;
   if GetExtendedUdpTable(nil, @TableSize, False, AF_INET, UDP_TABLE_OWNER_PID, 0) <> ERROR_INSUFFICIENT_BUFFER then
     Exit;

   GetMem(FExtendedUdpTable, TableSize);
   try
     if GetExtendedUdpTable(FExtendedUdpTable, @TableSize, TRUE, AF_INET, UDP_TABLE_OWNER_PID, 0) = NO_ERROR then
       for i := 0 to FExtendedUdpTable.dwNumEntries - 1 do
         if FExtendedUdpTable.Table[i].dwOwningPid = pid then
         begin
           Inc(udp_count);
           with lvPorts.Items.Add do
           begin
             Caption :=  IntToStr(FExtendedUdpTable.Table[i].dwLocalPort);
             SubItems.Add('');
             SubItems.Add('UDP');
           end;
         end;
   finally
     FreeMem(FExtendedUdpTable);
   end;
 finally
   lvPorts.Items.EndUpdate;
 end;

 if (tcp_count + udp_count) > 0 then result := true;

 UpdateCounterCaption(tcp_count, udp_count);
end;

procedure TForm1.lvProcessesChange(Sender: TObject; Item: TListItem; Change:
   TItemChange);
begin
 if Item.SubItems.Count = 0 then
   Exit;
 UpdateCounterCaption(0, 0);
 GetPortListByPID(StrToInt(Item.SubItems[0]));
end;

procedure TForm1.UpdateCounterCaption(const tcp, udp: Integer);
begin
 pnlCount.Caption := Format(Counter_Caption, [tcp+udp, tcp, udp]);
end;

end.

ScanPort.pas

unit ScanPort;
{
 Port Scan Module

 Added SercanTEK
 03.09.2018
 DelphiCan Team
}

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.Buttons, Vcl.StdCtrls,
 Vcl.ExtCtrls;

type
 TForm2 = class(TForm)
   ScanPortList: TStringGrid;
   FindPortEdit: TEdit;
   Label1: TLabel;
   FindButton: TButton;
   DetailCheck: TCheckBox;
   protocolCount: TPanel;
   procedure FindButtonClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormResize(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure FindPortEditKeyPress(Sender: TObject; var Key: Char);
   procedure FindPortEditMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FindPortEditExit(Sender: TObject);
   procedure FindPortEditChange(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   procedure ListOptions(var List:TStringgrid);
   procedure ListAdd(var List:TStringgrid;App,AppPid,IPprotocol,Sport,DPort:string);
   procedure ListReSize(var List:Tstringgrid);
   function  ListPIDDoList(List:TStringGrid;AppPid,IPProtocol,SPort,DPort:string):boolean;
   function  ListProtoColCount(List:TStringGrid;IPProtocol:string):integer;
 end;

var
 Form2: TForm2;

const

 APPNAME     = 0;
 APPPPID     = 1;
 PROTOCOL    = 2;
 SOURCE      = 3;
 DESTINATION = 4;

 PORTSTRING  = 'TCP/UDP : 1 .. 65535';

implementation
         uses main;
{$R *.dfm}

procedure EditStyleitalic(var PEdit : TEdit);
begin
  PEdit.Font.Style:=(PEdit.Font.Style + [fsitalic]);
  PEdit.Font.Color:= clgray;
end;

procedure EditStyleStandart(var PEdit : TEdit);
begin
  PEdit.Font.Style:=(PEdit.Font.Style - [fsitalic]);
  PEdit.Font.Color:= clDefault;
end;

function TForm2.ListPIDDoList(List:TStringGrid;AppPid,IPProtocol,SPort,DPort:string):boolean;
var
_Row:integer;
Begin
if Trim(AppPid) <> '' then
  begin
    For _Row:= 1 To List.RowCount-1 Do
     Begin
      if (Trim(List.Cells[APPPPID,_Row])  = Trim(AppPid)) and (Trim(List.Cells[PROTOCOL,_Row]) = Trim(IPProtocol)) and
         ((Trim(List.Cells[SOURCE,_Row]) = Trim(SPort)) or (Trim(List.Cells[DESTINATION,_Row]) = Trim(DPort)))  then
      begin
        result := true;
        exit;
      end;
     End;
     result := false;
  end;
end;

function TForm2.ListProtoColCount(List:TStringGrid;IPProtocol:string):integer;
var
_Row:integer;
_Count : integer;
Begin
if Trim(IPProtocol) <> '' then
  begin
  _Count := 0 ;
    For _Row:= 1 To List.RowCount-1 Do
     Begin
      if (Trim(List.Cells[PROTOCOL,_Row]) = Trim(IPProtocol)) then
      begin
        _Count := _Count + 1 ;
      end;
     End;
   result := _Count;
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
ListOptions(ScanPortList);
end;

procedure TForm2.FormResize(Sender: TObject);
begin
ListReSize(ScanPortList);
end;

procedure TForm2.FormShow(Sender: TObject);
begin
FindPortEdit.Text:='';
FindPortEdit.Text:=PORTSTRING;
EditStyleitalic(FindPortEdit);
ListOptions(ScanPortList);
end;

procedure TForm2.ListReSize(var List:Tstringgrid);
begin
 List.ColWidths[APPPPID]      := 80;
 List.ColWidths[PROTOCOL]     := 60;
 List.ColWidths[SOURCE]       := 75;
 List.ColWidths[DESTINATION]  := 100;

 List.ColWidths[APPNAME]  := List.Width - (  List.ColWidths[APPPPID] +
                                             List.ColWidths[PROTOCOL] +
                                             List.ColWidths[SOURCE] +
                                             List.ColWidths[DESTINATION]+10);
end;

procedure TForm2.FindPortEditChange(Sender: TObject);
begin
EditStyleStandart(FindPortEdit);
end;

procedure TForm2.FindPortEditExit(Sender: TObject);
begin
if FindPortEdit.Text = '' then
  begin
    FindPortEdit.Text:=PORTSTRING;
    EditStyleitalic(FindPortEdit);
  end;
end;

procedure TForm2.FindPortEditKeyPress(Sender: TObject; var Key: Char);
begin

 if Key = #13 then // Enter Key.
    FindButtonClick(self)
 else
  if not (key in ['0'..'9',#8]) then // Number Only !!
    begin
      Key:=#0;
      Beep;
    end;

end;

procedure TForm2.FindPortEditMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if FindPortEdit.Text = PORTSTRING then FindPortEdit.Text:='';
end;

procedure TForm2.ListOptions(var List:TStringgrid);
begin

List.RowCount := 1;
List.ColCount := 5;

List.FixedCols := 0;
List.FixedRows := 0;

List.Cells[APPNAME,0]     := 'Process Name';
List.Cells[APPPPID,0]     := 'Process PID';
List.Cells[PROTOCOL,0]    := 'Protocol';
List.Cells[SOURCE,0]      := 'Source Port';
List.Cells[DESTINATION,0] := 'Destination Port';

ListReSize(List);

end;

procedure TForm2.ListAdd(var List:TStringgrid;App,AppPid,IPprotocol,Sport,DPort:string);
var
ListRowAdd : integer;
begin
  if trim(App) <> '' then
  begin
    if DetailCheck.Checked then // Detail List
      begin
       ListRowAdd    := List.RowCount;
       List.RowCount := List.RowCount + 1;
       List.Cells[APPNAME, ListRowAdd]     := App;
       List.Cells[APPPPID, ListRowAdd]     := AppPid;
       List.Cells[PROTOCOL, ListRowAdd]    := IPprotocol;
       List.Cells[SOURCE, ListRowAdd]      := Sport;
       List.Cells[DESTINATION, ListRowAdd] := DPort;
      end
       else
      begin
       if not ListPIDDoList(List,AppPid,IPprotocol,Sport,Dport) then
         begin
          ListRowAdd    := List.RowCount;
          List.RowCount := List.RowCount + 1;
          List.Cells[APPNAME, ListRowAdd]     := App;
          List.Cells[APPPPID, ListRowAdd]     := AppPid;
          List.Cells[PROTOCOL, ListRowAdd]    := IPprotocol;

          if Sport = FindPortEdit.Text then
             List.Cells[SOURCE, ListRowAdd]      := Sport
             else
             List.Cells[SOURCE, ListRowAdd]      := '-';

          if Dport = FindPortEdit.Text then
             List.Cells[DESTINATION, ListRowAdd] := DPort
             else
             List.Cells[DESTINATION, ListRowAdd] := '-';


         end;
      end;
  end;

end;

procedure TForm2.FindButtonClick(Sender: TObject);
begin

if (FindPortEdit.Text <> '') and (FindPortEdit.Text<>PORTSTRING) then
begin
  ListOptions(ScanPortList);
  Form1.TCPPortFind(FindPortEdit.Text,ScanPortList);
  Form1.UDPPortFind(FindPortEdit.Text,ScanPortList);

  ProtocolCount.Caption := '   TCP : '+inttostr(ListProtoColCount(ScanPortList,'TCP'))+
                           ' - UDP : '+inttostr(ListProtoColCount(ScanPortList,'UDP'));
end
else
begin
   Beep;
   FindPortEdit.SetFocus;
end;

end;

end.
Cevapla
#19
Harika uygulama emeğinize sağlık
Cevapla
#20
Bana da tam tersi lazım olmuştu zamanında.

http://www.delphican.com/showthread.php?tid=1440
WWW
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Big Grin Delphi ile yazılımış takdire şayan bir program coyistik 71 48.185 11-04-2019, Saat: 12:12
Son Yorum: forumcuali



Konuyu Okuyanlar: 1 Ziyaretçi