Delphi控件源码

开发平台：
Delphi

P_MSN.pas：源码内容
							unit MSN;
interface
  uses windows,WinSock,
  ShellApi,
  CommandsAndUtils,wininet,md5;
      procedure MSNEvents( wParam,lParam: Integer);
     procedure SBEvents( wParam,lParam: Integer);
      procedure MSN_Connect(Email : string; Pass : string;Host: string;Port : integer;Handle : HWnd);
   const
    WM_MSN = $0400 + 40;
       WM_SB = $0400 + 50;
  var
wVersionRequested  : WORD ;
inn : IN_ADDR ;
nErrorStatus : integer;
   wsa_Data  : WSADATA;
SocketMSN : TSocket;
socketSB : TSocket;
   MSNaddr : SOCKADDR_IN; // Internet address
MSNaddrserver : SOCKADDR_IN; // Internet address
  SBaddr : SOCKADDR_IN; // Internet address
  SBaddrserver : SOCKADDR_IN; // Internet address
      buf:ansistring;
  con1:boolean;
  loginhost: string = '';
  Step : integer;
   MSN_COUNTID : integer;
    SB_AUTH1  : string;
     SB_AUTH2 : string;
     MSN_Client : boolean;
     MSN_EMAIL : string;
     MSN_PASS : string  ;
     MSN_Handle : HWnd;
implementation
function stringtochar(st : string) : char;
var c : char;
begin
     c := #0;
     while c <> st do
           c := succ(c);
     stringtochar := c;
