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