delphi3000 é um portal de dicas e nao uma unit ou pacote de componentes.
www.delphi3000.com []s Walter Alves Chagas Junior Projeto e desenvolvimento Telemont Engenharia [EMAIL PROTECTED] Fone: (31) 3389-8215 Fax: (31) 3389-8200 > -----Mensagem original----- > De: Gercil Junio [mailto:[EMAIL PROTECTED] > Enviada em: sexta-feira, 22 de outubro de 2004 20:52 > Para: Delphi BR > Assunto: Fw: [delphi-br] Achei isso no Delphi3000 > > > > 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 > > > > > > > > [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 <*> 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
