SendMess.pas

Previous  Top  Next

    
 

 

 

Code:

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Alexander Vaga

EMail:        primary:   icq2000cc@hobi.ru

             secondary: alexander_vaga@hotmail.com

Web:          http://icq2000cc.hobi.ru

Creation:     May, 2002

Legal issues: Copyright (C) 2002 by Alexander Vaga

             Kyiv, Ukraine

 

             This software is provided 'as-is', without any express or

             implied warranty.  In no event will the author be held liable

             for any  damages arising from the use of this software.

 

             Permission is granted to anyone to use this software for any

             purpose, including commercial applications, and to alter it

             and redistribute it freely.

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

 

unit SendMess;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs,  StdCtrls, Animate,

ExtCtrls, AppEvnts, ComCtrls, Inifiles, ToolWin,

Types,Packet,Main, RxCombos;

 

const PostSendInterval = 1000; //1 secs

type

TMessageTo = class(TForm)

   SendMemo: TMemo;

   ApplicationEvents1: TApplicationEvents;

   SendTimer: TTimer;

   Panel2: TPanel;

   Panel1: TPanel;

   SendAnime: TAnimatedImage;

   SendButton: TButton;

   Label3: TLabel;

   Chars: TEdit;

   CancelButton: TButton;

   MesFmtBox: TCheckBox;

   BGCombo: TColorComboBox;

   Label4: TLabel;

   FGCombo: TColorComboBox;

   Label5: TLabel;

   Panel3: TPanel;

   NNEd: TEdit;

   Label1: TLabel;

   ICQEd: TEdit;

   Label2: TLabel;

   ToolBar1: TToolBar;

   UINi: TToolButton;

   procedure CancelButtonClick(Sender: TObject);

   procedure SendButtonClick(Sender: TObject);

   procedure ApplicationEvents1Message(var Msg: tagMSG;

     var Handled: Boolean);

   procedure SendTimerTimer(Sender: TObject);

   procedure SendMemoKeyUp(Sender: TObject; var Key: Word;

     Shift: TShiftState);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

   procedure FormShow(Sender: TObject);

   procedure FGComboChange(Sender: TObject);

   procedure BGComboChange(Sender: TObject);

   procedure CalcChars;

private

   { Private declarations }

   SEQ1, SEQ2 : word;

   CharCount : integer;

public

   { Public declarations }

   User : PListRecord;

   FromWhom : longint;

end;

 

implementation

{$R *.DFM}

 

const FG=0;BG=1;

function GetColor(Memo:TMemo;Mode:byte):longint;

begin

    Result:=0;

    case Mode of

    FG:Result:=ColorToRGB(Memo.Font.Color);

    BG:Result:=ColorToRGB(Memo.Color);

    end;

    GetColor:=DSWAP(Result);

end;

 

procedure TMessageTo.CancelButtonClick(Sender: TObject);

begin

    Close;

end;

 

procedure TMessageTo.SendButtonClick(Sender: TObject);

var sNN,sMess,sUIN : string;

   tmp : PPack;

   sTmp : string;

   d1,d2 : longint;

   buf : TByteArray;

   ind,indmem : word;

const capab : string{16}= #$09#$46#$13#$49#$4C#$7F#$11#$D1+

                         #$82#$22#$44#$45#$53#$54#$00#$00;

     blok : string{26} = #$1B#$00#$07#$00#$00#$00#$00#$00+

                         #$00#$00#$00#$00#$00#$00#$00#$00+

                         #$00#$00#$00#$00#$00#$00#$03#$00+

                         #$00#$00;

    x:word=0;

begin

    sNN := NNEd.Text;

    sUIN := ICQEd.Text;

    if SendMemo.Lines.Count = 0 then exit;

    sMess := SendMemo.Text;

