nntpcli.pas

BaiduMp3 search baidu mp3

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.ArticleByNumber(Number : Integer; DestStream : TStream);
begin
    GetArticleByNumber(nntpArticleByNumber, Number, DestStream);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.ArticleByID(ID : String; DestStream : TStream);
begin
    GetArticleByID(nntpArticleByID, ID, DestStream);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.BodyByNumber(Number : Integer; DestStream : TStream);
begin
    GetArticleByNumber(nntpBodyByNumber, Number, DestStream);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.BodyByID(ID : String; DestStream : TStream);
begin
    GetArticleByID(nntpBodyByID, ID, DestStream);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.HeadByNumber(Number : Integer; DestStream : TStream);
begin
    GetArticleByNumber(nntpHeadByNumber, Number, DestStream);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.HeadByID(ID : String; DestStream : TStream);
begin
    GetArticleByID(nntpHeadByID, ID, DestStream);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.StatByNumber(Number : Integer);
begin
    GetArticleByNumber(nntpStatByNumber, Number, nil);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.StatByID(ID : String);
begin
    GetArticleByID(nntpStatByID, ID, nil);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.GetArticleByID(
    RqType     : TNntpRequest;
    ID         : String;
    DestStream : TStream);
begin
    GetArticle(RqType, ' <' + ID + '>', DestStream);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.GetArticleByNumber(
    RqType     : TNntpRequest;
    Number     : Integer;
    DestStream : TStream);
begin
    if Number > 0 then
        GetArticle(RqType, ' ' + IntToStr(Number), DestStream)
    else
        GetArticle(RqType, '', DestStream);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.GetArticle(
    RqType     : TNntpRequest;
    ID         : String;
    DestStream : TStream);
var
    Cmd : String;
begin
    case RqType of
    nntpArticleByID, nntpArticleByNumber:
        Cmd := 'ARTICLE';
    nntpBodyByID, nntpBodyByNumber:
        Cmd := 'BODY';
    nntpHeadByID, nntpHeadByNumber:
        Cmd := 'HEAD';
    nntpStatByID, nntpStatByNumber:
        Cmd := 'STAT';
    else
        raise NntpException.Create('Internal error: Invalid Request Type');
    end;

    if FState <> nntpReady then
        raise NntpException.Create('Not ready for ' + Cmd);
    FDataStream      := DestStream;
    FRequestType     := RqType;
    FRequestDoneFlag := FALSE;
    FArticleNumber   := -1;
    FArticleID       := '';
    FRequest         := Cmd + ID;
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.GetArticleNext;
var
    Data  : PChar;
begin
    Data := GetInteger(@FLastResponse[1], FStatusCode);
    if not (FStatusCode in [100, 215, 220, 221,
                            222, 223, 224, 231]) then begin
        DelayedRequestDone(FStatusCode);
        Exit;
    end;

    Data := GetInteger(Data, FArticleNumber);
    GetMessageID(Data, FArticleID);

    if FStatusCode in [223] then
        DelayedRequestDone(0)
    else begin
        FNext            := GetArticleLineNext;
        FLastCmdResponse := FLastResponse;;
        StateChange(nntpWaitingResponse);

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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.GetArticleLineNext;
const
    CrLf : String[2] = #13#10;
begin
    if FLastResponse = '.' then begin
        if FLastCmdResponse <> '' then begin
            FLastResponse    := FLastCmdResponse;
            FLastCmdResponse := '';
        end;
        if Assigned(FOnMessageEnd) then
            FOnMessageEnd(Self);
        DelayedRequestDone(0);
    end
    else begin
        if (Length(FLastResponse) > 1) and  { 26/10/02 }
           (FLastResponse[1] ='.') and (FLastResponse[2] ='.') then
            Delete(FLastResponse, 1, 1);
        if Assigned(FDataStream) then begin
            if Length(FLastResponse) > 0 then
                FDataStream.Write(FLastResponse[1], Length(FLastResponse));
            FDataStream.Write(CrLf[1], Length(CrLf));
        end;
        TriggerMessageLine; {AS}
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Next;
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for NEXT');
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpNext;
    FArticleNumber   := -1;
    FArticleID       := '';
    FRequest         := 'NEXT';
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Last;
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for LAST');
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpLast;
    FArticleNumber   := -1;
    FArticleID       := '';
    FRequest         := 'LAST';
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{AS}
procedure TNntpCli.ListNewsgroups(DestStream : TStream; chFiltre : String);
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for LIST NEWSGROUPS');
    FDataStream      := DestStream;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpListNewsgroups;
    FRequest         := 'LIST NEWSGROUPS';
    if chFiltre<>'' then
        FRequest := FRequest + ' '+chFiltre;
    FNext            := GetArticleNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Quit;
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for QUIT');
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpQuit;
    FRequest         := 'QUIT';
    FNext            := QuitNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.QuitNext;
begin
    GetInteger(@FLastResponse[1], FStatusCode);
    DelayedRequestDone(0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Abort;
begin
    FRequestType     := nntpAbort;
    FWSocket.Close;
    FLastResponse    := '205 Closing connection - goodbye';
    FStatusCode      := 205;
    FRequestDoneFlag := FALSE;
    DelayedRequestDone(0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Post(FromStream : TStream);
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for POST');
    FDataStream      := FromStream;
    FRequestDoneFlag := FALSE;
    FRequestType     := nntpPost;
    FRequest         := 'POST';
    FSentFlag        := FALSE;
    FNext            := PostNext;
    StateChange(nntpWaitingResponse);
    SendRequest;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.PostNext;
begin
    GetInteger(@FLastResponse[1], FStatusCode);
    if FStatusCode <> 340 then begin
        DelayedRequestDone(FStatusCode);
        Exit;
    end;
    FNext               := PostSendNext;
    FWSocket.OnDataSent := WSocketDataSent;
    PostBlock;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.PostBlock;
var
    Len  : Integer;
begin
    if FDataStream = nil then
        Len := 0                { No data to send }
    else
        Len := FDataStream.Read(FSendBuffer, SizeOf(FSendBuffer));

    if Len <= 0 then begin
        if FSentFlag then
            Exit;
        FSentFlag := TRUE;
        StrCopy(@FSendBuffer, #13#10 + '.' + #13#10);
        Len := 5;
    end;
    FWSocket.Send(@FSendBuffer, Len);
    Inc(FSendCount, Len);
    TriggerSendData;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.PostSendNext;
begin
    FWSocket.OnDataSent := nil;
    GetInteger(@FLastResponse[1], FStatusCode);
    if FStatusCode = 240 then
        DelayedRequestDone(0)
    else
        DelayedRequestDone(FStatusCode);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.PostDone;
begin
    FLastResponse := '441 posting failed';
    PostSendNext;
end;


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