IdGopher.pas | searchcode

/units/indy/IdGopher.pas

http://github.com/rofl0r/KOL
Pascal | 560 lines | 388 code | 39 blank | 133 comment | 4 complexity | eb788cd67da3ac6346a2b78304ba4850 MD5 | raw file

// 29-nov-2002

unit IdGopher;



interface



uses KOL { , 

  Classes } ,KOLClasses,

  IdEMailAddress, IdGlobal,

  IdHeaderList, IdTCPClient;



type

  TIdGopherMenuItem = object(TCollectionItem)

  protected

    FTitle: string;

    FItemType: Char;

    FSelector: string;

    FServer: string;

    FPort: Integer;

    FGopherPlusItem: Boolean;

    FGopherBlock: TIdHeaderList;

    FViews: PStrList;

    FURL: string;

    FAbstract: PStrList;

    FAsk: TIdHeaderList;

    fAdminEmail: TIdEMailAddressItem;

    function GetLastModified: string;

    function GetOrganization: string;

    function GetLocation: string;

    function GetGeog: string;

  public

     { constructor Create(ACollection: TCollection); override;

     } destructor Destroy; 

     virtual; procedure DoneSettingInfoBlock; virtual;

    property Title: string read FTitle write FTitle;

    property ItemType: Char read FItemType write FItemType;

    property Selector: string read FSelector write FSelector;

    property Server: string read FServer write FServer;

    property Port: Integer read FPort write FPort;

    property GopherPlusItem: Boolean read FGopherPlusItem

    write FGopherPlusItem;

    property GopherBlock: TIdHeaderList read FGopherBlock;

    property URL: string read FURL;

    property Views: PStrList read FViews;

    property AAbstract: PStrList read FAbstract;

    property LastModified: string read GetLastModified;

    property AdminEMail: TIdEMailAddressItem read fAdminEmail;

    property Organization: string read GetOrganization;

    property Location: string read GetLocation;

    property Geog: string read GetGeog;

    property Ask: TIdHeaderList read FAsk;

  end;

PIdGopherMenuItem=^TIdGopherMenuItem;

function NewIdGopherMenuItem(ACollection: TCollection):PIdGopherMenuItem;

