unit Main;
interface
uses
Windows, Messages, SysUtils, Graphics,
Forms, Dialogs, ComCtrls, Buttons, ToolWin,
ExtCtrls, Menus, ImgList, ScktComp, Controls,
StdCtrls, Classes, inifiles,
Types, Packet;
type
TForm1 = class(TForm)
MainT: TTimer;
StatusMenu: TPopupMenu;
OnlineConnected1: TMenuItem;
FreeForChat1: TMenuItem;
sep1: TMenuItem;
Away1: TMenuItem;
NAExtendedAway1: TMenuItem;
sep2: TMenuItem;
OccupiedUrgentMsgs1: TMenuItem;
DNDDoNotDisturb1: TMenuItem;
sep3: TMenuItem;
PrivacyInvisible1: TMenuItem;
OfflineDiscconnect1: TMenuItem;
Panel1: TPanel;
Panel3: TPanel;
ToolBar1: TToolBar;
StatusBtn: TToolButton;
Splitter1: TSplitter;
CLI: TClientSocket;
BG: TPanel;
Memo: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure InitUser;
procedure InitLogs;
procedure CloseLogs;
procedure ConnectMode(Mode : boolean);
procedure MainTTimer(Sender: TObject);
procedure OnlineConnected1Click(Sender: TObject);
procedure Away1Click(Sender: TObject);
procedure DNDDoNotDisturb1Click(Sender: TObject);
procedure PrivacyInvisible1Click(Sender: TObject);
procedure OfflineDiscconnect1Click(Sender: TObject);
procedure OccupiedUrgentMsgs1Click(Sender: TObject);
procedure FreeForChat1Click(Sender: TObject);
procedure NAExtendedAway1Click(Sender: TObject);
procedure CLIConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure CLI_ReadData(Sender: TObject; Socket: TCustomWinSocket);
procedure CLIDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure PacketSend(p:PPack);
procedure ShowUserONStatus(p:PPack);
procedure SNAC_15_3(p:PPack);
procedure SNAC_4_7(p:PPack);
procedure icq_Login(Status : longint);
procedure SetStatus(Status:longint);
procedure StatusChange(Status:longint);
procedure AuthorizePart(p:PPack);
procedure WorkPart(p:PPack);
procedure DoMsg(on_off:boolean;typemes,lenmes:integer;
data:PCharArray; r_uin:longint; DateTime:TDateTime);
procedure DoSimpleMsg(r_uin:longint; Text:string);
procedure ClearFIFO;
procedure debugFILE(tmp:PPack; Direction:char);
procedure LogMessage(s:string);
private{ Private declarations }
public { Public declarations }
protected { Protected declarations }
published { Published declarations }
end;
var Form1 : TForm1;
UIN : longint;
NICK : string;
PASSWORD : string;
ICQStatus : longint;
DIM_IP : IPArray;
Local_IP : string;
Local_Name : string;
SEQ : word;
FLAP : FLAP_HDR;
FLAP_DATA : TByteArray;
Index : integer;
NeedBytes : integer;
sCOOKIE : string;
Cookie : word;
WorkAddress : string;
WorkPort : integer;
log,mess : text;
const
isLogged : boolean = false;
isAuth : boolean = true;
isHDR : boolean = true;
HeadFIFO : PFLAP_Item = nil;
implementation
{$R *.DFM}
(****************************************************************)
procedure TForm1.PacketSend(p:PPack);
begin
SetLengthPacket(p);
CLI.socket.sendbuf(p^.data,p^.length);
debugFILE(p,'>');
PacketDelete(p);
end;
(****************************************************************)
procedure TForm1.ConnectMode(Mode : boolean);
begin
case Mode of
true: begin
isLogged := true;
case ICQStatus of
STATE_ONLINE: StatusBtn.Caption := 'online';
STATE_AWAY: StatusBtn.Caption := 'away';
STATE_DND: StatusBtn.Caption := 'dnd';
STATE_OCCUPIED: StatusBtn.Caption := 'occupied';
STATE_FREEFORCHAT: StatusBtn.Caption := 'freeforchat';
STATE_N_A: StatusBtn.Caption := 'na';
STATE_INVISIBLE: StatusBtn.Caption := 'invisible';
else StatusBtn.Caption := 'offline';
end;
end;
false: begin
If CLI.Active then CLI.Close;
ClearFIFO;
isLogged := false;
StatusBtn.Caption := 'offline';
end;
end; // case
end;
(****************************************************************)
procedure TForm1.FormCreate(Sender: TObject);
begin
InitUser;
InitLogs;
end;
(****************************************************************)
procedure TForm1.debugFILE(tmp:PPack; Direction:char);
begin
writeln(log,DateTimeToStr(Now)+' =================================');
writeln(log,Direction+'FLAP: '+inttohex(tmp^.Sign,2)+' '+
inttohex(tmp^.ChID,2)+' '+inttohex(swap(tmp^.SEQ),4)+' '+
inttohex(swap(tmp^.Len),4)+' '+'['+inttostr(swap(tmp^.Len))+']');
writeln(log,Direction+'SNACK: $'+inttohex(swap(tmp^.SNAC.FamilyID),4)+
':'+inttohex(swap(tmp^.SNAC.SubTypeID),4)+
' flags:$'+inttohex(swap(word(tmp^.SNAC.Flags)),4)+
' ref:$'+inttohex(DSwap(tmp^.SNAC.RequestID),8));
writeln(log,Dim2Str(@(tmp^.FLAP_BODY),swap(tmp^.FLAP.Len)));
writeln(log,Dim2Hex(@(tmp^.FLAP_BODY),swap(tmp^.FLAP.Len)));
writeln(log,'');
end;
(****************************************************************)
procedure TForm1.CLIDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
M(Memo,'Disconnected: '+Socket.RemoteAddress);
end;
(****************************************************************)
procedure TForm1.CLIConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
M(Memo,'Connected: '+Socket.RemoteAddress);
end;
(****************************************************************)
procedure TForm1.CLI_ReadData(Sender: TObject; Socket: TCustomWinSocket);
var num,Bytes,fact : integer;
pFIFO,CurrFIFO : PFLAP_Item;
buf : array[0..100] of byte;
begin
num := Socket.ReceiveLength;
if isHDR then begin // is it a flap header ?
if num>=6 then begin
Socket.ReceiveBuf(FLAP,6);
NeedBytes := swap(FLAP.Len);
Index := 0; // FLAP_DATA[0]
isHDR := not isHDR; // goto FLAP_DATA
end else begin
M(memo,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
Socket.ReceiveBuf(buf,num);
M(Memo,Dim2Hex(@(buf),num));
M(memo,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
end;
end else begin // DATA-BLOCK
Bytes := NeedBytes;
fact := Socket.ReceiveBuf(FLAP_DATA[Index],Bytes);
inc(Index,fact);
dec(NeedBytes,fact);
if NeedBytes = 0 then begin
New(pFIFO);
pFIFO^.FLAP := FLAP;
pFIFO^.Next := nil;
GetMem(pFIFO^.DATA,Index);
move(FLAP_DATA,PFIFO^.Data^,swap(FLAP.Len));
// AddLast
CurrFIFO:=HeadFIFO;
if HeadFIFO<>nil then begin
while CurrFIFO<>nil do
if CurrFIFO^.Next=nil then begin
CurrFIFO^.Next:=pFIFO;
break;
end else CurrFIFO:=CurrFIFO^.Next;
end else HeadFIFO:=pFIFO; // list is empty
isHDR := not isHDR; // goto FLAP_HDR
end;
end;
end;
(****************************************************************)
procedure TForm1.MainTTimer(Sender: TObject);
var FindFIFO : PFLAP_Item;
tmp : PPack;
begin
MainT.Enabled := false;
while HeadFIFO<>nil do begin
// Get HeadFIFO
FindFIFO := HeadFIFO;
if HeadFIFO^.Next=nil then HeadFIFO := nil
else HeadFIFO := HeadFIFO^.Next;
// creating new packet
tmp := PacketNew;
// Fill the packet
PacketAppend(tmp,@FindFIFO^.FLAP,sizeof(FLAP_HDR));
PacketAppend(tmp,FindFIFO^.DATA,swap(FindFIFO^.FLAP.Len));
// Release packet`s memory
FreeMem(FindFIFO^.DATA,swap(FindFIFO^.FLAP.Len));
Dispose(FindFIFO);
//
debugFILE(tmp,'< ');
if isAuth then AuthorizePart(tmp)
else WorkPart(tmp);
// Deleting packet
PacketDelete(tmp);
end;
MainT.Enabled := true;
end;
(****************************************************************)
procedure TForm1.AuthorizePart(p:PPack);
var ss : string;
T : integer;
tmp : PPack;
begin
PacketGoto(p,sizeof(FLAP_HDR)); // goto FLAP_DATA
// Authorize Server ACK
if (swap(p^.Len)=4)and
(swap(p^.SNAC.FamilyID)=0)and
(swap(p^.SNAC.SubTypeID)=1) then begin
M(Memo,'< Authorize Server CONNECT');
// Auth Request (Login)
SEQ := random($7FFF);
tmp := CreatePacket(1,SEQ);
PacketAppend32(tmp,DSwap(1));
TLVAppendStr(tmp,$1,s(UIN));
TLVAppendStr(tmp,$2,Calc_Pass(PASSWORD));
TLVAppendStr(tmp,$3,'ICQ Inc. - Product of ICQ (TM).2000a.4.31.1.3143.85');
TLVAppendWord(tmp,$16,$010A);
TLVAppendWord(tmp,$17,$0004); // for 2000a
TLVAppendWord(tmp,$18,$001F);
TLVAppendWord(tmp,$19,$0001);
TLVAppendWord(tmp,$1A,$0C47);
TLVAppendDWord(tmp,$14,$00000055);
TLVAppendStr(tmp,$0F,'en');
TLVAppendStr(tmp,$0E,'us');
PacketSend(tmp);
M(Memo,'>Auth Request (Login)');
end else // Auth Response (COOKIE or ERROR)
if (TLVReadStr(p,ss)=1){and(ss=s(UIN))}then begin
T := TLVReadStr(p,ss);
case T of
5: begin // BOS-IP:PORT
M(Memo,'< Auth Responce (COOKIE)');
WorkAddress := copy(ss,1,pos(':',ss)-1);
WorkPort := strtoint(copy(ss,pos(':',ss)+1,length(ss)-pos(':',ss)));
if (TLVReadStr(p,sCOOKIE)=6)then begin;
// Empty packet for disconnect
tmp:=CreatePacket(4,SEQ); // ChID=4
PacketSend(tmp);
// Disconnect from Autorize Server
OfflineDiscconnect1Click(self);
isAuth := false;
// Connecting to BOS
CLI.Address := WorkAddress;
CLI.Host := '';
CLI.Port := WorkPort;
M(Memo,'');
M(Memo,'>>> Connecting to BOS: '+ss);
CLI.Open;
end;
end;
4,8: begin
M(Memo,'< Auth ERROR');
M(Memo,'TLV($'+inttohex(T,2)+') ERROR');
M(Memo,'STRING: '+ss);
if pos('http://',ss)>0 then begin
end;
TLVReadStr(p,ss); M(Memo,ss);
OfflineDiscconnect1Click(self);
M(Memo,'');
end;
end;
end;
end;
(****************************************************************)
procedure TForm1.WorkPart(p:PPack);
var ss,ss2,sErr : string;
// T : integer;
tmp : PPack;
i : integer;
begin
if p^.FLAP.ChID = 4 then begin // SERVER GONNA DISCONNECT
PacketGoto(p,sizeof(FLAP_HDR));
TLVReadStr(p,ss); M(Memo,ss);
TLVReadStr(p,ss2); M(Memo,ss2);
OfflineDiscconnect1Click(self);
sErr:='Str1: ';
for i:=1 to length(ss) do sErr:=sErr+inttohex(byte(ss[i]),2)+' ';
sErr:=sErr+#13#10+'Str2: '+ss2+#13#10+#13#10;
ShowMessage('Another Computer Use YOUR UIN!'#13#10+#13#10+
sErr+'...i gonna to disconnect');
exit;
end;
PacketGoto(p,sizeof(FLAP_HDR)+sizeof(SNAC_HDR));
// BOS Connection ACK
if (swap(p^.Len)=4)and
(swap(p^.SNAC.FamilyID)=0)and
(swap(p^.SNAC.SubTypeID)=1) then begin
M(Memo,'< BOS connection ACK');
// BOS Sign-ON (COOKIE)
SEQ := random($7FFF);
tmp := CreatePacket(1,SEQ);
PacketAppend32(tmp,DSwap(1));
TLVAppendStr(tmp,$6,sCOOKIE);
PacketSend(tmp);
M(Memo,'>BOS Sign-ON (COOKIE)');
end else // BOS-Host ready
if (swap(p^.SNAC.FamilyID)=1)and
(swap(p^.SNAC.SubTypeID)=3) then begin
M(Memo,'< BOS-Host ready');
// I`m ICQ client, not AIM
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$1,$17);
PacketAppend32(tmp,dswap($00010003));
PacketAppend32(tmp,dswap($00020001));
PacketAppend32(tmp,dswap($00030001));
PacketAppend32(tmp,dswap($00150001));
PacketAppend32(tmp,dswap($00040001));
PacketAppend32(tmp,dswap($00060001));
PacketAppend32(tmp,dswap($00090001));
PacketAppend32(tmp,dswap($000A0001));
PacketSend(tmp);
M(Memo,'>"I`m ICQ client, not AIM"');
end else // ACK to "I`m ICQ Client"
if (swap(p^.SNAC.FamilyID)=$1)and // ACK
(swap(p^.SNAC.SubTypeID)=$18) then begin
M(Memo,'< ACK to "I`m ICQ client"');
// Rate Information Request
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$1,$6);
PacketSend(tmp);
M(Memo,'>Rate Information Request');
end else // Rate Information Response
if (swap(p^.SNAC.FamilyID)=$1)and
(swap(p^.SNAC.SubTypeID)=$7) then begin
M(Memo,'< Rate Information Response');
// ACK to Rate Information Response
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$1,$8);
PacketAppend32(tmp,DSwap($00010002));
PacketAppend32(tmp,DSwap($00030004));
PacketAppend16(tmp,Swap($0005));
PacketSend(tmp);
M(Memo,'>ACK to Rate Response');
// Request Personal Info
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$1,$0E);
PacketSend(tmp);
M(Memo,'>Request Personal Info');
// Request Rights for Location service
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$2,$02);
PacketSend(tmp);
M(Memo,'>Request Rights for Location service');
// Request Rights for Buddy List
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$3,$02);
PacketSend(tmp);
M(Memo,'>Request Rights for Buddy List');
// Request Rights for ICMB
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$4,$04);
PacketSend(tmp);
M(Memo,'>Request Rights for ICMB');
// Request BOS Rights
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$9,$02);
PacketSend(tmp);
M(Memo,'>Request BOS Rights');
end else // Personal Information
if (swap(p^.SNAC.FamilyID)=$1)and
(swap(p^.SNAC.SubTypeID)=$F) then begin
M(Memo,'< Personal Information');
end else // Rights for location service
if (swap(p^.SNAC.FamilyID)=$2)and
(swap(p^.SNAC.SubTypeID)=$3) then begin
M(Memo,'< Rights for location service');
end else // Rights for byddy list
if (swap(p^.SNAC.FamilyID)=$3)and
(swap(p^.SNAC.SubTypeID)=$3) then begin
M(Memo,'< Rights for byddy list');
end else // Rights for ICMB
if (swap(p^.SNAC.FamilyID)=$4)and
(swap(p^.SNAC.SubTypeID)=$5) then begin
M(Memo,'< Rights for ICMB');
end else // BOS Rights
if (swap(p^.SNAC.FamilyID)=$9)and
(swap(p^.SNAC.SubTypeID)=$3) then begin
M(Memo,'< BOS Rights');
// Set ICMB parameters
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$4,$2);
PacketAppend16(tmp,swap($0));
PacketAppend32(tmp,dswap($3));
PacketAppend16(tmp,swap($1F40));
PacketAppend16(tmp,swap($03E7));
PacketAppend16(tmp,swap($03E7));
PacketAppend16(tmp,swap($0));
PacketAppend16(tmp,swap($0));
PacketSend(tmp);
M(Memo,'>Set ICMB parameters');
// Set User Info (capability)
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$2,$4); // tlv(5)=capability
TLVAppendStr(tmp,5,#$09#$46#$13#$49#$4C#$7F#$11#$D1+
#$82#$22#$44#$45#$53#$54#$00#$00+
#$09#$46#$13#$44#$4C#$7F#$11#$D1+
#$82#$22#$44#$45#$53#$54#$00#$00);
PacketSend(tmp);
M(Memo,'>Set User Info (capability)');
// Send Contact List
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$3,$4);
PacketAppendB_String(tmp,s(UIN));
// PacketAppendB_String(tmp,s(someUIN));
PacketSend(tmp);
M(Memo,'>Send Contact List (1)');
case ICQStatus of
STATE_INVISIBLE: begin
// Send Visible List
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$9,$5);
PacketSend(tmp);
M(Memo,'>Send Visible List (0)');
end;
else begin
// Send Invisible List
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$9,$7);
PacketSend(tmp);
M(Memo,'>Send Invisible List (0)');
end;
end;//case
ConnectMode(true);
SetStatus(ICQStatus);
M(Memo,'>Set Status Code');
// Client Ready
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$1,$2);
PacketAppend32(tmp,dswap($00010003));
PacketAppend32(tmp,dswap($0110028A));
PacketAppend32(tmp,dswap($00020001));
PacketAppend32(tmp,dswap($0101028A));
PacketAppend32(tmp,dswap($00030001));
PacketAppend32(tmp,dswap($0110028A));
PacketAppend32(tmp,dswap($00150001));
PacketAppend32(tmp,dswap($0110028A));
PacketAppend32(tmp,dswap($00040001));
PacketAppend32(tmp,dswap($0110028A));
PacketAppend32(tmp,dswap($00060001));
PacketAppend32(tmp,dswap($0110028A));
PacketAppend32(tmp,dswap($00090001));
PacketAppend32(tmp,dswap($0110028A));
PacketAppend32(tmp,dswap($000A0003));
PacketAppend32(tmp,dswap($0110028A));
PacketSend(tmp);
M(Memo,'>Client Ready');
// Get offline messages
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$15,$2);
PacketAppend32(tmp,dswap($0001000A));
PacketAppend16(tmp,swap($0800));
PacketAppend32(tmp,UIN);
PacketAppend16(tmp,swap($3C00));
PacketAppend16(tmp,swap($0200));
PacketSend(tmp);
M(Memo,'>Get offline messages');
// Get Banner Address
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$15,$2);
PacketAppend16(tmp,swap($0001));
ss:='BannersIP';
PacketAppend16(tmp,swap(14+length(ss)+1));
PacketAppend16(tmp,swap($2100));
PacketAppend32(tmp,UIN);
PacketAppend16(tmp,swap($D007)); // Type
PacketAppend16(tmp,swap($0300)); // Cookie
PacketAppend16(tmp,swap($9808)); // SubType = xml-style (LNTS)
PacketAppendString(tmp,ss); // 'BannersIP'
PacketSend(tmp);
M(Memo,'>Get Banner Address');
end else // Reject notification
if (swap(p^.SNAC.FamilyID)=$3)and
(swap(p^.SNAC.SubTypeID)=$0A) then begin
M(Memo,'');
M(Memo,'< Reject from UIN: '+PacketReadB_String(p));
M(Memo,'');
end else // UIN ON-line
if (swap(p^.SNAC.FamilyID)=$3)and
(swap(p^.SNAC.SubTypeID)=$0B) then begin
M(Memo,'');
ShowUserONStatus(p);
M(Memo,'');
end else // UIN OFF-line ???
if (swap(p^.SNAC.FamilyID)=$3)and
(swap(p^.SNAC.SubTypeID)=$0C) then begin
M(Memo,'');
M(Memo,'< UIN OFF-line: '+PacketReadB_String(p));
M(Memo,'');
end else // SNAC 15,3 Meny purposes (offlines messages)
if (swap(p^.SNAC.FamilyID)=$15)and
(swap(p^.SNAC.SubTypeID)=$3) then begin
M(Memo,'');
SNAC_15_3(p);
M(Memo,'');
end else // SNAC 4,7 Incoming message
if (swap(p^.SNAC.FamilyID)=$4)and
(swap(p^.SNAC.SubTypeID)=$7) then begin
M(Memo,'');
SNAC_4_7(p);
M(Memo,'');
end else begin
M(Memo,'');
M(Memo,'???? Unrecognized SNAC: ????????');
M(Memo,'???? SNAC [$'+inttohex(swap(p^.SNAC.FamilyID),2)+':$'+
inttohex(swap(p^.SNAC.SubTypeID),2)+']');
M(Memo,'');
end;
end;
(****************************************************************)
procedure TForm1.ShowUserONStatus(p:PPack);
var T : word;
k,cnt : integer;
UINonline,TLV : string;
r_ip,r_r_ip,r_status : longint;
begin
UINonline := PacketReadB_String(p);
M(Memo,'< UIN ON-line: '+UINonline);
PacketRead16(p);
cnt := swap(PacketRead16(p));
for k:=1 to cnt do begin
T := TLVReadStr(p,TLV);
case T of
6: begin // STATUS
move(TLV[1],IPArray(r_status),4);
r_status := DSwap(r_status);
M(Memo,'#'+s(k)+' TLV($'+inttohex(T,2)+')'+
' STATUS: $'+inttohex(r_status,8));
end;
$A: begin // IP
move(TLV[1],IPArray(r_ip),4);
M(Memo,'#'+s(k)+' TLV($'+inttohex(T,2)+')'+
' IP: '+IPToStr(IPArray(r_ip)));
end;
$C: begin // REAL_IP
move(TLV[1],IPArray(r_r_ip),4);
M(Memo,'#'+s(k)+' TLV($'+inttohex(T,2)+')'+
' Real IP: '+IPToStr(IPArray(r_r_ip)));
end;
//else M(Memo,'??? #'+s(k)+' TLV($'+inttohex(T,2)+')');
end;
end;
end;
(****************************************************************)
procedure TForm1.SNAC_15_3(p:PPack);
var MessageType : word;
{myUIN,}hisUIN : longint;
SubType : array[0..3] of byte;
MessageSubType : longint absolute SubType;
year,month,day,hour,minute,typemes,{subtypemes,}lenmes : word;
tmp : PPack;
sTemp,URL : string;
begin
PacketRead32(p);
PacketRead16(p);
{myUIN := }PacketRead32(p);
MessageType := swap(PacketRead16(p));
{Cookie := }swap(PacketRead16(p));
//M(Memo,'< Cookie: $'+inttohex(Cookie,4));
case MessageType of
$DA07: begin
SubType[3] := 0;
SubType[2] := PacketRead8(p);
SubType[1] := PacketRead8(p);
SubType[0] := PacketRead8(p);
if(MessageSubType and $FF)<>$0A then begin
M(Memo,'< FAIL: SubType:$'+inttohex(MessageSubType,4));
end;
case MessageSubType of
$A2080A: begin // Banner URL
sTemp := PacketReadString(p);
sTemp[pos('< ',sTemp)] :='_';
URL := 'http://'+copy(sTemp,pos('>',sTemp)+1,
pos('< ',sTemp)-pos('>',sTemp)-1);
M(Memo,'< Banner HTML-Server: '+URL);
end;
else M(Memo,'< ??? SNAC 15,3; Type:$DA07; SubType: $'+
inttohex(MessageSubType,6));
end;//
end;
$4200: begin // END of offline messages
//M(Memo,'< Message-Type: $'+inttohex(MessageType,4));
M(Memo,'< End of OFFline messages');
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$15,$2);
PacketAppend16(tmp,swap($0001)); // TLV(1)
PacketAppend32(tmp,dswap($000A0800));
PacketAppend32(tmp,UIN);
PacketAppend16(tmp,swap($3E00)); // ACK
PacketAppend16(tmp,swap($0200));
PacketSend(tmp);
//M(Memo,'>ACK it');
end;
$4100: begin // OFFLINE MESSAGE
hisUIN := PacketRead32(p); // LE
//M(Memo,'< Message-Type: $'+inttohex(MessageType,4));
M(Memo,'< OFFLINE MESSAGE from UIN: '+s(hisUIN));
year := PacketRead16(p);
month := PacketRead8(p);
day := PacketRead8(p);
hour := PacketRead8(p);
minute := PacketRead8(p);
typemes := PacketRead8(p);
{subtypemes := }PacketRead8(p);
lenmes := PacketRead16(p);
DoMsg(false,typemes,lenmes,PCharArray(@(p^.data[p^.cursor])),
hisUIN,UTC2LT(year,month,day,hour,minute));
end;
else M(Memo,'< ??? SNAC 15,3; Type: $'+inttohex(MessageType,4));
end;//case
end;
(****************************************************************)
procedure TForm1.SNAC_4_7(p:PPack); // INCOMING MESSAGES
var i,cnt,T,MessageFormat,SubMode,SubMode2,Empty : word;
{myUIN,}hisUIN : longint;
SubType : array[0..3] of byte;
MessageSubType : longint absolute SubType;
tmp,tmp2,tmp3 : PPack;
sTemp : string;
dTemp : TByteArray;
typemes,{subtypemes,}unk,modifier,lenmes : word;
//for snac 4,0B (ack for msg-2 type)
d1,d2 : longint;
ACK : TByteArray;
ind : word;
begin
d1:=PacketRead32(p);
d2:=PacketRead32(p);
MessageFormat := swap(PacketRead16(p));
sTemp := PacketReadB_String(p);
ind:=0;
PLONG(@(ACK[ind]))^:=d1; inc(ind,4);
PLONG(@(ACK[ind]))^:=d2; inc(ind,4);
PWORD(@(ACK[ind]))^:=swap(MessageFormat);inc(ind,2);
PBYTE(@(ACK[ind]))^:=length(sTemp);inc(ind,1);
MOVE(sTemp[1],ACK[ind],length(sTemp));inc(ind,length(sTemp));
PWORD(@(ACK[ind]))^:=swap($0003);inc(ind,2);
try hisUIN := strtoint(sTemp); except hisUIN:=0; end;
M(Memo,'< From: '+sTemp);
PacketRead16(p); //warning level? garbage of OSCAR protocol
cnt := swap(PacketRead16(p)); // num of TLVs
for i:=1 to cnt do
if TLVReadStr(p,sTemp)=6 then begin { this is a HIS STATUS } end;
case MessageFormat of
$0001: begin
//M(Memo,'< Message-format: 1 (SIMPLY message)');
TLVReadStr(p,sTemp);
// copy TLV(2) to TMP
tmp := PacketNew;
PacketAppend(tmp,@(sTemp[1]),length(sTemp));
PacketGoto(tmp,0); // goto !!!!!
// work it
PacketRead16(tmp);
PacketRead16(tmp);
PacketRead8(tmp);
PacketRead16(tmp);
lenmes := swap(PacketRead16(tmp))-4;
PacketRead32(tmp);
PacketRead(tmp,@sTemp[1],lenmes);
SetLength(sTemp,lenmes);
DoSimpleMsg(hisUIN,sTemp);
// delete TMP
PacketDelete(tmp);
end;
$0002: begin
//M(Memo,'< Message-format: 2 (ADVANCED message)');
TLVReadStr(p,sTemp);
// copy TLV(5) to TMP
tmp := PacketNew;
PacketAppend(tmp,@(sTemp[1]),length(sTemp));
PacketGoto(tmp,0); // goto !!!!!
// work it
SubMode := swap(PacketRead16(tmp));
PacketRead32(tmp);
PacketRead32(tmp);
PacketRead(tmp,@dTemp,16); //capability 16 bytes
case SubMode of
$0000: begin
//M(Memo,'SubMode: $0000 NORMAL');
{T := }TLVReadWord(tmp,SubMode2);// 0001-normal 0002-file reply
TLVReadWord(tmp,Empty);// TLV(F) empty
T := TLVReadStr(tmp,sTemp);
if T=$2711 then begin
MOVE(sTemp[1],ACK[ind],47);inc(ind,47);
PLONG(@(ACK[ind]))^:=0; inc(ind,4);
//******************************************
tmp2 := PacketNew;
PacketAppend(tmp2,@(sTemp[1]),length(sTemp));
PacketGoto(tmp2,0); // goto !!!!!
PacketRead(tmp2,@dTemp,26);
PacketRead8(tmp2);
PacketRead16(tmp2);
PacketRead16(tmp2);
PacketRead16(tmp2);
PacketRead(tmp2,@dTemp,12);
typemes := PacketRead8(tmp2);
{subtypemes := }PacketRead8(tmp2);
unk:=swap(PacketRead16(tmp2));//0200
modifier:=swap(PacketRead16(tmp2));//0100
M(Memo,'Unk: $'+inttohex(unk,4));
M(Memo,'Modifier: $'+inttohex(modifier,4));
lenmes := PacketRead16(tmp2);
DoMsg(true,typemes,lenmes,PCharArray(@(tmp2^.data[tmp2^.cursor])),
hisUIN,Now2DateTime);
// delete TMP2
PacketDelete(tmp2);
PWORD(@(ACK[ind]))^:=1; inc(ind,2);
PBYTE(@(ACK[ind]))^:=0; inc(ind,1);
PLONG(@(ACK[ind]))^:=0; inc(ind,4);
PLONG(@(ACK[ind]))^:=-1; inc(ind,4);
// Sending Ack
tmp3 := CreatePacket($2,SEQ);
SNACAppend(tmp3,$4,$0B);
PacketAppend(tmp3,@ACK[0],ind);
PacketSend(tmp3);
//******************************************
end;// IF
end; //Submode:$0000
$0001: M(Memo,'SubMode:$0001 ??? message canceled ???');
$0002: M(Memo,'SubMode:$0002 FILE-ACK (not yet)');
end;//case SubMode
// delete TMP
PacketDelete(tmp);
end;
$0004: begin
//M(Memo,'< Message-format: 4 (url or contacts or auth-req)');
TLVReadStr(p,sTemp);
// copy TLV(5) to TMP
tmp := PacketNew;
PacketAppend(tmp,@(sTemp[1]),length(sTemp));
PacketGoto(tmp,0); // goto !!!!!
// work it
hisUIN := PacketRead32(tmp);
typemes := PacketRead8(tmp);
{subtypemes := }PacketRead8(tmp);
lenmes := PacketRead16(tmp);
DoMsg(true,typemes,lenmes,PCharArray(@(tmp^.data[tmp^.cursor])),
hisUIN,Now2DateTime);
// delete TMP
PacketDelete(tmp);
end;
else M(Memo,'< ??? SNAC 4,7; Message-format: '+s(MessageFormat));
end;//case MessageFormat
end;
(****************************************************************)
procedure TForm1.DoMsg(on_off:boolean;typemes,
lenmes:integer; data:PCharArray; r_uin:longint;
DateTime:TDateTime);
var i,pos1,pos2 : integer;
sTemp,sLog,sNN,sDT : string;
LTemp : array[1..6] of string;
begin
if (lenmes-1)=0 then exit;
setlength(sTemp,lenmes-1); // -1 for final string char #0
move(data^,sTemp[1],lenmes-1);
for i:=1 to 6 do LTemp[i]:='';
if (typemes <> TYPE_MSG)and(typemes<>0) then begin
if sTemp[length(sTemp)]<>#$FE then sTemp:=sTemp+#$FE;
pos2:=0;
for i:=1 to 6 do begin
pos1 := pos2+1;
pos2 := pos(#$FE,sTemp);
if pos2 = 0 then break;
LTemp[i] := copy(sTemp,pos1,pos2-pos1);
sTemp[pos2] := #$FF;
end;
end;
sNN := '';
case on_off of
true: sDT := '< -[A] ';
false: sDT := '< -[O] ';
end;
sDT := sDT+DateTimeToStr(DateTime)+' ';
case typemes of
0,TYPE_MSG:
FmtStr(sLog,sNN+' ['+s(r_uin)+'] "%s"',[sTemp]);
TYPE_ADDED:
FmtStr(sLog,'UIN:%d has added you to their contact list.'+
'Nick:%s FName:%s LName:%s E-mail:%s',
[r_uin,LTemp[1],LTemp[2],LTemp[3],LTemp[4]]);
TYPE_AUTH_REQ:
FmtStr(sLog,'UIN:%d has requested your authorization.'+
'Nick:%s FName:%s LName:%s E-mail:%s '#13#10'Reason:"%s"',
[r_uin,LTemp[1],LTemp[2],LTemp[3],LTemp[4],LTemp[6]]);
TYPE_URL:
FmtStr(sLog,'URL: UIN:%d, '#13#10'URL:%s, '#13#10'Description:"%s"',
[r_uin,LTemp[2],LTemp[1]]);
TYPE_WEBPAGER:
FmtStr(sLog,'WebPager: UIN:%d, Nick:%s, EMail:%s, '#13#10'"%s"',
[r_uin,LTemp[1],LTemp[4],LTemp[6]]);
TYPE_EXPRESS:
FmtStr(sLog,'MailExpress: UIN:%d, Nick:%s, EMail:%s, '#13#10'"%s"',
[r_uin,LTemp[1],LTemp[4],LTemp[6]]);
else FmtStr(sLog,'Instant message type %d from UIN:%d, '#13#10'Message:"%s"',
[typemes,r_uin,sTemp]);
end;//case
sLog := sDT+sLog;
M(Memo,sLog); LogMessage(sLog);
end;
(****************************************************************)
procedure TForm1.DoSimpleMsg(r_uin:longint; Text:string);
var sLog : string;
begin
sLog:= '< -[S] '+DateTimeToStr(Now)+' '+'['+s(r_uin)+'] "'+Text+'"';
M(Memo,sLog); LogMessage(sLog);
end;
(****************************************************************)
procedure TForm1.SetStatus(Status:longint);
var tmp : PPack;
begin
ICQStatus := Status;
// Set Status Code
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$1,$1E);
TLVAppendDWord(tmp,6,ICQStatus);
TLVAppendWord(tmp,8,$0000);
// imitation TLV(C)
PacketAppend32(tmp,dswap($000C0025)); // TLV(C)
StrToIP(Get_my_IP,DIM_IP);
PacketAppend(tmp,@DIM_IP,4); // IP address
PacketAppend32(tmp,dswap(28000+random(1000)));// Port
PacketAppend8(tmp,$04);
PacketAppend16(tmp,swap($0007));
PacketAppend16(tmp,swap($466B));
PacketAppend16(tmp,swap($AE68));
PacketAppend32(tmp,dswap($00000050));
PacketAppend32(tmp,dswap($00000003));
PacketAppend32(tmp,dswap(SecsSince1970));
PacketAppend32(tmp,dswap(SecsSince1970));
PacketAppend32(tmp,dswap(SecsSince1970));
PacketAppend16(tmp,swap($0000));
PacketSend(tmp);
case ICQStatus of
STATE_ONLINE: StatusBtn.Caption := 'online';
STATE_AWAY: StatusBtn.Caption := 'away';
STATE_DND: StatusBtn.Caption := 'dnd';
STATE_OCCUPIED: StatusBtn.Caption := 'occupied';
STATE_FREEFORCHAT: StatusBtn.Caption := 'freeforchat';
STATE_N_A: StatusBtn.Caption := 'na';
STATE_INVISIBLE: StatusBtn.Caption := 'invisible';
else StatusBtn.Caption := 'offline';
end;
end;
(****************************************************************)
procedure TForm1.StatusChange(Status:longint);
var tmp : PPack;
begin
if(not OL)then begin
Get_My_IP; if not OL then begin M(Memo,'OFF-line'); exit; end;
end;
if (not CLI.Active) then icq_Login(Status)
else if (not isLogged) then exit
else begin
ICQStatus := Status;
case ICQStatus of
STATE_INVISIBLE: begin
// Send Visible List
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$9,$5);
PacketSend(tmp);
M(Memo,'>Send Visible List (0)');
end;
else begin
// Send Invisible List
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$9,$7);
PacketSend(tmp);
M(Memo,'>Send Invisible List (0)');
end;
end;//case
// Set Status Code
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$1,$1E);
TLVAppendDWord(tmp,6,ICQStatus);
PacketSend(tmp);
case ICQStatus of
STATE_ONLINE: StatusBtn.Caption := 'online';
STATE_AWAY: StatusBtn.Caption := 'away';
STATE_DND: StatusBtn.Caption := 'dnd';
STATE_OCCUPIED: StatusBtn.Caption := 'occupied';
STATE_FREEFORCHAT: StatusBtn.Caption := 'freeforchat';
STATE_N_A: StatusBtn.Caption := 'na';
STATE_INVISIBLE: StatusBtn.Caption := 'invisible';
else StatusBtn.Caption := 'offline';
end;
end;
end;
(****************************************************************)
procedure TForm1.OnlineConnected1Click(Sender: TObject);
begin
StatusChange(STATE_ONLINE);
end;
(****************************************************************)
procedure TForm1.Away1Click(Sender: TObject);
begin
StatusChange(STATE_AWAY);
end;
(****************************************************************)
procedure TForm1.DNDDoNotDisturb1Click(Sender: TObject);
begin
StatusChange(STATE_DND);
end;
(****************************************************************)
procedure TForm1.PrivacyInvisible1Click(Sender: TObject);
begin
StatusChange(STATE_INVISIBLE);
end;
(****************************************************************)
procedure TForm1.OfflineDiscconnect1Click(Sender: TObject);
begin
ConnectMode(false);
end;
(****************************************************************)
procedure TForm1.OccupiedUrgentMsgs1Click(Sender: TObject);
begin
StatusChange(STATE_OCCUPIED);
end;
(****************************************************************)
procedure TForm1.FreeForChat1Click(Sender: TObject);
begin
StatusChange(STATE_FREEFORCHAT);
end;
(****************************************************************)
procedure TForm1.NAExtendedAway1Click(Sender: TObject);
begin
StatusChange(STATE_N_A);
end;
(****************************************************************)
procedure TForm1.icq_Login(Status : longint);
var cfg : TIniFile;
begin
randomize;
SEQ := random($7FFF);
Local_IP := Get_my_IP;
StrToIP(Local_IP,DIM_IP);
cfg := TIniFile.Create(ExtractFilePath(ParamStr(0))+'nICQ.ini');
try initStatus := cfg.ReadInteger('User','Status',online);
finally cfg.Free; end;
ICQStatus := status;
if CLI.Active then CLI.Close;
isAuth := true;
isHDR := true;
CLI.Address :='';
CLI.Host := 'login.icq.com';
CLI.Port := 5190;
M(Memo,'>>>>>>>>>> login.icq.com:5190 ');
CLI.Open;
end;
(****************************************************************)
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
OfflineDiscconnect1Click(self);
CloseLogs;
end;
(****************************************************************)
procedure TForm1.InitLogs;
begin
assignfile(mess,s(UIN)+'.mes');
try if FileExists(s(UIN)+'.mes') then append(mess)
else rewrite(mess);
M(Memo,DateTimeToStr(Now));
except end;
assignfile(log,s(UIN)+'.log');
try if FileExists(s(UIN)+'.log') then append(log)
else rewrite(log);
except end;
end;
(****************************************************************)
procedure TForm1.CloseLogs;
begin
try closefile(mess); except end;
try closefile(log); except end;
end;
(****************************************************************)
procedure TForm1.LogMessage(s:string);
begin
try writeln(mess,s); except end;
end;
(****************************************************************)
procedure TForm1.InitUser;
var cfg : TIniFile;
begin
cfg := TIniFile.Create(ExtractFilePath(ParamStr(0))+'nICQ.ini');
try
UIN := cfg.ReadInteger('User','Uin',0);
NICK := cfg.ReadString('User','Nick','');
PASSWORD := cfg.ReadString('User','Password','');
finally cfg.Free; end;
Caption := NICK+' : '+s(UIN);
end;
(****************************************************************)
procedure TForm1.ClearFIFO;
var Find : PFLAP_Item;
begin
// Del ALL
repeat
Find := HeadFIFO;
if HeadFIFO<>nil then begin
if HeadFIFO^.Next<>nil then
HeadFIFO := HeadFIFO^.Next
else HeadFIFO := nil;
end;
if Find<>nil then begin
FreeMem(Find^.DATA,swap(Find^.FLAP.Len));
Dispose(Find);
end;
until Find=nil;
end;
(****************************************************************)
end.
|
