Pelo que li, esta unit permite um aplicativo feito no Delphi usar os
protocolosdo Messenger

 
 
 []s

 Walter Alves Chagas Junior
 Projeto e desenvolvimento
 Telemont Engenharia 
 [EMAIL PROTECTED]
 Fone: (31) 3389-8215 Fax: (31) 3389-8200
 
 

> -----Mensagem original-----
> De: David Leão [mailto:[EMAIL PROTECTED]
> Enviada em: sexta-feira, 22 de outubro de 2004 17:51
> Para: [EMAIL PROTECTED]
> Assunto: Res: [delphi-br] Achei isso no Delphi3000
> 
> 
> 
> Do que se trata??
> 
> 
> 
> uma aplicação parecida com o messenger da microsoft??
> 
> []'s 
> 
>  
> 
> __________________________________________
> 
> David Leão Alves
> 
> Administrador de Banco de Dados
> 
> Governo do Estado do Amapá
> 
> Secretaria de Estado do Meio Ambiente - SEMA
> 
>  Av. Mendonça Furtado, 53 - Centro / Macapá-AP
> 
>  212-5318 - 212-5378
> 
>  212-5303
> 
>  [EMAIL PROTECTED] 
> 
>  www.sema.ap.gov.br 
> 
> -------Mensagem original-------
> 
>  
> 
> De: [EMAIL PROTECTED]
> 
> Data: 10/22/04 17:15:03
> 
> Para: '[EMAIL PROTECTED]'
> 
> Assunto: [delphi-br] Achei isso no Delphi3000
> 
>  
> 
> This is an implementation of the msn messenger protocol in 
> delphi it isnt
> 
> complete and in order to build it you will need the WSocket 
> package, most of
> 
> what is
> 
> presented here is a part of the specification (still not 
> enough to even make
> 
> a stripped down MSN Messenger clone).
> 
>  
> 
> The work you see here has its todos (most due to the fact 
> that I am simply
> 
> new to sockets programming), this article is based on works 
> of venkydude MSN
> 
> article and
> 
> a old version of KMerlin (an opensource msn messenger clone 
> for linux).
> 
>  
> 
> This is the second article I write on Instant Messaging (The 
> first one about
> 
> the yahoo protocol, something wich I have not been able to 
> complete due to
> 
> time
> 
> constraints (lot of work))
> 
>  
> 
> I am planning in updating this article As Soon As Posible and 
> I would like
> 
> some help, if you are interested (in helping me) contact me 
> at my email
> 
> address
> 
> ([EMAIL PROTECTED]) with the subject "YahooLib.pas" 
> (Without quotes, this
> 
> way I know it is about the msn/yahoo protocols)
> 
>  
> 
> So enough chat in here is the code:
> 
>  
> 
> <---------------------------------CODE------------------------
> --------------
> 
> -->
> 
>  
> 
>  
> 
> {GLOBAL TODO: IMPLEMENT LOCAL TODO's, cleanup, extend}
> 
> unit MSNMessenger;
> 
>  
> 
> interface
> 
>  
> 
> uses
> 
>   WSocket, MD5, Classes, SysUtils;
> 
>  
> 
> type
> 
>   TUserState = (
> 
>     usOnline,  // you are online
> 
>     usBusy,    // Actually busy
> 
>     usBRB,     // Be Right Back
> 
>     usAway,    // Away
> 
>     usOnPhone, //On Phone
> 
>     usLunch,   //Lunch
> 
>     usHidden,   //Hidden
> 
>     usOffline  //Offline
> 
>     );
> 
>  
> 
>   TMSNMessenger = class(TComponent)
> 
>   private
> 
>     FConnected: Boolean;
> 
>     FUserName: String;
> 
>     FPassword: String;
> 
>     FFriendlyUserName: String;
> 
>     FLog: TStrings;
> 
>     FFriendlyNameChange: TNotifyEvent;
> 
>     FState: TUserState;
> 
>     function GetHost: String;
> 
>     procedure SetHost(const Value: String);
> 
>     function GetPort: String;
> 
>     procedure SetPort(const Value: String);
> 
>     procedure SetUserName(const Value: String);
> 
>     procedure SetPassWord(const Value: String);
> 
>     function GetFriendlyUserName: String;
> 
>     procedure SetFriendlyUserName(const Value: String);
> 
>     procedure SetState(const Value: TUserState);
> 
>   protected
> 
>     FSocket: TWSocket;
> 
>     FTrialID: Integer;
> 
>  
> 
>     procedure SendVER;
> 
>     procedure ReceiveSYN;
> 
>  
> 
>     procedure SocketWrite(const AString: String);
> 
>     procedure LogWrite(const Data: String);
> 
>     procedure ProcessCommand(const ACommand: String);
> 
>     procedure SocketDisconnect(Sender: TObject; Error: Word);
> 
>     procedure SocketDataAvailable(Sender: TObject; Error: Word);
> 
>     procedure SocketConnect(Sender: TObject; Error: Word);
> 
>  
> 
>     procedure TriggerFriendlyNameChange; dynamic;
> 
>   public
> 
>     constructor Create(AOwner: TComponent); override;
> 
>     destructor Destroy; override;
> 
>  
> 
>     procedure Login;
> 
>     procedure Logoff;
> 
>   published
> 
>     property Host: String read GetHost write SetHost;
> 
>     property Port: String read GetPort write SetPort;
> 
>     property UserName: String read FUserName write SetUserName;
> 
>     property PassWord: String read FPassword write SetPassWord;
> 
>     property FriendlyUserName: String read GetFriendlyUserName write
> 
> SetFriendlyUserName;
> 
>     property Connected: Boolean read FConnected;
> 
>     property Log: TStrings read FLog write FLog;
> 
>     property FriendlyNameChange: TNotifyEvent read 
> FFriendlyNameChange write
> 
> FFriendlyNameChange;
> 
>     property Status: TUserState read FState write SetState;
> 
>   end;
> 
>  
> 
> implementation
> 
>  
> 
> uses windows;
> 
>  
> 
> const RealState: array[TUserState] of String =
> 
>   ('CHG %d NLN', 'CHG %d BSY', 'CHG %d BRB', 'CHG %d AWY', 
> 'CHG %d PHN',
> 
> 'CHG %d LUN',
> 
>    'CHG %d HDN', 'CHG %d FLN' );
> 
>  
> 
> type
> 
>   CharSet = Set of char;
> 
>  
> 
> function UTF8ToAnsi(x: string): ansistring;
> 
>   { Function that recieves UTF8 string and converts
> 
>     to ansi string }
> 
> var
> 
>   i: integer;
> 
>   b1, b2: byte;
> 
> begin
> 
>   Result := x;
> 
>   i := 1;
> 
>   while i <= Length(Result) do begin
> 
>     if (ord(Result[i]) and $80) <> 0 then begin
> 
>       b1 := ord(Result[i]);
> 
>       b2 := ord(Result[i + 1]);
> 
>       if (b1 and $F0) <> $C0 then
> 
>         Result[i] := #128
> 
>       else begin
> 
>         Result[i] := Chr((b1 shl 6) or (b2 and $3F));
> 
>         Delete(Result, i + 1, 1);
> 
>       end;
> 
>     end;
> 
>     inc(i);
> 
>   end;
> 
> end;
> 
>  
> 
> function AnsiToUtf8(x: ansistring): string;
> 
>   { Function that recieves ansi string and converts
> 
>     to UTF8 string }
> 
> var
> 
>   i: integer;
> 
>   b1, b2: byte;
> 
> begin
> 
>   Result := x;
> 
>   for i := Length(Result) downto 1 do
> 
>     if Result[i] >= #127 then begin
> 
>       b1 := $C0 or (ord(Result[i]) shr 6);
> 
>       b2 := $80 or (ord(Result[i]) and $3F);
> 
>       Result[i] := chr(b1);
> 
>       Insert(chr(b2), Result, i + 1);
> 
>     end;
> 
> end;
> 
>  
> 
> Function  ExtractWord(N:Integer;S:String;WordDelims:CharSet):String;
> 
> Var
> 
>   I,J:Word;
> 
>   Count:Integer;
> 
>   SLen:Integer;
> 
> Begin
> 
>   Count := 0;
> 
>   I := 1;
> 
>   Result := '';
> 
>   SLen := Length(S);
> 
>   While I <= SLen Do Begin
> 
>     {preskoc oddelovace}
> 
>     While (I <= SLen) And (S[I] In WordDelims) Do Inc(I);
> 
>     {neni-li na konci retezce, bude nalezen zacatek slova}
> 
>     If I <= SLen Then Inc(Count);
> 
>     J := I;
> 
>     {a zde je konec slova}
> 
>     While (J <= SLen) And Not(S[J] In WordDelims) Do Inc(J);
> 
>     {je-li toto n-te slovo, vloz ho na vystup}
> 
>     If Count = N Then Begin
> 
>       Result := Copy(S,I,J-I);
> 
>       Exit
> 
>     End;
> 
>     I := J;
> 
>   End; {while}
> 
> End;
> 
>  
> 
>  
> 
> function  WordAt(const Text : string; Position : Integer) : string;
> 
> begin
> 
>   Result := ExtractWord(Position, Text, [' ']);
> 
> end;
> 
>  
> 
> { TMSNMessenger }
> 
>  
> 
> constructor TMSNMessenger.Create(AOwner: TComponent);
> 
> begin
> 
>   inherited Create(AOwner);
> 
>   FSocket := TWSocket.Create(Self);
> 
>   FSocket.Addr := 'messenger.hotmail.com';
> 
>   FSocket.Port := '1863';
> 
>   FSocket.Proto:= 'tcp';
> 
>  
> 
>   FSocket.OnSessionConnected := SocketConnect;
> 
>   FSocket.OnSessionClosed    := SocketDisconnect;
> 
>   FSocket.OnDataAvailable    := SocketDataAvailable;
> 
>   FConnected := False;
> 
> end;
> 
>  
> 
> destructor TMSNMessenger.Destroy;
> 
> begin
> 
>   FSocket.Free;
> 
>   FSocket := nil;
> 
>   inherited Destroy;
> 
> end;
> 
>  
> 
> function TMSNMessenger.GetFriendlyUserName: String;
> 
> begin
> 
>   if not FConnected then
> 
>     Result := FFriendlyUserName;
> 
> end;
> 
>  
> 
> function TMSNMessenger.GetHost: String;
> 
> begin
> 
>   Result := FSocket.Addr;
> 
> end;
> 
>  
> 
> function TMSNMessenger.GetPort: String;
> 
> begin
> 
>   Result := FSocket.Port;
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.Login;
> 
> begin
> 
>   FSocket.Connect;
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.Logoff;
> 
> begin
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.LogWrite(const Data: String);
> 
> begin
> 
>   if Assigned( FLog ) then
> 
>     FLog.Add(Data);
> 
> end;
> 
>  
> 
> {Processcommand here is akin to a windowproc
> 
>   here we process all kind of info sent from the server
> 
>   as of now it is IFFull (full of if's) perhaps if i have
> 
>   some spare time will turn this into a case
> 
>  
> 
>   TODO: Clean this procedure mess up
> 
>   TODO: Add more commands}
> 
>  
> 
> procedure TMSNMessenger.ProcessCommand;
> 
> var
> 
>   Tmp: String;
> 
>   Hash: String;
> 
> begin
> 
>   Tmp := WordAt(ACommand, 1);
> 
>  
> 
>   if Tmp = 'VER' then
> 
>     SocketWrite('INF %d');
> 
>  
> 
>   if Tmp = 'INF' then
> 
>     SocketWrite('USR %d MD5 I '+ FUserName);
> 
>  
> 
>   if Tmp = 'USR' then
> 
>   begin
> 
>     if WordAt(ACommand, 4) = 'S' then
> 
>     begin
> 
>       Hash := WordAt(ACommand, 5);
> 
>       Delete(Hash, pos(#13#10, Hash), Length(Hash));
> 
>       Hash := StrMD5(Hash + PassWord);
> 
>       SocketWrite('USR %d MD5 S ' + Lowercase(Hash));
> 
>     end else
> 
>     begin
> 
>       FFriendlyUserName := WordAt(ACommand, 5);
> 
>       SocketWrite('SYN %d 1');
> 
>       ReceiveSYN;
> 
>     end;
> 
>   end;
> 
> {When you receive an XFR and you are not connected
> 
>   to the msn server it means redirect to another server}
> 
>   if (TMP = 'XFR') and not Connected then
> 
>   begin
> 
>     TMP := WordAt(ACommand, 4);
> 
>     FSocket.Close;
> 
>     Delete(Tmp, pos(':', Tmp), Length(Tmp));
> 
>     FSocket.Addr := Tmp;
> 
>     TMP := WordAt(ACommand, 4);
> 
>     Delete(Tmp, 1, pos(':', Tmp));
> 
>     FSocket.Port := Tmp;
> 
>     FSocket.Connect;
> 
>     Exit;
> 
>   end;
> 
> {Rename Friendly name}
> 
>   if (TMP = 'REA') then
> 
>   begin
> 
>     FFriendlyUserName := WordAt(ACommand, 5);
> 
>     FFriendlyUserName := StringReplace(FFriendlyUserName, '%20', ' ',
> 
> [rfReplaceall]);
> 
>     TriggerFriendlyNameChange;
> 
>   end;
> 
> {The out command is received before the server
> 
>   disconnects us, if it's because we've logged in another machine
> 
>   we receive the message OUT OTH (OTHER MACHINE)
> 
>   TODO write some event or something to retrieve this notification}
> 
>   if (TMP = 'OUT') then
> 
>   begin
> 
>     if pos('OTH', ACommand) > 1 then
> 
>       LogWrite('Logged out in another computer disconnecting');
> 
>   end;
> 
>  
> 
> end;
> 
>  
> 
> {SYN is without a doubt the most informationfull MSN Messenger Command
> 
>   SYN informs us of:
> 
>    available email
> 
>    Friend List
> 
>    Block List
> 
>    Reverse list (people that has you in their lists)
> 
>    Phone numbers (Home, mobile, etc.)
> 
>    MSN Messenger settings
> 
>    etc.
> 
>  
> 
>   however this comes with a price, since there is so much information
> 
>   WSocket may not get all the info properly (a quality of non blocking
> 
> sockets)
> 
>   thus in order to get it we will freeze this thread for 5 seconds
> 
> (meaning your forms will not receive any message and
> 
>   seem unresponsive for a while), I
> 
>   know there must be a better way around if somebody knows email me.
> 
>  
> 
>   TODO : Parse the received content
> 
>   TODO : look for a way wich does not have to freeze the thread
> 
> }
> 
>  
> 
> procedure TMSNMessenger.ReceiveSYN;
> 
> var
> 
>   Tmp: String;
> 
> begin
> 
>   FSocket.OnDataAvailable := nil;
> 
>  
> 
>   Sleep(5000);
> 
>   Tmp := FSocket.ReceiveStr;
> 
>  
> 
>   FSocket.OnDataAvailable := SocketDataAvailable;
> 
>   Tmp := UTF8ToAnsi(Tmp);
> 
>   LogWrite('RECV : ' + Tmp);
> 
>   SocketWrite('CHG %d NLN');
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SendVER;
> 
> begin
> 
>   SocketWrite('VER %d CVR0 MSNP5 MSNP6 MSNP7')
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SetFriendlyUserName(const Value: String);
> 
> var
> 
>   tmp: String;
> 
> begin
> 
>   if FConnected and (FUserName <> Value) then
> 
>   begin
> 
>     tmp := StringReplace(Value, ' ', '%20', [rfReplaceAll]);
> 
>     tmp := AnsiToUtf8(Tmp);
> 
>     SocketWrite('REA %d ' + FUsername + ' '+ tmp);
> 
>   end;
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SetHost(const Value: String);
> 
> begin
> 
>   if not Connected then
> 
>     if FSocket.Addr <> Value then
> 
>       FSocket.Addr := Value;
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SetPassWord(const Value: String);
> 
> begin
> 
>   if not Connected then
> 
>     if (FPassword <> Value) then
> 
>       FPassword := Value;
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SetPort(const Value: String);
> 
> begin
> 
>   if not Connected then
> 
>     if FSocket.Port <> Value then
> 
>       FSocket.Port := Value;
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SetState(const Value: TUserState);
> 
> begin
> 
>   if FConnected then
> 
>     if (FState <> Value) then
> 
>       SocketWrite( RealState[Value] );
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SetUserName(const Value: String);
> 
> begin
> 
>   if not FConnected then
> 
>     if FUsername <> Value then
> 
>       FUserName := Value;
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SocketConnect(Sender: TObject; Error: Word);
> 
> begin
> 
>   FTrialID := 1;
> 
>   SendVER;
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SocketDataAvailable(Sender: TObject; 
> Error: Word);
> 
> var
> 
>   Tmp: String;
> 
> begin
> 
>   Tmp := FSocket.ReceiveStr;
> 
>   Tmp := UTF8ToAnsi(Tmp);
> 
>   LogWrite('RECV : ' + Tmp);
> 
>   ProcessCommand(Tmp);
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SocketDisconnect(Sender: TObject; 
> Error: Word);
> 
> begin
> 
>   FConnected := False;
> 
>   LogWrite('Disconnected');
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.SocketWrite(const AString: String);
> 
> begin
> 
>   FSocket.SendStr(Format(AString, [FTrialID]) + #13+#10);
> 
>   LogWrite('SENT : ' + Format(AString, [FTrialID]));
> 
>   Inc(FTrialID);
> 
> end;
> 
>  
> 
> procedure TMSNMessenger.TriggerFriendlyNameChange;
> 
> begin
> 
>   if Assigned(FFriendlyNameChange) then
> 
>     FFriendlyNameChange(Self);
> 
> end;
> 
>  
> 
> end.
> 
>  
> 
> <---------------------------------/CODE-----------------------
> --------------
> 
> -->
> 
>  
> 
>  
> 
> a sample would be:
> 
>  
> 
>   AMSN := TMSNMessenger.Create(Self); // AMSN is a variable of type
> 
> TMSNMessenger
> 
>   AMSN.UserName := ''; // This indicates the username wich 
> should always be
> 
> of form [EMAIL PROTECTED]
> 
>   AMSN.PassWord := '';//This indicates the password
> 
>   AMSN.Log := MEmo1.Lines; // Log indicates a destination to dump the
> 
> received and sent information, I use it for retrieving 
> protocol information
> 
> and stuff but it is not obligatory to use it
> 
>   AMSN.Login;  // procedure wich indicates that  we should 
> start the login
> 
> process
> 
>  
> 
>  
> 
>  
> 
>   []s
> 
>  
> 
>   Walter Alves Chagas Junior
> 
>   Projeto e desenvolvimento
> 
>   Telemont Engenharia
> 
>   [EMAIL PROTECTED]
> 
>   Fone: (31) 3389-8215 Fax: (31) 3389-8200
> 
>  
> 
>  
> 
>  
> 
>  
> 
> [As partes desta mensagem que não continham texto foram removidas]
> 
>  
> 
>  
> 
>  
> 
> --
> 
> <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
> 
>  
> 
> Para ver as mensagens antigas, acesse:
> 
>   http://br.groups.yahoo.com/group/delphi-br/messages
> 
>  
> 
> Para falar com o moderador, envie um e-mail para:
> 
>   [EMAIL PROTECTED] ou [EMAIL PROTECTED]
> 
>  
> 
> Links do Yahoo! Grupos
> 
>  
> 
>  
> 
>  
> 
>  
> 
>  
> 
>  
> 
>  
> 
>  
> 
> [As partes desta mensagem que não continham texto foram removidas]
> 
> 
> 
> -- 
> <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
> 
> Para ver as mensagens antigas, acesse:
>  http://br.groups.yahoo.com/group/delphi-br/messages
> 
> Para falar com o moderador, envie um e-mail para:
>  [EMAIL PROTECTED] ou [EMAIL PROTECTED]
>  
> Links do Yahoo! Grupos
> 
> 
> 
> 
>  
> 
> 
> 


[As partes desta mensagem que não continham texto foram removidas]



-- 
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>

Para ver as mensagens antigas, acesse:
 http://br.groups.yahoo.com/group/delphi-br/messages

Para falar com o moderador, envie um e-mail para:
 [EMAIL PROTECTED] ou [EMAIL PROTECTED]
 
Links do Yahoo! Grupos

<*> Para visitar o site do seu grupo na web, acesse:
    http://br.groups.yahoo.com/group/delphi-br/

<*> Para sair deste grupo, envie um e-mail para:
    [EMAIL PROTECTED]

<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
    http://br.yahoo.com/info/utos.html

 



Responder a