MSN Messenger yapalım

Gerekli olan componenetler:


Tmsn Component 1.0


http://ikizce.com/depo_delphi/iletisim/Tmsn_v1.0.zip


WSocket


http://ikizce.com/depo_delphi/iletisim/fpwsock.zip


************************************************



<---------------------------------CODE---------------------------------------->



{GLOBAL TODO: IMPLEMENT LOCAL TODO's, cleanup, extend}


unit MSNMessenger;
interface
uses WSocket, MD5, Classes, SysUtils;


type


TUserState = (
usOnline, // online
usBusy, // meşgul
usBRB, // geri dönecek
usAway, // dışarıda
usOnPhone, //Telefonda
usLunch, //yemekte
usHidden, //gizli
usOffline //kapalı
);
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;
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;

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








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;





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;





if (TMP = 'OUT') then begin
if pos('OTH', ACommand) > 1 then
LogWrite('Logged out in another computer disconnecting');
end;
end;





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


AMSN := TMSNMessenger.Create(Self);
AMSN.UserName := ''; // [email]*@hotmail.com[/email] başlayan kullanıcı adın
AMSN.PassWord := '';//şifre
AMSN.Log := MEmo1.Lines; // Log
AMSN.Login;


***********************************


mesela;


AMSN := TMSNMessenger.Create(Self);
AMSN.UserName := 'hasanveben@hotmail.com';
AMSN.PassWord := '1234567';//Buraya kendi şifren
AMSN.Log := MEmo1.Lines;
AMSN.FriendlyUserName:='dostum@hotmail.com;//konuşmak istediğin arkadaş
AMSN.Login;