SUser.pas
01.01.2007
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
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 SUser;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Menus, Animate, ExtCtrls, Grids, AppEvnts,
Typess,Packet,Main,UInfo;
type
TSearchUser = class(TForm)
GroupBox1: TGroupBox;
SearchBtn: TButton;
StopSearchBtn: TButton;
SearchPage: TPageControl;
EMAIL: TTabSheet;
DETAILS: TTabSheet;
ICQn: TTabSheet;
Label1: TLabel;
GroupBox2: TGroupBox;
Label2: TLabel;
EMAILed: TEdit;
GroupBox3: TGroupBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
NICKed: TEdit;
FIRSTed: TEdit;
LASTed: TEdit;
GroupBox4: TGroupBox;
Label6: TLabel;
UINed: TEdit;
Label7: TLabel;
FoundUsers: TStringGrid;
FoundLabel: TLabel;
FoundPopupMenu: TPopupMenu;
AddToCList: TMenuItem;
Panel1: TPanel;
SUAnime: TAnimatedImage;
Info: TMenuItem;
ApplicationEvents1: TApplicationEvents;
procedure SearchBtnClick(Sender: TObject);
procedure StopSearchBtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure META_Search_User(NN,FN,LN : string);
procedure META_Search_UIN(sUIN : string);
procedure META_Search_Mail(Mail : string);
procedure FormCreate(Sender: TObject);
procedure AddToCListClick(Sender: TObject);
procedure InfoClick(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
private
{ Private declarations }
public
Failure : boolean;
Cookie : word;
{ Public declarations }
end;
implementation
{$R *.DFM}
type TFoundList = array[0..50] of TListRecord;
var FoundList : TFoundList;
FoundNum : integer;
procedure TSearchUser.SearchBtnClick(Sender: TObject);
var i : integer;
begin
FoundLabel.Caption := 'OFF-line mode is now!';
if (not OL) or (not isLogged) then exit;
FoundLabel.Caption := 'Found: ?';
EndOfSearch := true;
Failure := false;
FoundNum := 0;
FoundLabel.Caption := 'Found: '+s(FoundNum)+' user(s)';
FoundUsers.RowCount := 2;
case SearchPage.ActivePageIndex of
0: META_Search_Mail(EMAILed.Text);
1: META_Search_User(NICKed.Text,FIRSTed.Text,LASTed.Text);
2: META_Search_UIN(UINed.Text);
end;
SearchBtn.Enabled := false;
SUAnime.Active := true;
while not EndOfSearch do Application.ProcessMessages;
SUAnime.Active := false;
SearchBtn.Enabled := true;
FoundLabel.Caption := 'Found: '+s(FoundNum)+' user(s)';
if FoundNum > 0 then begin
for i:=0 to FoundNum-1 do begin
with FoundUsers,FoundList[i] do begin
case STATUS of
0: Cells[0,i+1] := 'O';
1: Cells[0,i+1] := '+';
2: Cells[0,i+1] := '?';
else Cells[0,i+1] := '.';
end;
Cells[1,i+1] := s(UIN);
Cells[2,i+1] := NICK;
Cells[3,i+1] := FIRST;
Cells[4,i+1] := LAST;
Cells[5,i+1] := PRI_E_MAIL;
case AUTH of
0: Cells[6,i+1] := 'Author.';
1: Cells[6,i+1] := 'Always';
else Cells[6,i+1] := 'Mode: '+s(AUTH);
end;
if i=FoundNum-1 then break;
RowCount := RowCount + 1;
end;
end;
end else begin
Foundusers.RowCount := 2;
FoundUsers.Cells[0,1] := '';
FoundUsers.Cells[1,1] := '';
FoundUsers.Cells[2,1] := '';
FoundUsers.Cells[3,1] := '';
FoundUsers.Cells[4,1] := '';
FoundUsers.Cells[5,1] := '';
FoundUsers.Cells[6,1] := '';
EndOfSearch := true;
end;
if Failure then FoundLabel.Caption := '!!! Failure !!!';
end;
procedure TSearchUser.StopSearchBtnClick(Sender: TObject);
begin
EndOfSearch := true;
SearchBtn.Enabled := true;
end;
procedure TSearchUser.FormClose(Sender: TObject; var Action: TCloseAction);
begin
EndOfSearch := true;
Destroy;
end;
procedure TSearchUser.META_Search_User(NN,FN,LN : string);
var p,a : PPack;
begin
if (NN='')and(FN='')and(LN='') then exit;
EndOfSearch := false;
a := PacketNew;
PacketGoto(a,2); // a[0..1] = len
PacketAppend32(a,main.UIN);
PacketAppend16(a,swap($D007));
Cookie := random($FF) shl 8;
PacketAppend16(a,swap(Cookie));
PacketAppend16(a,swap($1505));
PacketAppendString(a,FN);
PacketAppendString(a,LN);
PacketAppendString(a,NN);
PacketBegin(a);
PacketAppend16(a,a.length-2);
P:=CreatePacket(2,SEQ);
SNACAppend(p,$15,$2);
TLVAppend(p,1,a.length,@a.data);
PacketDelete(a);
Form1.PacketSend(p);
M(Form1.Memo,'>Search Detail: Nick:'+NN+' First:'+FN+' Last:'+LN+' '+
'Cookie:$'+inttohex(Cookie,4));
end;
procedure TSearchUser.META_Search_UIN(sUIN : string);
var p,a : PPack;
i : integer;
begin
if (sUIN='')then exit;
for i:=1 to length(sUIN) do if (sUIN[i]<'0')or(sUIN[i]>'9') then exit;
EndOfSearch := false;
a := PacketNew;
PacketGoto(a,2); // a[0..1] = len
PacketAppend32(a,main.UIN);
PacketAppend16(a,swap($D007));
Cookie := random($FF) shl 8;
PacketAppend16(a,swap(Cookie));
PacketAppend16(a,swap($1F05));
try PacketAppend32(a,strtoint(sUIN));
except PacketAppend32(a,10000000); end;
PacketBegin(a);
PacketAppend16(a,a.length-2);
P:=CreatePacket(2,SEQ);
SNACAppend(p,$15,$2);
TLVAppend(p,1,a.length,@a.data);
PacketDelete(a);
Form1.PacketSend(p);
M(Form1.Memo,'>Search UIN: '+sUIN+' '+
'Cookie:$'+inttohex(Cookie,4));
end;
procedure TSearchUser.META_Search_Mail(Mail : string);
var p,a : PPack;
begin
if (Mail='')or(pos('@',Mail)=0) then exit;
EndOfSearch := false;
a := PacketNew;
PacketGoto(a,2);// a[0..1] = len
PacketAppend32(a,main.UIN);
PacketAppend16(a,swap($D007));
Cookie := random($FF) shl 8;
PacketAppend16(a,swap(Cookie));
PacketAppend16(a,swap($2905));
PacketAppendString(a,Mail);
PacketBegin(a);
PacketAppend16(a,a.length-2);
P:=CreatePacket(2,SEQ);
SNACAppend(p,$15,$2);
TLVAppend(p,1,a.length,@a.data);
PacketDelete(a);
Form1.PacketSend(p);
M(Form1.Memo,'>Search E-Mail: '+Mail+' '+
'Cookie:$'+inttohex(Cookie,4));
end;
procedure TSearchUser.FormCreate(Sender: TObject);
begin
with FoundUsers do begin
Cells[0,0] := 'St';
Cells[1,0] := 'UIN';
Cells[2,0] := 'Nick Name';
Cells[3,0] := 'First Name';
Cells[4,0] := 'Last Name';
Cells[5,0] := 'E-Mail';
Cells[6,0] := 'Authorization';
end;
end;
procedure TSearchUser.AddToCListClick(Sender: TObject);
var Y : integer;
node : TTreeNode;
tmp : PPack;
begin
Y := FoundUsers.Selection.Top;
if FoundNum = 0 then exit;
// copy to Contact List
ContactList[CLNum] := FoundList[Y-1];
if ContactList[CLNum].NICK = '' then
ContactList[CLNum].NICK := s(ContactList[CLNum].UIN) ;
ContactList[CLNum].EXTRA.ICON_INDEX := simply_icq;
ContactList[CLNum].EXTRA.MES_IS := false;
// add to TTreeView
node := Form1.CL.Items.AddObject(nil,ContactList[CLNum].NICK,@ContactList[CLNum]);
node.ImageIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
node.SelectedIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
inc(CLNum);
Form1.CL.AlphaSort;
Form1.WriteToContactList(ContactList[CLNum-1]);
// Add to Contact List
tmp := CreatePacket(2,SEQ);
SNACAppend(tmp,$3,$4);
PacketAppendB_String(tmp,s(ContactList[CLNum-1].UIN));
Form1.PacketSend(tmp);
M(Form1.Memo,'>Add To Contact List: '
+s(ContactList[CLNum-1].UIN));
// ... a useru ob etom ne obiazatelno znat :^)
end;
procedure TSearchUser.InfoClick(Sender: TObject);
var TUI : TUserInfo;
Y : integer;
begin
Y := FoundUsers.Selection.Top;
if FoundNum = 0 then exit;
Application.CreateForm(TUserInfo,TUI);
TUI.AutoRetrieve := true;
TUI.Caption := 'Info: '+s(FoundList[Y-1].UIN)+' ( '+FoundList[Y-1].NICK+' )';
TUI.UIRecord := FoundList[Y-1];
TUI.Show;
end;
procedure TSearchUser.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var PBuff : PSearchRec;
i : integer;
IsAlways : boolean;
begin
if Msg.message = msg_SInfo then begin
if (Msg.wParam = Cookie)then begin
Handled := false;
PBuff := PSearchRec(Msg.lParam);
if FoundNum = 50 then exit;
IsAlways := false;
for i:=0 to FoundNum-1 do
if FoundUsers.Cells[1,i+1] = s(PBuff^.uin) then begin
IsAlways := true;
break;
end;
if not IsAlways then
with PBuff^ do begin
if uin <> 999999999 then begin
FoundList[FoundNum].UIN := uin;
FoundList[FoundNum].NICK := nick;
FoundList[FoundNum].FIRST := first;
FoundList[FoundNum].LAST := last;
FoundList[FoundNum].PRI_E_MAIL := email;
FoundList[FoundNum].AUTH := auth;
FoundList[FoundNum].STATUS := status;
inc(FoundNum);
end else Failure := true;
end;
Dispose(PBuff);
end;
end;
end;
end.