30-08-2018, Saat: 08:24
Teşekkürler elinize sağlık.
Bende 3 monitör var. Ortadaki monitörün ortasında
Bende 3 monitör var. Ortadaki monitörün ortasında
Program tarafından kullanılan portlar
|
30-08-2018, Saat: 08:24
Teşekkürler elinize sağlık.
Bende 3 monitör var. Ortadaki monitörün ortasında
31-08-2018, Saat: 01:33
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.
31-08-2018, Saat: 08:15
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)
31-08-2018, Saat: 09:45
(30-08-2018, Saat: 08:24)frmman Adlı Kullanıcıdan Alıntı: Teşekkürler elinize sağlık.O zaman sorun yok demektir (31-08-2018, Saat: 01:33)SercanTEK Adlı Kullanıcıdan Alıntı: Uygulama icin tesekkurler. Bu tarz güncellemeler yapılabilsin diye GitHub'ta
There's no place like 127.0.0.1
01-09-2018, Saat: 17:03
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
01-09-2018, Saat: 17:14
(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ş 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
02-09-2018, Saat: 00:02
(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; 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 . Aklıma gelmesi lazımdı 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: İyi çalışmalar
Çorbada Benimde Tuzum Bulunsun Dedim ve aşağıdaki Geliştirmeleri Hallettim.
GitHub > https://github.com/sercanca/Usedport-Free/tree/master 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.
15-05-2019, Saat: 01:43
Harika uygulama emeğinize sağlık
15-05-2019, Saat: 08:15
|
« Önceki Konu | Sonraki Konu »
|
Konu ile Alakalı Benzer Konular | |||||
Konular | Yazar | Yorumlar | Okunma | Son Yorum | |
Delphi ile yazılımış takdire şayan bir program | coyistik | 71 | 48.185 |
11-04-2019, Saat: 12:12 Son Yorum: forumcuali |