MSN Messenger in delphi

how to work with the msn messenger protocol in delphi

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 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

<---------------------------------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

 

Share this article!

Follow us!

Find more helpful articles:

Comments

Mar
16

Perfect Thanks

By MEHMET HAKKIOGLU