www.pudn.com > MSN Messenger µÄÔ´Âë.zip > chatform.pas

unit chatform; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ScktComp, StdCtrls, OleCtrls, ExtCtrls, ComCtrls; 
const 
 
  CRLF = #13 + #10; 
type 
  TMSNChatForm = class(TForm) 
    chatMSN: TClientSocket; 
    Panel1: TPanel; 
    Panel2: TPanel; 
    Button1: TButton; 
    Memo2: TMemo; 
    Splitter1: TSplitter; 
    Memo3: TMemo; 
    RichEdit1: TRichEdit; 
    Splitter2: TSplitter; 
    Memo1: TMemo; 
    Button2: TButton; 
    Timer1: TTimer; 
    Button3: TButton; 
    procedure chatMSNConnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure chatMSNDisconnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure chatMSNRead(Sender: TObject; Socket: TCustomWinSocket); 
    procedure FormShow(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure Button1Click(Sender: TObject); 
    procedure Memo2Change(Sender: TObject); 
    procedure Memo2KeyUp(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure Memo2KeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure RichEdit1Change(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
  private 
    trialId: Integer; 
  public 
    HostId, mail, CKIid, SesId, Usrmail, Usrname: String; 
    Request: Boolean; 
  end; 
 
var 
  MSNChatForm: TMSNChatForm; 
 
implementation 
 
uses Unit1, Unit2; 
 
{$R *.DFM} 
 
procedure TMSNChatForm.chatMSNConnect(Sender: TObject; Socket: TCustomWinSocket); 
begin 
  memo1.Lines.Add('Connected'); 
  if not Request then 
  {If buddy contacted us, answer} 
  begin 
    chatMSN.Socket.SendText('ANS ' + IntToStr(TrialId) + ' ' + Usrmail + ' ' 
                            + CKIid + ' '+ SesId + CRLF); 
    Memo1.Lines.Add('Sending...'); 
    Memo1.Lines.Add('ANS ' + IntToStr(TrialId) + ' ' + Usrmail + ' ' + CKIid 
                    + ' '+ SesId + CRLF); 
  end; 
  if Request then 
  {if we invite a buddy, send our info} 
  begin 
    chatMSN.Socket.SendText('USR ' + IntToStr(TrialId) + ' ' + Usrmail + ' ' 
                            + CKIid +CrLf); 
    Memo1.Lines.Add('Sending...'); 
    Memo1.Lines.Add('USR ' + IntToStr(TrialId) + ' ' + Usrmail + ' ' + CKIid 
                    +CrLf); 
  end; 
  trialid := trialid + 1; 
end; 
 
procedure TMSNChatForm.chatMSNDisconnect(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
  memo1.Lines.Add('Disconnected'); 
end; 
 
procedure TMSNChatForm.chatMSNRead(Sender: TObject; Socket: TCustomWinSocket); 
var 
  Data: String; 
  I: Integer; 
  SndFont, sndStyle: String; 
begin 
 // if FlashWindow(Handle, False) then Timer1.Enabled := True; 
  data := chatmsn.Socket.ReceiveText; 
  Memo1.Lines.Add('Receiving......'); 
  Memo1.Lines.Add('Aantal tekens: '+IntToStr(chatmsn.Socket.ReceiveLength)); 
  Memo1.Lines.Add(data); 
  Memo3.Clear; 
  Memo3.Lines.Add(Data); 
  if Pos('JOI', Data) = 1 then 
  {if a buddy joined the chat, tell the user, multiple buddies can enter the chat} 
  begin 
    Delete(Data, 1, 4); 
    Delete(Data, 1, Pos(' ',data)); 
    data := StringReplace(Data,'%20',' ',[rfReplaceAll]); 
    RichEdit1.SelAttributes.Name := 'MS Sans Serif'; 
    RichEdit1.Font.Size := 14; 
    RichEdit1.SelAttributes.Color := clGreen; 
    RichEdit1.SelAttributes.Style := []; 
    RichEdit1.Lines.Add('Chatpartner entered'); 
  end; 
  if (Pos('MSG', Data) = 1) and (Pos('Typing', Memo3.Lines.Strings[3]) = 0) then 
  {We received a message, let's go get it} 
  begin 
    For I := 0 to 4 do 
    begin 
      Data := Memo3.Lines.Strings[i]; 
      if Pos('MSG', Data) = 1 then 
      {Break up the message} 
      begin 
      {Get buddy's name} 
        Delete(Data, 1, 4); 
        Delete(Data, 1, Pos(' ',data)); 
        Delete(Data, Pos(' ', Data), Length(Data)); 
        data := StringReplace(Data,'%20',' ',[rfReplaceAll]); 
        RichEdit1.SelAttributes.Name := 'MS Sans Serif'; 
        RichEdit1.Font.Size := 14; 
        RichEdit1.SelAttributes.Color := clGray; 
        RichEdit1.SelAttributes.Style := []; 
        RichEdit1.Lines.Add(Data+ ' says:'); 
        Memo3.Lines.Delete(i); 
      end; 
      if Pos('X-MMS-IM', Data) = 1 then 
      {Get the fontstyle} 
      begin 
        Delete(Data, 1, Pos(' FN=', Data)+3); 
        sndFont := Data; 
        Delete(sndFont, Pos(';', sndFont), Length(sndFont)); 
        sndFont := StringReplace(sndFont,'%20',' ',[rfReplaceAll]); 
        RichEdit1.SelAttributes.Name := sndFont; 
        Delete(Data, 1, Pos('EF=', Data)+2); 
        if not (Data[1] = ';') then 
        begin 
          sndStyle := data; 
        end; 
        Delete(Data, 1, Pos('CO=', Data)+2); 
        Delete(Data, Pos(';', Data), Length(Data)); 
        if Length(Data) > 0 then 
          RichEdit1.SelAttributes.Color := StringToColor('$'+data) 
        else 
          RichEdit1.SelAttributes.Color := clBlack; 
        Memo3.Lines.Delete(0); 
      end; 
    end; 
    For I := 0 to 2 do Memo3.Lines.Delete(0); 
    Data := Memo3.Text; 
    Delete(Data, length(Data)-1, 2); 
    Memo3.Text := Data; 
    {when all styles have been applied, get the message} 
    RichEdit1.Lines.Add(Memo3.Text); 
  end else 
  For I := 0 to Memo3.Lines.Count - 1 do 
  begin 
    Data := Memo3.Lines.Strings[i]; 
    if (Pos('USR', Data) <> 0) then 
    {inviting user, send which buddie we want to invite} 
    begin 
      chatMSN.Socket.SendText('CAL ' + IntToStr(TrialId) + ' ' + mail +CrLf); 
      Memo1.Lines.Add('Sending...'); 
      Memo1.Lines.Add('CAL ' + IntToStr(TrialId) + ' ' + mail +CrLf); 
      trialid := trialid + 1; 
    end; 
    if (Pos('BYE', Data) <> 0) then 
    {We receive this when our buddy closes his chat window} 
    begin 
      chatMSN.Socket.SendText('CAL ' + IntToStr(TrialId) + ' ' + mail +CrLf); 
      {in this exmaple we call him back immediatly, but when ur in multi-chat 
       and someone leaves, but doesn't logoff of msn then he will be called back 
       into the chat as soon as u post a message. 
       When u can't figure out how to correct this error, then pls contact me and 
       i'll send a short example on how to do it} 
      Memo1.Lines.Add('Sending...'); 
      Memo1.Lines.Add('CAL ' + IntToStr(TrialId) + ' ' + mail +CrLf); 
      RichEdit1.SelAttributes.Name := 'MS Sans Serif'; 
      RichEdit1.Font.Size := 14; 
      RichEdit1.SelAttributes.Color := clRed; 
      RichEdit1.SelAttributes.Style := []; 
      RichEdit1.Lines.Add('Chatpartner left'); 
      trialid := trialid + 1; 
    end; 
  end; 
end; 
 
procedure TMSNChatForm.FormShow(Sender: TObject); 
begin 
  Memo1.Clear; 
  trialId := 1; 
  chatmsn.Host := HostID; 
  chatmsn.open; 
end; 
 
procedure TMSNChatForm.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
  {we leave the chatsession gracefully} 
  chatMSN.Socket.SendText('OUT'+CRLF); 
  chatMSN.Close; 
  Action := caFree; 
end; 
 
procedure TMSNChatForm.Button1Click(Sender: TObject); 
const 
  Header :String //header string 
=  'MIME-Version: 1.0' + CRLF + 
   'Content-Type: text/plain; charset=UTF-8' + CRLF + 
   'X-MMS-IM-Format: FN=Microsoft%20Sans%20Serif; EF=; CO=0; CS=0; PF=22'+ CRLF; 
var 
  Msg: String; 
begin 
  if Length(Memo2.Lines.Text) = 0 then exit; 
  Memo3.Clear; 
  Memo3.Lines.Add(Header); 
  Msg := Memo2.Lines.Text; 
  Memo3.Lines.Add(Msg); 
  Memo3.Lines.Delete(Memo3.Lines.Count); 
  Msg := Memo3.Lines.Text; 
  delete(Msg,Length(Msg)-1,2); 
  chatMSN.Socket.SendText('MSG ' + IntToStr(TrialId) + ' N ' 
                          + IntToStr(Length(Msg)) +CrLf 
                          + Msg); 
  Memo1.Lines.Add('Sending...'); 
  Memo1.Lines.Add('MSG ' + IntToStr(TrialId) + ' N ' 
                  + IntToStr(Length(Msg)) +CrLf 
                  + Msg); 
  RichEdit1.SelAttributes.Name := 'MS Sans Serif'; 
  RichEdit1.Font.Size := 14; 
  RichEdit1.SelAttributes.Color := clGray; 
  RichEdit1.SelAttributes.Style := []; 
  RichEdit1.Lines.Add(UsrName+ ' says:'); 
  RichEdit1.SelAttributes.Name := 'Lucida Handwriting'; 
  RichEdit1.SelAttributes.Color := clBlack; 
  RichEdit1.SelAttributes.Style := [fsBold]; 
  RichEdit1.Lines.Add(Memo2.Lines.Text); 
  trialid := trialid + 1; 
  Memo2.Clear; 
end; 
 
procedure TMSNChatForm.Memo2Change(Sender: TObject); 
begin 
  if Length(Memo2.Lines.Text) = 0 then 
  Button1.Enabled := False else Button1.Enabled := True; 
end; 
 
procedure TMSNChatForm.Memo2KeyUp(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  if (key = VK_RETURN) and (Shift <> [ssCtrl]) then Memo2.Clear; 
end; 
 
procedure TMSNChatForm.Memo2KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  if (Key = VK_RETURN) and (Shift <> [ssCtrl]) then 
  Button1Click(nil); 
end; 
 
procedure TMSNChatForm.RichEdit1Change(Sender: TObject); 
begin 
  SendMessage(RichEdit1.Handle, EM_SCROLLCARET, 0, 0); 
end; 
 
procedure TMSNChatForm.Button2Click(Sender: TObject); 
begin 
  Application.Terminate; 
end; 
 
procedure TMSNChatForm.Timer1Timer(Sender: TObject); 
begin 
  if FlashWindow(Handle, True) then Timer1.Enabled := False; 
end; 
 
procedure TMSNChatForm.Button3Click(Sender: TObject); 
begin 
  {add more buddies to the chatsession} 
  Form2.Showmodal; 
  if Form2.mail = '' then Exit; 
  chatMSN.Socket.SendText('CAL ' + IntToStr(TrialId) + ' ' + Form2.mail +CrLf); 
  Memo1.Lines.Add('Sending...'); 
  Memo1.Lines.Add('CAL ' + IntToStr(TrialId) + ' ' + Form2.mail +CrLf); 
  trialid := trialid + 1; 
end; 
 
end.