?? nntpcli.pas
字號(hào):
function GetInteger(Data : PChar; var Number : Integer) : PChar;
var
bSign : Boolean;
begin
Number := 0;
Result := StpBlk(Data);
if (Result = nil) then
Exit;
{ Remember the sign }
if Result^ in ['-', '+'] then begin
bSign := (Result^ = '-');
Inc(Result);
end
else
bSign := FALSE;
{ Convert any number }
while (Result^ <> #0) and (Result^ in ['0'..'9']) do begin
Number := Number * 10 + ord(Result^) - ord('0');
Inc(Result);
end;
{ Correct for sign }
if bSign then
Number := -Number;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetMessageID(Data : PChar; var ID : String) : PChar;
begin
ID := '';
Result := StpBlk(Data);
if Data = nil then
Exit;
while not (Result^ in [#0, '<']) do
Inc(Result);
if Result^ = '<' then begin
while Result^ <> #0 do begin
Inc(Result);
if Result^ = '>' then
break;
ID := ID + Result^;
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetNewsGroupName(Data : PChar; var GroupName : String) : PChar;
begin
GroupName := '';
Result := StpBlk(Data);
if Data = nil then
Exit;
{ Copy until first white space }
while (Result^ <> #0) and (not (Result^ in [' ', #9])) do begin
GroupName := GroupName + Result^;
Inc(Result);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetChar(Data : PChar; var Ch : Char) : PChar;
begin
Ch := #0;
Result := StpBlk(Data);
if Data = nil then
Exit;
Ch := Result^;
if Ch <> #0 then
Inc(Result);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function atoi(Data : String) : Integer;
begin
{$IFDEF VER80}
{ Nul terminate string for Delphi 1 }
Data[Length(Data) + 1] := #0;
{$ENDIF}
GetInteger(@Data[1], Result);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Register;
begin
RegisterComponents('FPiette', [TNntpCli]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TNntpCli.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF DUMP}
FDumpStream := TFileStream.Create('c:\temp\nntpcli.log', fmCreate);
FDumpBuf := '---- START -----' + #13 + #10;
FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
{$ENDIF}
FWindowHandle := AllocateHWnd(WndProc);
FState := nntpNotConnected;
FArticleNumber := -1;
FArticleID := '';
FArticleFirst := -1;
FArticleLast := -1;
FArticleEstimated := -1;
FStatusCode := 503; { program fault }
FWSocket := TWSocket.Create(Self);
FWSocket.OnSessionConnected := WSocketSessionConnected;
FWSocket.OnDataAvailable := WSocketDataAvailable;
FWSocket.OnSessionClosed := WSocketSessionClosed;
FWSocket.OnDnsLookupDone := WSocketDnsLookupDone;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TNntpCli.Destroy;
begin
{$IFDEF DUMP}
if Assigned(FDumpStream) then begin
FDumpBuf := '---- STOP -----' + #13 + #10;
FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
FDumpStream.Destroy;
end;
{$ENDIF}
if Assigned(FWSocket) then
FWSocket.Destroy;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.WndProc(var MsgRec: TMessage);
begin
with MsgRec do begin
case Msg of
WM_NNTP_REQUEST_DONE : WMNntpRequestDone(MsgRec);
else
Result := DefWindowProc(Handle, Msg, wParam, lParam);
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.WMNntpRequestDone(var msg: TMessage);
begin
if Assigned(FOnRequestDone) then
FOnRequestDone(Self, TNntpRequest(Msg.WParam), Msg.LParam);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.StateChange(NewState : TNntpState);
begin
if FState <> NewState then begin
FState := NewState;
TriggerStateChange;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.SendRequest;
begin
FLastCmdResponse := '';
{$IFDEF DUMP}
FDumpBuf := '<|';
FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
FDumpStream.WriteBuffer(FRequest[1], Length(FRequest));
FDumpBuf := '|' + #13#10;
FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
{$ENDIF}
FWSocket.SendStr(FRequest + #13 + #10);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Connect;
begin
if FState <> nntpNotConnected then
raise NntpException.Create('Already connected');
FRequestType := nntpConnect;
FRequestDoneFlag := FALSE;
FReceiveLen := 0;
FRequest := '';
FArticleNumber := -1;
FArticleID := '';
FArticleFirst := -1;
FArticleLast := -1;
FArticleEstimated := -1;
StateChange(nntpDnsLookup);
FWSocket.DnsLookup(FHost);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.Group(NewsGroupName : String);
begin
if FState <> nntpReady then
raise NntpException.Create('Not ready for GROUP');
FRequestDoneFlag := FALSE;
FRequestType := nntpGroup;
FRequest := 'GROUP ' + Trim(NewsGroupName);
FNext := GroupNext;
StateChange(nntpWaitingResponse);
SendRequest;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNntpCli.GroupNext;
var
Data : PChar;
Error : Integer;
begin
Data := GetInteger(@FLastResponse[1], FStatusCode);
Data := GetInteger(Data, FArticleEstimated);
Data := GetInteger(Data, FArticleFirst);
GetInteger(Data, FArticleLast);
if FStatusCode = 211 then
Error := 0
else
Error := FStatusCode;
TriggerRequestDone(Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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';
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -