{------------------------------------ The program is made by "ah D"! QQ: 9269563 E-mail: paf@163.net home page: http://coold.cn99.com Made in: 2002.8.27
** You can modify the code at will! But please keep this claim when reprint! ** ------------------------------- -----------------} Unit main;
Interface
Uses Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, Stdctrls, Comctrls, Winsock, SearchPortthread, Spin
type TForm1 = class (TForm) M1: TMemo; Port1: TEdit; Port2: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; Search: TSpeedButton; SB1: TStatusBar; MaxThread: TSpinEdit; Label4: TLabel; IP: TComboBox ; AboutButton: TSpeedButton; procedure SearchClick (Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure FormKeyPress (Sender: TObject; var Key: Char); procedure AboutButtonClick (Sender: TObject); procedure FormShow (Sender: TObject); private procedure Search_ST; procedure ThreadDone (Sender: TObject); procedure Search_Exit; function HostNameToIP (S: string): DWord; procedure AddComboBox (CB: TcomboBox); procedure SearchOK; {Private declarations} public ThreadList : array of tsearchportthread; // Thread array portList: TList; // Threads To use strings portindex: integer; // Positive port number Maxport, minport: integer; // Save the maximum and minimum port number Variables ADDR : Tsockaddr; // About: string; / / About StopThread: boolean; // Stop thread tag
{Public declarations} END;
Var Form1: TFORM1;
IMPLEMENTATION
{$ R * .dfm}
{============================== Custom function ============================================================================================================================================================================================== ==============} // ==== Start scan ==== procedure tform1.search_st (); vari, j: integer; address: dword; beginTry // detection Some -Address: = HostNameToip (PCHAR (IP.TEXT)); // Detects if IP is valid! If (address = inaddr_none) Then Begin showMessage ('Enter IP, domain name is invalid or network!'); Exit; ;
If Maxthread.Value <2 Then Begin // Detection Thread SHOWMESSAGE (') between 2-300!'); exit;
Maxport: = start (port2.text); // Maximum port number minport: = start (port1.text); // Minimum port number PortIndex: = minport;
If Minport> Maxport The Begin ShowMessage ('[Start Port] cannot be greater than the value of [end port]!'); exit; end; // port range detection if (Minport <1) or (MINPORT> 65535) OR (MAXPORT < 1) OR (MAXPORT> 65535) THEN BEGIN SHOWMESSAGE ('Input value exceeds the specified range!' # 13 # 10 'numerical range: 1-65535'); exit; end; // ------ Scan part ------- Search.caption: = 'Stop Scan'; Search.tag: = 1; AddcomboBox (IP); // Add IP or domain name to the list! m1.Lines.clear; m1.Lines.Add ( 'Is scanning:' ip.text # 13 # 10 '[port] | [Description] # 13 # 10' ---------------------- --------------- '); m1.Update; setlength; // Create Maxthread.Value Threaded array if (length (threadlist)> 1) THEN J: = Length (threadlist) -1; if (maxport-minport) For i: = 0 to j Do begin addr.sin_family: = afd_addr.s_addr: = address; // address addr.sin_port: = htons (portindex); // port ThreadList [I]: = Tsearchportthread.create (m1, addr); // Create thread 1 threadlist [i] .onterminate: = threaddone; // The thread is processed after processing PortList.Add (Threadlist [i]); // Add the thread to portlist sb1.panels [0] .text: = format ('Scanned Port:% s', [INTOSTR (PortIndex)]); PortIndex: = PortIndex 1; End; // Error Processing code ExceptshowMessage ('Error!'); End; end; / / ===== end ========== thread exit code ====== procedure TFORM1.THREADDONE (Sender: TOBJECT); Varindex: Integer; Begintry IF (portindex> = maxport) and (stopthread = false) THEN BEGIN Searchok (); stopthread: = true; exit; end; if (portindex> maxport) or (stopthread = true) instrument; Index: = portlist.indexof (sender); // Find the thread object portlist.delete (INDEX) in Filst; Addr.sin_port: = htons (portindex); // Port threadlist [index]: = tsearchportthread.create (m1, addr); // Create thread1threadList [index] .onterminate: = threaddone; // thread processing after processing The thing portlist.add (threadlist [index]); // add thread to portListsb1.panels [0] .text: = 'has been scanned port:' INTOSTR (portindex); portindex: = portIndex 1; except // error Process // sb1.panels [0] .text: = 'program error [thread exit]!'; End; end; // ===== End ===== / / ==== Stop scan ===== procedure tform1.search_exit; vari: integer; temp: tsearchportthread; begintry m1.lines.add ('[user interrupt]'); sb1.panels [0] .text: = 'Is closing the thread .....'; for i: = 0 to portlist.count - 1 dobegin Temp: = portList.items [i]; temp.terminate; // End thread end; searchok (); // Display start scan stopthread: = true; // stopthread is true, to stop scanning Except // error handling // sb1.panels [0] .text: = 'program error [stop scanning]!'; end; end; // ===== end ===== // ==== = Scan is completed =============================================================================================== .Text: = 'scan completion'; m1.Lines.add ('---------------------------------------------------------------------------------------------------------------------------------------------------------------- --- '# 13 # 10' Scan Complete! '); Portlist.free; // Release PortList's memory space end; // ==== end ==== / / ==== Domain name, IP automatically turn to IP ==== Function TFORM1.HOSTNAMETOIP (S: String): DWORD; constinaddr_none = $ fffffff; varhost: phostent; address: dword; beginaddress: = inet_addr (pchar) S)); if (Address = INADDR_NONE) then begin Host: = GetHostByName (Pchar (S)); if Host = nil then begin hostNameToIP: = INADDR_NONE; exit; end else begin hostNametoip: = longint (pointer (Host ^ .h_addr_list ^) ^); Exit; end; endelse begin hostnametoip: = address; exit; end; end; // ==== end ==== / / ==== Automatically add content in the contents of the ComboBox control to the list ======! Procedure TForm1.AddcomboBOX (CB: TcomboBox); Vara: Integer; Begin A: = Cb.Items.indexof (Cb.Text); if A = -1 Then Cb.Items.Add (Cb.Text); End; // == End === / / ◎ ◎ ◎ Custom function end ◎ ◎ ◎ {============================= 控 ======================================================================================================================================================================= =============} / / ==== Search button ===== procedure tform1.searchclick (sender: TOBJECT); beginif search.tag = 0 THEN BEGIN portList: = tList.create; // Create TSTRING SEARCH_ST (); // Start StopThread : = false; // Stop Up; // stop End; End; // =========== / / ======================================================================================================================================= === Procedure TFORM1.FormCreate (Sender: TOBJECT); Varwsadata: TWSADATA; Beginwsastartup (MakeWord (2, 0), WSADATA); // About: = m1.text; // Save the profile content into the About variable; / / ===== End ===== / / ===== form exit ====== procedure tForm1.FormDestroy (sender: TOBJECT); begin // portlist.free; // Release portlist's memory space wsacleanup; // end; // === == End ====== / / ===== When the 'Enter', the 'ESC' button is the action ====== Procedure TFORM1.FORMKEYPRESS (Sender: Tobject; VAR Key: char); beginif (key = # 13) and (Search.tag = 0) THEN SearchClick (Sender); // Start Scan IF (Key = # 27) and (search.tag = 1) Then SearchClick (Sender); // Stop scan end; // ==== = End ====== / / ==== About ===== Procedure TFORM1.AboutButtonClick (Sender: TOBject); BeginshowMessage (About 'Address: Shijing Sun Village, Pingshan Town, Longgang District, Shenzhen) # 10 # 13 # 10 ' Note : '# 13 # 10 ' This software is free software, the consequences of using this software to generate '# 13 # 10 ', I don't assume any responsibility! '# 13 # 10 # 13 # 10 ' This program is used Delphi write, if you want source code, please contact the author! '# 13 # 10 # 13 # 10 ' Production Time: August 27, 2002 '); // m1.text: = About; end; // == == End ===== / / ====== Window center ====== Procedure TFORM1.FORMSHOW (Sender: TOBJECT); Begin Left: = (Screen.Width - Width) DIV 2; Top: = (Screen.Height - Height) Div 2; End; / / ===== end ==== // ◎ ◎ control part end ◎ ◎ ◎ End. _____________________________________________________________________________________________________________________________________________________________________ If you write a scanner, don't connect directly. You should use another link method, otherwise your trace is discovered by others. For example, use SYS scan or FIN scan: I give you asynchronous socket API code: Unit unit1; interfaceuses Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, Winsock, ExtCtrls Const wm_socket = wm_user 1; // Socket message type TForm1 = class (TForm) Button1: TButton; Edit1: TEdit; Panel1: TPanel; Memo1: TMemo; procedure FormCreate (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure Button1Click (Sender: TObject); procedure Button2Click ( Sender: TOBJECT); Procedure Button3Click (Sender: Tobject); Private SockHD: Integer; // Socket Handle Serv_addr: TsockAddr; // Domestic Procedure Sockevent; Message WM_Socket; // Handling Cocket Message Procedure DSPMSG (MSG: String); // Display Information {Private Declarations} PUBLIC {Public Declarations} FORM1: TFORM1; Implementation {$ r * .dfm} Function lookup_hostname (const hostname: string): longint; // Translate the domain name into IP address VAR Remotehost: phostent; (* no, don't free it! *) ip_address: longint; begin ip_address: = - 1; Try if Hostname = '' Then Begin! *) lookup_hostname: = IP_ADDRESS; EXIT; END ELSE BEGIN IP_ADDRESS: = Winsock.inet_Addr (Pchar (Hostname)); (* try a xxx.xxx.xxx.xx first *) if ip_address = SOCKET_ERROR then begin RemoteHost: = Winsock.GetHostByName (PChar (hostname)); if (RemoteHost = NIL) or (RemoteHost ^ .h_length <= 0) then begin lookup_hostname: = ip_address; EXIT; (* host not found * ) end else ip_address: = longint (pointer (RemoteHost ^ .h_addr_list ^) ^); end; end; except ip_address: = - 1; end; lookup_hostname: = ip_address; end; procedure TFOrm1.DspMsg (msg: string); begin Memo1.Lines.Add (MSG '...'); if Memo1.Lines.count> 200 Then Memo1.Lines.Delete (0); END; Procedure TForm1. Sockevent (VAR Msg: TMESSAGE); // Handling Socket Message Begin Case Msg.lParam of FD_READ: Begin // Identifies to read data, of course, I have already linked DSPMSG ('can read data'); // Do where you want do end; FD_WRITE: Begin Dspmsg ('can send data'); // do what you want do end; FD_ERROR: Begin Dspmsg ('An error'); // If you are a client, it should be connected, that is, the port does not open END; FD_close: Begin DspMsg ('server disconnect "); // The other party closes the connection END; FD_CONNECT: BEGIN DSPMSG ('linkage server'); / / means the other party port opens; FD_ACCEPT: BEGIN DSPMSG ('Receives a request'); // This message can only appear end; End; end; procedure TForm1.FormCreate (Sender: TObject); var wsaData: TwsaData; begin // start winsock dynamic link libraries if WSAStartup (makeword (2,2), wsaData) <> 0 then begin messagebox (application.handle, 'not start winsock Dynamic connection library! ',' Warning ', MB_OK or MB_APPLMODAL OR MB_ICONWARNING); Application.Terminate; end; end; procedure tform1.formDestroy (sender: TOBJECT); begin // Turn off DLL WSACLANUP; END; procedure TForm1.Button1Click (Sender: TObject); begin Sockhd: = socket (AF_INET, SOCK_STREAM, 0); // Create a socket handle if Sockhd <0 then begin messagebox (application.handle,, 'warned' 'Can not create a handle!' , MB_OK or MB_APPLMODAL or MB_ICONWARNING); exit; end; Serv_addr.sin_addr.s_addr: = lookup_hostname (edit1.Text); // hostname Serv_addr.sin_family: = PF_INET; Serv_addr.sin_port: = htons (23); // any Port you want to connect if WSAAsyncSelect (Sockhd, Form1.handle, WM_SOCKET, FD_ACCEPT or FD_CONNECT or FD_CLOSE or FD_READ or FD_WRITE) = SOCKET_ERROR then begin messagebox (application.handle, 'Can not create a handle!', 'Warning', MB_OK or MB_APPLMODAL or MB_ICONWARNING); exit END; // Asynchronous Socket Connect (SockHD, Serv_addr, SIZEOF (Serv_Addr)); // Connection, the result will process the end in the previous processing function; I believe you should meet your requirements.
