onde vc pego o delphi 3000 ? e essa unit funciona ?
----- Original Message ----- From: "Walter Alves Chagas Junior" <[EMAIL PROTECTED]> To: <[EMAIL PROTECTED]> Sent: Friday, October 22, 2004 6:53 PM Subject: RES: [delphi-br] Achei isso no Delphi3000 Pelo que li, esta unit permite um aplicativo feito no Delphi usar os protocolosdo Messenger []s Walter Alves Chagas Junior Projeto e desenvolvimento Telemont Engenharia [EMAIL PROTECTED] Fone: (31) 3389-8215 Fax: (31) 3389-8200 > -----Mensagem original----- > De: David Leão [mailto:[EMAIL PROTECTED] > Enviada em: sexta-feira, 22 de outubro de 2004 17:51 > Para: [EMAIL PROTECTED] > Assunto: Res: [delphi-br] Achei isso no Delphi3000 > > > > Do que se trata?? > > > > uma aplicação parecida com o messenger da microsoft?? > > []'s > > > > __________________________________________ > > David Leão Alves > > Administrador de Banco de Dados > > Governo do Estado do Amapá > > Secretaria de Estado do Meio Ambiente - SEMA > > Av. Mendonça Furtado, 53 - Centro / Macapá-AP > > 212-5318 - 212-5378 > > 212-5303 > > [EMAIL PROTECTED] > > www.sema.ap.gov.br > > -------Mensagem original------- > > > > De: [EMAIL PROTECTED] > > Data: 10/22/04 17:15:03 > > Para: '[EMAIL PROTECTED]' > > Assunto: [delphi-br] Achei isso no Delphi3000 > > > > 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 > > ([EMAIL PROTECTED]) 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 [EMAIL PROTECTED] > > 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 > > > > > > > > []s > > > > Walter Alves Chagas Junior > > Projeto e desenvolvimento > > Telemont Engenharia > > [EMAIL PROTECTED] > > Fone: (31) 3389-8215 Fax: (31) 3389-8200 > > > > > > > > > > [As partes desta mensagem que não continham texto foram removidas] > > > > > > > > -- > > <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>> > > > > Para ver as mensagens antigas, acesse: > > http://br.groups.yahoo.com/group/delphi-br/messages > > > > Para falar com o moderador, envie um e-mail para: > > [EMAIL PROTECTED] ou [EMAIL PROTECTED] > > > > Links do Yahoo! Grupos > > > > > > > > > > > > > > > > > > [As partes desta mensagem que não continham texto foram removidas] > > > > -- > <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>> > > Para ver as mensagens antigas, acesse: > http://br.groups.yahoo.com/group/delphi-br/messages > > Para falar com o moderador, envie um e-mail para: > [EMAIL PROTECTED] ou [EMAIL PROTECTED] > > Links do Yahoo! Grupos > > > > > > > > [As partes desta mensagem que não continham texto foram removidas] -- <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>> Para ver as mensagens antigas, acesse: http://br.groups.yahoo.com/group/delphi-br/messages Para falar com o moderador, envie um e-mail para: [EMAIL PROTECTED] ou [EMAIL PROTECTED] Links do Yahoo! Grupos -- <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>> Para ver as mensagens antigas, acesse: http://br.groups.yahoo.com/group/delphi-br/messages Para falar com o moderador, envie um e-mail para: [EMAIL PROTECTED] ou [EMAIL PROTECTED] Links do Yahoo! Grupos <*> Para visitar o site do seu grupo na web, acesse: http://br.groups.yahoo.com/group/delphi-br/ <*> Para sair deste grupo, envie um e-mail para: [EMAIL PROTECTED] <*> O uso que você faz do Yahoo! Grupos está sujeito aos: http://br.yahoo.com/info/utos.html
