www.pudn.com > MSN Messenger µÄÔ´Âë.zip > Unit1.pas
{
USE OF THIS CODE IS AT UR OWN RISK!!!!!!!!
Hi all,
I'm Chris Monter.
This code is for educational purposes only!!!
It is based open a fantastic article about the MSN IM protocol located here:
http://www.venkydude.com/articles/msn.htm
Heck, if u read the article u won't even need this code :O)
Before u try to compile you'll need 1 extra component:
THashAlgMD5 (SDeanComponents (v1.5.5))
find it at:
http://www.fortunecity.com/skyscraper/true/882/Download.htm
MSN protocol uses Unicode UTF-8:
Delphi 6 supports it, lower versions don't :(
I use delphi 5, and I didn't find any components on UTF-8 decoding-encoding,
so u'll need to find out how to de/encode UTF-8 strings urself,
or leave them as they are.
This code was my first attempt at making a MSN Clone. It uses brute methods,
but it gets the job done... for the most part :)
If u know how to do certain things in a better way, then pls do let me know!!
at
koning3ton@hotmail.com
Enjoy exploring,
Chris.
PS: ANY HELP ON USING AND FREEING MUTLIPLE INSTANCES OF A FORM INSIDE A DLL AND
COMMUNICATING WITH THEM, WOULD BE GREATLY APPRICIATED.
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, HashAlg_U, HashAlgMD5_U,
ExtCtrls, ImgList, ComCtrls;
const
CRLF = #13 + #10;
type
TForm1 = class(TForm)
MD5: THashAlgMD5;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
loginname: TEdit;
passlogin: TEdit;
Button3: TButton;
Button4: TButton;
msn: TClientSocket;
Splitter1: TSplitter;
State: TImageList;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Memo2: TMemo;
Panel6: TPanel;
Panel7: TPanel;
Buddylist: TListView;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
UsrName: TLabel;
Memo1: TMemo;
Splitter2: TSplitter;
Label5: TLabel;
Button5: TButton;
Button6: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button4Click(Sender: TObject);
procedure msnConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure msnRead(Sender: TObject; Socket: TCustomWinSocket);
procedure msnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure BuddylistDblClick(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
public
trialid, //this value will be increased with "1" everytime we send a command to the server
msgid //this ID is needed when we try logging in, atleast i use this method :O)
//if u know a better way, let me know :)
: Integer;
end;
{Next procedure is needed when we use the form inside a DLL, see the included DLL project}
//procedure ShowDllForm(Mailid, Hostid, CKIid, SESid, Usrmail, Usrname: String; Request, Minimized: Boolean);stdcall;external 'Project1dll.dll' name 'ShowDllForm';
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ChatForm;
procedure TForm1.Button1Click(Sender: TObject);
begin
BuddyList.Items.Clear;
if (loginname.Text = '') or (passlogin.Text = '') then
begin
MessageBox(handle,'Didn''t u forget something.....' +#10+
'LIKE UR PASSWORD OR USERNAME!!!! :O)','COME ON NOW...', MB_OK or MB_ICONERROR);
Exit;
end;
msn.Close;
msn.Open;
msgid := 0;
trialid := 0;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
MSN.CLose;
BuddyList.Items.Clear;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MSN.CLose;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Memo1.Clear;
end;
procedure TForm1.msnConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
{ok, we are connected, let's start talking}
Memo1.Lines.Add('Connected!!!');
Memo1.Lines.Add('MSN Server IP: '+ MSN.Host);
Memo1.Lines.Add('Remote Port: '+ IntToStr(MSN.Port));
//send version info, to retrieve which protocol we'll use ==> MSNP7
MSN.Socket.SendText('VER '+ IntToStr(trialid) +' MSNP7 MSNP6 MSNP5 MSNP4 CVRO'+ CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('VER '+ IntToStr(trialid) +' MSNP7 MSNP6 MSNP5 MSNP4 CVRO'+ CRLF);
trialid := trialid + 1;
msgid := 0;
end;
procedure TForm1.msnRead(Sender: TObject;
Socket: TCustomWinSocket);
var
svrMSN,data: String;
Name,Mail,Stat: String;
tmpData, I, J, Image: Integer;
yo: THashArray;
NewItem:TListitem;
NotInList,requesting: Boolean;
Sesid,Hostid,CKIid :String;
ChatForm: TMSNChatForm;
procedure CheckImage(text:string);
begin
if Pos('PHN', text) <> 0 then begin Stat := 'Telefoon'; Image := 2; end;
if Pos('BRB', text) <> 0 then begin Stat := 'Ben zo terug'; Image := 3; end;
if Pos('BSY', text) <> 0 then begin Stat := 'Bezet'; Image := 2; end;
if Pos('LUN', text) <> 0 then begin Stat := 'Lunchpauze'; Image := 3; end;
if Pos('AWY', text) <> 0 then begin Stat := 'Afwezig'; Image := 3; end;
if Pos('NLN', text) <> 0 then begin Stat := 'Online'; Image := 0; end;
if Pos('IDL', text) <> 0 then begin Stat := 'Geblokkeerd'; Image := 4; end;
end;
begin
Memo1.Lines.Add('Recieving......');
Memo1.Lines.Add('Aantal tekens: '+IntToStr(msn.Socket.ReceiveLength));
data := msn.Socket.ReceiveText;
Memo1.Lines.Add(data);
if msgid = 0 then
// start the loggin in process, ask encryption method
begin
MSN.Socket.SendText('INF ' + IntToStr(trialid) + CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('INF ' + IntToStr(trialid) + CRLF);
trialid := trialid + 1;
msgid := msgid + 1;
exit;
end;
if msgid = 1 then
// ask the server if authentication algorithm is MD5
begin
MSN.Socket.SendText('USR ' + IntToStr(trialid) + ' MD5 I ' + Loginname.Text + CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('USR ' + IntToStr(trialid) + ' MD5 I ' + Loginname.Text + CRLF);
trialid := trialid + 1;
msgid := msgid + 1;
exit;
end;
if msgid = 2 then
begin
msgid := msgid + 1;
if data[1] = 'X' then // check if we have to connect to a different switch board server
begin //if so, get new IP and connect
Delete(data, 1, Pos(' ', data)+1);
Delete(data, 1, Pos(' ', data)+3);
Delete(data, Pos(':', data), Length(data));
svrMSN := data;
msgid := 0; //Reset msgID
while MSN.Active do //wait until connection is closed gracefully
begin
MSN.Close;
Application.ProcessMessages;
end;
Memo1.Lines.Add('Reconnect to: '+svrMSN);
MSN.Host := svrMSN;
MSN.Open; // connect to the changed switch board server = Restart whole logging process
exit;
end;
tmpData := Pos('S ', data);
Delete(data, 1, tmpData+1);
Delete(Data, Length(Data)-1, Length(Data));
Memo1.Lines.Add('Hash is: '+data);
yo := MD5.HashString(data+passlogin.Text);//Encrypt the hash with password using MD5 algorithm
MSN.Socket.SendText('USR ' + IntToStr(trialid) + ' MD5 S ' + Lowercase(MD5.HashToDisplay(yo)) + CRLF); // send the password encrypted string
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('USR ' + IntToStr(trialid) + ' MD5 S ' + MD5.HashToDisplay(yo) + CRLF);
trialid := trialid + 1;
exit;
end;
if msgid = 3 then
begin
if Data[Length(Data)-2] = '1' then
begin
Name := Data;
Delete(Name, 1, Pos(' OK ', Name)+3);
Delete(Name, 1, Pos(' ', Name));
Delete(Name, Pos(' ', Name), Length(Name));
Name := StringReplace(Name,'%20',' ',[rfReplaceAll]);
UsrName.Caption := Name;
end;
MSN.Socket.SendText('CHG ' + IntToStr(trialid) + ' NLN' +CRLF); // Logged in succesfully, change the user status to online
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('CHG ' + IntToStr(trialid) + ' NLN' +CRLF);
trialid := trialid + 1;
msgid := msgid + 1;
exit;
end;
if msgid = 4 then
begin
msgid := msgid + 1;
exit;
end;
if msgid = 5 then
begin
Memo2.Clear;
Memo2.Lines.Add(Data);
For I := 0 to Memo2.Lines.Count - 1 do
begin
Data := Memo2.Lines.Strings[i]; //retrieve online buddies, this is send back by the server automaticly when u change ur status to 'online'
if Pos('ILN', Data) <> 0 then
begin
Delete(Data,1, 4);
Delete(Data, 1, Pos(' ', Data));
CheckImage(Data);
Delete(Data,1,4);
mail := data;
Delete(mail, Pos(' ', mail), Length(mail));
Delete(data,1, Pos(' ',data));
Name := StringReplace(Data,'%20',' ',[rfReplaceAll]);
NewItem := BuddyList.Items.Add;
NewItem.ImageIndex := Image;
NewItem.Caption := Name;
NewItem.SubItems.Add(mail);
NewItem.SubItems.Add(Stat);
end;
end;
{The real MSN IM uses "SYN", to synchronize the database in the registry with the data from the server
We can use that here to... but it gives more info then we need, there is a sepperate button ontop of
Form1 to ask it when we logged in succesfully!}
MSN.Socket.SendText('LST ' + IntToStr(trialid) + ' FL' +CRLF); // Get buddylist
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('LST ' + IntToStr(trialid) + ' FL' +CRLF);
trialid := trialid + 1;
MSN.Socket.SendText('LST ' + IntToStr(trialid) + ' BL' +CRLF); // Get blocked buddies list
Memo1.Lines.Add('LST ' + IntToStr(trialid) + ' BL' +CRLF);
trialid := trialid + 1;
msgid := msgid + 1;
exit;
end;
//all the messages that we receive from the server, from now on, will be processed here
if msgid = 6 then
begin
Memo2.Clear;
Memo2.Lines.Add(Data);
For I := 0 to Memo2.Lines.Count - 1 do
begin
{server challenges the program by sending a hash, we have to encrypt
it with the right password, and send it back}
Data := Memo2.Lines.Strings[i];
if Pos('CHL', Data) <> 0 then
begin
Delete(Data,1, Pos('0 ', Data)+1);
Memo1.Lines.Add('Encode string: '+ Data +'(Lengte is: '+ IntToStr(Length(Data))+')');
{The password is a constant, it was retrieved probably by hacking...,
something i know nothing about..}
yo := MD5.HashString(data+'Q1P7W2E4J9R8U3S5');
MSN.Socket.SendText('QRY ' + IntToStr(trialid) + ' msmsgs@msnmsgr.com 32' +CRLF + Lowercase(MD5.HashToDisplay(yo)));
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('QRY ' + IntToStr(trialid) + ' msmsgs@msnmsgr.com 32' +CRLF + Lowercase(MD5.HashToDisplay(yo)));
end;
if Pos('ILN', Data) = 1 then
begin
Delete(Data,1, 4);
Delete(Data, 1, Pos(' ', Data));
CheckImage(Data);
Delete(Data,1,4);
mail := data;
Delete(mail, Pos(' ', mail), Length(mail));
Delete(data,1, Pos(' ',data));
Name := StringReplace(Data,'%20',' ',[rfReplaceAll]);
NewItem := BuddyList.Items.Add;
NewItem.ImageIndex := Image;
NewItem.Caption := Name;
NewItem.SubItems.Add(mail);
NewItem.SubItems.Add(Stat);
end;
if Pos('NLN', Data) = 1 then
begin
//When a buddy comes online, the server sends it to us
Delete(Data,1, 4);
CheckImage(Data);
Delete(Data,1,4);
mail := data;
Delete(mail, Pos(' ', mail), Length(mail));
Delete(data,1, Pos(' ',data));
Name := StringReplace(Data,'%20',' ',[rfReplaceAll]);
if BuddyList.Items.Count <> 0 then
for j:=0 to BuddyList.Items.Count -1 do
if Buddylist.Items.Item[j].SubItems.Strings[0] = mail
then
begin
Buddylist.Items.Item[j].Caption := Name;
if Buddylist.Items.Item[j].ImageIndex <> 4 then
begin
Buddylist.Items.Item[j].ImageIndex := Image;
Buddylist.Items.Item[j].SubItems.Strings[1] := Stat;
end else
begin
Buddylist.Items.Item[j].SubItems.Strings[1] := Stat+'/Blocked';
end;
Buddylist.Items.Item[j].SubItems.Strings[0] := Mail;
end;
end;
{Retrieving blocked buddies}
if (Pos('LST', Data) = 1) and (Pos(' BL ', Data) <> 0) then
begin
Delete(Data,1, 4);
Delete(Data, 1, Pos(' BL ', Data)+3);
Delete(Data, 1, Pos(' ', Data));
Delete(Data, 1, Pos(' ', Data));
Delete(Data, 1, Pos(' ', Data));
mail := data;
Delete(mail, Pos(' ', mail), Length(mail));
Name := data;
Delete(Name, 1, Pos(' ', Name));
if BuddyList.Items.Count <> 0 then
for j:=0 to BuddyList.Items.Count -1 do
if Buddylist.Items.Item[j].SubItems.Strings[0] = mail
then
begin
Buddylist.Items.Item[j].ImageIndex := 4;
Buddylist.Items.Item[j].SubItems.Strings[1] := Buddylist.Items.Item[j].SubItems.Strings[1]+'/Blocked';
end;
end;
{Server sends us a buddy went offline}
if Pos('FLN', Data) = 1 then
begin
Delete(Data,1, 4);
if BuddyList.Items.Count <> 0 then
for j:=0 to BuddyList.Items.Count -1 do
if Buddylist.Items.Item[j].SubItems.Strings[0] = data
then
if Buddylist.Items.Item[j].ImageIndex <> 4 then
begin
Buddylist.Items.Item[j].ImageIndex := 1;
Buddylist.Items.Item[j].SubItems.Strings[1] := 'Offline';
end else
begin
Buddylist.Items.Item[j].ImageIndex := 4;
Buddylist.Items.Item[j].SubItems.Strings[1] := 'Offline/Blocked';
end;
end;
{Retrieving all buddies on ur list}
if Pos('LST', Data) = 1 then
begin
Delete(data,1, Pos('FL ',data)+ 2);
Delete(data,1, Pos(' ',data));
Delete(data,1, Pos(' ',data));
Delete(data,1, Pos(' ',data));
mail := data;
Delete(mail, Pos(' ', mail), Length(mail));
Delete(data,1, Pos(' ',data));
Name := StringReplace(Data,'%20',' ',[rfReplaceAll]);
Notinlist := True;
if BuddyList.Items.Count <> 0 then
for j:=0 to BuddyList.Items.Count -1 do
if Buddylist.Items.Item[j].SubItems.Strings[0] = mail
then
Notinlist := False;
If NotInList then
begin
NewItem := BuddyList.Items.Add;
NewItem.Caption := Name;
NewItem.SubItems.Add(mail);
NewItem.SubItems.Add('Offline');
NewItem.ImageIndex := 1;
end;
end;
{we are being invited by a buddy to chat}
if Pos('RNG', Data) = 1 then
begin
Delete(Data,1,4);
SesId := Data;
Delete(SesId,Pos(' ', SesId), Length(SesId));
Delete(Data,1,Pos(' ', Data));
HostId := Data;
Delete(HostId, Pos(':', HostId), Length(HostId));
Delete(Data,1,Pos(' ', Data)+4);
CKIid := Data;
Delete(CKIid,Pos(' ', CKIid), Length(CKIid));
Delete(Data,1,Pos(' ', Data));
mail := Data;
Delete(mail,Pos(' ', mail), Length(mail));
Memo1.Lines.Add('Zender: '+''''+mail+''''+ CRLF+'Sessie ID: '+''''+SesId+''''+CRLF+'Host: '+''''+HostId+''''+CRLF+'CKI hash: '+''''+CKIid+'''');
requesting := false; //we are receiving a chat request
{Create a chatwindow, like this:}
ChatForm := TMSNChatForm.Create(Form1);
ChatForm.HostId := HostId;
ChatForm.mail := mail;
ChatForm.CKIid := CKIid;
ChatForm.SesId := SesId;
ChatForm.Usrmail := loginname.text;
ChatForm.Usrname := UsrName.Caption;
ChatForm.Request:= requesting;
ChatForm.WindowState := wsMinimized;
ChatForm.Caption := mail + ' - Conversation';
ChatForm.Show;
{or like this..}
{next line is needed when we use a DLL that holds the chatform
I don't use it yet because i know too little about freeing and using DLL's
Any help would be apriciated :O)}
// ShowDllForm(Mail, Hostid, CKIid, SESid, loginname.text, UsrName.Caption, Requesting, True);
end;
{We get the next command from the server, when we request a chatsession
We request it here by dblclicking a buddy in the TListview}
if Pos('XFR', data) = 1 then
begin
Delete(Data, 1, Pos('SB ', Data)+2);
HostId := Data;
Delete(HostId, Pos(':', HostId), Length(HostId));
Delete(Data, 1, Pos('CKI ', Data)+3);
CKIid := Data;
requesting := true;
ChatForm := TMSNChatForm.Create(Form1);
ChatForm.HostId := HostId;
ChatForm.mail := Buddylist.Selected.SubItems.Strings[0];
ChatForm.CKIid := CKIid;
ChatForm.SesId := SesId;
ChatForm.Usrmail := LoginName.text;
ChatForm.Usrname := UsrName.Caption;
ChatForm.Request:= requesting;
ChatForm.Caption := Buddylist.Selected.Caption + ' - Conversation';
ChatForm.Show;
{next line is needed when we use a DLL that holds the chatform
I don't use it yet because i know too little about freeing and using DLL's
Any help would be apriciated :O)}
// ShowDllForm(Buddylist.Selected.SubItems.Strings[0], Hostid, CKIid, SESid, loginname.text, UsrName.Caption, Requesting, False);
end;
end;
end;
end;
procedure TForm1.msnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Disconnected');
end;
procedure TForm1.BuddylistDblClick(Sender: TObject);
begin
If BuddyList.SelCount = 1 then
begin
if (Buddylist.Selected.ImageIndex = 1) or (Buddylist.Selected.ImageIndex = 4) then exit;
{Request the IP for the chatserver}
MSN.Socket.SendText('XFR ' + IntToStr(trialid) + ' SB' +CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('XFR ' + IntToStr(trialid) + ' SB' +CRLF);
trialid := trialid + 1;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
name: String;
begin
{Block/Deblock a buddie}
If not BuddyList.SelCount = 1 then Exit;
name := BuddyList.Selected.Caption;
name := StringReplace(Name, ' ', '%20',[rfReplaceAll]);
{Deblocking}
if BuddyList.Selected.ImageIndex = 4 then
begin
{remove buddy from blocklist}
MSN.Socket.SendText('REM ' + IntToStr(trialid) + ' BL ' + BuddyList.Selected.SubItems.Strings[0] +CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('REM ' + IntToStr(trialid) + ' BL ' + BuddyList.Selected.SubItems.Strings[0] +CRLF);
trialid := trialid + 1;
{add buddy to the list where buddies can see my status}
MSN.Socket.SendText('ADD ' + IntToStr(trialid) + ' AL ' + BuddyList.Selected.SubItems.Strings[0] + ' ' + Name +CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('ADD ' + IntToStr(trialid) + ' AL ' + BuddyList.Selected.SubItems.Strings[0] + ' ' + Name +CRLF);
BuddyList.Selected.ImageIndex := 0;
BuddyList.Selected.SubItems.Strings[1] := 'Online';
end else
{add buddy to blocklist}
begin
MSN.Socket.SendText('REM ' + IntToStr(trialid) + ' AL ' + BuddyList.Selected.SubItems.Strings[0] +CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('REM ' + IntToStr(trialid) + ' AL ' + BuddyList.Selected.SubItems.Strings[0] +CRLF);
trialid := trialid + 1;
MSN.Socket.SendText('ADD ' + IntToStr(trialid) + ' BL ' + BuddyList.Selected.SubItems.Strings[0] + ' ' + Name +CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('ADD ' + IntToStr(trialid) + ' BL ' + BuddyList.Selected.SubItems.Strings[0] + ' ' + Name +CRLF);
BuddyList.Selected.ImageIndex := 4;
BuddyList.Selected.SubItems.Strings[1] := BuddyList.Selected.SubItems.Strings[1] + '/Blocked';
end;
trialid := trialid + 1;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
{makes the server send all possible info on buddies}
MSN.Socket.SendText('SYN ' + IntToStr(trialid) + ' 0'+CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('SYN ' + IntToStr(trialid) + ' 0' +CRLF);
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
{does nothing but cause the connection to be closed because we send an illegal command}
MSN.Socket.SendText('INTRUDER ' + IntToStr(trialid) + ' ALERT'+CRLF);
Memo1.Lines.Add('Sending...');
Memo1.Lines.Add('INTRUDER ' + IntToStr(trialid) + ' ALERT'+CRLF);
end;
end.