//     if CharCount > 1024 then exit;

 

    tmp := CreatePacket(2,SEQ);

    SNACAppend(tmp,$4,$6);

    d1:=random($7FFFFFFF);

    d2:=random($7FFFFFFF);

    SEQ1:=dswap(d1);

    SEQ2:=dswap(d2);

    PacketAppend32(tmp,dswap(d1));

    PacketAppend32(tmp,dswap(d2));

 

    case MesFmtBox.Checked of

    true:

     begin // advanced message

       PacketAppend16(tmp,swap($0002));

       PacketAppendB_String(tmp,sUIN);

       ind:=0;fillchar(buf,sizeof(buf),'^');

       PLONG(@(buf[ind]))^:=dswap($0005FFFF);inc(ind,4);// TLV(5)+len

       PWORD(@(buf[ind]))^:=0;inc(ind,2);

       PLONG(@(buf[ind]))^:=dswap(d1);inc(ind,4);

       PLONG(@(buf[ind]))^:=dswap(d2);inc(ind,4);

       MOVE(capab[1],buf[ind],length(capab));inc(ind,length(capab));

       PLONG(@(buf[ind]))^:=dswap($000A0002);inc(ind,4);//TLV(A)=$0001

       PWORD(@(buf[ind]))^:=swap($0001);inc(ind,2);

       PLONG(@(buf[ind]))^:=dswap($000F0000);inc(ind,4);//TLV(F)empty

 

       PLONG(@(buf[ind]))^:=dswap($2711FFFF);inc(ind,4);// TLV(2711)+len

       indmem:=ind-2;

       MOVE(blok[1],buf[ind],length(blok));inc(ind,length(blok));

       PBYTE(@(buf[ind]))^:=0;inc(ind,1);

       PWORD(@(buf[ind]))^:=swap($FFFF);inc(ind,2);

       PWORD(@(buf[ind]))^:=swap($0E00);inc(ind,2);

       PWORD(@(buf[ind]))^:=swap($FFFF);inc(ind,2);

       PLONG(@(buf[ind]))^:=$0;inc(ind,4);

       PLONG(@(buf[ind]))^:=$0;inc(ind,4);

       PLONG(@(buf[ind]))^:=$0;inc(ind,4);//12 bytes=0

       PBYTE(@(buf[ind]))^:=1;inc(ind,1); // msg-type

       PBYTE(@(buf[ind]))^:=0;inc(ind,1); //sub_msg-type

       PWORD(@(buf[ind]))^:=swap($0000);inc(ind,2);

       PWORD(@(buf[ind]))^:=swap($0100);inc(ind,2);

 

       PWORD(@(buf[ind]))^:=length(sMess)+1;inc(ind,2);//LE len sMess+1

       move(sMess[1],buf[ind],length(sMess));inc(ind,length(sMess));

       PBYTE(@(buf[ind]))^:=0;inc(ind,1); //#00

       PLONG(@(buf[ind]))^:=dswap(GetColor(SendMemo,FG));inc(ind,4);//dswap($00FF0000);//FG

       PLONG(@(buf[ind]))^:=dswap(GetColor(SendMemo,BG));inc(ind,4);//dswap($08080800);//BG

 

       PWORD(@(buf[2]))^:=swap(ind-4);//len TLV(5)

       x:=length(blok)+27+length(sMess)+9;

       PWORD(@(buf[indmem]))^:=swap(x);//len TLV(2711)-!!!!!!!!!!!!

       PacketAppend(tmp,@buf,ind);

       // ack request ?

       PacketAppend32(tmp,dswap($00030000));// TLV(3)empry

     end;

    false:

     begin // simple message

       PacketAppend16(tmp,swap($0001));

       PacketAppendB_String(tmp,sUIN);

       PacketAppend16(tmp,swap(2));//tlv(2)

       PacketAppend16(tmp,swap(13+length(sMess)));//len tlv(2)

       PacketAppend32(tmp,dswap($05010001));

       PacketAppend16(tmp,swap($0101));

       PacketAppend8(tmp,$01);//7 bytes

       PacketAppend16(tmp,swap(4+length(sMess)));//lenmsg+4

       PacketAppend32(tmp,dswap($0)); //4 bytes=0

       PacketAppend(tmp,@(sMess[1]),length(sMess));

       PacketAppend16(tmp,swap($0006));//tlv(6)

       PacketAppend16(tmp,0);//len tlv(6)=0

     end;

    end;//case

    Form1.PacketSend(tmp);

    M(SendMemo,'Sending...');

    case MesFmtBox.Checked of

    true:  sTmp := '[A] ';

    false: sTmp := '[S] ';

    end;

    sTmp := '->'+sTmp+DateTimeToStr(Now)+' '+sNN+' ['+sUIN+']  "'+sMess+'"';

    M(Form1.Memo,sTmp);  Form1.LogMessage(sTmp);

 

    if MesFmtBox.Checked then begin

      SendAnime.Active := true;

      SendMemo.Enabled := false;

      SendButton.Enabled := false;

      MesFmtBox.Enabled := false;

    end else Close;

