ForumTayfa  

Go Back   ForumTayfa > Güvenlik & Bilgisayar & İnternet & Webmaster & Programlama Bölümü > Güvenlik & Bilgisayar & İnternet & Webmaster & Programlama > Programlama

Programlama Programlama hakkında herşeyi paylaştığımız, soru ve sorunlarımızı tartıştığımız bölüm...

Yeni Konu aç  Cevapla
 
LinkBack Seçenekler Stil
Alt 26.04.07, 16:57   #1 (permalink)
Deneyimli Tayfa
 
silentwolf - ait Kullanıcı Resmi (Avatar)
 
Üyelik Tarihi: Dec 2006
Nereden: burada
Mesaj Sayısı: 3.964
Konu Sayısı: 157
Takım: Fenerbahçe
Rep Gücü: 196650
Rep Puanı: 19663395
Rep Derecesi : silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000silentwolf 0-10000000
Ruh Hali:

Standart Msn Messenger Kaynak KodLarI (Delphi Icin)




Kod:
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.Kayıt Olmak İçin Tıklayınız...], 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.Kayıt Olmak İçin Tıklayınız...] 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
Kod:
<-------------------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
[Alıntıdır]


__________________
bir silahım olsaydı...




hiç bir farklılık ayrımcılığa neden olamaz.
Hürriyet Hürriyettir.

silentwolf isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Cevapla


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 
Seçenekler
Stil

Yetkileriniz
Konu Acma Yetkiniz Yok
Cevap Yazma Yetkiniz Yok
Eklenti Yükleme Yetkiniz Yok
Mesajınızı Değiştirme Yetkiniz Yok

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-Kodu Kapalı
Trackbacks are Açık
Pingbacks are Açık
Refbacks are Açık



Tüm Zamanlar GMT +3 Olarak Ayarlanmış. Şuanki Zaman: 11:00.


Powered by vBulletin® Version 3.8.0
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Search Engine Optimization by vBSEO 3.6.0
User Alert System provided by Advanced User Tagging v3.0.6 (Lite) - vBulletin Mods & Addons Copyright © 2020 DragonByte Technologies Ltd.
ForumTayfa

Arşiv: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 22 23 24 25 26 27 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 95 96 97 98 99 100 102 103 104 105 106 155 156 157 158 159 160 161 162 163 164 167 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271


ForumTayfa - Link Değişimi
Telinka İletişim | Voip Ürünleri | Link Değişimine Katılın |

Sitemiz bir forum sitesi olduğundan dolayı, kullanıcılar her türlü görüşlerini önceden onay olmadan anında siteye yazabilmektedir. ForumTayfa Yöneticileri mesajları itina ile kontrol etse de, bu yazılardan dolayı doğabilecek her türlü sorumluluk yazan kullanıcılara aittir. Yine de sitemizde yasalara aykırı unsurlar bulursanız [email protected] email adresine bildirebilirsiniz, şikayetiniz incelendikten sonra en kısa sürede gereken yapılacaktır.

Any member of our web site has the right of adding comments instantly without getting permisson due to the forum structure of our site basis. Althought, our site modarators check comments with care, all the responsibilities sourced from these comments directly belong to the members. If you still find any illegal content in our site ( A.buse, H.arassment, S.camming, H.acking, W.arez, C.rack, D.ivx, Mp.3 or any Illegal Activity ), please report us via [email protected] .Your reports will be evaluated as soon as the arrival of your e-mail.