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

各位大大 是否有人想把這個好玩的東西 寫成 vcl 這樣在寫套裝程式的時候 不就可以拿來替代 message 了 是不是比較好玩... kevin

呵呵，因為MSN沒有保存功能，結合它來開發一個收發程序並帶自動保存功能，或做郵件發送系統的時候，象OUTLOOK一樣能和它共享E-Mail地址，也是很好的。對嗎？

flyup兄有提到需要WSocket這個Package 哪有可以下載呢？    台灣 Delphi 俱樂部
PostgreSQL、FastReport專業討論區
http://www.delphi.club.tw

------
台灣 Delphi 俱樂部 

PostgreSQL、FastReport專業討論區

http://www.delphi.club.tw

這是小弟最近在網路上找到的，給有興趣的人參考 ^^ Tmsn Component 0.70 http://www.vclcomponents.com/x_authors.asp?ID_AUTHOR=8823 WSocket http://www.delphi32.com/vcl/2184 ________________________ 「有時候你以為天要塌下來了，其實是因為你站歪了！」

------
________________________
「有時候你以為天要塌下來了，其實是因為你站歪了！」

請問有人用過這一段程式嗎? 我使用如下的程式

  AMSN := TMSNMessenger.Create(Self);
  AMSN.UserName := 'leadoff.info@msa.hinet.net'; 
  AMSN.PassWord := '1234567';//This indicates the password
  AMSN.Log := MEmo1.Lines;
  AMSN.FriendlyUserName:='thomas0728@hotmail.com';
  AMSN.Login;

我要從 'leadoff.info@msa.hinet.net' 傳息給 'thomas0728@hotmail.com' 但好像沒反應,不知有那位大大用過 謝謝 如果愛情也有味覺 那麼 有沒有ㄧ種愛 微微泛酸 不太苦澀 有點甜密 嚐起來的滋味讓人想起幸福 Thomas Chiou

------
Thomas Chiou