end;

 

procedure TMessageTo.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

begin

    if Msg.message = msg_OnSrv then begin

      if (Msg.wParam = SEQ1)and(Msg.lParam = SEQ2) then begin

        SendAnime.Active := false;

        M(SendMemo,'<Srv`s ACK>');

        Handled := true;

      end;

    end;

    if Msg.message = msg_Sent then begin

      if (Msg.wParam = SEQ1)and(Msg.lParam = SEQ2) then begin

        SendAnime.Active := false;

        SendTimer.Interval := PostSendInterval;

        SendTimer.Enabled := true;

        M(SendMemo,'Message sent... ');

        Handled := true;

      end;

    end;

    if Msg.message = msg_SentErr then begin

      if (Msg.wParam = SEQ1)and(Msg.lParam = SEQ2) then begin

        SendAnime.Active := false;

        M(SendMemo,'Server`s Error... try SIMPLY message-format');

        SendMemo.Enabled := true;

        SendButton.Enabled := true;

        MesFmtBox.Enabled := true;

        Handled := true;

      end;

    end;

end;

 

procedure TMessageTo.SendTimerTimer(Sender: TObject);

begin

    SendTimer.Enabled := false;

    Close;

end;

 

procedure TMessageTo.CalcChars;

begin

    CharCount := length(SendMemo.Text);

    case CharCount of

    0..1023: with Chars do begin Font.Color := clGreen;  Color := clMenu; end;

        else with Chars do begin Font.Color := clYellow; Color := clRed;  end;

    end;

    Chars.Text := inttostr(CharCount);

end;

 

procedure TMessageTo.SendMemoKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

    CalcChars;

end;

 

procedure TMessageTo.FormClose(Sender: TObject; var Action: TCloseAction);

begin

    User^.EXTRA.BG := ColorToString(SendMemo.Color);

    User^.EXTRA.FG := ColorToString(SendMemo.Font.Color);

    Destroy;

end;

 

procedure TMessageTo.FormShow(Sender: TObject);

var sNN : string;

begin

    SendMemo.Color:=StringToColor(User^.EXTRA.BG);

    BGCombo.ColorValue:=SendMemo.Color;

    SendMemo.Font.Color:=StringToColor(User^.EXTRA.FG);

    FGCombo.ColorValue:=SendMemo.Font.Color;

    if User^.EXTRA.ICON_INDEX = simply_icq then

      UINi.ImageIndex := offline else

      UINi.ImageIndex := User^.EXTRA.ICON_INDEX;

    if (ICQStatus = STATE_INVISIBLE)or

       (User^.EXTRA.ICON_INDEX = simply_icq)then begin

       MesFmtBox.Enabled := false;

       MesFmtBox.Checked := false;

    end else begin

       MesFmtBox.Enabled := true;

       MesFmtBox.Checked := true;

    end;

    sNN := NNed.Text;

    CalcChars;

end;

 

procedure TMessageTo.FGComboChange(Sender: TObject);

begin

    SendMemo.Font.Color:=FGCombo.ColorValue;

    SendMemo.SetFocus;

end;

 

procedure TMessageTo.BGComboChange(Sender: TObject);

begin

    SendMemo.Color:=BGCombo.ColorValue;

    SendMemo.SetFocus;

end;

 

end.