idirc.pas

Indy控件的使用源代码

uses
  IdResourceStrings,
  SysUtils;

const
  { Responses from the server that do not appear as a numeric. }
  Commands: Array [0..12] of String = ('PRIVMSG', 'NOTICE', 'JOIN', 'PART', 'KICK', 'MODE',    {Do not Localize}
    'NICK', 'QUIT', 'INVITE', 'KILL', 'PING', 'WALLOPS', 'TOPIC');    {Do not Localize}
  { Standard CTCP queries and replies. }
  CTCPs: Array [0..9] of String = ('ACTION', 'SOUND', 'PING', 'FINGER', 'USERINFO', 'VERSION',    {Do not Localize}
    'CLIENTINFO', 'TIME', 'ERROR', 'DCC');    {Do not Localize}
  { Standard DCC queries and replies. }
  DCCs: Array [0..3] of String = ('SEND', 'CHAT', 'RESUME', 'ACCEPT');

  { The characters for the channel modes. In the same order as TIdIRCChannelModes. }
  ChannelModeChars: array [0..7] of Char = ('p', 's', 'i', 't', 'n', 'm', 'l', 'k');    {Do not Localize}
  { The characters for the user modes.  In the same order as TIdIRCUserModes. }
  UserModeChars: array [0..3] of Char = ('i', 'o', 's', 'w');    {Do not Localize}
  { Default CTCP Version and ClientInfo replies (just a bit of advertising if
    the client coder forgets to specify any other values). }

  IRCChannelPrefixes = ['&','#','+','!']; {do not translate}    {Do not Localize}

{ Register the component TIdIRC in Delphi. }

