nntpcli.pas

BaiduMp3 search baidu mp3

end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.NewNews(
    When          : TDateTime;
    GMTFLag       : Boolean;
    NewsGroupName : String;
    Distributions : String;
    DestStream    : TStream);
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for NEWNEWS');
    FDataStream      := DestStream;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpNewNews;
    if When = 0 then
        When := Now;
    if NewsGroupName = '' then
        NewsGroupName := '*';
    FRequest         := 'NEWNEWS ' + NewsGroupName + ' ' +
                        FormatDateTime('yymmdd hhnnss', When);
    if GMTFlag then
        FRequest := FRequest + ' GMT';
    if Length(Distributions) > 0 then
        FRequest     := FRequest + ' <' + Distributions + '>';
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Articles can be: a) a single (positive) article number                    }
{                  b) an article number followed by a dash                  }
{                  c) two article numbers separated by a dash               }
procedure TNntpCli.XOver(
    Articles   : String;
    DestStream : TStream);
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for XOVER');
    FDataStream      := DestStream;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpXOver;
    FRequest         := 'XOVER ' + Articles;
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{HLX}
procedure TNntpCli.XPat(
    DestStream : TStream;
    Header, Range, FindStr: String);
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for XPAT');
    FDataStream      := DestStream;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpXPAT;
    FRequest         := 'XPAT '+Header+' '+Range+' '+FindStr;
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.ListOverViewFmt(DestStream : TStream);
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for LIST OVERVIEW.FMT');
    FDataStream      := DestStream;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpListOverViewFmt;
    FRequest         := 'LIST OVERVIEW.FMT';
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.ListMotd(DestStream : TStream); {HLX}
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for LIST MOTD');
    FDataStream      := DestStream;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpListMotd;
    FRequest         := 'LIST MOTD';
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.DateNext;
var
    Data  : PChar;
    Buf   : String;
    Year, Month, Day, Hour, Min, Sec : Word;
