icqclient.pas

本程序是转载的

{Adds UIN to contact list after logon(when you are online), UIN automaticly
added to ContactList TStrings. After adding the UIN you will receive status
notifications. Returns True when UIN is added to the list(it wasn't there before).}
function TICQClient.AddContact(UIN: LongWord): Boolean;
var
  pkt: TRawPkt;
begin
  Result := False;
  if FContactLst.IndexOf(IntToStr(UIN)) < 0 then
  begin
    FContactLst.Add(IntToStr(UIN));
    Result := True;
  end else
    Exit;
  if not LoggedIn then Exit;
  CreateCLI_ADDCONTACT(@pkt, IntToStr(UIN), FSeq);           {SNAC(x03/x04)}
  FSock.SendData(pkt, pkt.Len);
end;

{Adds list of UINs to contact list after logon(when you are online), UIN automaticly
added to ContactList TStrings. After adding the UINs you will receive status
notifications. Returns True when UINs are added to the list(it wasn't there before).}
function TICQClient.AddContactMulti(UINlist: array of LongWord): Boolean;
var
pkt: TRawPkt;
temp : integer;
begin
  for temp := Low(UINList) to High(UINList) do
    FContactlst.Add(inttostr(uinlist[temp]));
  CreateCLI_ADDCONTACT_multi(@pkt, uinlist, FSeq); {SNAC(x03/x04)}
  FSock.SendData(pkt, pkt.Len);
  Result := True;
end;

{Addes UIN to the visible list. Use while you are online.
Returns True when UIN is added to the list(it wasn't there before).}
Function TICQClient.AddContactVisible(UIN: LongWord):Boolean;
var
  idx: Integer;
  pkt: TRawPkt;
  SL:TSTringList;
begin
  Result := False;
  idx := FVisibleLst.IndexOf(IntToStr(UIN));
  if idx > -1 then
    Exit;  // Already in list
  FVisibleLst.Add(IntToStr(UIN));
  Result := True;
  if not LoggedIn then Exit;
  if StatusToStr (FStatus)='Invisible' // *yegor
     then begin
          SL := TStringList.Create;
          Try
            SL.Add(IntToStr(UIN));
            CreateCLI_ADDVISIBLE(@pkt, SL, FSeq);
          Finally
            SL.Free;
          End;
          FSock.SendData(pkt, pkt.Len);
     end; // **yegor
end;

{Addes UIN to the invisible list. Use while you are online.
Returns True when UIN is added to the list(it wasn't there before).}
Function TICQClient.AddContactInvisible(UIN: LongWord):Boolean;
var
  idx: Integer;
  pkt: TRawPkt;
  SL:TSTringList;
begin
  Result := False;
  idx := FInVisibleLst.IndexOf(IntToStr(UIN));
  if idx > -1 then
    Exit;  // Already in list
  FInVisibleLst.Add(IntToStr(UIN));
  Result := True;
  if not LoggedIn then Exit;
  if StatusToStr (Status)<>'Invisible' // *yegor
     then begin
          SL := TStringList.Create;
          Try
            SL.Add(IntToStr(UIN));
            CreateCLI_ADDINVISIBLE(@pkt, SL, FSeq);
          Finally
            SL.Free;
          End;
          FSock.SendData(pkt, pkt.Len);
     end; // **yegor
end;

{Removes UIN from contact list. Use while you are online.}
procedure TICQClient.RemoveContact(UIN: LongWord);
var
  idx: Integer;
  pkt: TRawPkt;
begin
  idx := FContactLst.IndexOf(IntToStr(UIN));
  if idx > -1 then
    FContactLst.Delete(idx);
  if not LoggedIn then Exit;
  CreateCLI_REMOVECONTACT(@pkt, UIN, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Removes UIN from the visible list. Use while you are online.}
procedure TICQClient.RemoveContactVisible(UIN: LongWord);
var
  idx: Integer;
  pkt: TRawPkt;
begin
  idx := FVisibleLst.IndexOf(IntToStr(UIN));
  if idx > -1 then
    FVisibleLst.Delete(idx);
  if not LoggedIn then Exit;
  if StatusToStr (FStatus)='Invisible' // *yegor
     then begin
          CreateCLI_REMVISIBLE(@pkt, UIN, FSeq);
          FSock.SendData(pkt, pkt.Len);
     end; // **yegor
end;

{Removes UIN from the invisible list. Use while you are online.}
procedure TICQClient.RemoveContactInvisible(UIN: LongWord);
var
  idx: Integer;
  pkt: TRawPkt;
begin
  idx := FInvisibleLst.IndexOf(IntToStr(UIN));
  if idx > -1 then
    FInvisibleLst.Delete(idx);
  if not LoggedIn then Exit;
  if StatusToStr (FStatus)<>'Invisible' // *yegor
     then begin
          CreateCLI_REMINVISIBLE(@pkt, UIN, FSeq);
          FSock.SendData(pkt, pkt.Len);
     end; // **yegor
end;

{Query info about UIN. As answer you will recieve theese events: OnUserWorkInfo,
OnUserInfoMore, OnUserInfoAbout, OnUserInfoInterests, OnUserInfoMoreEmails,
OnUserFound.}
procedure TICQClient.RequestInfo(UIN: LongWord);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  FInfoChain.Values[IntToStr(FSeq2)] := IntToStr(UIN);
  CreateCLI_METAREQINFO(@pkt, FLUIN, UIN, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Request short info(nick, first, last, email) of UIN.}
procedure TICQClient.RequestInfoShort(UIN: LongWord);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  FSInfoChain.Values[IntToStr(FSeq2)] := IntToStr(UIN);
  CreateCLI_METAREQINFO_SHORT(@pkt, FLUIN, UIN, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Searches user by Mail}
procedure TICQClient.SearchByMail(const Email: String);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SEARCHBYMAIL(@pkt, FLUIN, Email, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Searches user by UIN}
procedure TICQClient.SearchByUIN(UIN: LongWord);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SEARCHBYUIN(@pkt, FLUIN, UIN, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Searches user by Name and other data}
procedure TICQClient.SearchByName(const FirstName, LastName, NickName, Email: String);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SEARCHBYNAME(@pkt, FLUIN, FirstName, LastName, NickName, Email, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Searches random user from Group, where Group id could be found in RandGroups:
array[1..11]...(ICQWorks.pas) constant. As answer you will receive OnUserFound
notification, only one user will be found.}
procedure TICQClient.SearchRandom(Group: Word);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SEARCHRANDOM(@pkt, FLUIN, Group, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Searches user in 'White Pages'. As answer you will receive OnUserFound notification
when at least one user found or OnUserNotFound if such user does not exist.}
procedure TICQClient.SearchWhitePages(const FirstName, LastName, NickName, Email: String; MinAge, MaxAge: Word;
  Gender: Byte; const Language, City, Country, Company, Department, Position, Occupation,
  Organization, OrganKeyWords, PastAffiliation, AffiKeyWords, KeyWord: String; Online: Boolean);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SEARCHWP(@pkt, FLUIN, FirstName, LastName, NickName, Email,
    MinAge, MaxAge,
    Gender,
    StrToLanguageI(Language),
    City, StrToCountryI(Country),
    Company,
    Department,
    Position,
    StrToOccupationI(Occupation),
    StrToOrganizationI(Organization),
    OrganKeyWords,
    StrToPastI(PastAffiliation),
    AffiKeyWords,
    KeyWord,
    Ord(Online),
    FSeq,
    FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Set general info about yourself. You can skip some parameters (eg. use '' -
empty strings) to unspecify some info. }
procedure TICQClient.SetSelfInfoGeneral(NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  //Truncate state if more then 3 chars
  if Length(State) > 3 then
    State := Copy(State, 0, 3);
  CreateCLI_METASETGENERAL(@pkt, FLUIN, NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip, StrToCountryI(Country), TimeZone, PublishEmail, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Set more info about yourself.}
procedure TICQClient.SetSelfInfoMore(Age: Word; Gender: Byte; const HomePage: String; BirthYear: Word; BirthMonth, BirthDay: Byte; Language1, Language2, Language3: String);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_METASETMORE(@pkt, FLUIN, Age, Gender, HomePage, BirthYear, BirthMonth, BirthDay, StrToLanguageI(Language1), StrToLanguageI(Language2), StrToLanguageI(Language3), FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Set info about yourself.}
procedure TICQClient.SetSelfInfoAbout(const About: String);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_METASETABOUT(@pkt, FLUIN, About, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Requests server side contact list. For more info look at OnServerListRecv event.}
procedure TICQClient.RequestContactList;
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_REQROSTER(@pkt, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Releases memory used while parsing the server side contact list.}
procedure TICQClient.DestroyUINList(var List: TList);
var
  i: Word;
begin
  if List = nil then Exit;
  if List.Count > 0 then
    for i := 0 to List.Count - 1 do
      FreeMem(List.Items[i], SizeOf(TUINEntry)); //Free allocated memory for TUINEntry
  List.Free;
  List := nil;
end;

{Sends sms message to Destination with Text.}
procedure TICQClient.SendSMS(const Destination, Text: String);
var
  pkt: TRawPkt;
begin
  if (Length(Text) = 0) or (not LoggedIn) then Exit;
  CreateCLI_SENDSMS(@pkt, FLUIN, Destination, Text, GetACP, GetSMSTime, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Sends Msg to UIN with advanced options, after UIN has got your message you will
receive confirmation. ID - randomly generated value, may be used for packet acknowledgements
(see OnAdvancedMsgAck event). If your Msg is in the RTF(RichText Format), then RTFFormat
parameter should be True, otherwise - False. Beware of using the RTF Format, some clients
(old versions of ICQ, linux & windows clones) don't support it.}
procedure TICQClient.SendMessageAdvanced(UIN: LongWord; const Msg: String; ID: Word; RTFFormat: Boolean);
var
  pkt: TRawPkt;
begin
  if (Length(Msg) = 0) or (not LoggedIn) then Exit;
  CreateCLI_SENDMSG_ADVANCED(@pkt, 0, ID, UIN, Msg, RTFFormat, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Send message to client dirrectly when it's possible}
function TICQClient.SendMessageDirect(UIN: LongWord; const Msg: String; RTFFormat: Boolean): Word;
var
  lpkt: TRawPkt;
begin
  Result := 0;
  if FDirect = nil then Exit;
  if (FDSeq = 0) then Inc(FSeq);
  Result := CreatePEER_MSG(@lpkt, Msg, RTFFormat, FDSeq);
  if not FDirect.SendData(UIN, @lpkt) then
    Result := 0;
end;

{Request an away messages, set when user changes status.}
procedure TICQClient.RequestAwayMsg(UIN: LongWord; ID: Word; ReqStatus: Byte);
var
  pkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_REQAWAYMSG(@pkt, 0, ID, UIN, ReqStatus, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Unregister an UIN number.}
procedure TICQClient.UnregisterUIN(const Password: String);
var
  pkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_UNREGUIN(@pkt, FLUIN, Password, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Change current password to NewPassword.}
procedure TICQClient.ChangePassword(const NewPassword: String);
var
  pkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_METASETPASS(@pkt, FLUIN, NewPassword, nil, 0, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Change current password to Buffer's value.}
procedure TICQClient.ChangePasswordPtr(Buffer: Pointer; BufLen: Word);
var
  pkt: TRawPkt;
begin