idgopher.pas

photo.163.com 相册下载器 多线程下载

          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 + IOHandler.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;

procedure TIdGopher.ProcessTextFile(ADestStream : TStream; APreviousData: String = '';    {Do not Localize}
  const ExpectedLength: Integer = 0);
begin
  WriteToStream(ADestStream, APreviousData);
  BeginWork(wmRead,ExpectedLength);
  try
    IOHandler.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);
var LS : TIdStreamVCL;
begin
  BeginWork(wmRead,ExpectedLength);
  try
    LS := TIdStreamVCL.Create(ADestStream);
    try
    WriteToStream(ADestStream, APreviousData);
      IOHandler.ReadStream(LS,-1,True);
    finally
      FreeAndNil(LS);
    end;
    ADestStream.Position := 0;
  finally
    EndWork(wmRead);
  end;
end;

Function TIdGopher.Search(ASelector, AQuery : String) : TIdGopherMenu;
begin
  Connect;
  try
    {Gopher does not give a greating}
    IOHandler.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
      IOHandler.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}
      IOHandler.WriteLn ( ASelector + TAB +'+'+ AView );    {Do not Localize}
      {We read only one byte from the peer}
      Reply := IOHandler.ReadChar;
      {Get the additonal reply code for error or success}
      case Reply of
        '-' : begin    {Do not Localize}
                {Get the length byte}
                IOHandler.ReadLn;
                ProcessGopherError;
              end; {-}
              {success - read file}
        '+' : begin    {Do not Localize}
                {Get the length byte}
                LengthBytes := StrToInt ( IOHandler.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
      IOHandler.WriteLn ( ASelector );
      Result := ProcessDirectory;
    end  // if not IsGopherPlus then
    else
    begin
      {Gopher does not give a greating}
      IOHandler.WriteLn ( ASelector + TAB+'+' + AView );    {Do not Localize}
      {We read only one byte from the peer}
      Reply := IOHandler.ReadChar;
      {Get the additonal reply code for error or success}
      case Reply of
        '-' : begin    {Do not Localize}
                IOHandler.ReadLn;
                ProcessGopherError;
              end;  {-}
        '+' : begin    {Do not Localize}
                {Get the length byte}
                LengthBytes := StrToInt ( IOHandler.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}
    IOHandler.WriteLn(ASelector + TAB + '$' + AView);    {Do not Localize}
    {We read only one byte from the peer}
    Reply := IOHandler.ReadChar;
    {Get the additonal reply code for error or success}
    case Reply of
      '-' : begin    {Do not Localize}
              IOHandler.ReadLn;
              ProcessGopherError;
            end;  {-}
      '+' : begin    {Do not Localize}
              {Get the length byte}
              LengthBytes := StrToInt ( IOHandler.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;  {length of the gopher items}

begin
  Connect;
  try
    if not IsGopherPlus then
    begin
      IOHandler.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}
      IOHandler.WriteLn ( ASelector + TAB +'+'+ AView );    {Do not Localize}
      {We read only one byte from the peer}
      Reply := IOHandler.ReadChar;
      {Get the additonal reply code for error or success}
      case Reply of
        '-' : begin    {Do not Localize}
                {Get the length byte}
                IOHandler.ReadLn;
                ProcessGopherError;
              end; {-}
              {success - read file}
        '+' : begin    {Do not Localize}
                {Get the length byte}
                LengthBytes := StrToInt ( IOHandler.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;
  {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 := TIdStringList.Create;
  FAbstract := TIdStringList.Create;
  FAsk := TIdHeaderList.Create;
  fAdminEmail := TIdEMailAddressItem.Create ( nil );
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 : TIdStringList);
    {Put our the sublock in the Block TIdStrings 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.