{ //////////////////////////////////////////////////////////////////////////// }
{ TIdIRCUser }
{ //////////////////////////////////////////////////////////////////////////// }

{ Create a new user in our list. }
constructor TIdIRCUser.Create(AClient: TIdIRC; ANick, AAddress: String);
begin
  inherited Create( AClient.Users );
  FClient := AClient;
  FNick := ANick;
  FAddress := AAddress;
  FData := nil;
  FReason := '';    {Do not Localize}
  Count := 1;
end;

{ Delete the user from our list. }
destructor TIdIRCUser.Destroy;
begin
  inherited Destroy;
end;

{ Send a private message to the user. }
procedure TIdIRCUser.Say(AMsg: String);
begin
  FClient.Say(FNick, AMsg);
end;

{ //////////////////////////////////////////////////////////////////////////// }
{ TIdIRCUsers }
{ //////////////////////////////////////////////////////////////////////////// }

{ Create the list of users. }
constructor TIdIRCUsers.Create(AClient: TIdIRC);
begin
  inherited Create (TIdIRCUser);
  FClient := AClient;
end;

{ Delete the list of users. }
destructor TIdIRCUsers.Destroy;
begin
  inherited Destroy;
end;

procedure TIdIRCUsers.SetItem ( Index: Integer; const Value: TIdIRCUser );
begin
 inherited SetItem (Index, Value);
end;

{inherited GetItem for our items property}

function TIdIRCUsers.GetItem(Index: Integer): TIdIRCUser;
begin
  Result := TIdIRCUser( inherited GetItem(Index));
end;

{ Increments the reference count for the user.  If the user does not exist,
  then a new user is created with a reference count of one.  If the user
  already exists, the address is updated.  Returns the user object. }
function TIdIRCUsers.Add(ANick, AAddress: String): TIdIRCUser;
var
  Index: Integer;
begin
  if Find(ANick, Index) then
  { The user already exists, so increment the reference count. }
  begin
    Result := Items[Index];
    if (AAddress <> '') and (Result.Address <> AAddress) then    {Do not Localize}
    begin
      Result.Address := AAddress;
    end;
    Inc(Result.Count);
  end
  else
  { Create a new user with a reference count of one. }
  begin

    Result := TIdIRCUser.Create(FClient, ANick, AAddress);

  end;
end;

{ Decrement the reference count for this user.  If the reference count becomes
  zero, then delete the user object and remove the nick from the list (if the
  nick in the list refers to the same user object). }
procedure TIdIRCUsers.Remove(AUser: TIdIRCUser);
var
  Index: Integer;
begin
  Dec(AUser.Count);
  if AUser.Count = 0 then
  begin
    if Find(AUser.Nick, Index) and ((Items[Index] as TIdIRCUser) = AUser) then
    begin
      Items[Index].Free;
    end;
  end;
end;

{ Returns the address for the specified nick, if available. }
function TIdIRCUsers.Address(ANick: String): String;
var
  Index: Integer;
begin
  Result := '';    {Do not Localize}
  if Find(ANick, Index) then
  begin
    Result := Items[Index].Address;
  end;
end;

{ Searches for the given nick. Returns True and the index number of the nick
  if found. }
function TIdIRCUsers.Find(ANick: String; var AIndex: Integer): Boolean;
begin
  { Need a case-insensitive search.  So it has to be done manually, I guess. }
  Result := False;
  AIndex := 0;
  while AIndex < Count do
  begin
    Result := AnsiCompareText(ANick, Items[AIndex].FNick) = 0;
    if Result then
    begin
      Exit;
    end;
    Inc(AIndex);
  end;
  { Search failed, so Index is set to -1. }
  AIndex := -1;
end;

{ Returns the user object for the given nick.  If the nick is not found, then
  it returns nil. }
function TIdIRCUsers.Get(ANick: String): TIdIRCUser;
var
  Index: Integer;
begin
  Result := nil;
  if Find(ANick, Index) then
  begin
    Result := Items[Index];
  end;
end;

{sort user list}
procedure TIdIRCUsers.Sort;
{I found this procedure at:

http://groups.google.com/groups?q=Sort+TCollection&start=30&hl=en&safe=off&rnum=35&selm=904181166%40f761.n5030.z2.FidoNet.ftn

and it seems to look good.}

  function DoCompare(AItem1, AItem2 : TIdIRCUser) : Integer;
  begin
    if Assigned(FOnSortCompareUsers) then
    begin
      FOnSortCompareUsers(Self,AItem1, AItem2, Result);
    end
    else
    begin
      Result := 0;
    end;
  end;

  procedure SwapItems(i, j : Integer);
  var
    T : TIdIRCUser;
  begin
    T := Items[i];
    Items[i] := Items[j];
    Items[j] := T;
  end;

  procedure SortItems(iStart, iEnd : Integer);
  var
    i, j : Integer;
    Med : TIdIRCUser;
  begin
    while iStart < iEnd do
    begin
      i := iStart;
      j := iEnd;

      if iStart = iEnd-1 then
      begin
        if DoCompare(Items[iStart], Items[iEnd]) > 0 then
        begin
          SwapItems(iStart, iEnd);
        end;
        Break;
      end;

      Med := Items[(i + j) div 2];

      repeat
        while DoCompare(Items[i], Med) < 0 do
        begin
          Inc(i);
        end;
        while DoCompare(Items[j], Med) > 0 do
        begin
          Dec(j);
        end;
        if i <= j then
        begin
          SwapItems(i, j);
          Inc(i);
          Dec(j);
        end;
      until i > j;

      if j-iStart > iEnd-i then
      begin
        SortItems(i, iEnd);
        iEnd := j;
      end
      else
      begin
        SortItems(iStart, j);
        iStart := i;
      end;
    end;
  end;

begin
  if Count > 0 then
  begin
    SortItems(0, Count - 1);
  end;
end;

{ Changes the user's nick. }    {Do not Localize}
procedure TIdIRCUsers.Nick(AFromNick, AToNick: String);
var
  Index: Integer;
  User: TIdIRCUser;
begin
  if Find(AFromNick, Index) then
  begin
    User := Items[Index];
    User.Nick := AToNick;
{I'm leaving this all commented because I'm not sure if it is needed or not due   
to some comments made by the author}
{    items[Index].Free;
    if Find(AToNick, Index) then
    { The ToNick already exists (probably from the previous user having quit
      IRC and a query window is still open), so replace the existing user
      object with the new user object.}
{      FNickList.Objects[Index] := User
    else
    { Add the user to the list with the new nick. }
{    begin
      Index := FNickList.Add(AToNick);
      FNickList.Objects[Index] := User;
    end;  }
  end;
end;

{ Purge the users list. }


{ //////////////////////////////////////////////////////////////////////////// }
{ TIdIRCChannel }
{ //////////////////////////////////////////////////////////////////////////// }

{ Create a new channel in the channel list. }
constructor TIdIRCChannel.Create(AClient: TIdIRC; AName: String);
begin
  inherited Create(AClient.FChannels);
  FClient := AClient;
  FName := AName;
  FTopic := '';    {Do not Localize}
  FMode := [];
  FLimit := 0;
  FKey := '';    {Do not Localize}
  FNames := TStringList.Create;
  FBans := TStringList.Create;
  FModeChange := False;
  FActive := False;
  FCloseType := ctReset;
  FData := nil;
  { Attach the event handler for channel updates. }
  FOnChannelUpdate := FClient.OnChannelUpdate;
end;

{ Delete a channel from the channel list. }
destructor TIdIRCChannel.Destroy;
begin