units/indy/IdNNTP.pas

   1 // 29-nov-2002
   2 unit IdNNTP;
   3
   4 interface
   5
   6 uses KOL { ,
   7   Classes } ,
   8   {IdException,}
   9   IdGlobal,
  10   IdTCPConnection,
  11   IdMessage,
  12   IdMessageClient;
  13
  14 type
  15   TModeType = (mtStream, mtIHAVE, mtReader);
  16
  17   TConnectionResult = (crCanPost, crNoPost, crAuthRequired, crTempUnavailable);
  18   TModeSetResult = (mrCanStream, mrNoStream, mrCanIHAVE, mrNoIHAVE, mrCanPost,
  19     mrNoPost);
  20
  21   TEventStreaming = procedure(const AMesgID: string; var AAccepted: Boolean) of
  22     object;
  23   TNewsTransportEvent = procedure(AMsg: PStrList) of object;
  24   TEventNewsgroupList = procedure(const ANewsgroup: string; const ALow, AHigh:
  25     Cardinal;
  26     const AType: string; var ACanContinue: Boolean) of object;
  27
  28   TEventNewNewsList = procedure(const AMsgID: string; var ACanContinue: Boolean)
  29     of object;
  30
  31   TIdNNTP = object(TIdMessageClient)
  32   protected
  33     FlMsgHigh,
  34       FlMsgLow,
  35       FlMsgNo: Cardinal;
  36     FsMsgID: string;
  37     FlMsgCount: Cardinal;
  38     FNewsAgent: string;
  39     FOnNewsgroupList,
  40       FOnNewGroupsList: TEventNewsgroupList;
  41     FOnNewNewsList: TEventNewNewsList;
  42     fOnSendCheck: TNewsTransportEvent;
  43     fOnSendTakethis: TNewsTransportEvent;
  44     fModeType: TModeType;
  45     fConectionResult: TConnectionResult;
  46     fModeResult: TModeSetResult;
  47     fOnSendIHAVE: TNewsTransportEvent;
  48     FbSetMode: Boolean;
  49     fPassword: string;
  50     fUserId: string;
  51
  52     function ConvertDateTimeDist(ADate: TDateTime; AGMT: boolean;
  53       const ADistributions: string): string;
  54     procedure SetModeType(const AValue: TModeType);
  55     procedure setConnectionResult(const AValue: TConnectionResult);
  56     procedure SetModeResult(const AValue: TModeSetResult);
  57     function Get(const ACmd: string; const AMsgNo: Cardinal; const AMsgID:
  58       string;
  59       AMsg: TIDMessage): Boolean;
  60     function SetArticle(const ACmd: string; const AMsgNo: Cardinal; const
  61       AMsgID: string): Boolean;
  62     procedure ProcessGroupList(const ACmd: string; const AResponse: integer;
  63       const AListEvent: TEventNewsgroupList);
  64   public
  65 //    constructor Create(AOwner: TComponent); override;
  66     procedure Connect; virtual;//override;
  67     procedure Disconnect; virtual;//override;
  68     function GetArticle(const AMsgNo: Cardinal; const AMsgID: string; AMsg:
  69       TIdMessage): Boolean;
  70     function GetBody(const AMsgNo: Cardinal; const AMsgID: string; AMsg:
  71       TIdMessage): Boolean;
  72     function GetHeader(const AMsgNo: Cardinal; const AMsgID: string; AMsg:
  73       TIdMessage): Boolean;
  74     procedure GetNewsgroupList; overload;
  75     procedure GetNewsgroupList(AList: PStrList); overload;
  76     procedure GetNewGroupsList(const ADate: TDateTime; const AGMT: boolean;
  77       const ADistributions: string); overload;
  78     procedure GetNewGroupsList(const ADate: TDateTime; const AGMT: boolean;
  79       const ADistributions: string; AList: PStrList); overload;
  80     procedure GetNewNewsList(const ANewsgroups: string;
  81       const ADate: TDateTime; const AGMT: boolean; ADistributions: string);
  82         overload;
  83     procedure GetNewNewsList(const ANewsgroups: string; const ADate: TDateTime;
  84       const AGMT: boolean; ADistributions: string; AList: PStrList); overload;
  85     procedure GetOverviewFMT(var AResponse: PStrList);
  86     function Next: Boolean;
  87     function Previous: Boolean;
  88     function SelectArticle(const AMsgNo: Cardinal): Boolean;
  89     procedure SelectGroup(const AGroup: string);
  90     procedure Send(AMsg: TidMessage);
  91     procedure SendIHAVE(AMsg: PStrList);
  92     procedure SendCheck(AMsgID: PStrList; var AResponses: PStrList);
  93     function SendCmd(const AOut: string; const AResponse: array of SmallInt):
  94       SmallInt;virtual;// override;
  95     function SendTakeThis(AMsg: PStrList): string;
  96     procedure SendXHDR(const AHeader: string; const AParam: string; var
  97       AResponse: PStrList);
  98     procedure SendXOVER(const AParm: string; var AResponse: PStrList);
  99
 100     property MsgID: string read fsMsgID;
 101     property MsgNo: Cardinal read FlMsgNo;
 102     property MsgHigh: Cardinal read FlMsgHigh;
 103     property MsgLow: Cardinal read FlMsgLow;
 104     property GreetingResult: TConnectionResult read fConectionResult write
 105       setConnectionResult;
 106     property ModeResult: TModeSetResult read fModeResult write SetModeResult;
 107     property MsgCount: Cardinal read flMsgCount write flMsgCount;
 108 //  published
 109     property NewsAgent: string read FNewsAgent write FNewsAgent;
 110     property Mode: TModeType read fModeType write SetModeType default mtReader;
 111     property Password: string read fPassword write fPassword;
 112     property UserId: string read fUserId write fUserId;
 113     property SetMode: Boolean read FbSetMode write FbSetMode default True;
 114
 115     property OnSendCheck: TNewsTransportEvent read fOnSendCheck
 116     write fOnSendCheck;
 117     property OnSendIHAVE: TNewsTransportEvent read fOnSendIHAVE
 118     write fOnSendIHAVE;
 119     property OnSendTakeThis: TNewsTransportEvent read fOnSendTakethis
 120     write fOnSendTakethis;
 121     property OnNewsgroupList: TEventNewsgroupList read FOnNewsgroupList
 122     write FOnNewsgroupList;
 123     property OnNewGroupsList: TEventNewsGroupList read FOnNewGroupsList
 124     write FOnNewGroupsList;
 125     property OnNewNewsList: TEventNewNewsList read FOnNewNewsList
 126     write FOnNewNewsList;
 127     property Port default IdPORT_NNTP;
 128   end;
 129
 130 PIdNNTP=^TIdNNTP;
 131 function NewIdNNTP(AOwner: PControl):PIdNNTP;
 132
 133 {type
 134   EIdNNTPException = object(EIdException);
 135 PIdNNTPException=^EIdNNTPException; type  MyStupid0=DWord;
 136   EIdNNTPNoOnNewGroupsList = object(EIdNNTPException);
 137 PdNNTPException=^IdNNTPException; type  MyStupid3137=DWord;
 138   EIdNNTPNoOnNewNewsList = object(EIdNNTPException);
 139 PNNTPException=^dNNTPException; type  MyStupid86104=DWord;
 140   EIdNNTPNoOnNewsgroupList = object(EIdNNTPException);
 141 PNTPException=^NNTPException; type  MyStupid20258=DWord;
 142   EIdNNTPStringListNotInitialized = object(EIdNNTPException);
 143 PTPException=^NTPException; type  MyStupid27292=DWord;
 144
 145   EIdNNTPConnectionRefused = object(EIdProtocolReplyError);
 146 PPException=^TPException; type  MyStupid67165=DWord;}
 147
 148 procedure ParseXOVER(Aline: string; var AArticleIndex: Cardinal;
 149   var ASubject,
 150   AFrom: string;
 151   var ADate: TDateTime;
 152   var AMsgId,
 153   AReferences: string;
 154   var AByteCount,
 155   ALineCount: Cardinal;
 156   var AExtraData: string);
 157
 158 procedure ParseNewsGroup(ALine: string; var ANewsGroup: string;
 159   var AHi, ALo: Cardinal;
 160   var AStatus: string);
 161
 162 implementation
 163
 164 uses {KOL,}
 165   IdComponent,
 166   IdResourceStrings,
 167   SysUtils;
 168
 169 procedure ParseXOVER(Aline: string; var AArticleIndex: Cardinal;
 170   var ASubject,
 171   AFrom: string;
 172   var ADate: TDateTime;
 173   var AMsgId,
 174   AReferences: string;
 175   var AByteCount,
 176   ALineCount: Cardinal;
 177   var AExtraData: string);
 178
 179 begin
 180   ALine := StringReplace(ALine, #9#8#9, #9, [rfReplaceAll]);
 181   AArticleIndex := StrToCard(Fetch(ALine, #9));
 182   ASubject := Fetch(ALine, #9);
 183   AFrom := Fetch(ALine, #9);
 184   ADate := StrInternetToDateTime(Fetch(Aline, #9));
 185   AMsgId := Fetch(Aline, #9);
 186   AReferences := Fetch(ALine, #9);
 187   AByteCount := StrToCard(Fetch(ALine, #9));
 188   ALineCount := StrToCard(Fetch(ALine, #9));
 189   AExtraData := ALine;
 190 end;
 191
 192 procedure ParseNewsGroup(ALine: string; var ANewsGroup: string;
 193   var AHi, ALo: Cardinal;
 194   var AStatus: string);
 195 begin
 196   ANewsgroup := Fetch(ALine, ' ');
 197   AHi := StrToCard(Fetch(Aline, ' '));
 198   ALo := StrToCard(Fetch(ALine, ' '));
 199   AStatus := ALine;
 200 end;
 201
 202  { constructor TIdNNTP.Create(AOwner: TComponent);
 203  }
 204 function NewIdNNTP (AOwner: PControl):PIdNNTP;
 205 begin
 206 New( Result, Create );
 207 with Result^ do
 208 begin
 209 //  inherited Create(AOwner);
 210
 211   Mode := mtReader;
 212 //  Port := IdPORT_NNTP;
 213   SetMode := True;
 214 end;
 215 end;
 216
 217 function TIdNNTP.SendCmd(const AOut: string; const AResponse: array of
 218   SmallInt): SmallInt;
 219 begin
 220   Result := inherited SendCmd(AOut, []);
 221   if (Result = 480) or (Result = 450) then
 222   begin
 223     inherited SendCmd('AuthInfo User ' + UserID, [381]);
 224     inherited SendCmd('AuthInfo Pass ' + Password, [281]);
 225     Result := inherited SendCmd(AOut, AResponse);
 226   end
 227   else
 228   begin
 229     Result := CheckResponse(Result, AResponse);
 230   end;
 231 end;
 232
 233 procedure TIdNNTP.Connect;
 234 begin
 235   inherited;
 236   try
 237     GetResponse([]);
 238     case ResultNo of
 239       200: GreetingResult := crCanPost;
 240       201: GreetingResult := crNoPost;
 241       400: GreetingResult := crTempUnavailable;
 242 //      502: raise EIdNNTPConnectionRefused.CreateError(502,
 243 //        RSNNTPConnectionRefused);
 244     end;
 245     case mode of
 246       mtStream:
 247         begin
 248 //          SendCmd('mode stream');
 249           if ResultNo <> 203 then
 250             ModeResult := mrNoStream
 251           else
 252             ModeResult := mrCanStream;
 253         end;
 254       mtReader:
 255         begin
 256 //          SendCmd('mode reader');
 257           if ResultNo <> 200 then
 258             ModeResult := mrNoPost
 259           else
 260             ModeResult := mrCanPost;
 261         end;
 262     end;
 263   except
 264     Disconnect;
 265     raise;
 266   end;
 267 end;
 268
 269 procedure TIdNNTP.Disconnect;
 270 begin
 271   try
 272     if Connected then
 273       WriteLn('Quit');
 274   finally
 275     inherited;
 276   end;
 277 end;
 278
 279 procedure TIdNNTP.GetOverviewFMT(var AResponse: PStrList);
 280 begin
 281 //  SendCmd('list overview.fmt', 215);
 282 //  Capture(AResponse);
 283 end;
 284
 285 procedure TIdNNTP.SendXOVER(const AParm: string; var AResponse: PStrList);
 286 begin
 287 //  SendCmd('xover ' + AParm, 224);
 288 //  Capture(AResponse);
 289 end;
 290
 291 procedure TIdNNTP.SendXHDR(const AHeader: string; const AParam: string; var
 292   AResponse: PStrList);
 293 begin
 294 //  SendCmd('XHDR ' + AHeader + ' ' + AParam, 221);
 295 //  Capture(AResponse);
 296 end;
 297
 298 procedure TIdNNTP.SelectGroup(const AGroup: string);
 299 var
 300   s: string;
 301 begin
 302   SendCmd('Group ' + AGroup, [211]);
 303   s := Copy(CmdResult, 5, Maxint);
 304   FlMsgCount := StrToCard(Fetch(s));
 305   FlMsgLow := StrToCard(Fetch(s));
 306   FlMsgHigh := StrToCard(Fetch(s));
 307 end;
 308
 309 function TIdNNTP.Get(const ACmd: string; const AMsgNo: Cardinal; const AMsgID:
 310   string;
 311   AMsg: TidMessage): Boolean;
 312 begin
 313   Result := SetArticle(ACmd, AMsgNo, AMsgID);
 314   if Result then
 315   begin
 316     AMsg.Clear;
 317     if AnsiSameText(ACmd, 'HEAD') then
 318     begin
 319       if ResultNo in [220, 221] then
 320       begin
 321         ReceiveHeader(AMsg, '.');
 322       end;
 323     end
 324     else
 325     begin
 326       if ResultNo in [220, 221] then
 327       begin
 328         ReceiveHeader(AMsg, '');
 329       end;
 330       if ResultNo in [220, 222] then
 331         ReceiveBody(AMsg);
 332     end;
 333   end;
 334 end;
 335
 336 procedure TIdNNTP.SendIHAVE(AMsg: PStrList);
 337 var
 338   i: Integer;
 339 //  MsgID: string;
 340   Temp: string;
 341 begin
 342 {  if not Assigned(FOnSendIHAVE) then
 343   begin
 344     for i := 0 to AMsg.Count - 1 do
 345       if IndyPos('Message-ID', AMsg.Strings[i]) > 0 then
 346       begin
 347         MsgID := AMsg.Strings[i];
 348         Temp := Fetch(MsgID, ':');
 349         Break;
 350       end;
 351     SendCmd('IHAVE ' + MsgID, 335);
 352     for i := 0 to AMsg.Count - 1 do
 353       WriteLn(AMsg[i]);
 354     WriteLn('.');
 355     Temp := Readln;
 356   end;}
 357 end;
 358
 359 procedure TIdNNTP.SendCheck(AMsgID: PStrList;
 360   var AResponses: PStrList);
 361 var
 362   i: Integer;
 363 begin
 364   if not Assigned(FOnSendCheck) then
 365   begin
 366 //    for i := 0 to AMsgID.Count - 1 do
 367 //      Writeln('CHECK ' + AMsgID.Strings[i]);
 368     for i := 0 to AMsgID.Count - 1 do
 369     begin
 370 {      if assigned(AResponses) then
 371         AResponses.Add(ReadLn)
 372       else
 373         raise
 374           EIdNNTPStringListNotInitialized.Create(RSNNTPStringListNotInitialized);}
 375     end;
 376   end;
 377 end;
 378
 379 function TIdNNTP.SendTakeThis(AMsg: PStrList): string;
 380 var
 381   i: Integer;
 382 //  MsgID: string;
 383   Temp: string;
 384 begin
 385 {  if not Assigned(FOnSendTakeThis) then
 386   begin
 387     if (Setmode) and (ModeResult = mrNoStream) then
 388     begin
 389       Mode := mtIHAVE;
 390       SendIHAVE(AMsg);
 391       Exit;
 392     end;
 393     for i := 0 to AMsg.Count - 1 do
 394       if IndyPos('Message-ID', AMsg.Strings[i]) > 0 then
 395       begin
 396         MsgID := AMsg.Strings[i];
 397         Temp := Fetch(MsgID, ':');
 398         Break;
 399       end;
 400     try
 401       Writeln('TAKETHIS ' + MsgID);
 402       for i := 0 to AMsg.Count - 1 do
 403         WriteLn(AMsg[i]);
 404       WriteLn('.');
 405     finally
 406       Result := Readln;
 407     end;
 408   end;}
 409 end;
 410
 411 procedure TIdNNTP.Send(AMsg: TidMessage);
 412 begin
 413 {  SendCmd('Post', 340);
 414   //Header
 415   with AMsg.ExtraHeaders do
 416   begin
 417     Values['Lines'] := IntToStr(AMsg.Body.Count);
 418     Values['X-Newsreader'] := NewsAgent;
 419   end;
 420   SendMsg(AMsg);
 421   inherited;
 422   SendCmd('.', 240);}
 423 end;
 424
 425 procedure TIdNNTP.ProcessGroupList(const ACmd: string; const AResponse: integer;
 426   const AListEvent: TEventNewsgroupList);
 427 var
 428   s1, sNewsgroup: string;
 429   lLo, lHi: Cardinal;
 430   sStatus: string;
 431   CanContinue: Boolean;
 432 begin
 433 {  BeginWork(wmRead, 0);
 434   try
 435     SendCmd(ACmd, AResponse);
 436     s1 := ReadLn;
 437     CanContinue := True;
 438     while (s1 <> '.') and CanContinue do
 439     begin
 440       ParseNewsGroup(s1, sNewsgroup, lHi, lLo, sStatus);
 441       AListEvent(sNewsgroup, lLo, lHi, sStatus, CanContinue);
 442       s1 := ReadLn;
 443     end;
 444   finally
 445     EndWork(wmRead);
 446   end;}
 447 end;
 448
 449 procedure TIdNNTP.GetNewsgroupList;
 450 begin
 451 {  if not Assigned(FOnNewsgroupList) then
 452     raise EIdNNTPNoOnNewsgroupList.Create(RSNNTPNoOnNewsgroupList);
 453
 454   ProcessGroupList('List', 215, FOnNewsgroupList);}
 455 end;
 456
 457 procedure TIdNNTP.GetNewGroupsList(const ADate: TDateTime; const AGMT: boolean;
 458   const ADistributions: string);
 459 begin
 460   if not Assigned(FOnNewGroupsList) then
 461   begin
 462 //    raise EIdNNTPNoOnNewGroupsList.Create(RSNNTPNoOnNewGroupsList);
 463   end;
 464   ProcessGroupList('Newgroups ' + ConvertDateTimeDist(ADate, AGMT,
 465     ADistributions), 231
 466     , FOnNewGroupsList);
 467 end;
 468
 469 procedure TIdNNTP.GetNewNewsList(const ANewsgroups: string;
 470   const ADate: TDateTime; const AGMT: boolean; ADistributions: string);
 471 var
 472   s1: string;
 473   CanContinue: Boolean;
 474 begin
 475 //  if not Assigned(FOnNewNewsList) then
 476 //    raise EIdNNTPNoOnNewNewsList.Create(RSNNTPNoOnNewNewsList);
 477
 478   BeginWork(wmRead, 0);
 479   try
 480 //    SendCmd('Newnews ' + ANewsgroups + ' ' + ConvertDateTimeDist(ADate, AGMT,
 481 //      ADistributions), 230);
 482     s1 := ReadLn;
 483     CanContinue := True;
 484     while (s1 <> '.') and CanContinue do
 485     begin
 486       FOnNewNewsList(s1, CanContinue);
 487       s1 := ReadLn;
 488     end;
 489   finally
 490     EndWork(wmRead);
 491   end;
 492 end;
 493
 494 function TIdNNTP.GetArticle(const AMsgNo: Cardinal; const AMsgID: string;
 495   AMsg: TidMessage): Boolean;
 496 begin
 497   Result := Get('Article', AMsgNo, AMsgID, AMsg);
 498 end;
 499
 500 function TIdNNTP.GetBody(const AMsgNo: Cardinal; const AMsgID: string;
 501   AMsg: TidMessage): Boolean;
 502 begin
 503   Result := Get('Body', AMsgNo, AMsgID, AMsg);
 504 end;
 505
 506 function TIdNNTP.GetHeader(const AMsgNo: Cardinal; const AMsgID: string;
 507   AMsg: TidMessage): Boolean;
 508 begin
 509   Result := Get('Head', AMsgNo, AMsgID, AMsg);
 510 end;
 511
 512 function TIdNNTP.Next: Boolean;
 513 begin
 514   Result := SetArticle('Next', 0, '');
 515 end;
 516
 517 function TIdNNTP.Previous: Boolean;
 518 begin
 519   Result := SetArticle('Last', 0, '');
 520 end;
 521
 522 function TIdNNTP.SelectArticle(const AMsgNo: Cardinal): Boolean;
 523 begin
 524   Result := SetArticle('Stat', AMsgNo, '');
 525 end;
 526
 527 function TIdNNTP.SetArticle(const ACmd: string; const AMsgNo: Cardinal;
 528   const AMsgID: string): Boolean;
 529 var
 530   s: string;
 531 begin
 532 {  if AMsgNo >= 1 then
 533     SendCmd(ACmd + ' ' + IntToStr(AMsgNo))
 534   else
 535     if AMsgID <> '' then
 536     SendCmd(ACmd + ' <' + AMsgID + '>')
 537   else
 538     SendCmd(ACmd);
 539
 540   if ResultNo in [220, 221, 222, 223] then
 541   begin
 542     if AMsgID = '' then
 543     begin
 544       s := CmdResult;
 545       Fetch(s, ' ');
 546       flMsgNo := StrToCard(Fetch(s, ' '));
 547       fsMsgID := s;
 548     end;
 549     Result := True;
 550   end
 551   else
 552     if (ResultNo = 421) or (ResultNo = 422)
 553     or (ResultNo = 423) or (ResultNo = 430) then
 554   begin
 555     Result := False;
 556   end
 557   else
 558   begin
 559     raise EidResponseError.Create(CmdResult);
 560   end;}
 561 end;
 562
 563 procedure TIdNNTP.SetModeType(const AValue: TModeType);
 564 begin
 565   fModeType := AValue;
 566 end;
 567
 568 procedure TIdNNTP.setConnectionResult(const AValue: TConnectionResult);
 569 begin
 570   fConectionResult := AValue;
 571 end;
 572
 573 procedure TIdNNTP.SetModeResult(const AValue: TModeSetResult);
 574 begin
 575   fModeResult := AValue;
 576 end;
 577
 578 procedure TIdNNTP.GetNewsgroupList(AList: PStrList);
 579 begin
 580 //  SendCmd('List', 215);
 581 //  Capture(AList);
 582 end;
 583
 584 procedure TIdNNTP.GetNewGroupsList(const ADate: TDateTime; const AGMT: boolean;
 585   const ADistributions: string; AList: PStrList);
 586 begin
 587 //  SendCmd('Newgroups ' + ConvertDateTimeDist(ADate, AGMT, ADistributions), 231);
 588 //  Capture(AList);
 589 end;
 590
 591 procedure TIdNNTP.GetNewNewsList(const ANewsgroups: string; const ADate:
 592   TDateTime;
 593   const AGMT: boolean; ADistributions: string; AList: PStrList);
 594 begin
 595 //  SendCmd('Newnews ' + ANewsgroups + ' ' + ConvertDateTimeDist(ADate, AGMT,
 596 //    ADistributions), 230);
 597 //  Capture(AList);
 598 end;
 599
 600 function TIdNNTP.ConvertDateTimeDist(ADate: TDateTime; AGMT: boolean;
 601   const ADistributions: string): string;
 602 begin
 603   Result := FormatDateTime('yymmdd hhnnss', ADate);
 604   if AGMT then
 605   begin
 606     Result := Result + ' GMT';
 607   end;
 608   if Length(ADistributions) > 0 then
 609   begin
 610     Result := ' <' + ADistributions + '>';
 611   end;
 612 end;
 613
 614 end.