begin
    Data := StpBlk(GetInteger(@FLastResponse[1], FStatusCode));
    if FStatusCode <> 111 then begin
        DelayedRequestDone(FStatusCode);
        Exit;
    end;
    Buf := Trim(StrPas(Data));
    if Length(Buf) = 14 then begin
        Year  := atoi(Copy(Buf, 1, 4));
        Month := atoi(Copy(Buf, 5, 2));
        Day   := atoi(Copy(Buf, 7, 2));
        Hour  := atoi(Copy(Buf, 9, 2));
        Min   := atoi(Copy(Buf, 11, 2));
        Sec   := atoi(Copy(Buf, 13, 2));
        FServerDate := EncodeDate(Year, Month, Day) +
                       EncodeTime(Hour, Min, Sec, 0);
    end;
    DelayedRequestDone(0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Date;
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for DATE');
    FServerDate      := 0;
    FDataStream      := nil;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpDate;
    FRequest         := 'DATE';
    FNext            := DateNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.ModeReaderNext;
begin
    GetInteger(@FLastResponse[1], FStatusCode);
    if FStatusCode in [200, 201] then
        DelayedRequestDone(0)
    else
        DelayedRequestDone(FStatusCode);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.ModeReader;
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for ModeReader');
    FServerDate      := 0;
    FDataStream      := nil;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpModeReader;
    FRequest         := 'MODE READER';
    FNext            := ModeReaderNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.XHdrLineNext;
const
    CrLf : String[2] = #13#10;
begin
    if FLastResponse = '.' then begin
        if FLastCmdResponse <> '' then begin
            FLastResponse    := FLastCmdResponse;
            FLastCmdResponse := '';
        end;
        if Assigned(FOnXHdrEnd) then
            FOnXHdrEnd(Self);
        DelayedRequestDone(0);
    end
    else begin
        if Assigned(FDataStream) then begin
            if Length(FLastResponse) > 0 then
                FDataStream.Write(FLastResponse[1], Length(FLastResponse));
            FDataStream.Write(CrLf[1], Length(CrLf));
        end;
        if Assigned(FOnXHdrLine) then
            FOnXHdrLine(Self);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.XHdrNext;
begin
    GetInteger(@FLastResponse[1], FStatusCode);
    if FStatusCode <> 221 then begin
        DelayedRequestDone(FStatusCode);
        Exit;
    end;

    FNext            := XHdrLineNext;
    FLastCmdResponse := FLastResponse;;
    StateChange(nntpWaitingResponse);

    if Assigned(FOnXHdrBegin) then
        FOnXHdrBegin(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Header is a header line such as "subject".                                }
{ Range is either:                                                          }
{   an article number                                                       }
{   an article number followed by a dash to indicate all following          }
{   an article number followed by a dash followed by another article number }
{ Range can be replaced by a message id.                                    }
{ If range is empty current article is used.                                }
procedure TNntpCli.XHdr(DestStream : TStream; Header : String; Range : String);
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for XHDR');
    FDataStream      := DestStream;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpXHdr;
    FRequest         := 'XHDR ' + Header;
    if Length(Range) > 0 then
        Frequest     := FRequest + ' ' + Range;
    FNext            := XHdrNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.AuthenticateNext1;
begin
    StpBlk(GetInteger(@FLastResponse[1], FStatusCode));
    if FStatusCode <> 381 then begin
        DelayedRequestDone(FStatusCode);
        Exit;
    end;
    FRequestDoneFlag := FALSE;
    FRequest         := 'AUTHINFO PASS ' + FPassWord;
    FNext            := AuthenticateNext2;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.AuthenticateNext2;
begin
    StpBlk(GetInteger(@FLastResponse[1], FStatusCode));
    if FStatusCode <> 281 then begin
        DelayedRequestDone(FStatusCode);
        Exit;
    end;
    DelayedRequestDone(0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Authenticate;
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for AUTHINFO');
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpAuthenticate;
    FRequest         := 'AUTHINFO USER ' + FUserName;
    FNext            := AuthenticateNext1;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure ParseListLine(
    const Line          : String;
    var NewsGroupName   : String;
    var LastArticle     : Integer;
    var FirstArticle    : Integer;
    var PostingFlag     : Char);
var
    Data : PChar;
begin
    if Length(Line) = 0 then
        Exit;
    Data := GetNewsGroupName(@Line[1], NewsGroupName);
    Data := GetInteger(Data, LastArticle);
    Data := GetInteger(Data, FirstArticle);
    GetChar(Data, PostingFlag);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.WSocketDataSent(Sender: TObject; ErrCode: Word);
begin
    if ErrCode <> 0 then begin
        PostDone;
        Exit;
    end;
    PostBlock;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.WSocketDnsLookupDone(Sender: TObject; ErrCode: Word);
begin
    if ErrCode <> 0 then
        DelayedRequestDone(ErrCode)
    else begin
        FWSocket.Addr  := FWSocket.DnsResult;
        FWSocket.Proto := 'tcp';
        FWSocket.Port  := FPort;
        StateChange(nntpWaitingBanner);
        FWSocket.Connect;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.WSocketSessionConnected(Sender: TObject; ErrCode: Word);
begin
    { Do not trigger the client SessionConnected from here. We must wait }
    { to have received the server banner.                                }
    if ErrCode <> 0 then begin
        DelayedRequestDone(ErrCode);
        FWSocket.Close
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.WSocketDataAvailable(Sender: TObject; ErrCode: Word);
var
    Len : Integer;
begin
    Len := FWSocket.RcvdCount;
    if Len < 0 then
        Exit;

    if Len = 0 then begin
        FWSocket.Close;
        Exit;
    end;

    { We use line mode, we will receive complete lines }
    FLastResponse := FWSocket.ReceiveStr;
    FRcvdCount := (FRcvdCount + Length(FLastResponse)) and $7FFFFFF;
    TriggerRcvdData;

    { Remove ending CR/LF, if any }
    if (Length(FLastResponse) >= 1) and
       (FLastResponse[Length(FLastResponse)] = #10) then
        SetLength(FLastResponse, Length(FLastResponse) - 1);
    if (Length(FLastResponse) >= 1) and
       (FLastResponse[Length(FLastResponse)] = #13) then
        SetLength(FLastResponse, Length(FLastResponse) - 1);

    if FRequestType = nntpAbort then
        Exit;

    if Assigned(FOnDisplay) and (Length(FLastResponse) > 0) then  {01/01/05}
        FOnDisplay(Self, @FLastResponse[1], Length(FLastResponse));

{$IFDEF VER80}
    { Add a nul byte at the end of string for Delphi 1 }
    FLastResponse[Length(FLastResponse) + 1] := #0;
{$ENDIF}
    if FState = nntpWaitingBanner then begin
        StateChange(nntpReady);
        GetInteger(@FLastResponse[1], FStatusCode);
        FPostingPermited := (FStatusCode = 200);
        TriggerSessionConnected(ErrCode); {AS}
        { PostMessage en plus par rapport