Unit scanipunit;
Interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ComCtrls, StdCtrls, Mask, Spin, Buttons, Gauges, StrUtils, SyncObjs, IdBaseComponent, IdComponent, IdIPWatch, Menus, ImgList;
type TScanIPFm = class (TForm) Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; Splitter1: TSplitter; GroupBox1: TGroupBox; GroupBox2: TGroupBox; Label1: TLabel; Label2: TLabel; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; SpeedButton3: TSpeedButton ; SpeedButton4: TSpeedButton; Panel4: TPanel; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; Edit4: TEdit; SpinButton1: TSpinButton; Panel5: TPanel; Edit5: TEdit; Edit6: TEdit; Edit7: TEdit; Edit8: TEdit; SpinButton2 : TSpinButton; SpeedButton5: TSpeedButton; SpeedButton6: TSpeedButton; Gauge2: TGauge; Gauge3: TGauge; radioGroup1: TRadioGroup; Label3: TLabel; Edit9: TEdit; RadioGroup2: TRadioGroup; Panel6: TPanel; Label4: TLabel; Edit10: TEdit; Label5: TLabel Edit11: TEDIT; EDIT12: TLABEL; EDIT12: TEDIT; Gauge1: Tgauge; SpeedButton7: TspeedButton; SpeedButton8: TspeedButton; Panel7: TPANEL; TREEVIEW1: Ttree View; Panel8: TPanel; Timer1: TTimer; Label7: TLabel; Label8: TLabel; Gauge4: TGauge; SpinEdit1: TSpinEdit; Label9: TLabel; Label10: TLabel; Label11: TLabel; Panel9: TPanel; ListView1: TListView; Panel22: TPanel; Panel10: TPanel; Panel11: TPanel; SpeedButton9: TSpeedButton; Panel12: TPanel; SpeedButton11: TSpeedButton; SpeedButton12: TSpeedButton; SpeedButton13: TSpeedButton; SpeedButton15: TSpeedButton; SaveDialog1: TSaveDialog; ComboBox1: TComboBox; Label12: TLabel; IdIPWatch1: TIdIPWatch; PopupMenu1: TPopupMenu; TPopupMenu; N1: TMenuItem; N2: TMENUITEM; N3: TMENUITEM; ImageList1: TimageList; Gauge5: Tgauge; N4: TMenuItem
N5: TMenuItem; N6: TMenuItem; N7: TMenuItem; procedure RadioGroup1Click (Sender: TObject); procedure Timer1Timer (Sender: TObject); procedure SpeedButton5Click (Sender: TObject); procedure SpeedButton6Click (Sender: TObject); procedure Edit1KeyUp (Sender: TObject ; var Key: Word; Shift: TShiftState); procedure FormCreate (Sender: TObject); procedure Edit2KeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Edit3KeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Edit4KeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Edit5KeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Edit6KeyUp (Sender: TObject; var Key: Word; Shift : TShiftState); procedure Edit7KeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Edit8KeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure SpeedButton4Click (Sender: TObject); procedure SpeedButton3Click (Sender: TObject); procedure SpeedButton2Click (Sender: TObject); procedure SpeedButton1Click (Sender: TObject); procedure SpinButton1UpClick (Sender: TObject); procedure Edit1MouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Edit5MouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SpinButton1DownClick (Sender: TObject); procedure SpinButton2DownClick (Sender: TObject); procedure SpinButton2UpClick (Sender: TObject); procedure Edit1Change (Sender: Tobject); Proceder: Tobject); Procedure Edit2Change (Sender: Tobject); Procedure Edit3Change (Sender: Tobject);
procedure SpinEdit1Change (Sender: TObject); procedure ListView1MouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure SpeedButton15Click (Sender: TObject); procedure SpeedButton11Click (Sender: TObject); procedure ListView1Click (Sender: TObject); procedure SpeedButton13Click (Sender: TObject); procedure RadioGroup2Click (Sender: TObject); procedure FormShow (Sender: TObject); procedure N2Click (Sender: TObject); procedure N3Click (Sender: TObject); procedure SpeedButton7Click (Sender: TObject); procedure N4Click (Sender: TObject); procedure N5Click (Sender: TObject); procedure N6Click (Sender: TObject); procedure N7Click (Sender: TObject); procedure N1Click (Sender: TObject); procedure SpeedButton12Click (Sender: TObject); private {Private declarations PUBLIC FROMA_IP, TOA_IP: BYTE ;FROMB_IP, TOB_IP: BYTE ;FROMD_IP, TOC_IP: BYTE ;FROMD_IP, TOD_IP: BYTE; Procedure FillLocalip; PROCEDURE GETTHESCANIP; P rocedure PingPorcess; procedure ScanPortPorcess; procedure SingleHostScan; procedure SingleHostScan2; procedure MultiHostScan; end; var ScanIPFm: TScanIPFm; OldEditText: string; FromEdit: TEdit; ToEdit: TEdit; LetPingSingle: TCriticalSection; LetScanSingle: TCriticalSection; SdPingCount: Integer; SdScanCount: integer; MultipingCount: Integer; Multiscancount: Integer; ImplementationUses pingthreadunit, Scanportthreadunit, Scanhostportthreadunit, Userinfo; {$ r * .dfm}
procedure TScanIPFm.GetTheScanIP; begin FromA_IP: = StrToInt (Edit1.Text); ToA_IP: = StrToInt (Edit5.Text); FromB_IP: = StrToInt (Edit2.Text); ToB_IP: = StrToInt (Edit6.Text); FromC_IP: = StrToInt (Edit3.text); TOC_IP: = strt (edit7.text); fromD_ip: = start (ed_ip: = strt); tod_ip: = start (edit8.text); end; procedure tscanipfm.filllocalip; var i: integer; theIndex: INTEGER ;. THEIPSTR: STRING; Begin Try theipstr: = ComboBox1.text; for i: = 1 to length (theipstr) do begin if theipstr [i] = '.' The Begin TheIndex: = i; edit1.text: = Strutils. leftStr (TheIPStr, theIndex - 1); Edit5.Text: = Edit1.Text; TheIPStr: = StrUtils.RightStr (TheIPStr, Length (TheIPStr) - theIndex); break; end; end; for i: = 1 to Length (TheIPStr ) Do Begin if theipstr [I] = '.' The begin theIndex: = I; Edit2.Text: = Strutils.leftstr (TheIpstr, TheIndex - 1); edit6.text: = Edit2.Text; theipstr: = strutils.rightstr (TheIpstr, Length (THEIPSTR) - THEINDEX; Break; end; end; for i: = 1 to length (theipstr) do begin if theipstr [i] = '.' The begin TheIndex: = i; edit3.text: = StrUtils.leftStr (TheIPStr, theIndex - 1); Edit7.Text: = Edit3.Text; TheIPStr: = StrUtils.RightStr (TheIPStr, Length (TheIPStr) - theIndex); break; end; end; Edit4.Text: = TheIPStr; EDIT8.TEXT: = TheipStr; Except end;
procedure TScanIPFm.PingPorcess; var iA, iB, iC, iD: integer; ThePingIP: string; ThePingThread: PingThread; TheTimeStr: string; TotalCount: int64; begin if SdPingCount> 0 then exit; Timer1.Enabled: = True; TotalCount: = 0; GetTheScanIP; TheTimeStr: = TimeToStr (Time); for iA: = FromA_IP to ToA_IP do for iB: = FromB_IP to ToB_IP do for iC: = FromC_IP to ToC_IP do for iD: = FromD_IP to ToD_IP do begin TotalCount: = TotalCount 1; end; gauge4.maxvalue: = MULTIPINGCOUNT; gauge2.Progress: = 0; try gauge2.maxvalue: = TotalCount; Except beep; spesedbutton6.down: = true; panel10.caption: = 'Search initialization error! '; Timer1.enabled: = false; exit; end; for ip do for IB: = from_ip to TOB: = fromB_ip to TOB_IP Do for IC: = fromc_ip to TOC_IP DO for ID: = fromd_ip to Tod_ip Do Begin THEGINGIP: = INTOSTR (Ia) '.' INTOSTR (IB) '.' INTOSTR (IC) '.' INTOSTR (ID);
Edit1.Text: = INTSTOTR (IA); edit2.text: = INTOSTOSTR (IB); edit3.text: = INTTOSTR (IC); edit4.text: = INTOSTR (ID); REPEAT // Settings Block Operation Application.ProcessMessages; Gauge4.Progress: = SdPingCount; Panel10.Caption: = 'total emitted current' IntToStr (SdPingCount) 'search threads'; if SpeedButton6.Down then begin repeat Application.ProcessMessages; Gauge4.Progress: = SdPingCount; Panel10.Caption : = 'There is currently' INTOSTR (SDPINGCOUNT) 'Search threads have not returned, please wait ...'; until sdpingcount = 0; speedbutton6.down: = true; Timer1.enabled: = false; gauge4.progress : = 0; THETIMESTR: = 'Scan time from:' THETIMESTR 'to:' Timetostr (Time); Application.MessageBox (Pchar (THETIMESTR), 'Scan Interrupt', MB_OK MB_ICONSTOP); Panel10.caption: = 'Search threads have all returned _____ok!'; exit; end; until SdPingCount Until SDPINGCOUNT = 0; speedbutton6.down: = true; timer1.enabled: = false; thetimestr: = 'scan time from:' Timestr 'to:' Timetostr (Time); panel10.caption: = 'Search thread Already returned _____ok! '; Gauge4.progress: = 0; Application.MessageBox (Pchar (Thattimestr),' Scan is', MB_OK MB_ICONICONFORMATION; procedure TScanIPFm.ScanPortPorcess; var iA, iB, iC, iD: integer; ThePingIP: string; TheScanThread: ScanPortThread; TheTimeStr: string; TotalCount: int64; begin if SdPingCount> 0 then exit; Timer1.Enabled: = True; TotalCount: = 0; GetTheScanIP; TheTimeStr: = TimeToStr (Time); for iA: = FromA_IP to ToA_IP do for iB: = FromB_IP to ToB_IP do for iC: = FromC_IP to ToC_IP do for iD: = FromD_IP to ToD_IP do begin TotalCount: = TotalCount 1; end; gauge4.maxvalue: = MULTIPINGCOUNT; gauge2.Progress: = 0; try gauge2.maxvalue: = TotalCount; Except beep; spesedbutton6.down: = true; panel10.caption: = 'Search initialization error! '; Timer1.enabled: = false; exit; end; for ip do for IB: = from_ip to TOB: = fromB_ip to TOB_IP Do for IC: = fromc_ip to TOC_IP DO for ID: = fromd_ip to Tod_ip Do Begin THEGINGIP: = INTOSTR (Ia) '.' INTOSTR (IB) '.' INTOSTR (IC) '.' INTOSTR (ID); Edit1.Text: = INTSTOTR (IA); edit2.text: = INTOSTOSTR (IB); edit3.text: = INTTOSTR (IC); edit4.text: = INTOSTR (ID); REPEAT // Settings Block Operation Application.ProcessMessages; Gauge4.Progress: = SdPingCount; Panel10.Caption: = 'total emitted current' IntToStr (SdPingCount) 'search threads'; if SpeedButton6.Down then begin repeat Application.ProcessMessages; Gauge4.Progress: = SdPingCount; Panel10.Caption : = 'There is currently' INTOSTR (SDPINGCOUNT) 'Search threads have not returned, please wait ...'; until sdpingcount = 0; speedbutton6.down: = true; Timer1.enabled: = false; gauge4.progress : = 0; THETIMESTR: = 'Scan time from:' THETIMESTR 'to:' Timetostr (Time); Application.MessageBox (Pchar (THETIMESTR), 'Scan Interrupt', MB_OK MB_ICONSTOP); Panel10.caption: = 'Search threads have all returned _____ok!'; exit; end; until SdPingCount INTTOSTR (SDPINGCOUNT) 'Search thread is not returned, please wait ...'; until sdpingcount = 0; speedbutton6.down: = true; timer1.enabled: = false; theetimester: = 'scan time from:' THetimeStr 'To:' Timetostr (Time); Panel10.caption: = 'Search thread has all returned _____ok!'; Gauge4.Progress: = 0; Application.MessageBox (Pchar (Thetstr), 'Scan finger', MB_OK MB_ICONINFORMATION); Procedure tscanipfm.singlehostscan; var i: integer; theportscan: scanhostportthread; ThenEwnode: Ttreenode; fromport, Toport: integer; project, toport: integer; project, toposcount: integer; TheNewNode: = TreeView1.Items.Add (nil, Edit10.Text); TheNewNode.ImageIndex: = 0; TheNewNode.StateIndex: = 0; TheNewNode.SelectedIndex: = 0; Gauge1.MaxValue: = StrToInt (Edit12.Text); Gauge1 .Progress: = 0; gauge5.maxvalue: = Multiscancount; gauge5.progress: = 0; fromport: = start (edit11.text); TOPORT: = stromport (edit12.text); for i: = fromport to toport do begin repeat Application.ProcessMessages; Gauge5.Progress: = SdScanCount; if SpeedButton8.Down then begin repeat Application.ProcessMessages; Gauge5.Progress: = SdScanCount; until SdScanCount = 0; Application.MessageBox ( '=== === scanned by your active end ',' scan interrupt ', MB_OK MB_ICONSTOP); Gauge5.Progress: = 0; exit; end; until SdScanCount Gauge1.MaxValue: = StrToInt (Edit12.Text); Gauge1.Progress: = 0; Gauge5.MaxValue: = MultiScanCount; Gauge5.Progress: = 0; FromPort: = StrToInt (Edit11.text); ToPort: = StrToInt (Edit12. text); for i: = FromPort to ToPort do begin repeat Application.ProcessMessages; Gauge5.Progress: = SdScanCount; if SpeedButton8.Down then begin repeat Application.ProcessMessages; Gauge5.Progress: = SdScanCount; until SdScanCount = 0; Application.MessageBox ('=== Scan is ended by you ===', 'scanned interrupt', MB_OK MB_ICONSTOP); Gauge5.Progress: = 0; EXIT; End; Until SDScount procedure TScanIPFm.MultiHostScan; var i: integer; TheNewNode: TTreeNode; begin SdScanCount: = 0; for i: = 0 to ListView1.Items.Count - 1 do begin if ListView1.Items [i] .Checked then begin Edit10.Text: = ListView1.Items [i] .Caption; TheNewNode: = TreeView1.Items.Add (nil, Edit10.Text); TheNewNode.ImageIndex: = 0; TheNewNode.StateIndex: = 0; TheNewNode.SelectedIndex: = 0; repeat Application. ProcessMessages; if SpeedButton8.Down then exit; until SdScanCount = 0; SingleHostScan2; end; end; Application.MessageBox ( '=== === scanning task is completed!', 'scanned', MB_OK MB_ICONSTOP); SpeedButton8.Down : = True; end; procedure tscanipfm.radiogroup1click (sender: TOBJECT); begin if Radiogroup1.itemindex = 0 Then Edit9.enable: = false else edit9.enable: = true; Procedure tscanipfm.timer1Timer (Sender: TOBJECT); VAR MIDCOLOR: TCOLOR; Begin Gauge3.Progress: = Gauge3.Progress 10; If gauge3.progress = 100 dam gauge3.progress: = 0; MIDCOLOR: = Gauge3.BackColor: = gauge3.ForeColor; gauge3.forecolor: = midcolor; end; Procedure tscanipfm.speedButton5Click (Sender: TOBJECT); begin if Radiogroup1.itemindex = 1 Then ScanportPorcess else pingporcess; Procedure tscanipfm.speedButton6Click (Sender: TOBJECT); begin Timer1.enabled: = false; Procedure tscanipfm.edit1keyup (Sender: Tobject; var key: word; shift: tshiftState); begin if key = 8 dam; if (48 <= key) and (key <= 57) THEN BEGIN IF STRTOINT ((Sender As Tedit) ) .Text)> 255 THEN (Sender as tedit) .Text: = '255'; end else (sender as tedit) .text: = OldeditText; OldeditText: = (sender as tedit) .text; if key = 190 Then Edit2 .SetFocus; Edit5.Text: = Edit1.Text; end; procedure TScanIPFm.FormCreate (Sender: TObject); begin OldEditText: = '0'; SdPingCount: = 0; SdScanCount: = 0; MultiPingCount: = 100; MultiScanCount: = = TcRiticalSection.create; letscansingle: = tcriticalsection.create; Procedure tscanipfm.edit2keyup (Sender: Tobject; var key: word; shift: tshiftState); begin if key = 8 dam; if (48 <= key) and (key <= 57) THEN BEGIN OF STRTOINT ((Sender AS TEDIT) ) .Text)> 255 THEN (Sender as tedit) .Text: = '255'; end else (sender as tedit) .Text: = OldeditText; OldeditText: = (sender as tedit) .text; if key = 190 Then Edit3 .Setfocus; edit6.text: = edit2.text; Procedure tscanipfm.edit3keyup (Sender: Tobject; var key: word; shift: tshiftState); begin if key = 8 THEN EXIT; if (48 <= key) and (key <= 57) THEN BEGIN IF STRTOINT ((Sender As Tedit) ) .Text)> 255 THEN (Sender as tedit) .Text: = '255'; end else (sender as tedit) .Text: = OldeditText; OldeditText: = (sender as tedit) .text; if key = 190 Then Edit4 .Setfocus; edit7.text: = edit3.text; Procedure tscanipfm.edit4keyup (Sender: Tobject; var key: word; shift: tshiftState); begin if key = 8 THEN EXIT; if (48 <= key) and (key <= 57) THEN BEGIN IF STRTOINT ((Sender AS TEDIT) ) .Text)> 255 THEN (Sender as tedit) .Text: = '255'; end else (sender as tedit) .Text: = OldeditText; OldeditText: = (sender as tedit) .text; if key = 190 Then Edit5 .SETFOCUS; End; Procedure Tscanipfm.edit5keyup (Sender: Tobject; Var Key: Word; Shift: tshiftstate); begin if key = 8 kil = 8 THEN EXIT; if (48 <= key) and (key <= 57) THEN BEGIN IFITONT (Sender as tedit) .Text)> 255 THEN (Sender as tedit) .Text: = '255'; end else (sender as tedit) .text: = OldeditText; OldeditText: = (sender as tedit) .text; if Key = 190 THEN EDIT6.SETFOCUS; Procedure tscanipfm.edit6keyup (Sender: Tobject; var key: word; shift: tshiftState); begin if key = 8 dam; if (48 <= key) and (key <= 57) THEN BEGIN OF STRTOINT ((Sender AS TEDIT) ) .Text)> 255 THEN (Sender as tedit) .Text: = '255'; end else (sender as tedit) .text: = OldeditText; OldeditText: = (sender as tedit) .text; if key = 190 Then Edit7 .SETFOCUS; END; Procedure tscanipfm.edit7keyup (Sender: Tobject; var key: word; shift: tshiftState); begin if key = 8 dam; if (48 <= key) and (key <= 57) THEN BEGIN IF STRTOINT ((Sender As Tedit) ) .Text)> 255 THEN (Sender as tedit) .Text: = '255'; end else (sender as tedit) .text: = OldeditText; OldeditText: = (sender as tedit) .text; if key = 190 Then Edit8 .SETFOCUS; END; Procedure tscanipfm.edit8Keyup (Sender: Tobject; var key: word; shift: tshiftstate); begin if key = 8 THEN EXIT; if (48 <= key) and (key <= 57) THEN BEGIN IF STRTOINT ((Sender As Tedit) ) .Text)> 255 THEN (Sender as tedit) .Text: = '255'; end else (sender as tedit) .text: = OldeditText; OldeditText: = (sender as tedit) .Text; if key = 190 Then Edit1 .Setfocus; end; procedure tscanipfm.speedButton4Click (sender: Tobject); begin edit4.text: = '0'; edit8.text: = '255'; end; Procedure tscanipfm.speedButton3Click (sender: TOBJECT); begin edit3.text: = '0'; edit7.text: = '255'; Procedure tscanipfm.speedButton2Click (sender: TOBJECT); begin edit2.text: = '0'; edit6.text: = '255'; Procedure tscanipfm.speedButton1Click (Sender: TOBJECT); begin edit1.text: = '0'; edit5.text: = '255'; end; procedure TScanIPFm.SpinButton1UpClick (Sender: TObject); begin if StrToInt (FromEdit.Text) 1> 255 then exit; if FromEdit <> nil then FromEdit.Text: = IntToStr (StrToInt (FromEdit.Text) 1); end; Procedure tscanipfm.edit1mousedown (Sender: Tobject; Button: tmousebutton; shift: tshiftstate; x, y: integer; begin from: = (sender as tedit); Procedure tscanipfm.edit5Mousedown (Sender: Tobject; Button: TMouseButton; Shift: tshiftstate; x, y: integer; begin toedit: = (sender as tedit) end; procedure TScanIPFm.SpinButton1DownClick (Sender: TObject); begin if StrToInt (FromEdit.Text) - 1 <0 then exit; if FromEdit <> nil then FromEdit.Text: = IntToStr (StrToInt (FromEdit.Text) - 1); end; Procedure tscanipfm.spinbutton2downclick (Sender: TOBJECT); Begin if StrtOINT - 1 <0 THEN EXIT; if ToEdit <> nil damtr (strt (toedit.text) - 1); procedure TScanIPFm.SpinButton2UpClick (Sender: TObject); begin if StrToInt (ToEdit.Text) 1> 255 then exit; if ToEdit <> nil then ToEdit.Text: = IntToStr (StrToInt (ToEdit.Text) 1); end; Procedure tscanipfm.edit1change (sender: TOBJECT); Begin IF (sender as tedit) .Text = '' Then (sender as tedit) .text: = '0'; Procedure tscanipfm.formdestroy (sender: TOBJECT); begin lettingsingLE.Free; letscansingle.free; Procedure tscanipfm.edit2change (sender: TOBJECT); Begin IF (sender as tedit) .Text = '' Then (Sender as tedit) .Text: = '0'; END; Procedure tscanipfm.edit3change (sender: TOBJECT); Begin IF (sender as tedit) .Text = '' Then (sender as tedit) .text: = '0'; end; Procedure tscanipfm.spinedit1change (sender: TOBJECT); begin multipount: = spinedit1.value; multiscount: = spiTISCANCOUE; Procedure Tscanipfm.ListView1Mousemove (Sender: Tobject; Shift: TshiftState; x, y: integer); begin listview1.hint: = 'Searched' ' INTSTOSTR (ListView1.count) '; end; Procedure Tscanipfm.SpeedButton15Click (Sender: TOBJECT); Procedure Tscanipfm.SpeedButton11Click (Sender: TOBJECT); Begin ListView1.Items.clear; Panel10.caption: = 'Scan Results All Clear'; end; procedure TScanIPFm.ListView1Click (Sender: TObject); begin if ListView1.Selected <> nil then SpeedButton12.Enabled: = True else SpeedButton12.Enabled: = False; if ListView1.Selected <> nil then Edit10.Text: = ListView1.Selected. CAPTION; END; procedure TScanIPFm.SpeedButton13Click (Sender: TObject); var SaveList: TStringList; i: integer; begin if SaveDialog1.Execute then begin SaveList: = TStringList.Create; for i: = 0 to ListView1.Items.Count - 1 do SaveList.Add (ListView1.Items [I] .caption); SaveList.Savetofile (SaveDialog1.FileName); SaveList.Free; end; end; Procedure tscanipfm.radiogroup2click (sender: TOBJECT); Begin if Radiogroup2.itemindex = 0 Then Edit10.Nabled: = true else edit10.enabled: = false END; procedure TScanIPFm.FormShow (Sender: TObject); begin IdIPWatch1.Active: = True; ComboBox1.Text: = IdIPWatch1.CurrentIP; ComboBox1.Items.Text: = IdIPWatch1.IPHistoryList.Text; IdIPWatch1.Active: = False; FillLocalIP; FromEdit : = Edit4; tEDIT: = Edit8; End; Procedure tscanipfm.n2click (sender: TOBJECT); begin if listview1.selected <> nil damtview; end; Procedure tscanipfm.n3click (sender: TOBJECT); begin if listview1.selected <> nil damview1.items.clear; Procedure tscanipfm.speedbutton7click (sender: TOBJECT); begin if Radiogroup2.itemindex = 0 Then Singlehostscan else multihostscan; Procedure tscanipfm.n4click (sender: Tobject); var i: integer; begin for i: = 0 to listview1.items.count - 1 do listview1.items [i] .CHECKED: = true; procedure TScanIPFm.N5Click (Sender: TObject); var i: integer; begin for i: = 0 to ListView1.Items.Count - 1 do ListView1.Items [i] .Checked: = False; end; procedure TScanIPFm.N6Click (Sender : TOBJECT); Begin if TreeView1.selected <> nil dam; end; Procedure tscanipfm.n7click (sender: TOBJECT); begin treewhat.Items.clear; procedure TScanIPFm.N1Click (Sender: TObject); begin if ListView1.Selected <> nil then begin UserForm.MaskEdit2.Text: = ListView1.Selected.Caption; UserForm.ComboBox1.Enabled: = True; UserForm.ShowModal; UserForm.ComboBox1. Enabled: = FALSE; END; Procedure tscanipfm.speedButton 12Click (Sender: Tobject); Begin N1Click (Self); End. Unit pingthreadunit; Interface Uses Classes, IDICMPClient, Sysutils, Comctrls, IDStackConsts type PingThread = class (TThread) private {Private declarations} protected EchoCount: integer; SaveTL: TListView; PingTheIP: string; MyIcmpClient: TIdIcmpClient; TheMaxEchoTime: integer; TheEchoTTl: byte; TheEchoStr: string; procedure SaveIP; procedure PingFiveIP; procedure MyIdIcmpClientReply ( ASENDER: TComponent; const storestatus; procedure execute; override; public constructor create (theip: string; ip: tlistView); Destructor Destroy; override; ImplementationUses scanipunit; constructor PingThread.Create (TheIP: string; TheTL: TListView); begin inherited Create (True); self.FreeOnTerminate: = True; EchoCount: = 0; PingTheIP: = TheIP; SaveTL: = TheTL; MyIcmpClient: = TIdIcmpClient.Create ( nil); MyIcmpClient.Protocol: = 1; MyIcmpClient.ReceiveTimeout: = 5000; MyIcmpClient.OnReply: = MyIdIcmpClientReply; LetPingSingle.Enter; SdPingCount: = SdPingCount 1; LetPingSingle.Leave; TheMaxEchoTime: = 0; TheEchoTTl: = 0; self .Suspended: = False; end; procedure PingThread.SaveIP; var TheListItem: TListItem; begin try TheListItem: = SaveTL.Items.Add; TheListItem.ImageIndex: = 0; TheListItem.Caption: = PingTheIP; TheLIstItem.SubItems.Add (IntToStr ((Echocount * 100) Div 5) '%'); Thelistitem.Subitems.Add (INTTOSTR (THEMAXECHOTIME) '' '' MS '); ThelistItem.Subitems.Add (INTTOSTR (THEECHOTTL); ThelistItem.suBItems.Add Theechostr); EXCEPT END; Procedure pingthread.pingfiveip; Var i: integer; begin myicmpclient.host: = pingtheip; for i: = 1 to 5 do myicmpclient.ping; Procedure pingthread.execute; begin tryfiveip; eXCEPT SELF.TERMINATE; procedure PingThread.MyIdIcmpClientReply (ASender: TComponent; const AReplyStatus: TReplyStatus); begin try TheMaxEchoTime: = TheMaxEchoTime AReplyStatus.MsRoundTripTime; TheEchoStr: = IntToStr (AReplyStatus.BytesReceived) 'byte'; TheEchoTTl: = AReplyStatus.TimeToLive; if ( Areplystatus.replystatustype = rsecho) Then IF (storestatus.fromipaddress = pingtheip) THEN Echocount: = echocount 1; Except end; destructor PingThread.Destroy; begin try if EchoCount> 0 then Synchronize (SaveIP); except end; MyIcmpClient.Free; LetPingSingle.Enter; SdPingCount: = SdPingCount - 1; LetPingSingle.Leave; inherited Destroy; end; end. Unit scanportthreadunit; Interface Uses classes, IDtcpclient, sysutils, comcls, idsocks; type ScanPortThread = class (TThread) private {Private declarations} protected SaveTL: TListView; ScanTheIP: string; ScanThePort: integer; MyTcpClient: TIdTcpClient; // TheScktInfo: TSocksInfo; procedure SaveIP; procedure Execute; override; public constructor Create (TheIP: string ;......................... .. ImplementationUses scanipunit; constructor ScanPortThread.Create (TheIP: string; ThePort: integer; TheTL: TListView); begin inherited Create (True); self.FreeOnTerminate: = True; ScanTheIP: = TheIP; ScanThePort: = ThePort; SaveTL: = TheTL; MyTcpClient: = Tidtcpclient.create (nil); //Thescktinfo :=tsocksinfo.create; LetPingsingLe.Enter; SDPINGCOUNT: = SDPINGCOUNT 1; LetPingsingLeave; Self.SUSPENDED: = false; procedure ScanPortThread.Execute; begin //TheScktInfo.Authentication:=saNoAuthentication; //TheScktInfo.Version:=svNoSocks; //TheScktInfo.Port:=0; //MyTcpClient.SocksInfo:=TheScktInfo; //MyTcpClient.UseNagle:=True ; MyTcpClient.Host: = ScanTheIP; MyTcpClient.Port: = ScanThePort; try MyTcpClient.Connect; except end; if MyTcpClient.Connected then begin Synchronize (SaveIP); MyTcpClient.Disconnect; end; Self.Terminate; end; procedure ScanPortThread.SaveIP; var TheListItem: TListItem; begin try TheListItem: = SaveTL.Items.Add; TheListItem.ImageIndex: = 0; TheListItem.Caption: = ScanTheIP; TheLIstItem.SubItems.Add ( '0'); TheLIstItem.SubItems. Add ('0'); thelistitem.subitems.add ('0'); ThelistItem.Subitems.Add ('0'); ThelistItem.Subitems.Add (Intept End; End; Destructor ScanportThread.Destroy Begin mytcpclient.free; //Thescktinfo.free; letPingsingLe.Enter; sdpingcount: = sdpingCount - 1; lettingsingsingle.Leave; inherited destroy; End.