nntpcli.pas

互联网套件

        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
        TriggerRequestDone(FStatusCode);
        Exit;
    end;

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

    if FStatusCode in [223] then
        TriggerRequestDone(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);
        TriggerRequestDone(0);
    end
    else begin
        if FLastResponse = '..' then
            FLastResponse := '.';
        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(FOnMessageLine) then
            FOnMessageLine(Self);
    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;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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);
    TriggerRequestDone(0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Abort;
begin
    FRequestType     := nntpAbort;
    FWSocket.Close;
    FLastResponse    := '205 Closing connection - goodbye';
    FStatusCode      := 205;
    FRequestDoneFlag := FALSE;
    TriggerRequestDone(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
        TriggerRequestDone(FStatusCode);
        Exit;
    end;
    FNext               := PostSendNext;
    FWSocket.OnDataSent := WSocketDataSent;
    PostBlock;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.PostBlock;
var
    Len  : Integer;
begin
    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);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.PostSendNext;
begin
    FWSocket.OnDataSent := nil;
    GetInteger(@FLastResponse[1], FStatusCode);
    if FStatusCode = 240 then
        TriggerRequestDone(0)
    else
        TriggerRequestDone(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;
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;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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.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
        TriggerRequestDone(FStatusCode);