nntpcli.pas

互联网套件

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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Authenticate;
begin
    if FState <> nntpReady then
        raise NntpException.Create('Not ready for DATE');
    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; Error: Word);
begin
    if Error <> 0 then begin
        PostDone;
        Exit;
    end;
    PostBlock;
end;


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


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.WSocketDataAvailable(Sender: TObject; Error: Word);
var
    Len : Integer;
    I   : Integer;
begin
    Len := FWSocket.Receive(@FReceiveBuffer[FReceiveLen],
                            sizeof(FReceiveBuffer) - FReceiveLen - 1);

    if FRequestType = nntpAbort then
        Exit;

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

    FReceiveBuffer[FReceiveLen + Len] := #0;
    if Assigned(FOnDisplay) then
        FOnDisplay(Self, @FReceiveBuffer[FReceiveLen], Len);
    FReceiveLen := FReceiveLen + Len;

    while FReceiveLen > 0 do begin
        I := Pos(#13#10, FReceiveBuffer);
        if I <= 0 then
            break;
        if I > FReceiveLen then
            break;

        FLastResponse := Copy(FReceiveBuffer, 1, I - 1);

{$IFDEF DUMP}
        FDumpBuf := '>|';
        FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
        FDumpStream.WriteBuffer(FLastResponse[1], Length(FLastResponse));
        FDumpBuf := '|' + #13#10;
        FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
{$ENDIF}
{$IFDEF VER80}
        { Add a nul byte at the end of string for Delphi 1 }
        FLastResponse[Length(FLastResponse) + 1] := #0;
{$ENDIF}
        FReceiveLen := FReceiveLen - I - 1;
        if FReceiveLen > 0 then
            Move(FReceiveBuffer[I + 1], FReceiveBuffer[0], FReceiveLen + 1);

        if FState = nntpWaitingBanner then begin
            StateChange(nntpReady);
            GetInteger(@FLastResponse[1], FStatusCode);
            FPostingPermited := (FStatusCode = 200);
            if Assigned(FOnSessionConnected) then
                FOnSessionConnected(Self, Error);
        end
        else if FState = nntpWaitingResponse then begin
            if Assigned(FNext) then
                FNext
            else
                StateChange(nntpReady);
        end
        else begin
            if Assigned(FOnDataAvailable) then
                FOnDataAvailable(Self, Error);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.WSocketSessionClosed(Sender: TObject; Error: Word);
begin
    if not (FRequestType in [nntpAbort]) then
        TriggerRequestDone(Error);
    if Assigned(FOnSessionClosed) then
        OnSessionClosed(Self, Error);
    StateChange(nntpNotConnected);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.TriggerStateChange;
begin
    if Assigned(FOnStateChange) then
        FOnStateChange(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.TriggerRequestDone(Error: Word);
begin
    if FRequestDoneFlag = FALSE then
        PostMessage(Handle, WM_NNTP_REQUEST_DONE, WORD(FRequestType), Error);
    FRequestDoneFlag := TRUE;
    FNext            := nil;
    if FWSocket.State = wsConnected then
        StateChange(nntpReady)
    else
        StateChange(nntpNotConnected);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.