idgopher.pas

Indy控件的使用源代码

procedure TIdGopher.ProcessTextFile(ADestStream : TStream; APreviousData: String = '';    {Do not Localize}
  const ExpectedLength: Integer = 0);
begin
  WriteToStream(ADestStream, APreviousData);
  BeginWork(wmRead,ExpectedLength);
  try
    Capture(ADestStream,'.',True);    {Do not Localize}
  finally
    EndWork(wmRead);
  end;  //try..finally
end;

procedure TIdGopher.ProcessFile ( ADestStream : TStream; APreviousData : String = '';    {Do not Localize}
  const ExpectedLength : Integer = 0);
begin
  BeginWork(wmRead,ExpectedLength);
  try
    WriteToStream(ADestStream, APreviousData);
    ReadStream(ADestStream,-1,True);
    ADestStream.Position := 0;
  finally
    EndWork(wmRead);
  end;
end;

Function TIdGopher.Search(ASelector, AQuery : String) : TIdGopherMenu;
begin
  Connect;
  try
    {Gopher does not give a greating}
    WriteLn ( ASelector + TAB + AQuery );
    Result := ProcessDirectory;
  finally
    Disconnect;
  end; {try .. finally .. end }
end;

procedure TIdGopher.GetFile (ASelector : String; ADestStream : TStream;
  IsGopherPlus : Boolean = False;
  AView: String = '');    {Do not Localize}
var Reply : Char;
    LengthBytes : Integer;  {legnth of the gopher items}

