?? nntpcli.pas
字號:
TriggerRequestDone(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;
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -