unit OSCARClient;
//
//This code (also called "TOSCARClient" or "TOSCAR") is COPYRIGHT trogdor.
//This code is released under the protection of The Artistic License.
//A copy of The Artistic License may be found at http://www.opensource.org/licenses/artistic-license.php
//A copy of the latest version of this code may be found at http://www.ithilien.tk
//
//This code uses Matthias Fichtner's implemenation of the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
//and a copy may be found at http://www.fichtner.net/delphi/md5.delphi.phtml
//
//No warranty is expressed or implied. Use at your own discretion. No programs
//were disassembled or decompiled to achieve this work.
//
//revisions:
//29 Apr 05- fixed a bug in the way IMs were sent.
//17 Jan 05
//19 Feb 04
//29 Jul 04
//10 Aug 04
//04 Nov 04
//-trogdor
(*
This component is a work in progress! What's ahead:
-Chat capability
-Code Cleanup (REALLY needed...I know)
-Revise the internal error system
-Direct IM (experimental, connect works, now for recieve)
-File transfer
-Things like alerts
-more
*)
interface
uses
Windows, SysUtils, Classes, Graphics, ScktComp, extctrls, md5unit;
type
TStatus = (Offline,Online,Idle,Away,SigningOn);
TClass = (AOL, Internet, UnconfirmedInternet, Unknown);
TCapability = (AddIns, BuddyIcon, Chat, DirectIM, FileTransfer, SendBuddyList, Talk, None);
TCapabilities = array of TCapability;
TService = (svBOS, svAdmin, svBuddyIcon, svLogin, svDirectConnect, svFileTransfer, svNone);
TBuddyListItemType = (blGroup, blBuddy);
TLogItem = record
Screenname:string;
TheLog:string;
TheRawLog:string;
end;
TConversation = record
Screenname:string;
History:TStringlist;
end;
TConversationLog = array of TConversation;
TTLV = record
T_Type:string;
L_Length:integer;
V_Value:string;
RemainingString:string;
end;
TICBMParameter = record
MaxMessageSNACsize: word;
MaxSenderWarningLevel: word;
MaxReceiverWarningLevel: word;
MinimumMessageInterval: word;
end;
TBuddyInfo = record
Buddy:string;
Group:string;
UserClass:TClass;
Status: TStatus;
OnlineTime:string;
IdleTime:string;
WarningLevel:integer;
MIME:string;
Profile:string;
Capabilities:TCapabilities;
end;
TBuddyListItem = record
Name:string;//sn or group name
ID:string;//word, unique per group
ItemType:TBuddyListItemType;//what is this item
Group:string;//that its in
Comment:string;//downloaded during signon
//alerts
end;
TSNAC = record
Family:string;
SubType:string;
Flags:string;
ReqID:string;
Payload:string;
end;
TClientInfo = record
Screenname:string;
Password:string;
DCPort:integer;
Status:TStatus;
UserClass:TClass;
WarningLevel:integer;
MemberSince:TDateTime;
Email:string;
RateLimit:integer;
ConversationLog: TConversationLog;
BuddyList:array of TBuddyListItem;
end;
TSSIData = record
NameLen:string;
Name:string;
GroupID:string;
BuddyID:string;
DataLen:string;
Data:string;
end;
TOnRcvIMEvent = procedure(Sender:TObject; ClientInfo:TClientInfo; Screenname:string; InstantMessage:string; RawHTML:string) of object;
TOnUpdateBuddyEvent = procedure(Sender:TObject; ClientInfo:TClientInfo; BuddyInfo:TBuddyInfo) of object;
TOnWarnedEvent = procedure(Sender:TObject; ClientInfo:TClientInfo; Screenname:string; Percentage:string) of object;
TOnErrorEvent = procedure(Sender:TObject; ClientInfo:TClientInfo; Service:TService; ErrorCode:String; ErrorDescription:String) of object;
TOnRcvInfoEvent = procedure(Sender:TObject; ClientInfo:TClientInfo; BuddyInfo:TBuddyInfo) of object;
TOnSignonEvent = procedure(Sender:TObject; ClientInfo:TClientInfo; Service:TService) of object;
TOnServerMessage = procedure(Sender:TObject; ClientInfo:TClientInfo; Service:TService; Description:string; aList: TStringList) of object;
TOSCARClient = class(TComponent)
private
BOSSock:TClientSocket;
AdminSock:TClientSocket;
bisock:TClientSocket;
dcSrv:TServerSocket;
dcSock:TClientSocket;
ftSock:TClientSocket;
RateTimer:TTimer;
FPreventRateError:Boolean;
Fpassword:string;
FServer:string;
FPort:string;
FRateLimit:integer;
FOnRcvIM: TOnRcvIMEvent;
FOnUpdateBuddy: TOnUpdateBuddyEvent;
FOnWarned: TOnWarnedEvent;
FOnError: TOnErrorEvent;
FOnRcvInfo: TOnRcvInfoEvent;
FOnSignon: TOnSignonEvent;
FOnServerMessage: TOnServerMessage;
FMaxLimit: Integer;
seccounter:integer;
mincounter:integer;
FWarningLevel:integer;
selfcheck:boolean;
FOKtoSend:boolean;
RateAssigned:boolean;
challengestr:string;
FClientProfile:string;
clientprofilelen:string;
clientversionmajor:string;
clientversionminor:string;
clientversionbuild:string;
bosserverip:string;
bosserverport:string;
cookie:string;
loginmode:boolean;
isBuddyListChanging:boolean;
globgroup:string;
FEmailAddr:string;
groupid:string;
itemid:string;
itype:string;
buddyid:string;
internalroster:TStringList;
addingnew:boolean;
newbuddyid:string;
dirimsn:string;
dirimip:string;
dirconned:boolean;
myBuddyIcon:TGraphic;
iconhex:string;
isBuddyIconChanging:boolean;
bi_ip:string;
bi_cookie:string;
bi_id:string;
my_id:string;
admin_ip:string;
admin_cookie:string;
currentgroup:string;
ft_dest_ip:string;
ft_dest_ip_alt:string;
ft_dest_port:string;
ftshortFilename:string;
ftlongFilename:string;
function keep_alive:integer;
function time_t2DateTime(UnixTime: Integer): TDateTime;
function HexToChar(S: String): char;
function c(byteval: Byte):string;overload;
function c(byteval: integer):string;overload;
function cw(wordval: Word):string;overload;
function cw(lotsofhex:string):string;overload;
function bmp2hex(bit:TGraphic):string;
function file2hex(filename:string):string;
function hextexttotext(hextext:string):string;
function seqnum:Word;
function padnulls(nbytes:integer):string;
//function cut(Str:string;IniPos:integer;Count:integer):string;
function StrToMD5(challengestr:string;password:string):string;
function handshake:integer;
function acct_confirm_req:integer;
function auth_req:integer;
procedure disconnect_login;
procedure connect_bos;
function bos_signon:integer;
function clientversions:integer;
function rate_req:integer;
function rate_ack:integer;
function req_UI:integer;
function reqSSIrights:integer;
function reqSSIinfo:integer;
function req_locate_rights:integer;
function req_buddy_list_rights:integer;
function req_ICBM_parameter_info:integer;
function req_BOS_rights:integer;
function activateSSI:integer;
function set_UI(Profile:string;Capabilities:TCapabilities):integer;
function set_ini_icbm_parameter:integer;
function setidletime:integer;
function client_ready:integer;
//function add_ICBM_parameter:integer;
function send_im(screenname:string;im:string):integer;
function set_away(awaymsg:string):integer;
function set_back:integer;
function set_idle:integer;
function set_available(amsg:string):integer;
function set_profile(profile:string):integer;
function get_profile(screenname:string):integer;
function get_away_msg(screenname:string):integer;
function get_selfinfo:integer;
function add_buddy(screenname:string;group:string):integer;
function delete_buddy(screenname:string;group:string):integer;
function get_buddylist:integer;
function warn_user(screenname:string;anon:boolean):integer;
function add_group(group:string):integer;
function delete_group(group:string):integer;
function group_is(buddy:string):string;
function ssi_open:integer;
function ssi_modify(group:string; addingnew:boolean):integer;
function ssi_modify_add_buddy(group,buddyid:string):integer;
function ssi_add_group(group:string):integer;
function ssi_add_buddy(group:string;screenname:string):integer;
function ssi_delete_buddy(group:string;screenname:string):integer;
function ssi_delete_group(group:string):integer;
function ssi_close:integer;
function add_deny(screenname:string):integer;
function delete_deny(screenname:string):integer;
procedure disconnect;
procedure reset;
function remove_self(buddy:string):integer;
//function dir_im_ack(buddy:string):integer;
function cipos(substr:string;str:string):integer;
function req_bi_service:integer;
function send_checksum(filename:string):integer;
function send_buddy_icon:integer;
function send_buddy_icon_to(sn,filename:string):integer;
function get_buddy_icon(sn:string):integer;
function BI_seqnum:Word;
procedure conn_bi;
//function texttohex(msg:string):string;
function req_admin_service:integer;
procedure conn_admin;
function service_handshake(Service:TService):integer;
function service_set_client_versions(Service:TService):integer;
function service_rate_req(Service:TService):integer;
function service_rate_ack(Service:TService):integer;
function service_client_ready(Service:TService):integer;
function admin_seqnum:Word;
//function set_as_admin(msg:string):string;
function format_sn(newsn:string):integer;
//function set_alias(group:string;sn:string;alias:string):integer;
function set_buddy_comment(group:string;screenname:string;comment:string):integer;
function get_buddy_comment(group:string;screenname:string):string;
function change_pwd(newpwd:string):integer;
function set_invisible:integer;
function set_visible:integer;
function connect_to_ft(IP,Port:string):integer;
function ft_buddy_approval_ack(screenname:string):integer;
function ftServerAuth(filename:string):integer;
function SentftServerAuthConfirm:integer;
function SendftFile:integer;
function dirconn(buddy:string;port:integer):integer;
function init_dc(buddy:string):integer;
protected
theseqnum: Word;
adminseqnum: Word;
biseqnum: Word;
ICBMinfo: TICBMParameter;
procedure OnBOSSockRead(Sender: TObject; Socket: TCustomWinSocket);
procedure OnBOSSockError(Sender:TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: integer);
procedure OndcSockRead(Sender: TObject; Socket: TCustomWinSocket);
procedure OndcSockConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure OndcSrvRead(Sender: TObject; Socket: TCustomWinSocket);
procedure OndcSrvConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure OndcSrvDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure OnAdminRead(Sender: TObject; Socket: TCustomWinSocket);
procedure OnAdminSockError(Sender:TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: integer);
procedure OnBIRead(Sender:TObject; Socket: TCustomWinSocket);
procedure OnBISockError(Sender:TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: integer);
procedure OnftSockRead(Sender: TObject; Socket: TCustomWinSocket);
procedure OnftSockConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ParseFLAP(msg:string; Service:TService);
procedure OnRateTimer(Sender: TObject);
procedure OnMsgRcv(SNAC:TSNAC; Service:TService);
procedure SetScreenname(Ascreenname:string);
procedure SetServer(AServer:string);
procedure SetPort(APort:string);
procedure SetPassword(APassword:string);
procedure SetPreventRateError(APreventRateError:boolean);
function isOKtoSend:boolean;
procedure doRcvInfo(Sender:TObject; ClientInfo:TClientInfo; BuddyInfo:TBuddyInfo);virtual;
procedure doRcvIm(Sender:TObject; ClientInfo:TClientInfo; Screenname, InstantMessage, RawHTML:string);virtual;
procedure doUpdateBuddy(Sender:TObject; ClientInfo:TClientInfo; BuddyInfo:TBuddyInfo);virtual;
procedure doError(Sender:TObject; ClientInfo:TClientInfo; Service:TService; ErrorCode,ErrorDescription:string);virtual;
procedure doWarned(Sender:TObject; ClientInfo:TClientInfo; Screenname,Percentage:string);virtual;
procedure doSignon(Sender:TObject; ClientInfo:TClientInfo; Service:TService);virtual;
procedure doServerMessage(Sender:TObject; ClientInfo:TClientInfo; Service:TService;Description:string; aList:TStringList);virtual;
public
ClientInfo:TClientInfo;
ServiceAdminOnline: boolean;
ServiceBIOnline: boolean;
constructor Create(AOwner: Tcomponent);override;
destructor Destroy;override;
procedure Signon(ICBMParameters:TICBMParameter);overload;
procedure Signon;overload;
procedure Signoff;
procedure GetProfile(Screenname:string);
procedure SetProfile(Profile:string);
procedure SetAway(AwayMessage:string);
procedure SetBack;
procedure SetIdle;
procedure SetInvisible;
procedure SetVisible;
procedure SetAvailable(AMessage:string);
function SendIM(Screenname:string;InstantMessage:string):integer;
procedure GetAwayMessage(Screenname:string);
procedure GetSelfInfo;
procedure AddBuddy(Screenname:string;Group:string);
procedure DeleteBuddy(Screenname:string;Group:string);
procedure GetBuddyList;
procedure Warn(Screenname:string; Anonymous:boolean);
procedure AddGroup(group:string);
procedure DeleteGroup(group:string);
procedure Block(Screenname:string);
procedure UnBlock(Screenname:string);
procedure RemoveSelf(Screenname:String);
function Normalize(screenname:string):string;
procedure DirectConnect(Screenname:string; Port:integer);
function send_dcim(screenname,im:string):integer;
procedure SetBuddyIcon(Filename:string);
procedure SendBuddyIcon(Screenname, Filename:string);
procedure SetBuddyComment(group:string;screenname:string;comment:string);
function GetBuddyComment(group:string;screenname:string):string;
procedure Format(NewScreenname:string);
procedure RequestService(Service:TService);
function StatusToStr(UserStatus: TStatus):string;
function ClassToStr(UserClass: TClass):string;
function CapabilityToStr(Capability: TCapability):string;
function CapabilitiesToStr(Capabilities: TCapabilities):string;
function ServiceStatus(Service:TService):TStatus;
function Conversation(Screenname:string):TStringlist;
procedure AddConverse(Screenname:string;TypeOfLog:string;Timestamp:TDateTime;Msg:string);
function stripHTML(HTML:string):string;
function GetUserClass(classstatus:string):TClass;//classstatus is OR'd class and status
function GetUserStatus(classstatus:string):TStatus;//classstatus is OR'd class and status
function caStrToTCaArray(caStr: string):TCapabilities;//caStr is string of hex of capabilites
function ServiceToStr(Service:TService):string;
procedure ChangePassword(NewPassword:string);
procedure GetBuddyIcon(screenname:string);
procedure SendCustom(Channel,FLAPPayload:string);
function isScreenname(sn:string):boolean;
function isIP(ip:string):boolean;
function hex2ip(hex:string):string;
//function getwatcherlist:integer;
function lookup_by_email(email:string):integer;
function tlv(string_of_hex:string):TTLV;
function init_ft(screenname,filename,description:string):integer;
published
property PreventRateError:Boolean read FPreventRateError write SetPreventRateError;
property Server:string read FServer write SetServer;
property Port:string read FPort write SetPort;
property Screenname:string read ClientInfo.Screenname write SetScreenname;
property Password:string read Fpassword write SetPassword;
property DCPort:integer read ClientInfo.DCPort write ClientInfo.DCPort;
property WarningLevel:integer read ClientInfo.WarningLevel;
property RateLimit:integer read FRateLimit;
property OKtoSend:boolean read isOKtoSend;
property Status:TStatus read ClientInfo.Status;
property OnRcvIm: TOnRcvIMEvent read FOnRcvIM write FOnRcvIM;
property OnUpdateBuddy: TOnUpdateBuddyEvent read FOnUpdateBuddy write FOnUpdateBuddy;
property OnWarned: TOnWarnedEvent read FOnWarned write FOnWarned;
property OnError: TOnErrorEvent read FOnError write FOnError;
property OnRcvInfo: TOnRcvInfoEvent read FOnRcvInfo write FOnRcvInfo;
property OnSignon: TOnSignonEvent read FOnSignon write FOnSignon;
property OnServerMessage: TOnServerMessage read FOnServerMessage write FOnServerMessage;
end;
const
caBuddyIcon: string='094613464c7f11d18222444553540000';
caDirectIM: string='094613454C7F11D18222444553540000';
caTalk: string='094613414C7F11D18222444553540000';
caFileTransfer: string='094613434C7F11D18222444553540000';
caAddIns:string='094613474C7F11D18222444553540000';
caSendBuddyList:string='0946134B4C7F11D18222444553540000';
caChat:string='748F2420628711D18222444553540000';
procedure Register;
implementation
constructor TOSCARClient.Create(AOwner: Tcomponent);
begin
inherited;
internalroster := TStringList.Create;
randomize;
SetLength(ClientInfo.ConversationLog,0);
ClientInfo.Status := Offline;
ServiceAdminOnline := false;
ServiceBIOnline := false;
my_id:='0629';
theseqnum := 0;
RateTimer := TTimer.Create(Self);
RateTimer.Interval := 3000;
RateTimer.Enabled := True;
RateTimer.OnTimer := OnRateTimer;
RateTimer.Enabled := False;
FClientProfile := 'AOL Instant Messenger, version 5.5.3501/WIN32';
clientprofilelen := '002d';
clientversionmajor := '0005';
clientversionminor := '0005';
clientversionbuild := '0dad'; {}
{
FClientProfile := 'AOL Instant Messenger, version 5.2.3277/WIN32';
clientprofilelen := '002d';
clientversionmajor := '0005';
clientversionminor := '0002';
clientversionbuild := '0ccd'; { }
{FClientProfile := 'AOL Instant Messenger, version 4.8.2646/WIN32';
clientprofilelen := '002d';
clientversionmajor := '0004';
clientversionminor := '0008';
clientversionbuild := '0a56'; {}
FMaxLimit := 10;
BOSSock := TClientSocket.Create(Self);
BOSSock.OnRead := OnBOSSockRead;
FServer := 'login.oscar.aol.com';
FPort := '5190';
BOSSock.Host := FServer;
BOSSock.Port := strtoint(FPort);
BOSSock.OnError := OnBOSSockError;
AdminSock := TClientSocket.Create(Self);
AdminSock.OnRead := OnAdminRead;
AdminSock.OnError := OnAdminSockError;
bisock := TClientSocket.Create(Self);
bisock.OnRead := OnBIRead;
bisock.Port := 5190;
bisock.OnError := OnBISockError;
//when someone dc's to you
dcSock := TClientSocket.Create(Self);
dcSock.OnRead := OndcSockRead;
dcsock.OnConnect := OndcSockConnect;
dcSock.Port := random(9999)+1;
dcSock.Active := False;
//when you ask to dc
dcSrv := TServerSocket.Create(Self);
dcSrv.OnClientRead := OndcSrvRead;
dcSrv.OnAccept := OndcSrvConnect;
dcSrv.OnClientDisconnect := OndcSrvDisconnect;
dcSrv.Port := 4443;
dcSrv.Active := false;
ftSock := TClientSocket.Create(self);
ftSock.OnRead := OnftSockRead;
ftSock.OnConnect := OnftSockConnect;
FRateLimit := FMaxLimit;
Randomize;
selfcheck := false;
mincounter := 10;
seccounter := 60;
FOKtoSend := False;{you have to signon first, of course!}
RateAssigned := False;
loginmode := true;
isBuddyListChanging := true;
addingnew := false;
myBuddyIcon := TGraphic.Create;
isBuddyIconChanging := false;
dirconned := false;
ClientInfo.Password := Fpassword;
ClientInfo.WarningLevel := 0;
end;
destructor TOSCARClient.Destroy;
var
i:integer;
begin
BOSSock.Free;
AdminSock.Free;
BISock.Free;
dcSock.Free;
myBuddyIcon.Free;
for i := 0 to length(ClientInfo.ConversationLog) -1 do
begin
ClientInfo.ConversationLog[i].History.free;
end;
SetLength(ClientInfo.ConversationLog,0);
end;
procedure TOSCARClient.Reset;
begin
theseqnum := 0;
ClientInfo.Status := offline;
SetLength(ClientInfo.ConversationLog,0);
ServiceAdminOnline := false;
ServiceBIOnline := false;
RateTimer.Interval := 3000;
RateTimer.Enabled := False;
FServer := 'login.oscar.aol.com';
FPort := '5190';
BOSSock.Host := FServer;
BOSSock.Port := strtoint(FPort);
BOSSock.close;
dcsock.Close;
AdminSock.Close;
bisock.Close;
dcSock.Active := False;
dirimsn := '';
dirimip := '';
FRateLimit := FMaxLimit;
selfcheck := false;
mincounter := 10;
seccounter := 60;
FOKtoSend := False;{you have to signon first, of course!}
RateAssigned := False;
loginmode := true;
isBuddyListChanging := true;
addingnew := false;
isBuddyIconChanging := false;
dirconned := false;
RateTimer.Enabled := False;
ClientInfo.Screenname := '';
ClientInfo.Password := '';
ClientInfo.WarningLevel := FWarningLevel;
end;
function TOSCARClient.time_t2DateTime(UnixTime: Integer): TDateTime;
begin
Result := EncodeDate(1970, 1, 1) + (UnixTime div 86400);
Result := Result + ((UnixTime mod 86400) / 86400);
end;
{function TOSCARClient.texttohex(msg:string):string;
var
msgline:string;
i:integer;
begin
for i := 1 to length(msg) do
begin
msgline := msgline + inttohex(ord(msg[i]),2);
end;
Result := msgline;
end; }
function TOSCARClient.cipos(substr:string;str:string):integer;
begin
Result := pos(lowercase(substr),lowercase(str));
end;
function TOSCARClient.normalize(screenname:string):string;
var
sn:string;
begin
sn := screenname;
sn := lowercase(sn);
while pos(' ',sn) <> 0 do
begin
delete(sn,pos(' ',sn),1);
end;
Result := sn;
end;
function TOSCARClient.isOKtoSend:boolean;
begin
if ClientInfo.Status = offline then
begin
result := false;
exit;
end;
if ClientInfo.WarningLevel < 84 then
begin
if (FRateLimit - ((ClientInfo.WarningLevel div 10)+1)) > 0 then FOKtoSend := True else FOKtoSend := False;
end
else begin
if (FRateLimit - (((ClientInfo.WarningLevel-10) div 10)+1)) > 0 then FOKtoSend := True else FOKtoSend := False;
end;
Result := FOKtoSend;
end;
procedure TOSCARClient.SetPreventRateError(APreventRateError:boolean);
begin
FPreventRateError := APreventRateError;
end;
procedure TOSCARClient.SetScreenname(Ascreenname:string);
begin
ClientInfo.Screenname := Ascreenname;
end;
procedure TOSCARCLient.SetPassword(APassword:string);
begin
Fpassword := Apassword;
ClientInfo.Password := FPassword;
end;
procedure TOSCARClient.SetServer(AServer:string);
begin
FServer := AServer;
BOSSock.Host := FServer;
end;
procedure TOSCARClient.SetPort(APort:string);
begin
FPort := APort;
BOSSock.Port := strtoint(FPort);
end;
procedure TOSCARClient.doRcvInfo;
begin
if assigned(FOnRcvInfo) then FOnRcvInfo(Sender,ClientInfo,BuddyInfo);
end;
procedure TOSCARClient.doRcvIm;
begin
AddConverse(Screenname,'Received IM',Now,RawHTML);
if assigned(FOnRcvIm) then FOnRcvIm(Sender,ClientInfo,Screenname,InstantMessage,RawHTML);
end;
procedure TOSCARCLient.doUpdateBuddy;
begin
AddConverse(BuddyInfo.Buddy,'Buddy Status Update',Now,StatusToStr(BuddyInfo.Status));
if assigned(FOnUpdateBuddy) then FOnUpdateBuddy(Self, ClientInfo, BuddyInfo);
end;
procedure TOSCARClient.doError;
begin
AddConverse(ClientInfo.Screenname,'Error',Now,ServiceToStr(Service)+': '+ErrorDescription);
if assigned(FOnError) then FOnError(Self,ClientInfo, Service,ErrorCode,ErrorDescription);
end;
procedure TOSCARClient.doWarned;
begin
AddConverse(Screenname,'Received Warning',Now,Percentage);
if assigned(FOnWarned) then FOnWarned(Self,ClientInfo,Screenname,Percentage);
end;
procedure TOSCARClient.doSignon;
begin
AddConverse(ClientInfo.Screenname,'Signed On',Now,ServiceToStr(Service));
if assigned(FOnSignon) then FOnSignon(Self,ClientInfo,Service);
end;
procedure TOSCARClient.doServerMessage;
begin
AddConverse(ClientInfo.Screenname,'Server Message',Now,ServiceToStr(Service)+': '+Description);
if assigned(FOnServerMessage) then FOnServerMessage(Self,ClientInfo,Service,Description,aList);
end;
procedure TOSCARClient.GetProfile(screenname:string);
begin
get_profile(screenname);
end;
procedure TOSCARClient.SetProfile(profile:string);
begin
set_profile(profile);
end;
procedure TOSCARClient.SetAway(AwayMessage:string);
begin
set_away(AwayMessage);
ClientInfo.Status := Away;
end;
procedure TOSCARClient.SetBack;
begin
set_back;
ClientInfo.Status := Online;
end;
function TOSCARClient.SendIM(Screenname:String;InstantMessage:string):integer;
begin
Result := 0;
if (dirconned) and (normalize(dirimsn)=normalize(screenname)) then
begin
if (send_dcim(screenname,instantMessage) = 1) then
begin
Result := 1;
end;
end else begin
if (not(not(OKtoSend) and (FPreventRateError))) then
begin
if (send_im(screenname,instantMessage) = 1) then
begin
Result := 1;
end;
end;
if (not(OKtoSend) and (FPreventRateError)) then
begin
inc(FRateLimit,((ClientInfo.WarningLevel div 10)+1));//we didnt really send a message so we un-dec
Result := 2;
end;
if FRateLimit <= 10 then dec(FRateLimit,(ClientInfo.WarningLevel div 10)+1) else dec(FRateLimit,(ClientInfo.WarningLevel div 10));
if not RateAssigned then
begin
RateAssigned := True;
RateTimer.Interval := round(((ClientInfo.WarningLevel/10)+3)*1000);
end;
end;
end;
procedure TOSCARClient.GetAwayMessage(Screenname:string);
begin
get_away_msg(screenname);
end;
procedure TOSCARClient.GetSelfInfo;
begin
get_selfinfo;
end;
procedure TOSCARClient.AddBuddy(Screenname:string;Group:string);
begin
add_buddy(screenname,group);
//get_buddylist;
end;
procedure TOSCARClient.DeleteBuddy(Screenname:string;Group:string);
begin
delete_buddy(screenname,group);
//get_buddylist;
end;
procedure TOSCARClient.AddGroup(group:string);
begin
add_group(group);
//get_buddylist;
end;
procedure TOSCARClient.DeleteGroup(group:string);
begin
delete_group(group);
//get_buddylist;
end;
procedure TOSCARClient.GetBuddyList;
begin
get_buddylist;
end;
procedure TOSCARClient.Warn(Screenname:string; Anonymous:boolean);
begin
warn_user(screenname,anonymous);
end;
procedure TOSCARClient.Block(Screenname:string);
begin
add_deny(screenname);
end;
procedure TOSCARClient.UnBlock(Screenname:string);
begin
delete_deny(screenname);
end;
procedure TOSCARClient.RemoveSelf(Screenname:string);
begin
remove_self(screenname);
end;
{
procedure TOSCARClient.SetBuddyIcon(Pic:TGraphic);
begin
myBuddyIcon := Pic;
send_checksum('');
send_buddy_icon;
end; }
procedure TOSCARClient.SetBuddyIcon(Filename:string);
begin
send_checksum(filename);
send_buddy_icon;
end;
procedure TOSCARClient.SendBuddyIcon(Screenname,Filename:string);
begin
send_buddy_icon_to(screenname,filename);
end;
procedure TOSCARClient.Format(NewScreenname:string);
begin
format_sn(NewScreenname);
end;
procedure TOSCARClient.SetBuddyComment(group:string;screenname:string;comment:string);
begin
set_buddy_comment(group,screenname,comment);
end;
function TOSCARClient.GetBuddyComment(group:string;screenname:string):string;
begin
Result := get_buddy_comment(group,screenname);
end;
procedure TOSCARClient.RequestService(Service:TService);
begin
if Service = svBuddyIcon then req_bi_service;
if Service = svAdmin then req_admin_service;
end;
function TOSCARClient.ServiceStatus(Service:TService):TStatus;
begin
Result := Offline;
if (service = svAdmin) and (AdminSock.Active) then Result := Online;
if (service = svBuddyIcon) and (BISock.Active) then Result := Online;
if (service = svBOS) and (BOSSock.Active) then Result := Online;
end;
function TOSCARClient.caStrToTCaArray(caStr: string):TCapabilities;
begin
if cipos(caChat,caStr) <> 0 then
begin
setlength(Result, length(Result)+1);
Result[length(Result)-1] := Chat;
end;
if cipos(caSendBuddyList,caStr) <> 0 then
begin
setlength(Result, length(Result)+1);
Result[length(Result)-1] := SendBuddyList;
end;
if cipos(caAddIns,caStr) <> 0 then
begin
setlength(Result, length(Result)+1);
Result[length(Result)-1] := AddIns;
end;
if cipos(caFileTransfer,caStr) <> 0 then
begin
setlength(Result, length(Result)+1);
Result[length(Result)-1] := FileTransfer;
end;
if cipos(caTalk,caStr) <> 0 then
begin
setlength(Result, length(Result)+1);
Result[length(Result)-1] := Talk;
end;
if cipos(caBuddyIcon,caStr) <> 0 then
begin
setlength(Result, length(Result)+1);
Result[length(Result)-1] := BuddyIcon;
end;
if cipos(caDirectIM,caStr) <> 0 then
begin
setlength(Result, length(Result)+1);
Result[length(Result)-1] := DirectIM;
end;
if caStr = '' then
begin
setlength(Result,1);
Result[0] := None;
end;
end;
function TOSCARClient.GetUserStatus(classstatus:string):TStatus;
begin
Result := Offline;
if length(classstatus) >= 3 then
begin
if ((classstatus[3] = '1') or (classstatus[3] = '2' {AOL})) then Result := Online;
if classstatus[3] = '3' then Result := Away;
end;
if Result = Offline then Result := Online;
end;
function TOSCARClient.StatusToStr(UserStatus: TStatus):string;
begin
if UserStatus = Online then Result := 'Online';
if UserStatus = Offline then Result := 'Offline';
if UserStatus = Away then Result := 'Away';
if UserStatus = Idle then Result := 'Idle';
end;
function TOSCARClient.GetUserClass(classstatus:string):TClass;
begin
Result := UnconfirmedInternet;//right? ;-)
if length(classstatus) >= 4 then
begin
if classstatus[4] = '0' then Result := Internet;
if classstatus[4] = '1' then Result := UnconfirmedInternet;
if classstatus[4] = '4' then Result := AOL;
end;
end;
function TOSCARClient.ServiceToStr(Service:TService):string;
begin
if Service = svBOS then Result := 'BOS';
if Service = svAdmin then Result := 'Administration';
if Service = svBuddyIcon then Result := 'Buddy Icon';
end;
function TOSCARClient.ClassToStr(UserClass: TClass):string;
begin
if UserClass = AOL then Result := 'AOL';
if UserClass = UnconfirmedInternet then Result := 'Unconfirmed Internet';
if UserClass = Internet then Result := 'Internet';
end;
function TOSCARClient.CapabilityToStr(Capability: TCapability):string;
begin
if Capability = AddIns then Result := 'Add-Ins';
if Capability = BuddyIcon then Result := 'Buddy Icon';
if Capability = Chat then Result := 'Chat';
if Capability = DirectIM then Result := 'DirectIM';
if Capability = FileTransfer then Result := 'File Transfer';
if Capability = SendBuddyList then Result := 'Send Buddy List';
if Capability = Talk then Result := 'Talk';
if Capability = None then Result := '';
end;
function TOSCARClient.CapabilitiesToStr(Capabilities: TCapabilities):string;
var
i:integer;
begin
for i := 0 to length(Capabilities)-1 do
begin
Result := Result + CapabilityToStr(Capabilities[i]);
if (i <> length(Capabilities)-1) then Result := Result + ', ';
end;
end;
procedure TOSCARClient.ChangePassword(NewPassword:string);
begin
change_pwd(NewPassword);
end;
function TOSCARClient.isScreenname(sn:string):boolean;
var
i:integer;
begin
Result := True;
if ((length(sn) > 16) or (length(sn) < 3)) then Result := False;
for i := 0 to length(sn)-1 do
begin
if isDelimiter('~`!@#$%^&*()-_=+\|[]{};'':"<>,./?',sn,i) then Result := False;
end;
end;
function TOSCARClient.isIP(ip:string):boolean;
begin//this isnt very strict, and if doesnt have to be. it pretty much differntiates between an obvious ip and a obvious non-ip
Result := true;
if (length(ip) < 7) or (length(ip) > 15) then result := false;
if (pos('.',ip) = 0) then result := false;
if ip[1] = '0' then result := false;
end;
function TOSCARClient.hex2ip(hex:string):string;
begin
Result := inttostr(strtoint('$0'+copy(hex,1,2)))+'.'+inttostr(strtoint('$0'+copy(hex,3,2)))+'.'+inttostr(strtoint('$0'+copy(hex,5,2)))+'.'+inttostr(strtoint('$0'+copy(hex,7,2)));
end;
function TOSCARClient.stripHTML(HTML:string):string;
begin
{http://www.ramsch.org/martin/uni/fmi-hp/iso8859-1.html} //for a list of these
while not (cipos('
',HTML) = 0) do
begin
{replace & with "}
HTML[cipos('
',HTML)] := #13;
{del quot;} {1st character is replaced...}
delete(HTML,cipos('br>',HTML),3);
end;
while not (cipos('
',HTML) = 0) do
begin
{replace & with "}
HTML[cipos('
',HTML)] := #13;
{del quot;} {1st character is replaced...}
delete(HTML,cipos('hr>',HTML),3);
end;
while ((cipos('<',HTML) <> 0) and (cipos('>',HTML) <> 0)) do
begin
if (cipos('<',HTML) < cipos('>',HTML)) then delete(HTML,cipos('<',HTML),cipos('>',HTML)-cipos('<',HTML)+1) else delete(html,1,cipos('>',html));
end;
while not (cipos('"',HTML) = 0) do
begin
{replace & with "}
HTML[cipos('"',HTML)] := '"';
{del quot;} {1st character is replaced...}
delete(HTML,cipos('quot;',HTML),5);
end;
while not (cipos('&',HTML) = 0) do
begin
HTML[cipos('&',HTML)] := '&';
delete(HTML,cipos('amp;',HTML),4);
end;
while not (cipos('>',HTML) = 0) do
begin
HTML[cipos('>',HTML)] := '>';
delete(HTML,cipos('gt;',HTML),3);
end;
while not (cipos('<',HTML) = 0) do
begin
HTML[cipos('<',HTML)] := '<';
delete(HTML,cipos('lt;',HTML),3);
end;
Result := HTML;
end;
procedure TOSCARClient.SetIdle;
begin
set_idle;
end;
function TOSCARClient.Conversation(Screenname:string):TStringList;
var
i:integer;
begin
Result := nil;
for i := 0 to length(ClientInfo.ConversationLog) -1 do
begin
if Normalize(ClientInfo.ConversationLog[i].Screenname) = Normalize(Screenname) then
begin
Result := ClientInfo.ConversationLog[i].History;
end;
end;
end;
procedure TOSCARClient.AddConverse(Screenname:string;TypeOfLog:string;Timestamp:TDateTime;Msg:string);
var
i:integer;
begin
for i := 0 to length(ClientInfo.ConversationLog) -1 do
begin
if normalize(ClientInfo.ConversationLog[i].Screenname) = normalize(Screenname) then
begin
ClientInfo.ConversationLog[i].History.Add(normalize(Screenname)+', '+TypeOfLog+', '+DateTimeToStr(Timestamp)+', '+Msg);
exit;
end;
end;
SetLength(ClientInfo.ConversationLog,length(ClientInfo.ConversationLog)+1);
ClientInfo.ConversationLog[length(ClientInfo.ConversationLog)-1].Screenname := normalize(Screenname);
ClientInfo.ConversationLog[length(ClientInfo.ConversationLog)-1].History := tstringlist.create;
ClientInfo.ConversationLog[length(ClientInfo.ConversationLog)-1].History.Add(normalize(Screenname)+', '+TypeOfLog+', '+DateTimeToStr(Timestamp)+', '+Msg);
end;
procedure TOSCARClient.SetInvisible;
begin
set_invisible;
end;
procedure TOSCARClient.SetVisible;
begin
set_visible;
end;
procedure TOSCARClient.SetAvailable(AMessage:string);
begin
set_available(amessage);
end;
procedure TOSCARClient.GetBuddyIcon(screenname:string);
begin
get_buddy_icon(screenname);
end;
procedure TOSCARClient.SendCustom(Channel,FLAPPayload:string);
var
len:word;
msg:string;
begin
msg := cw(FLAPPayload);
len := strtoint('$0'+inttohex(length(msg),4));
BOSSock.Socket.SendText(cw($2A)+cw(Channel)+cw(seqnum)+cw(len)+msg);
end;
procedure TOSCARClient.Signon;
begin
ClientInfo.Status := SigningOn;
BOSSock.Open;
end;
procedure TOSCARClient.Signon(ICBMParameters:TICBMParameter);
begin
ICBMinfo := ICBMParameters;
BOSSock.open;
end;
procedure TOSCARClient.Signoff;
begin
disconnect;
reset;
end;
procedure TOSCARClient.DirectConnect(Screenname:string; Port:integer);
begin
dirconn(Screenname,Port);
end;
procedure TOSCARClient.conn_admin;
begin
AdminSock.Host := admin_ip;
AdminSock.Port := 5190;
AdminSock.open;
end;
procedure TOSCARClient.conn_bi;
begin
bisock.Host := bi_ip;
bisock.Port := 5190;
bisock.Open;
end;
function TOSCARClient.HexToChar(S: String): char;
var
c:char;
begin
c :=char(StrToInt('$0' + S));
Result := c;
end;
function TOSCARClient.hextexttotext(hextext:string):string;
var
i,x:integer;
temp,msgtext:string;
begin
for i := 1 to (length(hextext) div 2) do
begin
x := i * 2;
temp := hextext[x-1]+hextext[x];
msgtext := msgtext + HextoChar(temp);
end;
result := msgtext;
end;
function TOSCARClient.seqnum:Word;
begin
theseqnum := theseqnum + $0001;
Result := theseqnum;
end;
function TOSCARClient.admin_seqnum:Word;
begin
adminseqnum := adminseqnum + $0001;
Result := adminseqnum;
end;
function TOSCARClient.BI_seqnum:Word;
begin
BIseqnum := BIseqnum + $0001;
Result := BIseqnum;
end;
function TOSCARClient.c(byteval: Byte):string;
var
asciiout: string;
begin
asciiout := chr(byteval);
if byteval = $0 then asciiout := #0;
Result := asciiout;
end;
function TOSCARClient.c(byteval: integer):string;
var
asciiout: string;
begin
asciiout := chr(byteval);
if byteval = $0 then asciiout := #0;
Result := asciiout;
end;
function TOSCARClient.cw(wordval: Word):string;
var
hi,lo:Byte;
asciiout: string;
begin
hi := wordval div $100;
lo := wordval mod $100;
asciiout := c(hi) + c(lo);
Result := asciiout;
end;
function TOSCARClient.cw(lotsofhex:string):string;
var
asciiout,t:string;
temp:string;
i,x:integer;
b:byte;
begin
for i := 1 to (length(lotsofhex) div 2) do
begin
x := i * 2;
t := '$0'+lotsofhex[x-1]+lotsofhex[x];
b := strtoint(t);
temp := c(b);
asciiout := asciiout + temp;
if cipos(asciiout,'#$') <> 0 then
begin
//del the $
delete(asciiout,cipos(asciiout,'#$')+1,1);
end;
end;
result := asciiout;
end;
function TOSCARClient.bmp2hex(bit:TGraphic):string;
var
astrm:tmemorystream;
st,fin:string;
i:integer;
begin
st := '';
fin := '';
astrm:=tmemorystream.Create;
bit.SaveToStream(astrm);
setlength(st,astrm.size);
astrm.Position := 0;
astrm.Read(Pointer(st)^,astrm.Size);
astrm.Free;
for i := 1 to length(st) do
begin
fin := fin + inttohex(ord(st[i]),2);
end;
Result := fin;
end;
function TOSCARClient.file2hex(filename:string):string;
var
fstream:tfilestream;
st,fin:string;
i:integer;
begin
st := '';
fin := '';
fstream := tfilestream.Create(filename,(fmOpenRead OR fmShareDenyNone));
setlength(st,fstream.size);
fstream.Position := 0;
fstream.Read(Pointer(st)^,fstream.Size);
fstream.Free;
for i := 1 to length(st) do
begin
fin := fin + inttohex(ord(st[i]),2);
end;
Result := fin;
end;
function TOSCARClient.tlv(string_of_hex:string):TTLV;
var
typelv,tlvalue:string;
len:integer;
begin
typelv := copy(string_of_hex,1,4);
delete(string_of_hex,1,4);
len := strtoint('$0'+copy(string_of_hex,1,4));
delete(string_of_hex,1,4);
tlvalue := copy(string_of_hex,1,len*2);
delete(string_of_hex,1,len*2);
Result.T_Type := typelv;
Result.L_Length := len;
Result.V_Value := tlvalue;
Result.RemainingString := string_of_hex;
end;
function TOSCARClient.StrToMD5(challengestr:string;password:string):string;
begin
Result := md5unit.MD5Print(md5unit.MD5String(challengestr + cw(md5unit.md5print(md5unit.MD5String(password))) + 'AOL Instant Messenger (SM)'));
end;
function TOSCARClient.padnulls(nbytes:integer):string;
var
i:integer;
begin
result := '';
for i := 0 to nbytes do
begin
result := result + '00';
end;
end;
function TOSCARClient.service_handshake(Service:TService):integer;
var
len:word;
msg:string;
begin
Result := 0;
if service = svAdmin then
begin
msg := cw('00000001')+cw('00060100')+cw(admin_cookie);
len := strtoint('$0'+inttohex(length(msg),4));
if (AdminSock.Socket.SendText(cw($2A01)+cw(admin_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
if service = svBuddyIcon then
begin
msg := cw('00000001')+cw('00060100')+cw(bi_cookie);
len := strtoint('$0'+inttohex(length(msg),4));
if (bisock.Socket.SendText(cw($2A01)+cw(bi_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
end;
function TOSCARClient.service_set_client_versions(Service:TService):integer;
var
len:word;
msg:string;
begin
Result := 0;
if service = svAdmin then
begin
msg := cw('000100170000000000000001000300180001');
len := strtoint('$0'+inttohex(length(msg),4));
if (AdminSock.Socket.SendText(cw($2A02)+cw(admin_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
if service = svBuddyIcon then
begin
msg := cw('000100170000000000000001000300180001');
len := strtoint('$0'+inttohex(length(msg),4));
if (bisock.Socket.SendText(cw($2A02)+cw(bi_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
end;
function TOSCARClient.service_rate_req(Service:TService):integer;
var
len:word;
msg:string;
begin
Result := 0;
if service = svAdmin then
begin
msg := cw('00010006000000000006');
len := strtoint('$0'+inttohex(length(msg),4));
if (AdminSock.Socket.SendText(cw($2A02)+cw(admin_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
if service = svBuddyIcon then
begin
msg := cw('00010006000000000006');
len := strtoint('$0'+inttohex(length(msg),4));
if (bisock.Socket.SendText(cw($2A02)+cw(bi_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
end;
function TOSCARClient.service_rate_ack(Service:TService):integer;
var
len:word;
msg:string;
begin
Result := 0;
if service = svAdmin then
begin
msg := cw('0001000800000000000000010002000300040005');
len := strtoint('$0'+inttohex(length(msg),4));
if (AdminSock.Socket.SendText(cw($2A02)+cw(admin_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
if service = svBuddyIcon then
begin
msg := cw('0001000800000000000000010002000300040005');
len := strtoint('$0'+inttohex(length(msg),4));
if (bisock.Socket.SendText(cw($2A02)+cw(bi_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
end;
function TOSCARClient.service_client_ready(Service:TService):integer;
var
len:word;
msg:string;
begin
Result := 0;
if service = svAdmin then
begin
msg := cw('00010002000000000000000f000100040001000100030004076c');
len := strtoint('$0'+inttohex(length(msg),4));
if (AdminSock.Socket.SendText(cw($2A02)+cw(admin_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
ServiceAdminOnline := true;
doSignon(Self,ClientInfo,svAdmin);
end;
if service = svBuddyIcon then
begin
msg := cw('00010002000000000000000f000100040001000100030004076c');
len := strtoint('$0'+inttohex(length(msg),4));
if (bisock.Socket.SendText(cw($2A02)+cw(bi_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
ServiceBIOnline := true;
doSignon(Self,ClientInfo,svBuddyIcon);
end;
end;
function TOSCARClient.handshake:integer;
var
len:word;
msg:string;
begin
msg := cw('00000001');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A01)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.acct_confirm_req:integer;
var
len:word;
msg:string;
begin
msg := cw('001700060000000000000001')+cw(inttohex(length(ClientInfo.Screenname),4))+ClientInfo.Screenname+cw('004b0000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.auth_req:integer;
var
len:word;
msg:string;
begin
msg :=cw('001700020000000000000001')+cw(inttohex(length(ClientInfo.Screenname),4))+ClientInfo.Screenname+cw('00250010')+cw(StrToMD5(challengestr,ClientInfo.Password))+cw('004c00000003002d')+Fclientprofile+cw('001600020109'+'00170002'+clientversionmajor+'00180002'+clientversionminor+'001900020000'+'001a0002'+clientversionbuild+'00140004000000c7'+'000f0002656e'+'000e00027573'+'004a000101');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
procedure TOSCARClient.disconnect_login;
begin
BOSSock.Close;
end;
procedure TOSCARClient.connect_bos;
begin
BOSSock.Host := bosserverip;
BOSSock.port := strtoint(bosserverport);
BOSSock.Open;
end;
function TOSCARClient.req_admin_service:integer;
var
len:word;
msg:string;
begin
msg := cw('00010004000000000000')+cw('0007');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.bos_signon:integer;
var
len:word;
msg:string;
begin
msg := cw('000000010006'+inttohex((length(cookie) div 2),4)+ cookie);
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A01)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.clientversions:integer;
var
len:word;
msg:string;
begin
msg := cw('00010017000000000017'+'0001000300130003000200010003000100040001000600010008000100090001000a0001000b0001000c0001');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.rate_req:integer;
var
len:word;
msg:string;
begin
msg := cw('00010006000000000006');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.rate_ack:integer;
var
len:word;
msg:string;
begin
msg := cw('00010008000000000008')+cw('00010002000300040005');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.req_UI:integer;
var
len:word;
msg:string;
begin
msg := cw('0001000e00000000000e');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.reqSSIrights:integer;
var
len:word;
msg:string;
begin
msg := cw('00130002000000000002');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.reqSSIinfo:integer;
var
len:word;
msg:string;
begin
msg := cw('001300050000000300053ed55a78006e');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.req_locate_rights:integer;
var
len:word;
msg:string;
begin
msg := cw('00020002000000000002');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.req_buddy_list_rights:integer;
var
len:word;
msg:string;
begin
msg := cw('00030002000000000002');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.req_ICBM_parameter_info:integer;
var
len:word;
msg:string;
begin
msg := cw('00040004000000000004');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.req_BOS_rights:integer;
var
len:word;
msg:string;
begin
msg := cw('00090002000000000002');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.activateSSI:integer;
var
len:word;
msg:string;
begin
msg := cw('00130007000000000007');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.set_UI(Profile:string;Capabilities:TCapabilities):integer;
var
len:word;
msg:string;
caps:string;
begin
caps := {caBuddyIcon+}caDirectIM+caTalk+caFileTransfer+caAddIns+caSendBuddyList+caChat;
//addtl := profile + '
'+ClientInfo.Screenname+' is using TOSCARClient for Delphi. www.ithilien.tk';
msg := cw('00020004000000000000'+{'0001'+inttohex(length('text/x-aolrtf; charset="us-ascii"'),4))+'text/x-aolrtf; charset="us-ascii"'+cw('0002'+inttohex(length(addtl),4))+addtl+cw(}'0005'+inttohex(length(cw(caps)),4)+caps);//+cw('000600060004000400020002');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.set_ini_icbm_parameter:integer;
var
len:word;
msg:string;
begin
{if (not assigned(@ICBMinfo.MaxMessageSNACsize)) then} ICBMinfo.MaxMessageSNACsize := $1F40;
{if (not assigned(@ICBMinfo.MaxSenderWarningLevel)) then }ICBMinfo.MaxSenderWarningLevel := $03e7;
{ if (not assigned(@ICBMinfo.MaxReceiverWarningLevel)) then} ICBMinfo.MaxReceiverWarningLevel := $03e7;
{ if (not assigned(@ICBMinfo.MinimumMessageInterval)) then }ICBMinfo.MinimumMessageInterval := $0000;
msg := cw('00040002000000000000')+cw('0000')+cw('0000000b')+cw(ICBMinfo.MaxMessageSNACsize)+cw(ICBMinfo.MaxSenderWarningLevel)+cw(ICBMinfo.MaxReceiverWarningLevel)+cw(ICBMinfo.MinimumMessageInterval)+cw('0000');
msg := cw('00040002000000000000')+cw('0000')+cw('0000000b')+cw('1f40')+cw('03e7')+cw('03e7')+cw('0000')+cw('0000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.setidletime:integer;
var
len:word;
msg:string;
begin
msg := cw('00010011000000000011')+cw('00000000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.client_ready:integer;
var
len:word;
msg:string;
begin
msg := cw('00010002000000000002')+cw('00010003011006290013000301100629000200010110062900030001011006290004000101100629000600010110062900080001010400010009000101100629000a000101100629000b000101040001000c000101040001');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
{
function TOSCARClient.add_ICBM_parameter:integer;
var
len:word;
msg:string;
begin
msg := cw('00040002000000000000')+cw('0000000000031f4003e703e700000000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end; }
function TOSCARClient.send_im(screenname:string;im:string):integer;
var
len:word;
msg:string;
begin
Result := 0;
if length(im) > 1024 then
begin
doerror(self,ClientInfo,svBOS,'IMLength','Message must not exceed 1024 characters');
exit;
end;
msg := cw('00040006000000010006') +{ cw('323838333844')+}cw('0000000000000000')+cw('0001')+cw(inttohex(length(screenname),2)) + screenname + cw('0002')+cw(inttohex((length(im)+$F),4))+cw('050100030101020101')+{cw(inttohex((length(im)+$4),2))}{<----old, EXPERIMENTAL-------->}cw(inttohex((length(im)+$4),4))+cw('00000000')+im+{EXPERIMENTAL---->}cw('00030000');
len := strtoint('$0'+inttohex(length(msg),4));
try
Result := BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg);
except on e:exception do
doError(Self,ClientInfo,svBOS,'',e.Message);
end;
AddConverse(screenname,'Send IM',Now,im);
end;
function TOSCARClient.send_dcim(screenname,im:string):integer;
var
len,payloadlen:word;
msg:string;
begin {this is padding a 36 sum byte "slot" for the sn- the sn can presumably be anywhere in this null padding as long as the sum eq 36 bytes}
payloadlen := strtoint('$0'+inttohex(length(im),4)); {mikyboodle} {8} {22}
msg := cw('000100060000')+{dc uid}cw('0000000000000000')+{padding}cw('00000000000000000000')+{len of the dcpayload}cw(payloadlen)+cw('000000000000')+cw('0060')+{notcw'd works obsly('00000000')bc= ->}{cw('')}clientinfo.screenname+cw(36-length(clientinfo.screenname));//cw('000000000000000000000000000000000000000000000000000000000000');
len := strtoint('$0'+inttohex(length(msg)+6,4));//of entire non msg dc packet, including dcflap header (4f444332)= 4bytes
if (dcsrv.Socket.connections[0].SendText(cw($4f44)+cw($4332)+cw(len)+msg+im) = 1) then Result := 1 else Result := 0;
AddConverse(screenname,'Send IM',Now,im);
end; //
// 4 + 16 + 16 = 36
// 8 + 6 + 22 = 36
// 4 + 10 + 22 = 36
function TOSCARClient.set_idle:integer; // 4 + 15 + 23 = 36
var
len:word;
msg:string;
begin
msg := cw('00010011000000000000') + cw('ffffffff');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.set_available(amsg:string):integer;
var
msg,therest:string;
begin
therest := cw('0002')+cw('04')+cw(inttohex(length(amsg)+4,2))+cw(inttohex(length(amsg),4))+amsg+cw('0000');
msg := cw('0001001e000000000000') + cw('001d')+cw(inttohex(length(therest),4)) +therest;
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(inttohex(length(msg),4))+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.set_away(awaymsg:string):integer;
var
len,lenawaymsg:word;
msg:string;
begin
//awaymsg := 'away!!';
lenawaymsg := strtoint('$0'+inttohex(length(awaymsg),4));
msg := cw('00020004000000000000') + cw('0003001f')+'text/aolrtf; charset="us-ascii"'+cw('0004')+cw(lenawaymsg)+awaymsg;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.set_back:integer;
var
len:word;
msg:string;
begin
msg := cw('00020004000000000004') + cw('00040000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.set_profile(profile:string):integer;
var
len,lenpro:word;
msg:string;
begin
Result := 0;
//profile := profile+'
'+ClientInfo.Screenname+' uses TOSCARClient. It''s a free Delphi/C++ Builder component at www.ithilien.tk.';
lenpro := strtoint('$0'+inttohex(length(profile),4));
if length(profile) > 1024 then
begin
doerror(self,ClientInfo,svBOS,'ProfileLen','Profile must not exceed 1024 characters');
exit;
end;
msg := cw('00020004000000000000') + cw('0003001f')+'text/aolrtf; charset="us-ascii"'+cw('0002')+cw(lenpro)+profile;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.get_profile(screenname:string):integer;
var
len:word;
msg:string;
begin
msg := cw('000200150000000c0015')+cw('00000001')+cw(inttohex(length(screenname),2))+screenname;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.get_away_msg(screenname:string):integer;
var
len:word;
msg:string;
begin
msg := cw('00020015000000080015')+cw('00000002')+cw(inttohex(length(screenname),2))+screenname;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.get_selfinfo:integer;
var
len:word;
msg:string;
begin
msg := cw('0001000e00000000000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.ssi_open:integer;
var
len:word;
msg:string;
begin
msg := cw('00130011000000000000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
isBuddyListChanging := true;
end;
function TOSCARClient.ssi_add_buddy(group:string;screenname:string):integer;
var
len:word;
msg:string;
i:integer;
begin
Result := 0;
groupid := 'zzzz';
for i := 0 to length(ClientInfo.BuddyList) -1 do if ((ClientInfo.BuddyList[i].ItemType = blGroup) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(group))) then groupid := ClientInfo.BuddyList[i].ID;
if groupid = 'zzzz' then
begin
doerror(Self,ClientInfo,svBOS,'BuddyListError','Group '+group+' does not exist');
exit;
end;
buddyid := inttostr(random(9))+inttostr(random(9))+inttostr(random(9))+inttostr(random(9));//+inttostr(random(9));//if isgroup then itemid = 0000 //i made this up too
newbuddyid := buddyid;
itemid := buddyid;
itype := '0000';//0000 is 'buddy';
msg := cw('00130008000000000000')+cw(inttohex(length(normalize(screenname)),4))+normalize(screenname)+cw(groupid)+cw(itemid)+cw(itype)+cw('0000'); //last word is len of "additional", which is nothing
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.ssi_delete_buddy(group:string;screenname:string):integer;
var
len:word;
msg:string;
i:integer;
begin
Result := 0;
groupid := 'zzzz';
buddyid := 'zzzz';
for i := 0 to length(ClientInfo.BuddyList)-1 do if ((ClientInfo.BuddyList[i].ItemType = blBuddy) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(screenname)) and (normalize(ClientInfo.BuddyList[i].Group) = normalize(group))) then buddyid := ClientInfo.BuddyList[i].ID;
for i := 0 to length(ClientInfo.BuddyList)-1 do if ((ClientInfo.BuddyList[i].ItemType = blGroup) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(group))) then groupid := ClientInfo.BuddyList[i].ID;
if ((groupid = 'zzzz') or (buddyid = 'zzzz')) then
begin
doerror(Self,ClientInfo,svBOS,'BuddyListError','Buddy or Group does not exist');
exit;
end;
itemid := buddyid;
itype := '0000';//0000 is 'buddy';
msg := cw('0013000a000000000000')+cw(inttohex(length(normalize(screenname)),4))+normalize(screenname)+cw(groupid)+cw(itemid)+cw(itype)+cw('0000'); //last word is len of "additional", which is nothing
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.add_deny(screenname:string):integer;
var
len:word;
msg:string;
i:integer;
begin
Result := 0;
groupid := '0000';
itemid := 'zzzz';
for i := 0 to length(ClientInfo.BuddyList)-1 do if ((ClientInfo.BuddyList[i].ItemType = blBuddy) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(screenname))) then buddyid := ClientInfo.BuddyList[i].ID;
itemid := buddyid;
if (itemid = 'zzzz') then
begin
doerror(Self,ClientInfo,svBOS,'BuddyListError','Buddy does not exist');
exit;
end;
itype := '0003';//0003 is 'deny';
msg := cw('00130008000000000000')+cw(inttohex(length(normalize(screenname)),4))+normalize(screenname)+cw(groupid)+cw(itemid)+cw(itype)+cw('0000'); //last word is len of "additional", which is nothing
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.delete_deny(screenname:string):integer;
var
len:word;
msg:string;
i:integer;
begin
Result := 0;
groupid := '0000';
itemid := 'zzzz';
for i := 0 to length(ClientInfo.BuddyList)-1 do if ((ClientInfo.BuddyList[i].ItemType = blBuddy) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(screenname))) then buddyid := ClientInfo.BuddyList[i].ID;
itemid := buddyid;
if (itemid = 'zzzz') then
begin
doerror(Self,ClientInfo,svBOS,'BuddyListError','Buddy does not exist');
exit;
end;
itype := '0003';//0003 is 'deny';
msg := cw('0013000a000000000000')+cw(inttohex(length(normalize(screenname)),4))+normalize(screenname)+cw(groupid)+cw(itemid)+cw(itype)+cw('0000'); //last word is len of "additional", which is nothing
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.ssi_add_group(group:string):integer;
var
len:word;
msg:string;
begin
groupid := inttostr(random(9))+inttostr(random(9))+inttostr(random(9))+inttostr(random(9));//+inttostr(random(9));//if isgroup then itemid = 0000 //i made this up too
itemid := '0000';
itype := '0001';//0001 is 'group';
msg := cw('00130008000000000000')+cw(inttohex(length(group),4))+group+cw(groupid)+cw(itemid)+cw(itype)+cw('0000'); //last word is len of "additional", which is nothing
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.ssi_delete_group(group:string):integer;
var
len:word;
msg:string;
i:integer;
begin
Result := 0;
groupid := 'zzzz';
for i := 0 to length(ClientInfo.BuddyList)-1 do if ((ClientInfo.BuddyList[i].ItemType = blGroup) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(group))) then groupid := ClientInfo.BuddyList[i].ID;
if (groupid = 'zzzz') then
begin
doerror(Self,ClientInfo,svBOS,'BuddyListError','Group does not exist or still has items in it');
exit;
end;
itemid := '0000';
itype := '0001';//0001 is 'group';
msg := cw('0013000a000000000000')+cw(inttohex(length(group),4))+group+cw(groupid)+cw(itemid)+cw(itype)+cw('0000'); //last word is len of "additional", which is nothing
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
{official mimic} function TOSCARClient.ssi_modify_add_buddy(group,buddyid:string):integer;
var
len:word;
msg:string;
additional,list_of_buddy_ids:string;
i:integer;
begin
itemid := '0000';//'all groups have an itemid of 0x0000
itype := '0001';//0001 is 'group';
if buddyid = '' then buddyid := '0000';
if addingnew then group := '';
list_of_buddy_ids := newbuddyid;
for i := 0 to length(clientinfo.BuddyList)-1 do
begin
if (clientinfo.buddylist[i].ItemType = blBuddy) and (normalize(clientinfo.BuddyList[i].Group) = (group)) then list_of_buddy_ids := list_of_buddy_ids + clientinfo.buddylist[i].ID;
end;
additional := '00c8'{T:list of buddies in buddyid form}+ inttohex((length(list_of_buddy_ids) div 2),4)+ list_of_buddy_ids;
msg := cw('00130009000000000000')+cw(inttohex(length(group),4))+group+cw(groupid)+cw(itemid)+cw(itype)+cw(inttohex((length(additional) div 2),4))+cw(additional);
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
(*{trillian mimic}function TOSCARClient.ssi_modify_add_buddy(group,buddyid:string):integer;
var
len:word;
msg:string;
additional,list_of_buddy_ids:string;
i:integer;
begin
itemid := '0000';//'all groups have an itemid of 0x0000
itype := '0001';//0001 is 'group';
if buddyid = '' then buddyid := '0000';
if addingnew then group := '';
list_of_buddy_ids := newbuddyid;
for i := 0 to length(clientinfo.BuddyList)-1 do
begin
if (clientinfo.buddylist[i].ItemType = blBuddy) and (clientinfo.BuddyList[i].Group = group) then list_of_buddy_ids := list_of_buddy_ids + clientinfo.buddylist[i].ID;
end;
additional := '00c80002'+ buddyid;
msg := cw('00130008000000000000')+cw(inttohex(length(group),4))+group+cw(groupid)+cw(itemid)+cw(itype)+cw(inttohex((length(additional) div 2),4))+cw(additional);
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end; *)
function TOSCARClient.ssi_modify(group:string;addingnew:boolean):integer;
var
len:word;
msg:string;
additional:string;
begin
itemid := '0000';//'all groups have an itemid of 0x0000
itype := '0001';//0001 is 'group';
if buddyid = '' then buddyid := '0000';
if addingnew then group := '';
additional := '00c8'{T:list of buddies in buddyid form}+ '0002'+buddyid;
msg := cw('00130009000000000000')+cw(inttohex(length(group),4))+group+cw(groupid)+cw(itemid)+cw(itype)+cw(inttohex((length(additional) div 2),4))+cw(additional);
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.ssi_close:integer;
var
len:word;
msg:string;
begin
msg := cw('00130012000000000000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.keep_alive:integer;
begin
if (BOSSock.Socket.SendText(cw($2A05)+cw(seqnum)+cw($0000)) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.add_buddy(screenname:string;group:string):integer;
begin
//This is odd: The official client sends this, but when i do, i dont recieve online/offline notification. BUT the buddy IS on the SSI. Wild.
//ssi_open;
Result := ssi_add_buddy(group,screenname);
globgroup:=group;
isBuddyListChanging := true;
end;
function TOSCARClient.delete_buddy(screenname:string;group:string):integer;
begin
//see add_buddy
//ssi_open;
Result := ssi_delete_buddy(group,screenname);
globgroup:=group;
isBuddyListChanging := true;
end;
function TOSCARClient.get_buddylist;
var
len:word;
msg:string;
begin
setlength(ClientInfo.BuddyList,0);
msg := cw('00130004000000000004');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.add_group(group:string):integer;
begin
ssi_open;
Result := ssi_add_group(group);
globgroup := group;
addingnew := true;
end;
function TOSCARClient.delete_group(group:string):integer;
begin
ssi_open;
Result := ssi_delete_group(group);
globgroup := group;
end;
function TOSCARClient.group_is(buddy:string):string; //first existence of buddy in buddylist
var
i:integer;
begin
for i := 0 to length(ClientInfo.Buddylist)-1 do
begin
if (clientinfo.BuddyList[i].ItemType = blBuddy) and (normalize(clientinfo.BuddyList[i].Name) = normalize(buddy)) then
begin
Result := clientinfo.BuddyList[i].group;
exit;
end;
end;
end;
function TOSCARClient.warn_user(screenname:string;anon:boolean):integer;
var
len:word;
msg,sendas:string;
begin
if anon then sendas := '0001' else sendas := '0000';
msg := cw('00040008000000000000')+cw(sendas)+cw(inttohex(length(screenname),2))+screenname;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.remove_self(buddy:string):integer;
var
len:word;
msg:string;
begin
msg := cw('00130016000000000000')+cw(inttohex(length(buddy),2))+buddy;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.dirconn(buddy:string;port:integer):integer; ////////HARD CODED SELF IP////////////
var
len:word;
msg,myip:string;
begin
port := $115b;//4443;
myip := 'c0a80006'; //192.168.0.6 '0a56028f'; // 10.86.2.143
dcsrv.Active := true;
dirimsn := buddy;
msg := cw('00040006000000000000')+cw('0000000000000000')+cw('0002')+cw(inttohex(length(buddy),2))+buddy+cw('0005')+cw('0032')+cw('00000000000000000000')+cw(caDirectIM)+cw('000a')+cw('0002')+cw('0001')+cw('0003')+cw('0004')+{self ip}cw(myip)+cw('0005')+cw('0002')+cw(port)+cw('000f')+cw('0000')+cw('0003')+cw('0000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
{function TOSCARClient.dir_im_ack(buddy:string):integer;
var
len:word;
msg:string;
begin
msg := cw('00040006000000000000')+cw('f97bed0016770000')+cw('0002')+cw(inttohex(length(buddy),2))+buddy+cw('0005')+cw('001a')+cw('0002')+cw('f97bed001677')+cw('0000')+cw(caDirectIM);
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end; }
function TOSCARClient.init_dc(buddy:string):integer;
var
len:word;
msg:string;
begin
msg := cw('000100060000')+cw('0000000000000000')+cw('000000000000000000000000000000000000')+cw('0060')+clientinfo.screenname+cw(36-length(clientinfo.screenname));//cw('00000000')+ClientInfo.Screenname+cw('00000000000000000000000000000000000000000000');
len := strtoint('$0'+inttohex(length(msg)+6,4));
if (dcsrv.Socket.Connections[0].SendText(cw('4F444332')+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.req_bi_service:integer;
var
len:word;
msg:String;
begin
msg := cw('00010004000000000000')+cw('0010');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.send_checksum(filename:string):integer;
var
len:word;
msg,addtl,checksum:string;
begin
isBuddyIconChanging := True;
iconhex := cw(file2hex(filename));
checksum := md5unit.md5print(md5unit.MD5String(iconhex));
addtl := cw('0131000000d500120010'+checksum);
if bi_id = '' then bi_id := inttohex(random($FFFF),4);
msg := cw('00130009000000000000')+cw('0001310000')+cw(bi_id)+cw('0014')+cw(inttohex(length(addtl),4))+addtl;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
{ iconhex := cw(bmp2hex(myBuddyIcon));
checksum := md5unit.md5print(md5unit.MD5String(iconhex));
addtl := cw('0131000000d500120010'+checksum);
if bi_id = '' then bi_id := inttohex(random($FFFF),4);
msg := cw('00130009000000000000')+cw('0001310000')+cw(bi_id)+cw('0014')+cw(inttohex(length(addtl),4))+addtl;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
}end;
function TOSCARClient.send_buddy_icon:integer;
var
len:word;
msg:string;
begin
isBuddyIconChanging := False;
//msg := cw('00100002000000000000')+cw('0001')+cw(inttohex(length(copy(iconhex,1,length(iconhex)-53))*2,4))+copy(iconhex,1,length(iconhex)-53);
msg := cw('00100002000000000000')+cw('0001')+cw(inttohex(length(iconhex),4))+iconhex;
len := strtoint('$0'+inttohex(length(msg),4));
if (bisock.Socket.SendText(cw($2A01)+cw(bi_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.get_buddy_icon(sn:string):integer;
var
len:word;
msg:string;
begin
//msg := cw('00100002000000000000')+cw('0001')+cw(inttohex(length(copy(iconhex,1,length(iconhex)-53))*2,4))+copy(iconhex,1,length(iconhex)-53);
//msg := cw('00100004000000000000')+cw(inttohex(length(sn),2))+sn+cw('01000101')+;
len := strtoint('$0'+inttohex(length(msg),4));
if (bisock.Socket.SendText(cw($2A02)+cw(bi_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.send_buddy_icon_to(sn,filename:string):integer;{Does not work and isnt expected to}
var
len:word;
msg:string;
myicon:string;
begin
myicon := cw(file2hex(filename));
msg := cw('00040006000000020006')+cw('5c85c3034f1500000002')+cw(inttohex(length(sn),2))+sn+cw('00050d2700005c85c3034f150000')+cw(caBuddyIcon)+cw('000a00020001000f000027110cff0000c7fd0000')+cw(inttohex(length(myicon),4))+cw('3f3cf47a')+myicon;//0cda
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
{function TOSCARClient.set_alias(group:string;sn:string;alias:string):integer;
var
len:word;
msg,addtl,als:string;
i:integer;
begin
Result := 0;
groupid := 'zzzz';
buddyid := 'zzzz';
for i := 0 to length(ClientInfo.BuddyList) -1 do
begin
if cipos('group '+group,internalroster[i]) = 1 then groupid := copy(internalroster[i],cipos('|',internalroster[i])+1,4);// 4 b/c id is word
end;
for i := 0 to length(ClientInfo.BuddyList) -1 do
begin
if cipos('buddy '+normalize(screenname),internalroster[i]) = 1 then buddyid := copy(internalroster[i],cipos('|',internalroster[i])+1,length(internalroster[i])-cipos('|',internalroster[i])+1);// 4 b/c id is word
end;
if ((groupid = 'zzzz') or (buddyid = 'zzzz')) then
begin
doerror(Self, ClientInfo,svBOS,'BuddyListError','Buddy or Group does not exist');
exit;
end;
itemid := buddyid;
itype := '0000';//0000 is 'buddy';
als := alias;
addtl := cw('0131')+cw(inttohex(length(alias),4))+alias;
msg := cw('00130009000000000000')+cw(inttohex(length(normalize(screenname)),4))+normalize(screenname)+cw(groupid)+cw(itemid)+cw(itype)+cw(inttohex(length(addtl),4))+addtl;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end; }
function TOSCARClient.set_buddy_comment(group:string;screenname:string;comment:string):integer;
var
len:word;
msg,addtl:string;
i:integer;
begin
Result := 0;
groupid := 'zzzz';
buddyid := 'zzzz';
for i := 0 to length(ClientInfo.BuddyList)-1 do if ((ClientInfo.BuddyList[i].ItemType = blBuddy) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(screenname)) and (normalize(ClientInfo.BuddyList[i].Group) = normalize(group))) then
begin
buddyid := ClientInfo.BuddyList[i].ID;
ClientInfo.BuddyList[i].Comment := comment;
end;
for i := 0 to length(ClientInfo.BuddyList)-1 do if ((ClientInfo.BuddyList[i].ItemType = blGroup) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(group))) then groupid := ClientInfo.BuddyList[i].ID;
if ((groupid = 'zzzz') or (buddyid = 'zzzz')) then
begin
doerror(Self,ClientInfo,svBOS,'BuddyListError','Buddy or Group does not exist');
exit;
end;
itemid := buddyid;
itype := '0000';//0000 is 'buddy';
addtl := cw('013C')+cw(inttohex(length(comment),4))+comment;
msg := cw('00130009000000000000')+cw(inttohex(length(normalize(screenname)),4))+normalize(screenname)+cw(groupid)+cw(itemid)+cw(itype)+cw(inttohex(length(addtl),4))+addtl;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.get_buddy_comment(group:string;screenname:string):string;
var
i:integer;
begin
for i := 0 to length(ClientInfo.BuddyList)-1 do
begin
if ((ClientInfo.BuddyList[i].ItemType = blBuddy) and (normalize(ClientInfo.BuddyList[i].Name) = normalize(screenname)) and (normalize(ClientInfo.BuddyList[i].Group) = normalize(group))) then
begin
Result := ClientInfo.BuddyList[i].Comment;
exit;
end;
end;
end;
{
function TOSCARClient.getwatcherlist:integer;
var
len:word;
msg:string;
begin
msg := cw('00030006000000000000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end; }
function TOSCARClient.format_sn(newsn:string):integer;
var
len:word;
msg:string;
begin
msg := cw('00070004000000000000')+cw('0001')+cw(inttohex(length(newsn),4))+newsn;
len := strtoint('$0'+inttohex(length(msg),4));
if (AdminSock.Socket.SendText(cw($2A02)+cw(admin_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.change_pwd(newpwd:string):integer;
var
len:word;
msg:string;
begin
msg := cw('00070004000000000000')+cw('0002')+cw(inttohex(length(newpwd),4))+newpwd+cw('0012')+cw(inttohex(length(Fpassword),4))+Fpassword;
len := strtoint('$0'+inttohex(length(msg),4));
if (AdminSock.Socket.SendText(cw($2A02)+cw(admin_seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.lookup_by_email(email:string):integer;
var
len:word;
msg:string;
begin
msg := cw('000a0002000000000000')+email;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.set_invisible:integer;
var
len:word;
msg:string;
begin
msg := cw('0001001e0000000000000006000400000101');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.set_visible:integer;
var
len:word;
msg:string;
begin
msg := cw('0001001e0000000000000006000400000000');
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.init_ft(screenname,filename,description:string):integer;
var
len:word;
msg,msg1,msg0:string;
begin
msg0 := cw('000100010002'+'a000')+filename+cw('00000000');
msg1 := cw('0000'+'0b19020d0f0e4c12'+caFileTransfer+'000a00020001'+{'00030004c0a80002'+'000500021446'+}'000f0000'+'000e0002')+'en'+cw('000d'+inttohex(length('us-ascii'),4))+'us-ascii'+cw('000c'+inttohex(length(description),4))+description+cw('2711'+inttohex(length(msg0),4))+msg0;
msg := cw('00040006000000000000'+'0b19020d0f0e4c12'+'0002'+inttohex(length(screenname),2))+screenname+cw('0005'+inttohex(length(msg1),4))+msg1;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.ft_buddy_approval_ack(screenname:string):integer;
var
len:word;
msg,msg1:string;
begin
msg1 := cw('0002'+'0b19020d0f0e4c12'+caFileTransfer);
msg := cw('00040006000000000000'+'0b19020d0f0e4c12'+'0002'+inttohex(length(screenname),2))+screenname+cw('0005'+inttohex(length(msg1),4))+msg1;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.connect_to_ft(IP,Port:string):integer;
begin
result := 1;
try
ftSock.Host := IP;
ftSock.Port := strtoint(port);
ftSock.Open;
except on e:exception do result := 0 end;
end;
function TOSCARClient.ftServerAuth(filename:string):integer;
var
msg:string;
begin
msg := 'OFT2'+cw('01000101'+'0b19020d0f0e4c12'+'000000000001000100010001000b0000000b0000'+'4033c8792984'+'0000ffff00000000000000000000ffff000000000000ffff0000')+'Cool FileXfer'+cw('00000000000000000000000000000000000000201c110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000')+ftshortFilename+cw('00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000');
if (ftsock.Socket.SendText(msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.SentftServerAuthConfirm:integer;
var
len:word;
msg,msg1:string;
begin
msg1 := cw('044a0002000000000000')+cw(inttohex(length(ClientInfo.Screenname),2))+ClientInfo.Screenname+cw('0b19020d0f0e4c12'+'00010010'+caFileTransfer);
msg := cw(inttohex(length(msg1),2))+msg1;
len := strtoint('$0'+inttohex(length(msg),4));
if (BOSSock.Socket.SendText(cw($2A02)+cw(seqnum)+cw(len)+msg) = 1) then Result := 1 else Result := 0;
end;
function TOSCARClient.SendftFile:integer;
var
msg:string;
begin
msg := file2hex(ftlongfilename);
if (ftsock.Socket.SendText(msg) = 1) then Result := 1 else Result := 0;
end;
{==========================================================}
{==========================================================}
{==========================================================}
procedure TOSCARClient.OnMsgRcv(SNAC:TSNAC; Service:TService);
var
ssi_items_count,len,warninglevelint,idletime,i,rostercount,percentage:integer;
buddy_comment, errmsg,errcode,errdesc,caStr,tlvalue,signontime,typelv,channel,ssi_version,number_items,item_name,group_id,item_id,i_type,moretlv,payloadtext,buddy,im,sessionid,warninglevel,userclass,userclassstatus,profile,onlinetime,temp,mime,raw,service_id,service_ip,service_cookie,BuddyList:string;
roster:array of TBuddyListItem;
BuddyListItem: TBuddyListItem;
list_of_sns:tstringlist;
none:TCapabilities;
isIdle:boolean;
BuddyInfo:TBuddyInfo;
blank:TStringList;
lastelement:integer;
begin
{handshake} {NOTE:for this one, these arent
true fam. and sub, that just how i parse it}
if (SNAC.Family = '0000') and (SNAC.subtype = '0001') then
begin
if Service = svAdmin then
begin
service_handshake(svAdmin);
exit;
end;
if Service = svBuddyIcon then
begin
service_handshake(svBuddyIcon);
exit;
end;
if loginmode then
begin
handshake;
acct_confirm_req;
end;
if not loginmode then bos_signon;
loginmode := False;
end;
{Acct confirm reply}
if (SNAC.family = '0017') then
begin
if (SNAC.subtype = '0007') then
begin
if snac.payload[1] = '0' then delete(snac.payload,1,4);//extra len word?
payloadtext := hextexttotext(SNAC.payload);
//cuts off nasty odd explicit data len word
challengestr := payloadtext;//copy(payloadtext,3,length(payloadtext));
auth_req;
end;
if (SNAC.subtype = '0003') then
begin
if isScreenname(hextexttotext(tlv(snac.Payload).V_Value)) then
begin{Screenname}
ClientInfo.Screenname := hextexttotext(tlv(snac.Payload).V_Value);
snac.Payload := tlv(snac.Payload).RemainingString;
end;
if tlv(snac.Payload).T_Type = '0005' then
begin{BOSIP:Port}
bosserverip := hextexttotext(tlv(snac.Payload).V_Value);
snac.Payload := tlv(snac.Payload).RemainingString;
bosserverport := copy(bosserverip,cipos(':',bosserverip)+1,(length(bosserverip)-(cipos(':',bosserverip)-1)));
delete(bosserverip,cipos(':',bosserverip),(length(bosserverip)-(cipos(':',bosserverip)-1)));
{Auth. Cookie}
cookie := tlv(snac.Payload).V_Value;
snac.Payload := tlv(snac.Payload).RemainingString;
{Email Addr}
FEmailAddr := hextexttotext(tlv(snac.Payload).V_Value);
snac.Payload := tlv(snac.Payload).RemainingString;
ClientInfo.Email := FEmailAddr;
snac.Payload := tlv(snac.Payload).RemainingString;
{Connect to BOS}
disconnect_login;
doSignon(Self,ClientInfo, svLogin);
connect_bos;
end
else begin
errcode := tlv(snac.Payload).T_Type;
errmsg := hextexttotext(tlv(snac.Payload).V_Value);
snac.Payload := tlv(snac.Payload).RemainingString;
errdesc := hextexttotext(errcode);
if errcode = '0004' then errdesc := 'Incorrect Password'+' '+errmsg;
if errcode = '0005' then errdesc := 'Incorrect Password'+' '+errmsg;
if errcode = '0016' then errdesc := 'Too many users per IP'+' '+errmsg;
if errcode = '0017' then errdesc := 'Too many users per IP'+' '+errmsg;
if errcode = '0005' then errdesc := 'Incorrect Password'+' '+errmsg;
if errcode = '0018' then errdesc := 'Connecting too frequently; Try again in a few minutes'+' '+errmsg;
if errcode = '001D' then errdesc := 'Connecting too frequently; Try again in a few minutes'+' '+errmsg;
if errcode = '' then errcode := 'Unknown Error'+' '+errmsg;
doerror(Self, ClientInfo,svBOS,errcode,errdesc);
end;
end;
end;
if (SNAC.Family = '0001') then
begin
if (SNAC.SubType = '0003') then {Host Ready}
begin
if Service = svAdmin then
begin
service_set_client_versions(svAdmin);
exit;
end;
if Service = svBuddyIcon then
begin
service_set_client_versions(svBuddyIcon);
exit;
end;
clientversions;
end;
if (SNAC.SubType = '0018') then {BOS- related Rep}
begin
if Service = svAdmin then
begin
service_rate_req(svAdmin);
exit;
end;
if Service = svBuddyIcon then
begin
service_rate_req(svBuddyIcon);
exit;
end;
rate_req;
end;
if (SNAC.SubType = '0007') then {Rate Response}
begin
if Service = svAdmin then
begin
service_rate_ack(svAdmin);
service_client_ready(svAdmin);
exit;
end;
if Service = svBuddyIcon then
begin
service_rate_ack(svBuddyIcon);
service_client_ready(svBuddyIcon);
exit;
end;
rate_ack;
req_UI;
reqSSIrights;
reqSSIinfo;
req_locate_rights;
req_buddy_list_rights;
req_ICBM_parameter_info;
req_BOS_rights;
end;
if (SNAC.SubType = '000F') then {Self Info Response}
begin
len := strtoint('$0'+copy(SNAC.payload,1,2));//BYTE sn len
delete(SNAC.payload,1,2);
buddy := hextexttotext(copy(SNAC.payload,1,len*2));
delete(SNAC.payload,1,len*2);
if buddy <> '' then //lame-o hack to make this work
begin
warninglevel := copy(SNAC.payload,1,4);//word
delete(SNAC.payload,1,len*2);
warninglevelint := (strtoint('$0'+warninglevel) div 10);
ClientInfo.WarningLevel := warninglevelint;
number_items := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
for i := 1 to strtoint('$0'+number_items) do
begin
if tlv(SNAC.payload).T_Type = '0001' then ClientInfo.UserClass := GetUserClass(tlv(SNAC.payload).V_Value);
if tlv(SNAC.payload).T_Type = '0006' then ClientInfo.Status := GetUserStatus(tlv(SNAC.payload).V_Value);
if tlv(SNAC.payload).T_Type = '0005' then ClientInfo.MemberSince := time_t2DateTime(strtoint('$0'+tlv(SNAC.payload).V_Value));
SNAC.payload := tlv(SNAC.payload).RemainingString;
//if (typelv = '0001') then userclassstatus := tlvalue;
end;
end;
end;
if (SNAC.SubType = '0010') then //warned
begin
delete(SNAC.payload,1,4*4);
if length(SNAC.payload) = 4 then//only the warning level remains, aka anon
begin
warninglevel := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
warninglevelint := round(strtoint('$0'+warninglevel) div 10);
buddy := '';
end
else begin
warninglevel := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
warninglevelint := round(strtoint('$0'+warninglevel) div 10);
len := strtoint('$0'+copy(SNAC.payload,1,2));//BYTE sn len
delete(SNAC.payload,1,2);
buddy := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
buddy := hextexttotext(buddy);
end;
percentage := (warninglevelint - ClientInfo.WarningLevel);
ClientInfo.WarningLevel := warninglevelint;
doWarned(Self,ClientInfo,buddy,inttostr(percentage)+'%');
end;
if ((SNAC.SubType = '0006') and (Service = svDirectConnect)) then
begin
delete(SNAC.payload,1,10*2);
len := (strtoint('$0'+copy(snac.Payload,1,4)));
delete(snac.payload,1,4);
delete(snac.payload,1,12*2);
buddy := copy(SNAC.payload,1,cipos('00',SNAC.payload));
delete(SNAC.payload,1,36*2);//36 byte sn slot
buddy := hextexttotext(buddy);
if not dirconned then
begin
init_dc(ClientInfo.Screenname);
dirconned := true;
end else
begin//all dc parsing here...it could be anything. right now, its only IM's
im := copy(SNAC.payload,length(snac.payload)-(len*2)+1,len*2);
raw := hextexttotext(im);
im := stripHTML(raw);
doRcvIm(Self,ClientInfo,buddy,im,raw);
end;
end;
if (SNAC.SubType = '0002') then
begin
delete(SNAC.payload,1,6*2);
my_id := copy(SNAC.payload,1,4);
end;
if (SNAC.SubType = '0005') then
begin
delete(SNAC.payload,1,4);//Tlv
delete(SNAC.payload,1,4);//Tlv
delete(SNAC.payload,1,4);//tLv
delete(SNAC.payload,1,4);
delete(SNAC.payload,1,4);//Tlv
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4); //just confirming the SNAC.Family (admin/bi)
service_id := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);//Tlv
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
service_ip := hextexttotext(copy(SNAC.payload,1,len*2));
delete(SNAC.payload,1,len*2);
if (cipos(':',service_ip) <> 0) then delete(service_ip,cipos(':',service_ip),length(service_ip)-cipos(':',service_ip));
delete(SNAC.payload,1,4); //Tlv
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
service_cookie := copy(SNAC.payload,1,len*2);
if (service_id = '0007') then
begin
admin_ip := service_ip;
admin_cookie := service_cookie;
conn_admin;
end;
if (service_id = '0010') then
begin
bi_ip := service_ip;
bi_cookie := service_cookie;
conn_bi;
end;
end;
end;
{a reply- This one b/c we req'd
it above- therefore we know that once we
get this we con move on w/ the signon
process. We still dont care about the data}
{and this is somthing unknown directly after the reps- so we wait until it}
if (SNAC.Family = '0004') then
begin
if (SNAC.SubType = '000C') then {dir im ack}
begin
//dir_im_ack(dirimsn);
//dc request has been confirmed, 4443 ought to already be open, so just wait for the connect
end;
if (SNAC.SubType = '0007') then
begin {Recieve Message}
temp := hextexttotext(SNAC.payload);
sessionid := copy(SNAC.payload,1,4*4);
sessionid := hextexttotext(sessionid);
delete(SNAC.payload,1,4*4);//thats 3 words
channel := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);//channel
len := strtoint('$0'+copy(SNAC.payload,1,2));//BYTE sn len
delete(SNAC.payload,1,2);
buddy := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
buddy := hextexttotext(buddy);
warninglevel := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
number_items := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
for i := 1 to strtoint('$0'+number_items) do
begin
if tlv(SNAC.payload).T_Type = '0001' then userclass := tlv(SNAC.payload).V_Value;
if tlv(SNAC.payload).T_Type = '0003' then ft_dest_ip := tlv(SNAC.payload).V_Value;
SNAC.payload := tlv(SNAC.payload).RemainingString;
//if (typelv = '0001') then userclassstatus := tlvalue;
end;
{delete(SNAC.payload,1,4);//Tlv
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
userstatus := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2); }
{ if ((cipos(caDirectIM,SNAC.payload)<>0) and (dirimip = ''))then
begin
dirimip := copy(SNAC.payload,cipos('00040004',SNAC.payload)+8,2*5);//4 bytes (IP)
dirimip := hex2ip(dirimip);
dcSock.Address := dirimip;
dcSock.Open;
exit;
end; }
if cipos(caFileTransfer,SNAC.payload)<>0 then
begin
SNAC.payload := tlv(SNAC.payload).V_Value;//tlv-remaining packet
delete(SNAC.payload,1,4); //null word
delete(SNAC.payload,1,2*8); //8-byte file ID
delete(SNAC.payload,1,2*$10); //A byte caFiletTransfer
repeat
if (tlv(SNAC.payload).T_Type = '0002') and (ft_dest_ip = '') then ft_dest_ip := tlv(SNAC.payload).V_Value;
if tlv(SNAC.payload).T_Type = '0004' then ft_dest_ip_alt := tlv(SNAC.payload).V_Value;
if tlv(SNAC.payload).T_Type = '0005' then ft_dest_port := tlv(SNAC.payload).V_Value;
SNAC.payload := tlv(SNAC.payload).RemainingString;
until SNAC.payload = '';
ft_dest_ip := hex2ip(ft_dest_ip);
ft_dest_ip_alt := hex2ip(ft_dest_ip_alt);
if not isip(ft_dest_ip) and isip(ft_dest_ip_alt) then ft_dest_ip := ft_dest_ip_alt;
if not isip(ft_dest_ip) then ft_dest_ip := 'ars.oscar.aol.com';
if ft_dest_port = '' then ft_dest_port := '5190';// i made this up;;
ft_buddy_approval_ack(buddy);
connect_to_ft(ft_dest_ip,ft_dest_port);
exit;
end;
{
delete(SNAC.payload,1,4);//Tlv
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
delete(SNAC.payload,1,len*2);//unknown tlV
delete(SNAC.payload,1,4);//Tlv
len := strtoint('$0'+copy(SNAC.payload,1,4));//tLv - length of rest of SNAC.payload
delete(SNAC.payload,1,4);
delete(SNAC.payload,1,len*2);//unknown tlV
}
delete(SNAC.payload,1,4);//Tlv
len := strtoint('$0'+copy(SNAC.payload,1,4));//tLv - length of rest of SNAC.payload
delete(SNAC.payload,1,4);
im := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
//13 for aol-ers?
if GetUserClass(userclass[4]) = AOL then delete(im,1,(13*2)) else delete(im,1,(15*2));
while pos('00',im)=1 do delete(im,1,2);
{delete(SNAC.payload,1,4*(15));//15 words of status, idle time, etc things i need to parse
delete(SNAC.payload,1,4);//Tlv
len := strtoint('$0'+copy(SNAC.payload,1,4));//tLv
delete(SNAC.payload,1,4);
im := copy(SNAC.payload,1,len*2);
//im := SNAC.payload; }
raw := hextexttotext(im);
//im := copy(im,cipos('',im),(cipos('',im))-cipos('',im));
//onreceiveim(buddy,im,sessionid);
{ end; }
im := stripHTML(raw);
doRcvIm(Self,ClientInfo,buddy,im,raw);
end;
end;
if (SNAC.Family = '0002') and (SNAC.SubType = '0006') then//profile
begin/////////////THIS IS A MESS AND NEEDS TO BE REVISED//////////////
len := strtoint('$0'+copy(SNAC.payload,1,2));//BYTE sn len
delete(SNAC.payload,1,2);
buddy := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
buddy := hextexttotext(buddy);
warninglevel := copy(SNAC.payload,1,4);//word warninglevel
delete(SNAC.payload,1,4);
warninglevelint := (strtoint('$0'+warninglevel) div 10);
userclass := copy(SNAC.payload,1,4);//word UC 3-something 4-AOL?), 5-(AOL?) or 5-away...gaim...?
delete(SNAC.payload,1,4);
while length(snac.Payload) > 0 do
begin
if tlv(SNAC.payload).T_Type = '0001' then mime := hextexttotext(tlv(SNAC.payload).V_Value);
if tlv(SNAC.payload).T_Type = '0002' then profile := hextexttotext(tlv(SNAC.payload).V_Value);
if tlv(SNAC.payload).T_Type = '000f' then onlinetime := tlv(SNAC.payload).V_Value;
SNAC.payload := tlv(SNAC.payload).RemainingString;
end;
{if (strtoint(userclass) = 5) then
begin
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
temp := copy(SNAC.payload,1,len*2);//constant 0x0010
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);//0x000f
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
onlinetime := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);//0x001d
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
temp := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);//0x0003
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
temp := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
temp := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
mime := copy(SNAC.payload,1,len*2);
mime := hextexttotext(mime);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
profile := copy(SNAC.payload,1,len*2);
profile := hextexttotext(profile);
delete(SNAC.payload,1,len*2);
if pos(#0,mime) <> 0 then
begin
profile := 'Note: AOL member profiles are not accessible through AOL Instant Messenger.';
mime := '';
end;
end else if (strtoint(userclass) = 3) then
begin
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
temp := copy(SNAC.payload,1,len*2);//constant 0x0010
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);//0x000f
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
onlinetime := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);//0x001d
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
temp := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);//0x0003
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
mime := copy(SNAC.payload,1,len*2);
mime := hextexttotext(mime);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
profile := copy(SNAC.payload,1,len*2);
profile := hextexttotext(profile);
delete(SNAC.payload,1,len*2);
if profile = '' then profile := 'No Information Provided';
end else begin
delete(SNAC.payload,1,4);//0x0003
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
temp := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
mime := copy(SNAC.payload,1,len*2);
mime := hextexttotext(mime);
delete(SNAC.payload,1,len*2);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
profile := copy(SNAC.payload,1,len*2);
profile := hextexttotext(profile);
delete(SNAC.payload,1,len*2);
end;
//form1.memo3.text := profile; do rcv profile
}
if profile = '' then
begin
profile := 'Note: AOL member profiles are not accessible through AOL Instant Messenger.';
mime := '';
end;
BuddyInfo.Buddy := buddy;
BuddyInfo.Group := group_is(BuddyInfo.Buddy);
BuddyInfo.UserClass := GetUserClass(userclass);
BuddyInfo.OnlineTime := onlinetime;
BuddyInfo.WarningLevel := warninglevelint;
BuddyInfo.MIME := mime;
BuddyInfo.Profile := profile;
doRcvInfo(Self,ClientInfo,BuddyInfo);
end;
if (SNAC.Family = '0003') then
begin
if (SNAC.SubType = '0001') then//command not supported
begin
doServerMessage(Self,ClientInfo,svNone,'Command Not Supported',nil);
end;
if (SNAC.SubType = '000C') then//buddy signoff
begin
len := strtoint('$0'+copy(SNAC.payload,1,2));//BYTE sn len
delete(SNAC.payload,1,2);
buddy := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
buddy := hextexttotext(buddy);
{warninglevel := copy(SNAC.payload,1,4);
warninglevelint := round(strtoint('$0'+warninglevel) div 10);
delete(SNAC.payload,1,4);
delete(SNAC.payload,1,4);//T
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
userclass := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2); }
BuddyInfo.Buddy := buddy;
BuddyInfo.Group := group_is(BuddyInfo.Buddy);
BuddyInfo.UserClass := Unknown;
BuddyInfo.OnlineTime := '';
BuddyInfo.IdleTime := '';
BuddyInfo.Status := Offline;
BuddyInfo.Capabilities := None;
BuddyInfo.WarningLevel := 0;
BuddyInfo.MIME := '';
BuddyInfo.Profile := '';
doUpdateBuddy(Self,ClientInfo,BuddyInfo);
end;
if (SNAC.SubType = '000B') then//buddy signon
begin
len := strtoint('$0'+copy(SNAC.payload,1,2));//BYTE sn len
delete(SNAC.payload,1,2);
buddy := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
buddy := hextexttotext(buddy);
warninglevel := copy(SNAC.payload,1,4);
warninglevelint := round(strtoint('$0'+warninglevel) div 10);
delete(SNAC.payload,1,4);
number_items := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
isIdle := False;
for i := 1 to strtoint('$0'+number_items) do
begin
typelv := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
tlvalue := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
if (typelv = '0001') then userclassstatus := tlvalue;
//if (typelv = '000C') then//DC info
if (typelv = '000D') then caStr := tlvalue;//capabilites
{ if ((typelv = '000F') and (strtoint('$0'+tlvalue) > 0)) then
begin
idletime := strtoint('$0'+tlvalue);
isIdle := True;
end; }
if (typelv = '0003') then signontime := DateTimeToStr(time_t2DateTime(strtoint('$0'+tlvalue)));//signon time
//if (typelv = '0005') then//member since
end;
BuddyInfo.Buddy := buddy;
BuddyInfo.Group := group_is(BuddyInfo.Buddy);
BuddyInfo.UserClass := GetUserClass(userclassstatus);
BuddyInfo.WarningLevel := WarningLevelint;
BuddyInfo.IdleTime := inttostr(IdleTime);
BuddyInfo.Capabilities := caStrToTCaArray(caStr);
if isIdle then
begin
BuddyInfo.Status := Idle;
doUpdateBuddy(Self,ClientInfo,BuddyInfo);
end
else begin
BuddyInfo.Status := GetUserStatus(userclassstatus);
doUpdateBuddy(Self,ClientInfo,BuddyInfo);
end;
end;
end;
if (Service = svAdmin) and (SNAC.Family = '0007') then
begin
if (SNAC.SubType = '0005') then
begin
delete(SNAC.payload,1,4);
SNAC.payload := tlv(SNAC.payload).RemainingString;
len := strtoint('$'+copy(SNAC.payload,1,2));
delete(SNAC.payload,1,2);
if isScreenname(hextexttotext(tlv(SNAC.payload).V_Value)) then clientInfo.Screenname := tlv(SNAC.payload).V_Value;
//ack! gasp...need...more...parsing...*choke*...
doServerMessage(Self,ClientInfo,svAdmin,'Information Update Successful',nil);
//sucessful pwd change;
end;
if (SNAC.SubType = '0001') then
begin
delete(SNAC.payload,1,4);
SNAC.payload := tlv(SNAC.payload).RemainingString;
//ack! gasp...need...more...parsing...*choke*...
doServerMessage(Self,ClientInfo,svAdmin,'Information Update Failed',nil);
//sucessful pwd change;
end;
end;
if (SNAC.Family = '0013') then
begin
if (SNAC.SubType = '0003') then
begin
activateSSI;
set_UI('',nil);//(Profile,Capabilities);
set_ini_icbm_parameter;
setidletime;
client_ready;
ClientInfo.Status := Online;
doSignon(Self, ClientInfo, svBOS);
RateTimer.Enabled := True;
end;
if (SNAC.SubType = '0006') then
begin //ssi return- ###THIS PARSING ASSUMES FIRST RECIPT OF BL, NOT MIDSESSION REQ'S###
rostercount := 0;
delete(SNAC.Payload,1,2);
ssi_items_count := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.Payload,1,4);
delete(Snac.Payload,1,6*2);
//this is probably an important block, like blocks or allows or somehting
SNAC.Payload := tlv(SNAC.Payload).RemainingString;
delete(Snac.Payload,1,6*2);
//this too
SNAC.Payload := tlv(SNAC.Payload).RemainingString;
for i := 0 to ssi_items_count-3 do //-3 (0 index, and 2 manully above)
begin
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
item_name := hextexttotext(copy(SNAC.payload,1,len*2));
delete(SNAC.payload,1,len*2);
group_id := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
item_id := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
i_type := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
moretlv := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
while (length(moretlv)>0) do
begin
if (tlv(moretlv).T_Type = '013C') then buddy_comment := hextexttotext(tlv(moretlv).V_Value);
//alerts
//phone numbers
//etc
moretlv := tlv(moretlv).RemainingString;
end;
if ((item_name <> '') and (item_id = '0000') and (i_type = '0001')) then
begin
BuddyListItem.Name := item_name;
BuddyListItem.ID := group_id;
BuddyListItem.ItemType := blGroup;
BuddyListItem.Group := '';
currentgroup := item_name;
setlength(roster,rostercount+1);
roster[rostercount] := BuddyListItem;
inc(rostercount);
end;
if ((item_name <> '') and (i_type = '0000')) then
begin
BuddyListItem.Name := item_name;
BuddyListItem.ID := item_id;
BuddyListItem.ItemType := blBuddy;
BuddyListItem.Group := currentgroup;
BuddyListItem.Comment := buddy_comment;
buddy_comment := '';
setlength(roster,rostercount+1);
roster[rostercount] := BuddyListItem;
inc(rostercount);
end;
end;
{if copy(SNAC.payload,1,4) = '0006' then //return from request
begin
delete(SNAC.payload,1,4*4);//4 words
end;
if copy(SNAC.payload,1,4) = '0000' then //as it should be:0x00 0x000n-first byte is version; n is # of items
begin
ssi_version := copy(SNAC.payload,1,2);
delete(SNAC.payload,1,2);
end;
number_items := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
rostercount := 0;
//setlength(roster,groupcount+1,buddycount+1);
for i := 1 to strtoint('$0'+number_items) do
begin
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
item_name := copy(SNAC.payload,1,len*2);
item_name := hextexttotext(item_name);
delete(SNAC.payload,1,len*2);
group_id := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
item_id := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
i_type := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
moretlv := copy(SNAC.payload,1,len*2);
delete(SNAC.payload,1,len*2);
if tlv(SNAC.Payload).T_Type = '013c' then
begin
buddy_comment := tlv(SNAC.Payload).V_Value;
SNAC.Payload := tlv(snac.Payload).RemainingString;
end;
//moretlv parsing here
if (i_type = '0014') then
begin
bi_id := item_id;
end;
if ((item_name <> '') and (item_id = '0000') and (i_type = '0001')) then
begin
BuddyListItem.Name := item_name;
BuddyListItem.ID := group_id;
BuddyListItem.ItemType := blGroup;
BuddyListItem.Group := '';
currentgroup := item_name;
setlength(roster,rostercount+1);
roster[rostercount] := BuddyListItem; //'group '+item_name+'|'+group_id;
inc(rostercount);
end;
if ((item_name <> '') and (i_type = '0000')) then
begin
BuddyListItem.Name := item_name;
BuddyListItem.ID := item_id;
BuddyListItem.ItemType := blBuddy;
BuddyListItem.Group := currentgroup;
BuddyListItem.Comment := buddy_comment;
setlength(roster,rostercount+1);
roster[rostercount] := BuddyListItem;//'buddy '+item_name+'|'+item_id;
inc(rostercount);
end;
end;}
lastelement := length(ClientInfo.BuddyList);
setlength(ClientInfo.BuddyList, length(ClientInfo.BuddyList)+length(roster));
for i := lastelement to length(ClientInfo.BuddyList) -1 do ClientInfo.BuddyList[i] := roster[i-lastelement];
//yeah ok this sucks. deal with it.
{
if ((item_name <> '') and (item_name = first_bl_item)) then setlength(internalroster,0);
if first_bl_item = '' then first_bl_item := item_name;
}
{ if length(roster) > 0 then
begin
for i := 0 to length(roster) -1 do
begin
if pos(normalize(roster[i]),internalroster.text) = 0 then
begin
internalroster.add(roster[i]);
end;
end; }
//doServerMessage(Self,ClientInfo, svBOS, 'BuddyList', nil);
{ end; }
end;
if (SNAC.SubType = '000E') then//open ssi ack
begin
delete(SNAC.payload,1,4*4);//4 words
if (SNAC.payload <> '000A') then//ssi form error- client fault
begin
if isBuddyIconChanging then
begin
send_buddy_icon;
end
else begin
if isBuddyListChanging then
begin
ssi_modify_add_buddy(globgroup,newbuddyid);
isBuddyListChanging := false;
end else
begin
ssi_close;
//update the buddylist
setlength(ClientInfo.BuddyList,0);
get_buddylist;
end;
end;
end
else begin
if not isBuddyIconChanging then ssi_close;
if isBuddyIconChanging then isBuddyIconChanging := False;//doerr send_buddy_icon;
end;
end;
end;
if ((Service = svAdmin) and (SNAC.Family = '0007') and (SNAC.SubType = '0005')) then
begin
{delete(SNAC.payload,1,4);
number_items := copy(SNAC.payload,1,4);
delete(SNAC.payload,1,4);
for i := 1 to strtoint('$0'+number_items) do
begin
if copy(SNAC.payload,1,4) = '0001' then
begin
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
if hextexttotext(copy(SNAC.payload,1,len*2)) <> '' then ClientInfo.Screenname := hextexttotext(copy(SNAC.payload,1,len*2));
delete(SNAC.payload,1,len*2);
end;
end; }
end;
if (SNAC.Family = '000A') then
begin
if (SNAC.SubType = '0001') then
begin
doError(Self, ClientInfo,svBOS,'LookupError','No Screennames Found');
end;
if (SNAC.SubType = '0003') then
begin
list_of_sns := TStringlist.Create;
while length(SNAC.payload) > 0 do
begin
delete(SNAC.payload,1,4);
len := strtoint('$0'+copy(SNAC.payload,1,4));
delete(SNAC.payload,1,4);
BuddyList := hextexttotext(copy(SNAC.payload,1,len*2));
delete(SNAC.payload,1,len*2);
list_of_sns.Add(BuddyList);
end;
//doRcvBuddyList(Self,list_of_sns);
doServerMessage(Self,ClientInfo,svAdmin,'Search by Email',list_of_sns);
end;
end;
end;
{function TOSCARClient.set_as_admin(msg:string):string; //remnant of passthrough mode
var
header,newlen,data,msgline,temp,newmsg:string;
i:integer;
begin
//change the tLv
newmsg := copy(msg,1,pos(ClientInfo.Screenname,msg)+length(ClientInfo.Screenname)+8)+cw('0002')+copy(msg,pos(ClientInfo.Screenname,msg)+length(ClientInfo.Screenname)+10,length(msg));
//change the header data len
header := copy(msg,1,4);
data := copy(newmsg,7,length(newmsg));
newlen := cw(inttohex(length(data),4));
newmsg := header + newlen + data;
//newmsg := copy(newmsg,1,4)+cw(inttohex(length('127.0.0.1:6'),4))+copy(newmsg,6,length(newmsg));
Result := newmsg;
end; }
procedure TOSCARClient.parseflap(msg:string; Service:TService);
var
aSNAC: TSNAC;
msgline,datalenstr,FLAPpayload:string;
i,datalen:integer;
dcm:boolean;
begin
//convert to string of hex
for i := 1 to length(msg) do
begin
msgline := msgline + inttohex(ord(msg[i]),2);
end;
//check to see if the cmd start is dirconn style.
if (cipos('4F',msgline) = 1) then dcm := True else dcm := False;
if not dcm then
begin
//whenever you find a cmd start, the is a cmd behind it
while (cipos('2A',msgline) = 1) do
begin
//delete header except datalen
//8 is '2a010001xxxx...'
//8 chars pre datalen
delete(msgline,1,8);
//word datalen
datalenstr := copy(msgline,1,4);
datalenstr := '$0' + datalenstr;
datalen := strtoint(datalenstr);
//del datalen
delete(msgline,1,4);
//x2 b/c its a string still
FLAPpayload := copy(msgline,1,datalen*2);
delete(msgline,1,datalen*2);
//////now, we work with FLAPSNAC.payload, not msgline, b/c there
//////might be more snacs in msgline. mmmmmm, snacs.
//del Family
aSNAC.Family := copy(FLAPpayload,1,4);
delete(FLAPpayload,1,4);
//del SubType
aSNAC.SubType := copy(FLAPpayload,1,4);
delete(FLAPpayload,1,4);
//del flags
aSNAC.flags := copy(FLAPpayload,1,4);
delete(FLAPpayload,1,4);
//del reqid
aSNAC.reqid := copy(FLAPpayload,1,8);
delete(FLAPpayload,1,8);
//the rest is history
aSNAC.payload := FLAPpayload;
//remnant of passthrough mode
//if (SNAC.Family = '0001') and (SNAC.SubType = '000f') then snacSNAC.payload := copy(set_as_admin(texttohex(snacSNAC.payload)),16,length(set_as_admin(texttohex(snacSNAC.payload))));
Onmsgrcv(aSNAC,Service);
end;//while
end else begin //no while structure for dc. i suppose this is bad code. but official dc will only have 1 command...i will revise
delete(msgline,1,4*2); //4 bytes dc cmd start- ODC "oscar dir conn" says gaim
delete(msgline,1,4); //len of entire packet incl header
FLAPpayload := msgline;
aSNAC.Family := copy(FLAPpayload,1,4); //always 0006
delete(FLAPpayload,1,4);
aSNAC.SubType := copy(FLAPpayload,1,4); //always 0001
delete(FLAPpayload,1,4);
aSNAC.flags := copy(FLAPpayload,1,4); //i think theyre unused
delete(FLAPpayload,1,4);
aSNAC.reqid := copy(FLAPpayload,1,8*2); //dc id's arent requids. they are random, client generated (in "cli->" dc), 8 byte ids
delete(FLAPpayload,1,8*2);
aSNAC.payload := FLAPpayload;
Onmsgrcv(aSNAC,Service);
end;
end;
procedure TOSCARClient.OnBOSSockRead(Sender: TObject; Socket: TCustomWinSocket);
begin
parseflap(BOSSock.Socket.ReceiveText,svBOS);
end;
procedure TOSCARClient.OnBOSSockError(Sender:TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: integer);
begin
doError(Self, ClientInfo,svBOS,inttostr(ErrorCode),'');
ErrorCode := 0;
disconnect;
end;
procedure TOSCARClient.OndcSockRead(Sender: TObject; Socket: TCustomWinSocket);
begin
//dirimsn := dcsock.Socket.Connections[0].RemoteAddress; 24.210.251.214
parseflap(dcSock.Socket.ReceiveText,svDirectConnect);
end;
procedure TOSCARClient.OndcSockConnect(Sender: TObject; Socket: TCustomWinSocket);
begin ////////////needs to be completely revised bc working cli-> dc code.
(* //dodcConnect;
if not dirconned then
begin
//dir_im_ack(dirimsn);
//InitiateDirectConnection(ClientInfo.Screenname);
//dirconned := true;
end; *)
end;
procedure TOSCARClient.OnftSockConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
SentftServerAuthConfirm;
end;
procedure TOSCARClient.OndcSrvRead(Sender: TObject; Socket: TCustomWinSocket);
begin
dirimip := dcsrv.Socket.Connections[0].RemoteAddress; // a way to keep track of who's who...
parseflap(dcsrv.Socket.Connections[0].ReceiveText,svDirectConnect);
end;
procedure TOSCARClient.OndcSrvConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
//connected socket wise, still have to dc auth
end;
procedure TOSCARClient.OndcSrvDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
//disconnected from dc. dirconned := false
end;
procedure TOSCARClient.disconnect;
var
i : integer;
begin
ClientInfo.Status := Offline;
ServiceAdminOnline := false;
ServiceBIOnline := false;
BOSSock.Socket.Close;
dcsock.Socket.Close;
AdminSock.Close;
bisock.Close;
for i := 0 to length(ClientInfo.ConversationLog) -1 do
begin
ClientInfo.ConversationLog[i].History.free;
end;
SetLength(ClientInfo.ConversationLog,0);
end;
procedure TOSCARClient.OnAdminRead(Sender: TObject; Socket: TCustomWinSocket);
begin
parseflap(AdminSock.Socket.ReceiveText,svAdmin);
end;
procedure TOSCARClient.OnAdminSockError(Sender:TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: integer);
begin
doError(Self, ClientInfo,svAdmin,inttostr(ErrorCode),'Could not connect to service');
ErrorCode := 0;
ServiceAdminOnline := false;
AdminSock.Close;
end;
procedure TOSCARClient.OnRateTimer(Sender: TObject);
begin
if FRateLimit < FMaxLimit then inc(FRateLimit);
RateAssigned := False;
RateTimer.Interval := round(((ClientInfo.WarningLevel/10)+3)*1000);
end;
procedure TOSCARClient.OnBIread(Sender: TObject; Socket: TCustomWinSocket);
begin
parseflap(bisock.socket.ReceiveText,svBuddyIcon);
end;
procedure TOSCARClient.OnftSockRead(Sender: TObject; Socket: TCustomWinSocket);
begin
parseflap(ftsock.socket.ReceiveText,svFileTransfer);
end;
procedure TOSCARClient.OnBISockError(Sender:TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: integer);
begin
doError(Self, ClientInfo,svBuddyIcon,inttostr(ErrorCode),'Could not connect to service');
ErrorCode := 0;
ServiceBIOnline := false;
bisock.Close;
end;
procedure Register;
begin
RegisterComponents('Internet', [TOSCARClient]);
end;
end.
{Here's the old animation function if anyone wants to use it.
procedure TOSCARClient.OnAnitimer(Sender:TObject);
var
temp1,temp2:string;
i:integer;
n:tstringlist;
ani_rand_location:integer;
begin
if not ((ClientInfo.Status = Offline) or (ClientInfo.Status = SigningOn)) then
begin
if (ani_style = aniSpace) and (ani_direction = anirandom) then
begin
temp1 := ClientInfo.PreAnimated;
n := tstringlist.create;
for i := 1 to length(temp1) do
begin
n.Add(temp1[i]);
end;
ani_rand_location := random(n.Count-1)+1;
n.Insert(ani_rand_location, ' ');
temp1 := '';
for i := 0 to n.Count-1 do
begin
temp1 := temp1 + n.Strings[i];
end;
format_sn(temp1,true);
n.free;
end;
if (ani_style = aniSpace) and (ani_direction = aniFrontToBack) then //cycle space through front to back
begin
if (ani_sp_f2b > length(ClientInfo.PreAnimated)) or (ani_sp_f2b < 1) then ani_sp_f2b := 1;
temp1 := ClientInfo.PreAnimated;
n := tstringlist.create;
for i := 1 to length(temp1) do
begin
n.Add(temp1[i]);
end;
n.Insert(ani_sp_f2b, ' ');
temp1 := '';
for i := 0 to n.Count-1 do
begin
temp1 := temp1 + n.Strings[i];
end;
temp1 := trim(temp1);
format_sn(temp1,true);
n.free;
inc(ani_sp_f2b);
end;
if (ani_style = aniCapital) and (ani_direction = aniRandom) then //cycle capital through front to back
begin
ani_rand_location := random(length(ClientInfo.PreAnimated)-1)+1;
temp1 := uppercase(ClientInfo.PreAnimated);
temp2 := lowercase(ClientInfo.PreAnimated);
temp2[ani_rand_location] := temp1[ani_rand_location];
format_sn(temp2,true);
end;
if (ani_style = aniCapital) and (ani_direction = aniFrontToBack) then //cycle capital through front to back
begin
if (ani_cap_f2b > length(ClientInfo.PreAnimated)) or (ani_cap_f2b <= 0) then ani_cap_f2b := 1;
temp1 := uppercase(ClientInfo.PreAnimated);
temp2 := lowercase(ClientInfo.PreAnimated);
temp2[ani_cap_f2b] := temp1[ani_cap_f2b];
format_sn(temp2,true);
inc(ani_cap_f2b);
end;
if (ani_style = aniCapital) and (ani_direction = aniBackToFront) then //cycle capital through front to back
begin
if (ani_cap_b2f <= 0) then ani_cap_b2f := length(ClientInfo.PreAnimated);
temp1 := uppercase(ClientInfo.PreAnimated);
temp2 := lowercase(ClientInfo.PreAnimated);
temp2[ani_cap_b2f] := temp1[ani_cap_b2f];
format_sn(temp2,true);
dec(ani_cap_b2f);
end;
if (ani_style = aniSpace) and (ani_direction = aniBackToFront) then //space back to front
begin
if ani_sp_b2f < 1 then ani_sp_b2f := length(ClientInfo.PreAnimated);
temp1 := ClientInfo.PreAnimated;
n := tstringlist.create;
for i := 1 to length(temp1) do
begin
n.Add(temp1[i]);
end;
n.Insert(ani_sp_b2f, ' ');
temp1 := '';
for i := 0 to n.Count-1 do
begin
temp1 := temp1 + n.Strings[i];
end;
temp1 := trim(temp1);
format_sn(temp1,true);
n.free;
dec(ani_sp_b2f);
end;
end;
end;
}