nntpsend.pas

snmp设计增加相应SNMP的OID,是实时处理的.

{==============================================================================|
| Project : Ararat Synapse                                       | 001.004.001 |
|==============================================================================|
| Content: NNTP client                                                         |
|==============================================================================|
| Copyright (c)1999-2003, Lukas Gebauer                                        |
| All rights reserved.                                                         |
|                                                                              |
| Redistribution and use in source and binary forms, with or without           |
| modification, are permitted provided that the following conditions are met:  |
|                                                                              |
| Redistributions of source code must retain the above copyright notice, this  |
| list of conditions and the following disclaimer.                             |
|                                                                              |
| Redistributions in binary form must reproduce the above copyright notice,    |
| this list of conditions and the following disclaimer in the documentation    |
| and/or other materials provided with the distribution.                       |
|                                                                              |
| Neither the name of Lukas Gebauer nor the names of its contributors may      |
| be used to endorse or promote products derived from this software without    |
| specific prior written permission.                                           |
|                                                                              |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
| DAMAGE.                                                                      |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 1999-2003.               |
| All Rights Reserved.                                                         |
|==============================================================================|
| Contributor(s):                                                              |
|==============================================================================|
| History: see HISTORY.HTM from distribution package                           |
|          (Found at URL: http://www.ararat.cz/synapse/)                       |
|==============================================================================}

{:@abstract(NNTP client)
NNTP (network news transfer protocol)

Used RFC: RFC-977, RFC-2980
}

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$H+}

unit nntpsend;

interface

uses
  SysUtils, Classes,
  {$IFDEF STREAMSEC}
  TlsInternalServer, TlsSynaSock,
  {$ENDIF}
  blcksock, synautil;

const
  cNNTPProtocol = 'nntp';

type

  {:abstract(Implementation of Network News Transfer Protocol.

   Note: Are you missing properties for setting Username and Password? Look to
   parent @link(TSynaClient) object!

   Are you missing properties for specify server address and port? Look to
   parent @link(TSynaClient) too!}
  TNNTPSend = class(TSynaClient)
  private
    {$IFDEF STREAMSEC}
    FSock: TSsTCPBlockSocket;
    FTLSServer: TCustomTLSInternalServer;
    {$ELSE}
    FSock: TTCPBlockSocket;
    {$ENDIF}
    FResultCode: Integer;
    FResultString: string;
    FData: TStringList;
    FDataToSend: TStringList;
    FAutoTLS: Boolean;
    FFullSSL: Boolean;
    FNNTPcap: TStringList;
    function ReadResult: Integer;
    function ReadData: boolean;
    function SendData: boolean;
    function Connect: Boolean;
  public
    constructor Create;
    destructor Destroy; override;

    {:Connects to NNTP server and begin session.}
    function Login: Boolean;

    {:Logout from NNTP server and terminate session.}
    function Logout: Boolean;

    {:By this you can call any NNTP command.}
    function DoCommand(const Command: string): boolean;

    {:by this you can call any NNTP command. This variant is used for commands
     for download information from server.}
    function DoCommandRead(const Command: string): boolean;

    {:by this you can call any NNTP command. This variant is used for commands
     for upload information to server.}
    function DoCommandWrite(const Command: string): boolean;

    {:Download full message to @link(data) property. Value can be number of
     message or message-id (in brackets).}
    function GetArticle(const Value: string): Boolean;

    {:Download only body of message to @link(data) property. Value can be number
     of message or message-id (in brackets).}
    function GetBody(const Value: string): Boolean;

    {:Download only headers of message to @link(data) property. Value can be
     number of message or message-id (in brackets).}
    function GetHead(const Value: string): Boolean;

    {:Get message status. Value can be number of message or message-id
     (in brackets).}
    function GetStat(const Value: string): Boolean;

    {:Select given group.}
    function SelectGroup(const Value: string): Boolean;

    {:Tell to server 'I have mesage with given message-ID.' If server need this
     message, message is uploaded to server.}
    function IHave(const MessID: string): Boolean;

    {:Move message pointer to last item in group.}
    function GotoLast: Boolean;

    {:Move message pointer to next item in group.}
    function GotoNext: Boolean;

    {:Download to @link(data) property list of all groups on NNTP server.}
    function ListGroups: Boolean;

    {:Download to @link(data) property list of all groups created after given time.}
    function ListNewGroups(Since: TDateTime): Boolean;

    {:Download to @link(data) property list of message-ids in given group since
     given time.}
    function NewArticles(const Group: string; Since: TDateTime): Boolean;

    {:Upload new article to server. (for new messages by you)}
    function PostArticle: Boolean;

    {:Tells to remote NNTP server 'I am not NNTP client, but I am another NNTP
     server'.}
    function SwitchToSlave: Boolean;

    {:Call NNTP XOVER command.}
    function Xover(xoStart, xoEnd: string): boolean;

    {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
    function StartTLS: Boolean;

    {:Try to find given capability in extension list. This list is getted after
     successful login to NNTP server. If extension capability is not found,
     then return is empty string.}
    function FindCap(const Value: string): string;

    {:Try get list of server extensions. List is returned in @link(data) property.}
    function ListExtensions: Boolean;
  published
    {:Result code number of last operation.}
    property ResultCode: Integer read FResultCode;

    {:String description of last result code from NNTP server.}
    property ResultString: string read FResultString;

    {:Readed data. (message, etc.)}
    property Data: TStringList read FData;

    {:If is set to @true, then upgrade to SSL/TLS mode after login if remote
     server support it.}
    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;

    {:SSL/TLS mode is used from first contact to server. Servers with full
     SSL/TLS mode usualy using non-standard TCP port!}
    property FullSSL: Boolean read FFullSSL Write FFullSSL;
{$IFDEF STREAMSEC}
    property Sock: TSsTCPBlockSocket read FSock;
    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
{$ELSE}
    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
    property Sock: TTCPBlockSocket read FSock;
{$ENDIF}
  end;

implementation

constructor TNNTPSend.Create;
begin
  inherited Create;
{$IFDEF STREAMSEC}
  FTLSServer := GlobalTLSInternalServer;
  FSock := TSsTCPBlockSocket.Create;
  FSock.BlockingRead := True;
{$ELSE}
  FSock := TTCPBlockSocket.Create;
{$ENDIF}
  FData := TStringList.Create;
  FDataToSend := TStringList.Create;
  FNNTPcap := TStringList.Create;
  FSock.ConvertLineEnd := True;
  FTimeout := 60000;
  FTargetPort := cNNTPProtocol;
  FAutoTLS := False;
  FFullSSL := False;
end;

destructor TNNTPSend.Destroy;
begin
  FSock.Free;
  FDataToSend.Free;
  FData.Free;
  FNNTPcap.Free;
  inherited Destroy;
end;

function TNNTPSend.ReadResult: Integer;
var
  s: string;
begin
  Result := 0;
  FData.Clear;
  s := FSock.RecvString(FTimeout);
  FResultString := Copy(s, 5, Length(s) - 4);
  if FSock.LastError <> 0 then
    Exit;
  if Length(s) >= 3 then
    Result := StrToIntDef(Copy(s, 1, 3), 0);
  FResultCode := Result;
end;

function TNNTPSend.ReadData: boolean;
var
  s: string;
begin
  repeat
    s := FSock.RecvString(FTimeout);
    if s = '.' then
      break;
    if (s <> '') and (s[1] = '.') then
      s := Copy(s, 2, Length(s) - 1);