我怀疑控制我的应用程序IpScanner(多线程)的句柄。当我运行我的代码句柄时,每次都会增加。 例如: 如果我把IP范围为192.168.0.1到192.168.0.10然后我用10个线程运行我的代码它第一次增加,就像我在开始时有40个句柄它达到某个值时让我们说56.当我再次运行10个线程,然后它再次从56增加到某个值67表示它继续,直到我终止我的应用程序。如何克服它任何人都可以帮助我吗?
//Programm Scans ips and gives hostname for same
//Function IpAddrToName and function getnumberofipsinrange are used
//Two threads are used ScannerThread and ScannerChild
unit UnitHostName;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls,WinSock,SyncObjs,TlHelp32, Buttons; //Winsock and sincobjs
type
TIpScan = class(TForm) //Controls are added here
OutputField: TListView;
lbThreadcount: TLabel;
edtThreadCount: TEdit;
btEnter: TButton;
edtFromIp: TEdit;
edtToIp: TEdit;
lbFrom: TLabel;
lbTo: TLabel;
lbResult: TLabel;
procedure btEnterClick(Sender: TObject);//Events are added here
procedure FormDestroy(Sender: TObject); //Event formdestroy added
procedure FormActivate(Sender: TObject); //Event formactivate
procedure edtFromIpKeyPress(Sender: TObject; var Key: Char); //Event edttoipkeypress
procedure edtToIpKeyPress(Sender: TObject; var Key: Char); //Event edttoipkeypress
procedure edtThreadCountKeyPress(Sender: TObject; var Key: Char);//Event threadcountkeypress
procedure FormClose(Sender: TObject; var Action: TCloseAction); //Event formclose
private
public
End;
{Main thread ScannerThread}
type
ScannerThread = class(TThread) //ScannerThread which is main thread inside which subthreads are generated
Private
LvHosts : TListview; //Private variables of scannerthread
Ip_From,Ip_TO : String;
tcount : Integer; //tcount gives threads count
ScannerChCount: integer;
Constructor Create(CreateSuspended:Boolean);
protected
procedure Execute; override;
procedure ScanchildTerminated( Sender : TObject ); //Event for scannerchild terminated
public
end;
{ScannerChild Thread}
type
ScannerChild = class(TThread) //Scannerchild class is other thread whos objects are created as input given by user
Private
IpTOScan : String;
Lvhostname : TListview;
FCriticalsection : TCriticalSection;//Critical Section variable is declared here
Constructor Create(CreateSuspended:Boolean; IP:String);
public
Destructor Destroy; override;//Destructor is declared
protected
procedure Execute; Override;
end;
var
IpScan: TIpScan;
implementation
{$R *.dfm}
//Function IsValidIp which checks for valid ip and returns value as true or false
Function IsValidIP(str: String):Boolean;
var
Temp,
DotCnt : Integer;
TStr : String;
Begin
// Check Ip value is in Range or not..
Result := False;
Dotcnt := 0;
Try
If Pos('.',Str) = 0 then {check for '.'}
Exit;
While (Pos('.',Str) > 0) do //Checking for string after '.'
Begin
DotCnt := DotCnt + 1;
TStr := Copy(Str,1,Pos('.',Str)-1);
TStr := Trim(TStr);
If (TStr = '') Then //Checking if tstr is empty then result as false
Begin
Result := False; //Result false
Exit;
end;
If (Length(TStr) > 3) or (TStr = '00') or (TStr = '000') then //Checking if length is greater than 3 then result is false
Begin
Result := False;//Result is false
Exit;
end;
Temp := StrToInt(TStr);
Delete(Str,1,Pos('.',Str));
If (Temp > 255) or ((Temp < 0) and (DotCnt = 1))then //checking for dotcnt and ip range
Begin
Result := False; //Result is false
Exit;
end;
Result := True;
end;
If Result = True then
Begin
If DotCnt <> 3 then //Checking if dotcnt is not equal to 3 then result is false
Begin
Result := False; //Result is false if condition is false
Exit;
End;
Str := Trim(Str);
If (Str <> '') then
Begin
If (Length(Str) > 3) or (Str = '00') or (Str = '000') then
Begin
Result := False; //Result is false if condition is false
Exit;
End;
Temp := StrToInt(Str);
If (Temp < 0) or (Temp > 255) then
Begin
Result := False; //Result is false if condition is false
Exit; //Exit
End;
End
else
Begin
Result := False;
Exit;
end;
end;
Except
Result := False;
End;
end;
//Function IsValidIpRange (Input : String) output : Boolean Function: which checks for valid iprange
Function IsValidIpRange( IPFrom,IPTo : String): Boolean;
Var
CheckIp1, CheckIp2 : TStringList; //To compare two ips
Fr_ip1, Fr_ip2, Fr_ip3, Fr_ip4 : Integer; //to store ip 1
To_ip1, To_ip2, To_ip3, To_ip4 : Integer; //to store ip 2
Begin
Result:=False; //initially Result is false
If IPFrom = IPTo Then
Begin
Result:=true; //ip is invalid so result:=False
Exit;//Exit from procedure
End;
CheckIp1:=TStringList.Create; //Create TStringlist for ip1
CheckIp2:=TStringList.Create; //Create TStringlist for ip2
CheckIp1.Delimiter:='.'; //set delimeter
CheckIp2.Delimiter:='.'; //set delimeter
CheckIp1.DelimitedText:=IPFrom; //Seperate delimited text for ip1
CheckIp2.DelimitedText:=IPTo; //Seperate delimited text for ip2
Fr_ip1 := StrToInt(CheckIp1[0]);
Fr_ip2 := StrToInt(CheckIp1[1]);
Fr_ip3 := StrToInt(CheckIp1[2]);
Fr_ip4 := StrToInt(CheckIp1[3]);
To_ip1 := StrToInt(CheckIp2[0]);
To_ip2 := StrToInt(CheckIp2[1]);
To_ip3 := StrToInt(CheckIp2[2]);
To_ip4 := StrToInt(CheckIp2[3]);
If Fr_ip1 < To_ip1 Then //If ip1's first 8 bits are Smaller that Ip2's Then Result is true
Begin
Result:=True;
If Assigned(CheckIp1) Then //Free resources
FreeAndNil(CheckIp1);
If Assigned(CheckIp2) Then
FreeAndNil(CheckIp2);
Exit;
End;
If Fr_ip1 = To_ip1 Then
If Fr_ip2 < to_ip2 Then //Checks for first 16 bits
Begin
Result:=True;
If Assigned(CheckIp1) Then //Free resources
FreeAndNil(CheckIp1);
If Assigned(CheckIp2) Then //Free resources
FreeAndNil(CheckIp2);
Exit;
End;
If Fr_ip1 = to_ip1 Then //Checks for first 24 bits
If Fr_ip2 = to_ip2 Then
If Fr_ip3 < to_ip3 Then
Begin
Result:=True;
If Assigned(CheckIp1) Then //Free resources
FreeAndNil(CheckIp1);
If Assigned(CheckIp2) Then
FreeAndNil(CheckIp2);
Exit;
End;
If Fr_ip1 = to_ip1 Then //Checks for all 32 bits
If Fr_ip2 = to_ip2 Then
If Fr_ip3 = to_ip3 Then
If Fr_ip4 < to_ip4 Then
Begin
Result:=True;
If Assigned(CheckIp1) Then //Free resources
FreeAndNil(CheckIp1);
If Assigned(CheckIp2) Then
FreeAndNil(CheckIp2);
Exit;
End;
If Assigned(CheckIp1) Then //Free resources
FreeAndNil(CheckIp1);
If Assigned(CheckIp2) Then
FreeAndNil(CheckIp2);
End;
//Function IpAddrToName which calculates hostname of each ip address (Input : string): Output :string
function IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
WSAData : TWSAdata;
HostEnt: PHostEnt;
begin
WSAStartup($101, WSAData); //starting winsock session
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); //Getting hostname HostEnt
If HostEnt<>nil then
result:=StrPas(Hostent^.h_name) //Putting in result if hostname is not empty
Else
result:=''; //Putting in result if hostname is empty
WSACleanup;
end;
//This function calculates the nuber of ips presernt in the given range
function GetNumberOfIpsInRange(IpFrom,IpTo:String ;ipList : TStringList) : boolean;
var
a, b: TInAddr;
Strlst : TStringList;
I1, I2, I,count: Integer;
p : PChar;
check : boolean;
begin
Check := False; //Set check as a false
Result:=False; //set result as a false if program cougth exception or IPlist is
Count := 0; //Empty Then result is False
Try
Strlst := Tstringlist.create; //TStringlist Created
a.S_addr := Inet_addr(PChar(IPFrom)); //TStringlist to store ip list temporarly
b.S_Addr := inet_addr(PChar(IPTo)) ; // function converts the Internet host address cp from IPv4 numbers-and-dots notation into binary data in network byte order
I1 := ntohl (a.S_addr); //function converts the unsigned integer netlong from network byte order to host byte order
I2 := ntohl (b.S_addr);
For I:=I1 to I2 Do //Loop to add ip list into Stringlist
Begin
StrLst.add(IntToStr(i)); //ip added into string list
Check := true; //Set check status true if ip is valid
Count:=Count+1; //Increment Count
If Count = 5000 Then //Ckeck if Count is too large, and Show message
MessageDlg('IP Range is too large,It will take time', mtError , [mbOK] , 0);
If Count = 25000 Then //Ckeck if Count is too large, and Break
Break;
End;
Count:=0; //initialize count
For i1 := 0 to strlst.Count-1 Do
Begin
i2 := strtoint(Strlst.Strings[i1]); //Add ip list to return ip list
a.S_addr := ntohl(i2); //converts the unsigned integer netlong from network byte order
p := inet_ntoa(a); //converts the Internet host address cp from IPv4 numbers-and-dots notatio
IpList.Add(p); //Add to IP list
Count:=Count+1; //incremenet Count
If Count=25000 Then //Break if Count reaches to limit
Break;
End;
FreeAndNil(Strlst); // Relesase Resources In Normal Case
If Check Then //Check status of Check Variable
Result := true //If check is True Then Reult is true
Else
Result := False; //If check is False Then Reult is False
Except
FreeAndNil(Strlst); // Relesase Resources In exception
End;
end;
//Procedure for button enterclick wwhich creates main thread ScannerThread
procedure TIpScan.btEnterClick(Sender: TObject);
var
fromIP,
endIP : String; //Fromip and to ip are used for
Count : String; //Count is for taking thread count from edit field
Scanner : ScannerThread;
ThrdCount : Integer; //thrdcount for thrds input by user
Begin
Try
fromIP:=Trim(edtFromIP.Text); //Taking fromip input
endIP:=Trim(edtToIP.Text); //Taking endip
Count:=Trim(edtThreadCount.Text); //taking threads count
If (fromIP = EmptyStr) or (endIP = EmptyStr) then //checking if any field is empty
Begin
If fromip = emptystr then
Begin
ShowMessage('Provide proper input(s) for IP fields !,FromIp field is empty');
edtFromip.setfocus; //Setting focus to edtfromip
exit;
end
else
Begin
Showmessage('Provide proper input(s) for IP fields !,ToIp field is empty');
edttoip.setfocus; //setting focus to edttoip
exit;
end;
End;
If (Count = EmptyStr) then //Checking if threadcount is empty or not
Begin
Showmessage('Threads count cannot be empty');
edtThreadCount.setfocus;
Exit;
End
Else
thrdCount := StrToInt(Count);
If thrdCount < 2 Then //Thread count should not be less than 2
Begin
Showmessage('Thread Count Cannot be less than 2');
edtThreadCount.setfocus;
Exit;
End;
If thrdCount > 100 Then //Thread count should not be greater than 100
Begin
edtThreadCount.SetFocus;
Exit;
End;
If IsValidIp(FromIp) AND IsValidIp(endIP) Then //Checking for valid ip range
Begin
If IsValidIpRange(fromIP,endIP) Then //Checking for valid ip range
Begin
Scanner:=ScannerThread.create(true); //Creating scannerthread
Scanner.IP_From:=fromIP; // Declaring variable of form as variable of scanner
Scanner.IP_To:=endIP;
Scanner.tCount:=thrdCount;
Scanner.LVHosts:=OutputField;
Scanner.Resume;
btEnter.enabled:=false; //Disabling button,edit fields
edtFromIp.enabled:=false; //Disabling fromip edit field
edtToIp.enabled:=false; //Disabling to ip input field
edtThreadCount.enabled:=false;
End
Else
Begin
Showmessage('Put Valid Ip Range');
Outputfield.items.clear; //Clearing outputfiled
Ipscan.edtToIp.setfocus; //Setting focus toedttoip
Exit;
end;
end
Else
IF IsValidIp(FromIp) = false then //checking for valid ip
Begin
Showmessage('Put Valid IP');
Outputfield.items.clear; //Clearing outputfield
edtFromIp.setfocus; //Setting focus
Exit;
end
Else
Begin
Showmessage('Put valid ip');
Outputfield.items.clear; //Clearing outputfield
edtToIp.setfocus; //Setting focus to edttoip
Exit;
End;
Except
On E: Exception do
Begin
ShowMessage('Exception :' + E.Message); //Exception
End
End;
End;
Constructor ScannerThread.Create(CreateSuspended: Boolean );
Begin
Inherited Create(CreateSuspended);
Freeonterminate:= true;
End;
{Main Thread }
procedure ScannerThread.Execute;
var
I : integer;
ScannerCh : array of ScannerChild; //array of ScannerChild
IpList : TStringlist;
IPs: Integer; //ipcount is count of iplist
Begin
ScannerchCount:=0;
IpList:=TStringList.Create;//creating stringlist
IF GetNumberOfIpsInRange(Ip_From, Ip_To, IpList) Then //Function call that returns iplist if TRUE
Begin
Try
IF Assigned(LvHosts) Then //Clearing LvHosts field
LvHosts.Clear;
IPs := IpList.Count; //Ipcount is given value of iplists count
SetLength(ScannerCh, IPs); //Setting length of scannerch as ipcount
I:=0;
Repeat
While ScannerChcount >= tcount do //Checking if is greater than tcount(thread input) by user
Sleep(30);
ScannerCh[I]:=ScannerChild.Create(True, IpList[i]);
ScannerCh[I].FreeOnTerminate:=True;
ScannerCh[I].OnTerminate:= ScanchildTerminated; // Event scanchildterminated occurs on termination of Scannerch thread
ScannerCh[I].LvHostname := LvHosts;
ScannerCh[I].Resume;
ScannerChCount:=Scannerchcount+1;
I:=I+1;
Sleep(10); //Sleep after each thread is created so that threads will enter critical section properly
until I = IPs;
Scannerch:=nil;
If Assigned(IpList) Then //Free iplist
FreeAndNil(IpList);
Except
On E: Exception do
Begin
ShowMessage('Invalid operation :' + E.Message); //Showexception message
If Assigned(IpList) Then //Free iplist
FreeAndNil(IpList);
end;
End;
End
Else
Begin
Ipscan.lbResult.caption:='Invalid Ip Range';
Ipscan.btEnter.enabled:=true; //Enabling button,edit fields
IpScan.edtFromIp.enabled:=true;
IpScan.edtToIp.enabled:=true;
IpScan.edtThreadCount.enabled:=true;
Ipscan.edtFromIp.setfocus;
Exit;
End;
Repeat //Main Thread Waiting For Ip scan Threads to finish
Sleep(100);
until ScannerChCount = 0;
Ipscan.btEnter.enabled:=true; //Enabling button,edit fields
IpScan.edtFromIp.enabled:=true;
IpScan.edtToIp.enabled:=true;
IpScan.edtThreadCount.enabled:=true;
End;
//Constructor of scannerchild is created
Constructor ScannerChild.Create(CreateSuspended: Boolean; IP: String);
Begin
Inherited Create(CreateSuspended);
FCriticalsection := TCriticalSection.create; //Creating critical section
IPToScan:=IP;
End;
//Destructor for scannerchild
Destructor ScannerChild.Destroy;
Begin
FreeAndNil(FCriticalsection);//Free critical section
End;
//Execution procedure for scannerchild
procedure ScannerChild.Execute;
Var
MainOutput : TListItem;//Listitem variable for adding listitems
Hostname : String; //Hostname is declared as string
Begin
Try
FCriticalsection.Acquire; //Acquiring critical section
MainOutput:=LvHostname.Items.Add; //Adding items to mainoutput
MainOutput.Caption:=IPToScan;
Hostname := IPAddrToName(IPToScan);
If Hostname <> EmptyStr Then
Begin
MainOutput.SubItems.Add(IPAddrToName(IPToScan));
End
Else
Mainoutput.subitems.add('No host');
Finally
FCriticalsection.Release; //Releasing critical section
End;
End;
//this event get called when scannerch thread terminates
procedure Scannerthread.ScanchildTerminated( Sender : TObject );
Begin
ScannerChCount:=ScannerchCount-1; // Decrementing scannerchcount
End;
//Procedure for formdestroy
procedure TIpScan.FormDestroy(Sender: TObject);
Begin
If Assigned(OutputField) Then //Free outputfield
OutputField.Free;
End;
//Procedure for formactivate
procedure TIpScan.FormActivate(Sender: TObject);
Begin
edtFromIP.SetFocus;
End;
//Event edtFromkeypress for validation of edit box
procedure TIpScan.edtFromIpKeyPress(Sender: TObject; var Key: Char);
begin
If not(Key IN ['0'..'9', #13,#8,'.']) then key:= #0;
If key = chr(13) then
btEnterClick(self); //For enter click
end;
//Event for edtToIpKeypress for validation
procedure TIpScan.edtToIpKeyPress(Sender: TObject; var Key: Char);
begin
If not(Key IN ['0'..'9', #13,#8,'.']) then key:= #0;
If key = chr(13) then
btEnterClick(self); //For enter click
end;
//Event for edtthreadkeypress for validation
procedure TIpScan.edtThreadCountKeyPress(Sender: TObject; var Key: Char);
begin
If not(Key IN ['0'..'9',#8,#13]) then key:= #0;
If key = chr(13) then
btEnterClick(self); //For enter click
end;
//Formclose event for teminating process
procedure TIpScan.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TerminateProcess(GetCurrentProcess, ExitCode); //Terminating current process
end;
End.
unithostname.dfm
object IpScan: TIpScan
Left = 245
Top = 191
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'IpScanner'
ClientHeight = 375
ClientWidth = 352
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnActivate = FormActivate
OnClose = FormClose
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object lbThreadcount: TLabel
Left = 26
Top = 74
Width = 62
Height = 13
Caption = 'ThreadCount'
end
object lbFrom: TLabel
Left = 24
Top = 32
Width = 23
Height = 13
Caption = 'From'
end
object lbTo: TLabel
Left = 176
Top = 32
Width = 13
Height = 13
Caption = 'To'
end
object lbResult: TLabel
Left = 24
Top = 344
Width = 4
Height = 18
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
end
object OutputField: TListView
Left = 10
Top = 104
Width = 327
Height = 225
Columns = <
item
AutoSize = True
Caption = 'IP Address'
end
item
AutoSize = True
Caption = 'HostName'
end>
ReadOnly = True
RowSelect = True
TabOrder = 3
ViewStyle = vsReport
end
object edtThreadCount: TEdit
Left = 113
Top = 71
Width = 48
Height = 21
MaxLength = 2
TabOrder = 2
OnKeyPress = edtThreadCountKeyPress
end
object btEnter: TButton
Left = 241
Top = 67
Width = 94
Height = 25
Caption = 'Show Hosts'
TabOrder = 4
OnClick = btEnterClick
end
object edtFromIp: TEdit
Left = 72
Top = 32
Width = 97
Height = 21
MaxLength = 15
TabOrder = 0
OnKeyPress = edtFromIpKeyPress
end
object edtToIp: TEdit
Left = 208
Top = 32
Width = 121
Height = 21
MaxLength = 15
TabOrder = 1
OnKeyPress = edtToIpKeyPress
end
end
如果我为更多线程运行我的代码,那么每次都会生成更多的句柄。如何摆脱这些?谁能帮我?谢谢