Msn messenger en delphi

Msn messenger en delphi

Msn messenger en delphi : Plusieurs milliers de conseils pour vous faciliter la vie.

la façon de travailler avec le protocole de msn messenger en delphi

Cet article est severement obsolete et sera mis a jour bientot

C'est une implementation du protocole de msn messenger en delphi, il n'est pas complet et pour le construire, vous aurez besoin de la WSocket paquet, la plupart de ce qui est presente ici est une partie de la specification (pas encore assez a faire de meme une depouille de MSN Messenger clone). Le travail que vous voyez ici a son todos (la plupart en raison du fait que je suis tout simplement nouvelle pour les sockets de programmation), cet article est base sur les travaux de venkydude MSN article et d'une ancienne version de KMerlin (une opensource clone de msn messenger pour linux). C'est le deuxieme article que j'ecris sur la Messagerie Instantanee (Le premier sur le yahoo protocole, quelque chose dont je n'ai pas ete en mesure de terminer en raison de contraintes de temps (beaucoup de travail)) j'ai l'intention de mettre a jour cet article Des Que Possible

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

{GLOBAL TODO: mettre en oeuvre les taches, de nettoyage, de prolonger}
unite MSNMessenger
interface

WSocket, MD5, Classes, SysUtils
type
TUserState = (
usOnline, // vous etes en ligne
usBusy, // Effectivement occupe
usBRB, // de Retour
usAway, // Loin
usOnPhone, //Sur le Telephone
usLunch, //le Dejeuner
usHidden, //Caches
usOffline //Offline
)
TMSNMessenger = class(TComponent)
private
FConnected: Boolean
FUserName: String
FPassword: String
FFriendlyUserName: String
FLog: TStrings
FFriendlyNameChange: TNotifyEvent
FState: TUserState
fonction GetHost: String
procedure SetHost(const Valeur: String)
fonction GetPort: String
procedure SetPort(const Valeur: String)
procedure SetUserName(const Valeur: String)
procedure SetPassWord(const Valeur: String)
fonction GetFriendlyUserName: String
procedure SetFriendlyUserName(const Valeur: String)
procedure SetState(const Valeur: TUserState)
protected
FSocket: TWSocket
FTrialID: Integer
procedure SendVER
procedure ReceiveSYN
procedure SocketWrite(const AString: String)
procedure LogWrite(const : String)
procedure ProcessCommand(const Commande: String)
procedure SocketDisconnect(Sender: TObject Erreur: Word)
procedure SocketDataAvailable(Sender: TObject Erreur: Mot)
procedure SocketConnect(Sender: TObject Erreur: Mot)
procedure TriggerFriendlyNameChange dynamique
public
constructeur Create(AOwner: TComponent) remplacer
destructeur Detruire remplacer
procedure Connexion
procedure Deconnexion
publie
propriete Hote: la Chaîne de lecture GetHost ecrire SetHost
proprietes Port: la Chaîne de lecture GetPort ecrire SetPort
proprietes nom d'utilisateur: la Chaîne de lecture FUserName ecrire SetUserName
proprietes Mot de passe: la Chaîne de lecture FPassword ecrire SetPassWord
proprietes FriendlyUserName: la Chaîne de lecture GetFriendlyUserName ecrire SetFriendlyUserName
proprietes est Connecte: Boolean lire FConnected
proprietes Log: TStrings lire FLog ecrire FLog
proprietes FriendlyNameChange: TNotifyEvent lire FFriendlyNameChange ecrire FFriendlyNameChange
proprietes Statut: TUserState lire FState ecrire SetState
fin
application
utilise windows
const RealState: array[TUserState] String =
('CHG %d NLN', 'CHG %d BSY', 'CHG %d BRB', 'CHG %d ENVIRON', 'CHG %d RSP', 'CHG %d LUN',
'CHG %d HDN', 'CHG %d FLN' )
type
CharSet = Set char
fonction UTF8ToAnsi(x: string): ansistring
{ Fonction qui reçoit chaîne UTF8 et convertit
a la norme ansi string }
var
i: integer
b1, b2: octet
begin
Result := x
i := 1
while i <= Longueur(Suite) commencer
si (ord(resultat[i]) et $80) <> 0 alors commencer
b1 := ord(resultat[i])
b2 := ord(resultat[i 1])
si (b1 et $F0) <> $C0
Result[i] := #128
else begin
Result[i] := Chr((b1 shl 6) ou (b2 et $3F))
Supprimer(Resultat, j' 1, 1)
fin
fin
inc(i)
fin
fin
fonction AnsiToUtf8(x: ansistring): string
{ Fonction qui reçoit chaîne ansi et convertit
chaîne UTF8 }
var
i: integer
b1, b2: octet
begin
Result := x
pour i := Longueur(Suite) downto 1
si Result[i] >= #127 alors commencer
b1 := $C0 ou (ord(resultat[i]) rsh 6)
b2 := $80 ou (ord(resultat[i]) et $3F)
Result[i] := chr(b1)
Insert(chr(b2), Resultat, j' 1)
fin
fin
Fonction ExtractWord(N:Entier S:String WordDelims:jeu de caracteres):String
Var
I,J:Mot
Count:Integer
Ve:Entier
Begin
Count := 0
I := 1
Result := '
Ve := Longueur(S)
While I <= SLen Commencer
{preskoc oddelovace}
While (I <= SLen) Et (S[I] De WordDelims) Ne Inc(I)
{neni-li na konci retezce, bude nalezen zacatek slova}
Si I <= SLen Inc(Nombre)
J := I
{une zde je konec slova}
While (J <= SLen) Et Pas(S[J] De WordDelims) Ne Inc(J)
{je-li toto n-te slovo, vloz ho na vystup}
Si Count = N Puis Commencer
Result := Copy(S,I,J-I)
Sortie
Fin
I := J
Fin {en} en
Fin

fonction WordAt(const Texte : string Position : Entier) : string
begin
Result := ExtractWord(Position, Texte, [' '])
fin
{ TMSNMessenger }
constructeur TMSNMessenger.Create(AOwner: TComponent)
begin
herite 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
fin
destructeur TMSNMessenger.Detruire
begin
FSocket.Gratuit
FSocket := nul
herite Detruire
fin

fonction TMSNMessenger.GetFriendlyUserName: String
begin
sinon FConnected puis
Result := FFriendlyUserName
fin
fonction TMSNMessenger.GetHost: String
begin
Result := FSocket.Addr
fin
fonction TMSNMessenger.GetPort: String
begin
Result := FSocket.Port
fin
procedure TMSNMessenger.La connexion
begin
FSocket.Se connecter
fin
procedure TMSNMessenger.Fermeture de session
begin
fin
procedure TMSNMessenger.LogWrite(const : String)
begin
si Assigne( Fouetter ) puis
Fouetter.Ajouter(Donnees)
fin
{Processcommand ici, s'apparente a un windowproc
ici, nous traitons tous les types d'informations envoyes par le serveur
comme de maintenant, il est IFFull (si) peut-etre que si j'ai
temps libre, va en faire un cas
TODO: Nettoyer cette procedure mess up
TODO: Ajouter plus de commandes}
procedure TMSNMessenger.ProcessCommand
var
Tmp: String
Hash: String
begin
Tmp := WordAt(Commande, 1)
si Tmp = 'VER'
SocketWrite('INF %d' )
si Tmp = 'INF' /font>
SocketWrite('USR %d MD5 I ' FUserName)
si Tmp = 'USR'
begin
si WordAt(Commande, 4) = 'S'
begin
Hash := WordAt(Commande, 5)
Supprimer(Hachage, pos(#13#10, De hachage), Longueur(Hash))
Hash := StrMD5(Hachage de Mot de passe)
SocketWrite('USR %d MD5 S' Minuscules(Hash))
else
begin
FFriendlyUserName := WordAt(Commande, 5)
SocketWrite('SYN %d 1')
ReceiveSYN
fin
fin
{Lorsque vous recevez un XFR et vous n'etes pas connecte
pour le msn serveur, il signifie rediriger vers un autre serveur}
si (TMP = 'XFR') et pas Connecte
begin
TMP := WordAt(Commande, 4)
FSocket.Fermer
Supprimer(Tmp, pos(':', Tmp), Longueur(Tmp))
FSocket.Addr := Tmp
TMP := WordAt(Commande, 4)
Supprimer(Tmp, 1, pos(':', Tmp))
FSocket.Port := Tmp
FSocket.Se connecter
Sortie
fin
{Renommer le nom Convivial}
si (TMP = 'REA') puis
begin
FFriendlyUserName := WordAt(Commande, 5)
FFriendlyUserName := StringReplace(FFriendlyUserName, ' ', ' ', [rfReplaceall])
TriggerFriendlyNameChange
fin
{La commande est reçue avant que le serveur
deconnecte nous, si c'est parce que nous avons enregistre dans une autre machine
nous recevoir le message d'OTH (AUTRE MACHINE)
TODO ecrire quelque evenement ou quelque chose pour recuperer cette notification}
si (TMP = '') puis
begin
si pos('Q', la Commande) > 1
LogWrite('non Connecte a un autre ordinateur en debranchant')
fin
fin
{SYN est sans doute le plus informationfull MSN Messenger Commande
SYN nous informe de:
electronique
Liste d'amis
Liste
Inverse (liste de personnes que vous avez dans leurs listes)
numero de Telephone (Domicile, mobile, etc.)
MSN Messenger parametres
etc.
toutefois, cela vient avec un prix, car il ya tellement d'informations
WSocket ne peut pas obtenir toutes les infos correctement (une qualite de non blocage des sockets)
donc pour l'obtenir nous allons geler ce fil de discussion pour 5 secondes
(le sens de vos formulaires ne recevrez pas de message et
sembler cesser de repondre pendant un certain temps), je
il doit y avoir une meilleure façon de contourner si quelqu'un sait m'envoyer un email.
TODO : Analyser le contenu reçu
TODO : trouver un moyen qui n'a pas de geler le fil
}
procedure TMSNMessenger.ReceiveSYN
var
Tmp: String
begin
FSocket.OnDataAvailable := nul
Sommeil(5000)
Tmp := FSocket.ReceiveStr
FSocket.OnDataAvailable := SocketDataAvailable
Tmp := UTF8ToAnsi(Tmp)
LogWrite('RECV :' Tmp)
SocketWrite('CHG %d NLN')
fin
procedure TMSNMessenger.SendVER
begin
SocketWrite('VER %d CVR0 MSNP5 MSNP6 MSNP7')
fin
procedure TMSNMessenger.SetFriendlyUserName(const Valeur: String)
var
tmp: String
begin
si FConnected et (FUserName < Valeur>) puis
begin
tmp := StringReplace(Valeur ' ', ' ', [rfReplaceAll])
tmp := AnsiToUtf8(Tmp)
SocketWrite('REA %d' FUsername ' ' tmp)
fin
fin
procedure TMSNMessenger.SetHost(const Valeur: String)
begin
sinon Connecte
si FSocket.Addr <> Valeur puis
FSocket.Addr := Valeur
fin
procedure TMSNMessenger.SetPassWord(const Valeur: String)
begin
sinon Connecte
si (FPassword < Valeur>) puis
FPassword := Valeur
fin
procedure TMSNMessenger.SetPort(const Valeur: String)
begin
sinon Connecte
si FSocket.Port <> Valeur puis
FSocket.Port := Valeur
fin
procedure TMSNMessenger.SetState(const Valeur: TUserState)
begin
si FConnected puis
si (FState < Valeur>) puis
SocketWrite( RealState[Valeur] )
fin
procedure TMSNMessenger.SetUserName(const Valeur: String)
begin
sinon FConnected puis
si FUsername <> Valeur puis
FUserName := Valeur
fin
procedure TMSNMessenger.SocketConnect(Sender: TObject Erreur: Mot)
begin
FTrialID := 1
SendVER
fin
procedure TMSNMessenger.SocketDataAvailable(Sender: TObject Erreur: Mot)
var
Tmp: String
begin
Tmp := FSocket.ReceiveStr
Tmp := UTF8ToAnsi(Tmp)
LogWrite('RECV :' Tmp)
ProcessCommand(Tmp)
fin
procedure TMSNMessenger.SocketDisconnect(Sender: TObject Erreur: Mot)
begin
FConnected := False
LogWrite('Deconnecte')
fin
procedure TMSNMessenger.SocketWrite(const AString: String)
begin
FSocket.SendStr(Format(AString, [FTrialID]) #13 #10)
LogWrite('ENVOYE :' Format(AString, [FTrialID]))
Inc(FTrialID)
fin
procedure TMSNMessenger.TriggerFriendlyNameChange
begin
si Assigne(FFriendlyNameChange) puis
FFriendlyNameChange(Auto)
fin
fin.< & & & & & & & & & & & & & & & & -/CODE & & & & & & & & & & & & & & & & & & & -> un exemple serait: AMSN := TMSNMessenger.Creer des(Auto) // AMSN est une variable de type TMSNMessenger AMSN.UserName: nom d'utilisateur= ' // indique le nom d'utilisateur qui doit toujours etre de la forme *@hotmail.com AMSN.Mot de passe := ' //indique que le mot de passe AMSN.Journal := MEmo1.Lignes // Journal indique une destination pour vider le reçu et envoye des informations, je l'utilise pour recuperer des informations sur le protocole et les choses, mais il n'est pas obligatoire de l'utiliser AMSN.Connexion // procedure qui indique que nous devrions commencer le processus de connexion