This article is severly outdated and will be updated soon


This is an implementation of the msn messenger protocol in delphi it isnt complete and in order to build it you will need the [Sadece Kayıtlı Kullanıcılar Linkleri Görebilir. Üye Olmak İçin Tıklayın...], 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 [Sadece Kayıtlı Kullanıcılar Linkleri Görebilir. Üye Olmak İçin Tıklayın...] 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

<-------------------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 *@hotmail.com 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