{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: Alexander Vaga
EMail: primary: icq2000cc@hobi.ru
  secondary: alexander_vaga@hotmail.com
Web: <a href="http://icq2000cc.hobi.ru
Creation:" title="http://icq2000cc.hobi.ru
Creation:">http://icq2000cc.hobi.ru
Creation:</a> 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.