type 

  TIdGopherMenu = object(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;

PIdGopherMenu=^TIdGopherMenu;

function NewIdGopherMenu:PIdGopherMenu;

type

  TIdGopherMenuEvent = procedure(Sender: TObject;

    MenuItem: TIdGopherMenuItem) of object;



  TIdGopher = object(TIdTCPClient)

  private

  protected

    FOnMenuItem: TIdGopherMenuEvent;

    procedure DoMenu(MenuItem: TIdGopherMenuItem);

    procedure ProcessGopherError;

    function MenuItemFromString(stLine: string; Menu: TIdGopherMenu)

      : TIdGopherMenuItem;

    function ProcessDirectory(PreviousData: string = '';

      const ExpectedLength: Integer = 0): TIdGopherMenu;

    function LoadExtendedDirectory(PreviousData: string = '';

      const ExpectedLength: Integer = 0): TIdGopherMenu;

    procedure ProcessFile(ADestStream: TStream; APreviousData: string = '';

      const ExpectedLength: Integer = 0);

    procedure ProcessTextFile(ADestStream: TStream;

      APreviousData: string = ''; const ExpectedLength: Integer = 0);

  public

//    constructor Create(AOwner: TComponent); override;

    function GetMenu(ASelector: string; IsGopherPlus: Boolean = False; AView:

      string = ''):

    TIdGopherMenu;

    function Search(ASelector, AQuery: string): TIdGopherMenu;

    procedure GetFile(ASelector: string; ADestStream: TStream; IsGopherPlus:

      Boolean = False; AView: string = '');

    procedure GetTextFile(ASelector: string; ADestStream: TStream; IsGopherPlus:

      Boolean = False; AView: string = '');

    function GetExtendedMenu(ASelector: string; AView: string = ''):

      TIdGopherMenu;

//  published

    property OnMenuItem: TIdGopherMenuEvent read FOnMenuItem write FOnMenuItem;

    property Port default IdPORT_GOPHER;

  end;



PIdGopher=^TIdGopher;

function NewIdGopher(AOwner: PControl):PIdGopher;



implementation



uses

  IdComponent,{ IdException,}

  IdGopherConsts,

  IdTCPConnection,

  SysUtils;



procedure WriteToStream(AStream: TStream; AString: string);

begin

  if Length(AString) > 0 then

    AStream.Write(AString[1], Length(AString));

end;

 



function NewIdGopher(AOwner: PControl):PIdGopher;

// constructor TIdGopher.Create(AOwner: TComponent);

begin

//  inherited;

New( Result, Create );

with Result^ do

begin

//  Port := IdPORT_GOPHER;

end;

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;

  ErrorNo := StrToInt(Fetch(ErrMsg));

//  raise EIdProtocolReplyError.CreateError(ErrorNo, Copy(ErrMsg, 1, Length(ErrMsg)

//    - 5));

end;



function TIdGopher.MenuItemFromString(stLine: string;

  Menu: TIdGopherMenu): TIdGopherMenuItem;

begin

{  stLine := Trim(stLine);

  if Assigned(Menu) then

  begin

    Result := Menu.Add;

  end

  else

  begin

    Result := TIdGopherMenuItem.Create(nil);

  end;

  Result.Title := IdGlobal.Fetch(stLine, TAB);

  if Length(Result.Title) > 0 then

  begin

    Result.ItemType := Result.Title[1];

  end

  else

  begin

    Result.ItemType := IdGopherItem_Error;

  end;

  Result.Title := Copy(Result.Title, 2, Length(Result.Title));

  Result.Selector := Fetch(stLine, TAB);

  Result.Server := Fetch(stLine, TAB);

  Result.Port := StrToInt(Fetch(stLine, TAB));

  stLine := Fetch(stLine, TAB);

  Result.GopherPlusItem := ((Length(stLine) > 0) and

    (stLine[1] = '+'));}

end;



function TIdGopher.LoadExtendedDirectory(PreviousData: string = '';

  const ExpectedLength: Integer = 0): TIdGopherMenu;

var

  stLine: string;

  gmnu: TIdGopherMenuItem;

begin

{  BeginWork(wmRead, ExpectedLength);

  try

    Result := TIdGopherMenu.Create;

    gmnu := nil;

    repeat

      stLine := PreviousData + ReadLn;

      PreviousData := '';

      if (stLine <> '.') then

      begin

        if (Copy(stLine, 1, Length(IdGopherPlusInfo)) = IdGopherPlusInfo) then

        begin

          if (gmnu <> nil) then

          begin

            gmnu.DoneSettingInfoBlock;

            DoMenu(gmnu);

          end;

          gmnu := MenuItemFromString(RightStr(stLine,

            Length(stLine) - Length(IdGopherPlusInfo)), Result);

          gmnu.GopherBlock.Add(stLine);

        end

        else

        begin

          if Assigned(gmnu) and (stLine <> '') then

          begin

            gmnu.GopherBlock.Add(stLine);

          end;

        end;

      end

      else

      begin

        if (gmnu <> nil) then

        begin

          DoMenu(gmnu);

        end;

      end;

    until (stLine = '.') or not Connected;

  finally EndWork(wmRead);

  end;}

end;



function TIdGopher.ProcessDirectory(PreviousData: string = '';

  const ExpectedLength: Integer = 0): TIdGopherMenu;

var

  stLine: string;



begin

{  BeginWork(wmRead, ExpectedLength);

  try

    Result := TIdGopherMenu.Create;

    repeat

      stLine := PreviousData + ReadLn;

      PreviousData := '';

      if (stLine <> '.') then

      begin

        DoMenu(MenuItemFromString(stLine, Result));

      end;

    until (stLine = '.') or not Connected;

  finally

    EndWork(wmRead);

  end;}

end;



procedure TIdGopher.ProcessTextFile(ADestStream: TStream; APreviousData: string =

  '';

  const ExpectedLength: Integer = 0);

begin

  WriteToStream(ADestStream, APreviousData);

  BeginWork(wmRead, ExpectedLength);

  try

//    Capture(ADestStream, '.', True);

  finally

    EndWork(wmRead);

  end;

end;



procedure TIdGopher.ProcessFile(ADestStream: TStream; APreviousData: string =

  '';

  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

    WriteLn(ASelector + TAB + AQuery);

    Result := ProcessDirectory;

  finally

    Disconnect;

  end;

end;



procedure TIdGopher.GetFile(ASelector: string; ADestStream: TStream;

  IsGopherPlus: Boolean = False;

  AView: string = '');

var

  Reply: Char;

  LengthBytes: Integer;



begin

  Connect;

  try

    if not IsGopherPlus then

    begin

      WriteLn(ASelector);

      ProcessFile(ADestStream);

    end

    else

    begin

      AView := Trim(Fetch(AView, ':'));

      WriteLn(ASelector + TAB + '+' + AView);

      ReadBuffer(Reply, 1);

      case Reply of

        '-':

          begin

            ReadLn;

            ProcessGopherError;

          end;

        '+':

          begin

            LengthBytes := StrToInt(ReadLn);

            case LengthBytes of

              -1: ProcessTextFile(ADestStream);

              -2: ProcessFile(ADestStream);

            else

              ProcessFile(ADestStream, '', LengthBytes);

            end;

          end;

      else

        begin

          ProcessFile(ADestStream, Reply);

        end;

      end;

    end;

  finally

    Disconnect;

  end;

end;



function TIdGopher.GetMenu(ASelector: string; IsGopherPlus: Boolean = False;

  AView: string = ''):

TIdGopherMenu;

var

  Reply: Char;

  LengthBytes: Integer;

begin

//  Result := nil;

  Connect;

  try

    if not IsGopherPlus then

    begin

      WriteLn(ASelector);

      Result := ProcessDirectory;

    end

    else

    begin

      WriteLn(ASelector + TAB + '+' + AView);

      ReadBuffer(Reply, 1);

      case Reply of

        '-':

          begin

            ReadLn;

            ProcessGopherError;

          end;

        '+':

          begin

            LengthBytes := StrToInt(ReadLn);

            Result := ProcessDirectory('', LengthBytes);

          end;

      else

        begin

          Result := ProcessDirectory(Reply);

        end;

      end;

    end;

  finally

    Disconnect;

  end;

end;



function TIdGopher.GetExtendedMenu(ASelector, AView: string): TIdGopherMenu;

var

  Reply: Char;

  LengthBytes: Integer;

begin

//  Result := nil;

  Connect;

  try

    WriteLn(ASelector + TAB + '$' + AView);

    ReadBuffer(Reply, 1);

    case Reply of

      '-':

        begin

          ReadLn;

          ProcessGopherError;

        end;

      '+':

        begin

          LengthBytes := StrToInt(ReadLn);

          Result := LoadExtendedDirectory('', LengthBytes);

        end;

    else

      Result := ProcessDirectory(Reply);

    end;

  finally

    Disconnect;

  end;

end;



procedure TIdGopher.GetTextFile(ASelector: string; ADestStream: TStream;

  IsGopherPlus: Boolean; AView: string);

var

  Reply: Char;

  LengthBytes: Integer;



begin

  Connect;

  try

    if not IsGopherPlus then

    begin

      WriteLn(ASelector);

      ProcessTextFile(ADestStream);

    end

    else

    begin

      AView := Trim(Fetch(AView, ':'));

      WriteLn(ASelector + TAB + '+' + AView);

      ReadBuffer(Reply, 1);

      case Reply of

        '-':

          begin

            ReadLn;

            ProcessGopherError;

          end;

        '+':

          begin

            LengthBytes := StrToInt(ReadLn);

            case LengthBytes of

              -1: ProcessTextFile(ADestStream);

              -2: ProcessFile(ADestStream);

            else

              ProcessTextFile(ADestStream, '', LengthBytes);

            end;

          end;

      else

        begin

          ProcessTextFile(ADestStream, Reply);

        end;

      end;

    end;

  finally

    Disconnect;

  end;

end;



function TIdGopherMenu.Add: TIdGopherMenuItem;

begin

//  Result := TIdGopherMenuItem(inherited Add);

end;



//constructor TIdGopherMenu.Create;

function NewIdGopherMenu:PIdGopherMenu;

begin

New( Result, Create );

//  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;



//constructor TIdGopherMenuItem.Create(ACollection: TCollection);

function NewIdGopherMenuItem(ACollection: TCollection):PIdGopherMenuItem;

begin

New( Result, Create );

with Result^ do

begin

//  inherited;

{  FGopherBlock := TIdHeaderList.Create;

  FGopherBlock.Sorted := False;

  FGopherBlock.Duplicates := dupAccept;

  FGopherBlock.UnfoldLines := False;

  FGopherBlock.FoldLines := False;

  FViews := PStrList.Create;

  FAbstract := PStrList.Create;

  FAsk := TIdHeaderList.Create;

  fAdminEmail := TIdEMailAddressItem.Create(nil);

  FAbstract.Sorted := False;}

end;

end;



destructor TIdGopherMenuItem.Destroy;

begin

  FreeAndNil(fAdminEmail);

  FreeAndNil(FAsk);

  FreeAndNil(FAbstract);

  FreeAndNil(FGopherBlock);

  FreeAndNil(FViews);

  inherited;

end;



procedure TIdGopherMenuItem.DoneSettingInfoBlock;

const

  BlockTypes: array[1..3] of string = ('+VIEWS', '+ABSTRACT', '+ASK');

var

  idx: Integer;

  line: string;



  procedure ParseBlock(Block: PStrList);

  begin

{    Inc(idx);

    while (idx < FGopherBlock.Count) and

      (FGopherBlock[idx][1] = ' ') do

    begin

      Block.Add(TrimLeft(FGopherBlock[idx]));

      Inc(idx);

    end;

    Dec(idx);}

  end;



begin

(*  idx := 0;

  while (idx < FGopherBlock.Count) do

  begin

    Line := FGopherBlock[idx];

    Line := UpperCase(Fetch(Line, ':'));

    case PosInStrArray(Line, BlockTypes) of

      {+VIEWS:}

      0: ParseBlock(FViews);

      {+ABSTRACT:}

      1: ParseBlock(FAbstract);

      {+ASK:}

      2: ParseBlock(FAsk);

    end;

    Inc(idx);

  end;

  fAdminEmail.Text := FGopherBlock.Values[' Admin'];*)

end;



function TIdGopherMenuItem.GetGeog: string;

begin

  Result := FGopherBlock.Values[' Geog'];

end;



function TIdGopherMenuItem.GetLastModified: string;

begin

  Result := FGopherBlock.Values[' Mod-Date'];

end;



function TIdGopherMenuItem.GetLocation: string;

begin

  Result := FGopherBlock.Values[' Loc'];

end;



function TIdGopherMenuItem.GetOrganization: string;

begin

  Result := FGopherBlock.Values[' Org'];

end;



end.