begin
  Connect;
  try
    if not IsGopherPlus then
    begin
      WriteLn ( ASelector );
      ProcessFile ( ADestStream );
    end  // if not IsGopherPlus then
    else
    begin
      {I hope that this drops the size attribute and that this will cause the
       Views to work, I'm not sure}    {Do not Localize}
      AView := Trim ( Fetch ( AView, ':' ) );    {Do not Localize}
      WriteLn ( ASelector + TAB +'+'+ AView );    {Do not Localize}
      {We read only one byte from the peer}
      ReadBuffer( Reply, 1 );
      {Get the additonal reply code for error or success}
      case Reply of
        '-' : begin    {Do not Localize}
                {Get the length byte}
                ReadLn;
                ProcessGopherError;
              end; {-}
              {success - read file}
        '+' : begin    {Do not Localize}
                {Get the length byte}
                LengthBytes := StrToInt ( ReadLn );
                case LengthBytes of
                 {dot terminated - probably a text file}
                  -1 : ProcessTextFile ( ADestStream );
                  {just read until I disconnect you}
                  -2 : ProcessFile ( ADestStream );
                else
                  ProcessFile ( ADestStream, '', LengthBytes);    {Do not Localize}
                end; //case LengthBytes of
              end; {+}
        else
        begin
          ProcessFile ( ADestStream, Reply );
        end;  //else ..case Reply of
      end;  //case Reply of
    end; //else..if IsGopherPlus then
  finally
    Disconnect;
  end; {try .. finally .. end }
end;

function TIdGopher.GetMenu ( ASelector : String; IsGopherPlus : Boolean = False; AView : String = '' ) :    {Do not Localize}
      TIdGopherMenu;
var Reply : Char;
    LengthBytes : Integer;  {legnth of the gopher items}
begin
  Result := nil;
  Connect;
  try
    if not IsGopherPlus then
    begin
      WriteLn ( ASelector );
      Result := ProcessDirectory;
    end  // if not IsGopherPlus then
    else
    begin
      {Gopher does not give a greating}
      WriteLn ( ASelector + TAB+'+' + AView );    {Do not Localize}
      {We read only one byte from the peer}
      ReadBuffer( Reply, 1 );
      {Get the additonal reply code for error or success}
      case Reply of
        '-' : begin    {Do not Localize}
                ReadLn;
                ProcessGopherError;
              end;  {-}
        '+' : begin    {Do not Localize}
                {Get the length byte}
                LengthBytes := StrToInt ( ReadLn );
                Result := ProcessDirectory ('', LengthBytes );    {Do not Localize}
              end;  {+}
        else
        begin
          Result := ProcessDirectory ( Reply );
        end; //else..case Reply of
      end; //case Reply of
    end; //if not IsGopherPlus then
  finally
    Disconnect;
  end;  {try .. finally .. end }
end;

Function TIdGopher.GetExtendedMenu(ASelector, AView: String) : TIdGopherMenu;
var
  Reply : Char;
  LengthBytes : Integer;  {legnth of the gopher items}
begin
  Result := nil;
  Connect; try
    {Gopher does not give a greating}
    WriteLn(ASelector + TAB + '$' + AView);    {Do not Localize}
    {We read only one byte from the peer}
    ReadBuffer(Reply, 1);
    {Get the additonal reply code for error or success}
    case Reply of
      '-' : begin    {Do not Localize}
              ReadLn;
              ProcessGopherError;
            end;  {-}
      '+' : begin    {Do not Localize}
              {Get the length byte}
              LengthBytes := StrToInt ( ReadLn );
              Result := LoadExtendedDirectory( '', LengthBytes);    {Do not Localize}
            end;  {+}
    else
      Result := ProcessDirectory ( Reply );
    end; //case Reply of
  finally
    Disconnect;
  end;  {try .. finally .. end }
end;

procedure TIdGopher.GetTextFile(ASelector: String; ADestStream: TStream;
  IsGopherPlus: Boolean; AView: String);
var Reply : Char;
    LengthBytes : Integer;  {legnth of the gopher items}

begin
  Connect;
  try
    if not IsGopherPlus then
    begin
      WriteLn ( ASelector );
      ProcessTextFile ( ADestStream );
    end  // if not IsGopherPlus then
    else
    begin
      {I hope that this drops the size attribute and that this will cause the
       Views to work, I'm not sure}    {Do not Localize}
      AView := Trim ( Fetch ( AView, ':' ) );    {Do not Localize}
      WriteLn ( ASelector + TAB +'+'+ AView );    {Do not Localize}
      {We read only one byte from the peer}
      ReadBuffer( Reply, 1 );
      {Get the additonal reply code for error or success}
      case Reply of
        '-' : begin    {Do not Localize}
                {Get the length byte}
                ReadLn;
                ProcessGopherError;
              end; {-}
              {success - read file}
        '+' : begin    {Do not Localize}
                {Get the length byte}
                LengthBytes := StrToInt ( ReadLn );
                case LengthBytes of
                 {dot terminated - probably a text file}
                  -1 : ProcessTextFile ( ADestStream );
                  {just read until I disconnect you}
                  -2 : ProcessFile ( ADestStream );
                else
                  ProcessTextFile ( ADestStream, '', LengthBytes);    {Do not Localize}
                end; //case LengthBytes of
              end; {+}
        else
        begin
          ProcessTextFile ( ADestStream, Reply );
        end;  //else ..case Reply of
      end;  //case Reply of
    end; //else..if IsGopherPlus then
  finally
    Disconnect;
  end; {try .. finally .. end }
end;

{ TIdGopherMenu }

function TIdGopherMenu.Add: TIdGopherMenuItem;
begin
  Result := TIdGopherMenuItem ( inherited Add );
end;

constructor TIdGopherMenu.Create;
begin
  inherited Create ( TIdGopherMenuItem );
end;

function TIdGopherMenu.GetItem(Index: Integer): TIdGopherMenuItem;
begin
  result := TIdGopherMenuItem( inherited Items [ index ] );
end;

procedure TIdGopherMenu.SetItem( Index: Integer;
  const Value: TIdGopherMenuItem );
begin
  inherited SetItem ( Index, Value );
end;

{ TIdGopherMenuItem }

constructor TIdGopherMenuItem.Create(ACollection: TCollection);
begin
  inherited;
  FGopherBlock := TIdHeaderList.Create;
  FGopherBlock.Sorted := False;
  FGopherBlock.Duplicates := dupAccept;
  {we don't unfold or fold lines as headers in that block start with a space}    {Do not Localize}
  FGopherBlock.UnfoldLines := False;
  FGopherBlock.FoldLines := False;
  FViews := TStringList.Create;
  FAbstract := TStringList.Create;
  FAsk := TIdHeaderList.Create;
  fAdminEmail := TIdEMailAddressItem.Create ( nil );
  FAbstract.Sorted := False;
end;

destructor TIdGopherMenuItem.Destroy;
begin
  FreeAndNil ( fAdminEmail );
  FreeAndNil ( FAsk );
  FreeAndNil ( FAbstract );
  FreeAndNil ( FGopherBlock );
  FreeAndNil ( FViews );
  inherited;
end;

procedure TIdGopherMenuItem.DoneSettingInfoBlock;
{These constants are for blocks we wish to obtain - don't change as they are   
 part of Gopher+ protocol}
const
  BlockTypes : Array [1..3] of String = ('+VIEWS', '+ABSTRACT', '+ASK');    {Do not Localize}
var
  idx : Integer;
  line : String;

    Procedure ParseBlock ( Block : TStringList);
    {Put our the sublock in the Block TStrings and increment
    the pointer appropriatriately}
    begin
      Inc ( idx );
      while ( idx < FGopherBlock.Count ) and
        ( FGopherBlock [ idx ] [ 1 ] = ' ' ) do    {Do not Localize}
      begin
         Block.Add ( TrimLeft ( FGopherBlock [ idx ] ) );
         Inc ( idx );
      end;  //while
      {correct for incrementation in the main while loop}
      Dec ( idx );
    end;

begin
  idx := 0;
  while ( idx < FGopherBlock.Count ) do
  begin
    Line := FGopherBlock [ idx ];
    Line := UpperCase ( Fetch( Line, ':' ) );    {Do not Localize}
    case PosInStrArray ( Line, BlockTypes ) of
      {+VIEWS:}
      0 : ParseBlock ( FViews );
      {+ABSTRACT:}
      1 : ParseBlock ( FAbstract );
      {+ASK:}
      2 : ParseBlock ( FAsk );
    end; //case PosInStrArray ( Line, BlockTypes ) of
    Inc ( idx );
  end;  //while ( idx < FGopherBlock.Count ) do
  fAdminEmail.Text := FGopherBlock.Values [ ' Admin' ];    {Do not Localize}
end;

function TIdGopherMenuItem.GetGeog: String;
begin
  Result := FGopherBlock.Values [ ' Geog' ];    {Do not Localize}
end;

function TIdGopherMenuItem.GetLastModified: String;
begin
  Result := FGopherBlock.Values [ ' Mod-Date' ];    {Do not Localize}
end;

function TIdGopherMenuItem.GetLocation: String;
begin
  Result := FGopherBlock.Values [ ' Loc' ];    {Do not Localize}
end;

function TIdGopherMenuItem.GetOrganization: String;
begin
  Result := FGopherBlock.Values [ ' Org' ];    {Do not Localize}
end;

end.