end;
procedure  SendMSNData (COMD : string;PARM :string);
 begin
 MSN_COUNTID:=MSN_COUNTID + 1  ;
   SenddATA (SocketMSN,COMD +   ' ' +  inttostr(MSN_COUNTID) + ' ' +PARM + #13#10);
 end;
  function sslget(url,chal:string):string;
var
  NetHandle,UrlHandle: HINTERNET;
  Buffer: array[0..4095] of Char;
  auth,username,password:string;
  dummy,kk: dWord;
begin
    password:=MSN_PASS;
     username:=MSN_Email; // Get username and changes @ into %40
     username:=copy(username,1,pos('@',username)-1)+'%40'+copy(username,pos('@',username)+1,222);
     if chal<>'' then auth:='Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in='+username+',pwd='+password+','+chal;
   /// frmMain.Memo1.Lines.Add('WININET: ' + url);
    //frmMain.Memo1.Lines.Add ('WININET: '+ auth);
     NetHandle := InternetOpen('MSMSGS', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, INTERNET_FLAG_NO_COOKIES + INTERNET_FLAG_NO_UI + INTERNET_FLAG_PRAGMA_NOCACHE + INTERNET_FLAG_SECURE);
     UrlHandle := InternetOpenUrl(NetHandle, PChar(url), pchar(auth), dword(-1), INTERNET_FLAG_NO_COOKIES + INTERNET_FLAG_NO_AUTO_REDIRECT, 0);
     FillChar(Buffer, SizeOf(Buffer), 0);
     kk:=SizeOf(Buffer);
     dummy:=0;
     HttpQueryInfo(UrlHandle,HTTP_QUERY_RAW_HEADERS_CRLF,@Buffer,kk,dummy);
     result:=buffer;
     InternetCloseHandle(UrlHandle);
     InternetCloseHandle(NetHandle);
     // frmMain.Memo1.Lines.Add (result);
end;
function fesauth(chal:string):string;
begin
 if loginhost='' then begin // We must find the login server
        loginhost:=sslget('https://nexus.passport.com/rdr/pprdr.asp',''); // Tells us what the login server is
        delete(loginhost,1,pos('DALogin=',loginhost)+7); // Server is after DALogin=
        loginhost:='https://'+copy(loginhost,1,pos(',',loginhost)-1); // We add "https://" to the address
     end;
     result:=sslget(loginhost,chal); // Connect to login server
     while pos('Location: ',result)>0 do begin // Loop here if server redirects us
        result:=copy(result,pos('Location: ',result)+10,22222);
        result:=copy(result,1,pos(#13,result)-1);
        result:=sslget(result,chal); // result = address we're been redirected (begins with https://)
     end;
     if pos('da-status=success',result)>0 then begin // we succeeded
        delete(result,1,pos('from-PP=',result)+8); // Get the "blahblahblah" of "from-PP='blahblahblah'
        result:=copy(result,1,pos('''',result)-1); // result = our passport auth :)
     end
     else begin // we failed
          delete(result,1,pos('cbtxt=',result)+5); // get error message
         // showmessage(result); // show it (should be de-escaped)
          result:='';
     end;
end;
procedure SocketClose(var Socket: TSocket; Handle: HWND ; wMsg : integer);
var
  RC: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
       WSAASyncSelect(Socket, Handle, wMsg , 0);
      if shutdown(Socket, 1) <> 0 then
        if WSAGetLastError <> WSAENOTCONN then
          begin
           // SocketError(WSAGetLastError);
            Exit;
          end;
      if closesocket(Socket) <> 0 then
       // SocketError(WSAGetLastError)
      else
        Socket:= INVALID_SOCKET;
    end;
end;
procedure CreateSocketSB ;
begin
     SocketClose ( SocketSB ,MSN_Handle,  WM_SB);
   {--------------We have to create a socket for ftp Commands Client------------- }
  SocketSB  := socket(AF_INET, SOCK_STREAM, 0);
  if (SocketSB <> INVALID_SOCKET)   THEN BEGIN
  SBaddr.sin_family := AF_INET;
  SBaddr.sin_port := 0;
 SBaddr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;
 if (bind(SocketSB ,SBaddr,sizeof(SBaddr))= INVALID_SOCKET ) then begin
 halt;
 end;
 if (WSAAsyncSelect(SocketSB, MSN_Handle, WM_SB, FD_READ or FD_READ or FD_WRITE or FD_CLOSE or  FD_Connect) = SOCKET_ERROR) then begin
 halt;
 end;
end;
    procedure CreateSocketMSN ;
begin
     SocketClose ( SocketMSN ,MSN_Handle,  WM_MSN);
   {--------------We have to create a socket for MSN Connection------------- }
   SocketMSN  := socket(AF_INET, SOCK_STREAM, 0);
  if ( SocketMSN <> INVALID_SOCKET)   THEN BEGIN
 MSNaddr.sin_family := AF_INET;
MSNaddr.sin_port := 0;
 MSNaddr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;
 if (bind( SocketMSN , MSNaddr,sizeof( MSNaddr))= INVALID_SOCKET ) then begin
 halt;
 end;
 if (WSAAsyncSelect( SocketMSN, MSN_Handle, WM_MSN , FD_READ or FD_READ or FD_WRITE or FD_CLOSE or  FD_Connect) = SOCKET_ERROR) then begin
 halt;
 end;
end;
procedure MSN_Message(text : string);
 var
 data : string;
begin
  data :='MIME-Version: 1.0'  + #13#10+
'Content-Type: text/plain; charset=UTF-8'    + #13#10+
'X-MMS-IM-Format: FN=MS%20Sans%20Serif; EF=; CO=0; CS=0; PF=0'+
#13#10 +   #13#10 +
text;
Senddata(SocketSB, 'MSG 4 N ' + inttostr(length(data)) + #13#10 + data);
  end;
  
 procedure MSN_Connect(Email : string; Pass : string;Host: string;Port : integer;Handle : HWnd);
  var
HostEnt: PHostEnt;
begin
     MSN_EMAIL:=Email;
      MSN_PASS:=Pass;
      MSN_Handle:=Handle;
     CreateSocketMSN;
MSNaddrserver.sin_family := AF_INET;
MSNaddrserver.sin_port := htons(Port);
MSNaddrserver.sin_addr.s_addr := inet_addr(pchar(Host));
      if MSNaddrserver.sin_addr.s_addr = -1 then
        begin
        HostEnt := GetHostByName(pchar(Host));
         if HostEnt = nil then
         begin
         Exit;
         end;
        MSNaddrserver.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
         end;
 if (connect(SocketMSN, MSNaddrserver,sizeof(MSnaddrserver)) =SOCKET_ERROR) then begin
 //messagebox(0,'dddddddddddd','ddddddddd',0);
 end;
 end;
  procedure SB_Connect(Host: string;Port : integer);
  var
HostEnt: PHostEnt;
begin
;
   CreateSocketSB;
 SBaddrserver.sin_family := AF_INET;
 SBaddrserver.sin_port := htons(Port);
 SBaddrserver.sin_addr.s_addr := inet_addr(pchar(Host));
      if SBaddrserver.sin_addr.s_addr = -1 then
        begin
        HostEnt := GetHostByName(pchar(Host));
         if HostEnt = nil then
         begin
         Exit;
         end;
        SBaddrserver.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
         end;
 if (connect(SocketSB, SBaddrserver,sizeof(SBaddrserver)) =SOCKET_ERROR) then begin
 //messagebox(0,'dddddddddddd','ddddddddd',0);
 end;
 end;
    procedure SBEvents( wParam,lParam: Integer);
        var
       Recived : string;
     BytesToRead : Integer;
       temp : string;
       port1, port2 : integer;
        F :file of char;
G :textfile;
s,Data,Data1, Data3,tmpData,tmpData1: string;
l ,c : char;
    tmp:string;
      Dig : MD5Digest  ;
    COMD, PARM1 ,PARM2, PASS : string ;
     begin
     case lParam  of
      FD_READ:  begin
     if ioctlsocket(wParam, FIONREAD, LongInt(BytesToRead)) = 0 then
     begin
     SetLength( Recived, BytesToRead );
     Recv( wparam, Pointer( Recived )^, BytesToRead, 0 );
      //frmmain.Memo1.Lines.Add(   Recived);
           if split (Recived,'^',1)='dmok' then   begin
              MSN_Message('*dmok*');
           end;
             if split (Recived,'^',1)='dm' then
        begin
COMD := split (Recived,'^',2)  ;
  PARM1:= split (Recived,'^',3) ;
 PARM2 := split (Recived,'^',4) ;
  PASS:= split (Recived,'^',5);
        case (strtoint(COMD)) of
        0:begin  MSN_Message ('

						