MSN Messenger in delphi |
|
|
|
flyup
資深會員   發表：280 回覆：508 積分：385 註冊：2002-04-15 發送簡訊給我 |
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
|
|
kevinh921
一般會員   發表：6 回覆：8 積分：2 註冊：2002-09-12 發送簡訊給我 |
|
|
andykwok
一般會員 發表：1 回覆：3 積分：0 註冊：2002-07-01 發送簡訊給我 |
|
|
lukyshu
中階會員 發表：16 回覆：120 積分：93 註冊：2002-04-19 發送簡訊給我 |
|
|
kunying
一般會員 發表：17 回覆：28 積分：19 註冊：2002-03-14 發送簡訊給我 |
這是小弟最近在網路上找到的，給有興趣的人參考 ^^ Tmsn Component 0.70
http://www.vclcomponents.com/x_authors.asp?ID_AUTHOR=8823 WSocket
http://www.delphi32.com/vcl/2184 ________________________
「有時候你以為天要塌下來了，其實是因為你站歪了！」
------
________________________ 「有時候你以為天要塌下來了，其實是因為你站歪了！」 |
|
thomas0728
中階會員 發表：112 回覆：260 積分：89 註冊：2002-03-12 發送簡訊給我 |
請問有人用過這一段程式嗎?
我使用如下的程式
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 |
發表時間：2003-02-25 14:20:52
IP:61.217.xxx.xxx 未訂閱
系統時間：2024-05-03 15:43:10
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |