idgopher.pas

Indy控件的使用源代码

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10171: IdGopher.pas 
{
{   Rev 1.0    2002.11.12 10:39:30 PM  czhower
}

{*******************************************************}
{                                                       }
{       Indy Gopher Client TIdGopher                    }
{                                                       }
{       Copyright (C) 2000 Winshoes Working Group       }
{       Started by J. Peter Mugaas                      }
{       April 20, 2000                                  }
{                                                       }
{*******************************************************}
{
 2000-June- 9  J. Peter Mugaas
  -adjusted the Gopher+ support so that line-unfolding is disabled in
   FGopherBlock.  Many headers we use start with spaces
  -made the ASK block into a TIdHeaderList to facilitate use better.  This does
   unfold lines
 2000-May -24  J. Peter Mugaas
  -changed interface of file retrieval routines to so DestStream property does
   not have to even exist now.
 2000-May -17  J. Peter Mugaas
  -Optimized the DoneSettingInfoBlock method in the TIdGopherMenuItem object
  -Added Ask property to the TIdGopherMenuItem 
 2000-May -13  J. Peter Mugaas
  -Chanded the event types and classes to be prefixed with Id.
 2000-Apr.-28  J. Peter Mugaas
  -Added built in Gopher+ support
 2000-Apr.-21  J. Peter Mugaas
  -Added the ability to receive a file
  -Restructured this component to make the code more reabible,
   facilitate processing, and improve object orientation
 2000-Apr.-20  J. Peter Mugaas
  -Started this unit
}

unit IdGopher;

interface

uses
  Classes,
  IdAssignedNumbers,
  IdEMailAddress,
  IdHeaderList, IdTCPClient;

type
  TIdGopherMenuItem = class ( TCollectionItem )
  protected
    FTitle : String;
    FItemType : Char;
    FSelector : String;
    FServer : String;
    FPort : Integer;
    FGopherPlusItem : Boolean;
    FGopherBlock : TIdHeaderList;
    FViews : TStringlist;
    FURL : String;
    FAbstract : TStringList;
    FAsk : TIdHeaderList;
    fAdminEmail : TIdEMailAddressItem;
    function GetLastModified : String;
    function GetOrganization : String;
    function GetLocation : String;
    function GetGeog : String;
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
    {This procedure updates several internal variables and should be done when
    all data has been added}
    procedure DoneSettingInfoBlock; virtual;
    {This is the title for the gopher Menu item and should be displayed to the
    user}
    property Title : String read FTitle write FTitle;
    {This charactor indicates the type of Item that this is.
    Use this to determine what methods to call to get the item}
    property ItemType : Char read FItemType write FItemType;
    {This is the Selector you use to retreive the item}
    property Selector : String read FSelector write FSelector;
    {This is the server you connect to and request the item from.  Set the host
    property to this when retrieving it}
    property Server : String read FServer write FServer;
    {This indicates the port you connect to in order to request the item.  Set
    the port property to this value to get an item.}
    property Port : Integer read FPort write FPort;
    {This indicates if the item is on a Gopher+ server - you can use
    GetExtended Menues for menus}
    property GopherPlusItem : Boolean read FGopherPlusItem
      write FGopherPlusItem;
    {These items are only available if you use the GetExtendedMenu method}
    {This is the complete information block for this gopher+ item}
    property GopherBlock : TIdHeaderList read FGopherBlock;
    {URL listed at +URL: Section }
    property URL : String read FURL;
    {This is the Gopher Views available for the item.  You can include this
    when requesting it}
    property Views : TStringList read FViews;
    {abstract of Gopher item - had to be AAbstract due to Pascal reserved word}
    {this is a summery of a particular item - e.g. "Read about our greate
     products"}
    property AAbstract : TStringList read FAbstract;
    {This is the date that the item was last modified}
    property LastModified : String read GetLastModified;
    {This is contact information for the adminst}
    property AdminEMail : TIdEMailAddressItem read fAdminEmail;
    {This is the organization running the server and
    is usually only found in the Root item}
    property Organization : String read GetOrganization;
    {This is the location where the Gopher is
    and is usually only found in the Root item}
    property Location : String read GetLocation;
    {This is the latitude longitude and longitude of the Gopher server
    and is usually only found in the Root item}
    property Geog : String read GetGeog;
    {This Gopher+ information is used for prmoting users for Query data}
    property Ask : TIdHeaderList read FAsk;
  end;
  TIdGopherMenu = class ( TCollection )
  protected
    function GetItem ( Index: Integer ) : TIdGopherMenuItem;
    procedure SetItem ( Index: Integer; const Value: TIdGopherMenuItem );
  public
    constructor Create; reintroduce;
    function Add: TIdGopherMenuItem;
    property Items [ Index: Integer ] : TIdGopherMenuItem read GetItem
      write SetItem; default;
  end;
  TIdGopherMenuEvent = procedure ( Sender : TObject;
    MenuItem : TIdGopherMenuItem ) of object;

  TIdGopher = class ( TIdTCPClient )
  private
    { Private declarations }
  protected
    { Protected declarations }
    FOnMenuItem : TIdGopherMenuEvent;
    {This triggers the menu item event}
    Procedure DoMenu ( MenuItem : TIdGopherMenuItem  );
    {This fires an exception for Gopher+ errors}
    Procedure ProcessGopherError;
    {This takes parses a string and makes a Menu Item for it}
    Function MenuItemFromString ( stLine : String; Menu : TIdGopherMenu)
      : TIdGopherMenuItem;
    {Process the menu while we retreive it}
    Function ProcessDirectory ( PreviousData : String = '';    {Do not Localize}
      const ExpectedLength: Integer = 0) : TIdGopherMenu;
    {This processes extended Gopher Menues}
    Function LoadExtendedDirectory ( PreviousData : String = '';    {Do not Localize}
     const ExpectedLength: Integer = 0) : TIdGopherMenu;
    {This processes the file when we retreive it and puts it in ADestStream. }
    procedure ProcessFile ( ADestStream : TStream; APreviousData : String = '';    {Do not Localize}
      const ExpectedLength : Integer = 0);
    {For Gopher +, we call this routine when we get a -2 length which means,
    read until you see EOL+.+EOL}
    Procedure ProcessTextFile ( ADestStream : TStream;
      APreviousData: String = ''; const ExpectedLength: Integer = 0);    {Do not Localize}
  public
    { Public declarations }
    constructor Create ( AOwner: TComponent ); override;
    Function GetMenu (ASelector : String; IsGopherPlus : Boolean = False; AView : String = '' ) :    {Do not Localize}
      TIdGopherMenu;
    Function Search(ASelector, AQuery : String) : TIdGopherMenu;
    procedure GetFile (ASelector : String; ADestStream : TStream; IsGopherPlus : Boolean = False; AView: String = '');    {Do not Localize}
    procedure GetTextFile(ASelector : String; ADestStream : TStream; IsGopherPlus : Boolean = False; AView: String = '');    {Do not Localize}
    Function GetExtendedMenu (ASelector : String; AView: String = '' ) : TIdGopherMenu;    {Do not Localize}
  published
    { Published declarations }
    property OnMenuItem : TIdGopherMenuEvent read FOnMenuItem write FOnMenuItem;
    property Port default IdPORT_Gopher;
  end;

implementation

uses
  IdComponent, IdException,
  IdGlobal, IdGopherConsts,
  IdTCPConnection,
  SysUtils;

Procedure WriteToStream(AStream : TStream; AString : String);
begin
  if Length(AString) > 0 then
    AStream.Write( AString [ 1 ], Length ( AString ) );
end;

{ TIdGopher }

constructor TIdGopher.Create ( AOwner: TComponent );
begin
  inherited;
  Port := IdPORT_GOPHER;
end;

procedure TIdGopher.DoMenu(MenuItem: TIdGopherMenuItem);
begin
  if Assigned( FOnMenuItem ) then
    FOnMenuItem( Self, MenuItem );
end;

procedure TIdGopher.ProcessGopherError;
var ErrorNo : Integer;
    ErrMsg : String;
begin
  ErrMsg := AllData;
  {Get the error number from the error reply line}
  ErrorNo := StrToInt ( Fetch ( ErrMsg ) );
  {we want to drop the CRLF+'.'+CRLF}    {Do not Localize}
  raise EIdProtocolReplyError.CreateError(ErrorNo, Copy(ErrMsg, 1, Length(ErrMsg) - 5));
end;

function TIdGopher.MenuItemFromString(stLine: String;
  Menu: TIdGopherMenu): TIdGopherMenuItem;
begin
  {just in case a space thows things off}
  stLine := Trim(stLine);
  if Assigned ( Menu ) then
  begin
    Result := Menu.Add;
  end  // if Assigned ( Menu ) then
  else
  begin
    Result := TIdGopherMenuItem.Create( nil );
  end; // else .. if Assigned ( Menu ) then
  {title and Item Type}
  Result.Title := IdGlobal.Fetch ( stLine, TAB );
  if Length ( Result.Title ) > 0 then
  begin
    Result.ItemType := Result.Title [ 1 ];
  end  //if Length.Result.Title > 0 then
  else
  begin
    Result.ItemType := IdGopherItem_Error;
  end; //else..if Length.Result.Title > 0 then
  {drop first charactor because that was the item type indicator}
  Result.Title := Copy ( Result.Title, 2, Length ( Result.Title ) );
  {selector string}
  Result.Selector := Fetch ( stLine, TAB );
  {server}
  Result.Server  := Fetch ( stLine, TAB );
  {port}
  Result.Port    := StrToInt ( Fetch ( stLine, TAB ) );
  {is Gopher + Item}
  stLine := Fetch ( stLine, TAB );
  Result.GopherPlusItem := ( (Length ( stLine) > 0 ) and
     ( stLine [ 1 ] = '+' ) );    {Do not Localize}
end;

Function TIdGopher.LoadExtendedDirectory ( PreviousData : String = '';    {Do not Localize}
  const ExpectedLength: Integer = 0) : TIdGopherMenu;
var
  stLine : String;
  gmnu : TIdGopherMenuItem;
begin
  BeginWork(wmRead, ExpectedLength); try
    Result := TIdGopherMenu.Create;
    gmnu := nil;
    repeat
      stLine := PreviousData + ReadLn;
      {we use the Previous data only ONCE}
      PreviousData := '';    {Do not Localize}
      {we process each line only if it is not the last and the
      OnMenuItem is assigned}
      if ( stLine <> '.' ) then    {Do not Localize}
      begin
        {This is a new Extended Gopher menu so lets start it}
        if ( Copy (stLine, 1, Length ( IdGopherPlusInfo ) ) = IdGopherPlusInfo ) then
        begin
          {fire event for previous item}
          if (gmnu <> nil) then
          begin
            gmnu.DoneSettingInfoBlock;
            DoMenu ( gmnu );
          end;  //if (gmnu <> nil) then
          gmnu := MenuItemFromString ( RightStr( stLine,
            Length ( stLine ) - Length ( IdGopherPlusInfo ) ) , Result );
          gmnu.GopherBlock.Add ( stLine);
        end //if (Pos(IdGopherGPlusInfo, stLine) = 0) then
        else
        begin
          if Assigned( gmnu ) and (stLine <> '') then    {Do not Localize}
          begin
            gmnu.GopherBlock.Add ( stLine );
          end;
        end;  //else...if (Pos(IdGopherGPlusInfo, stLine) = 0) then
      end //if not stLine = '.' then    {Do not Localize}
      else
      begin
        {fire event for the last line}
        if (gmnu <> nil) then
        begin
          DoMenu ( gmnu );
        end;  //if (gmnu <> nil) then
      end; //if ( stLine <> '.' ) then    {Do not Localize}
    until (stLine = '.') or not Connected;    {Do not Localize}
  finally EndWork(wmRead); end;
end;

Function TIdGopher.ProcessDirectory ( PreviousData : String = '';    {Do not Localize}
  const ExpectedLength: Integer = 0) : TIdGopherMenu;
var stLine : String;

begin
  BeginWork(wmRead,ExpectedLength); try
    Result := TIdGopherMenu.Create;
    repeat
      stLine := PreviousData + ReadLn;
      {we use the Previous data only ONCE}
      PreviousData := '';    {Do not Localize}
      {we process each line only if it is not the last and the OnMenuItem
      is assigned}
      if ( stLine <> '.' ) then    {Do not Localize}
      begin
      //add Gopher Menu item and fire event
        DoMenu ( MenuItemFromString ( stLine, Result ) );
      end; //if not stLine = '.' then    {Do not Localize}
    until (stLine = '.') or not Connected;    {Do not Localize}
  finally
    EndWork(wmRead);
  end; //try..finally
end;