home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / FastNet / Nntp / nntpdem.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  12KB  |  405 lines
  1. ///////////////////////////////////////////////////////////////////////////
  2. //                                                                       //
  3. // Copyright ⌐ 1997-1998, NetMasters, L.L.C                              //
  4. //  - All rights reserved worldwide. -                                   //
  5. //  Portions may be Copyright ⌐ Inprise.                                 //
  6. //                                                                       //
  7. // NNTP Demo Unit 1:  (UNIT1.PAS)                                        //
  8. //                                                                       //
  9. // DESCRIPTION:                                                          //
  10. //                                                                       //
  11. // THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY //
  12. // KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE   //
  13. // IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR //
  14. // PURPOSE.                                                              //
  15. //                                                                       //
  16. ///////////////////////////////////////////////////////////////////////////
  17. //
  18. // Revision History
  19. //
  20. //                                                                       //
  21. ///////////////////////////////////////////////////////////////////////////
  22. unit nntpdem;
  23.  
  24. interface
  25.  
  26. uses
  27.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  28.   StdCtrls, Psock, NMNNTP, ComCtrls, ExtCtrls;
  29.  
  30. const
  31.   NumMsg = 'Number of Messages: ';
  32.   
  33. type
  34.   TForm1 = class(TForm)
  35.     PageControl1: TPageControl;
  36.     TabSheet1: TTabSheet;
  37.     TabSheet2: TTabSheet;
  38.     NMNNTP1: TNMNNTP;
  39.     TabSheet3: TTabSheet;
  40.     Edit1: TEdit;
  41.     Label1: TLabel;
  42.     Edit2: TEdit;
  43.     Label2: TLabel;
  44.     Edit3: TEdit;
  45.     Label3: TLabel;
  46.     Edit4: TEdit;
  47.     Label4: TLabel;
  48.     Button1: TButton;
  49.     Button2: TButton;
  50.     Label5: TLabel;
  51.     Edit5: TEdit;
  52.     Label6: TLabel;
  53.     Edit6: TEdit;
  54.     Label7: TLabel;
  55.     GroupBox1: TGroupBox;
  56.     RadioButton1: TRadioButton;
  57.     RadioButton2: TRadioButton;
  58.     RadioButton3: TRadioButton;
  59.     CheckBox1: TCheckBox;
  60.     TabSheet4: TTabSheet;
  61.     Panel1: TPanel;
  62.     Button3: TButton;
  63.     ListBox1: TListBox;
  64.     StatusBar1: TStatusBar;
  65.     Memo1: TMemo;
  66.     Label8: TLabel;
  67.     Memo2: TMemo;
  68.     Label9: TLabel;
  69.     Memo3: TMemo;
  70.     Label10: TLabel;
  71.     Memo4: TMemo;
  72.     Panel2: TPanel;
  73.     ListBox2: TListBox;
  74.     Button5: TButton;
  75.     Button6: TButton;
  76.     OpenDialog1: TOpenDialog;
  77.     Label11: TLabel;
  78.     Memo5: TMemo;
  79.     Label12: TLabel;
  80.     Panel3: TPanel;
  81.     Label14: TLabel;
  82.     Edit9: TEdit;
  83.     Edit10: TEdit;
  84.     Label15: TLabel;
  85.     Edit11: TEdit;
  86.     Label16: TLabel;
  87.     Button7: TButton;
  88.     Button8: TButton;
  89.     Button4: TButton;
  90.     Edit7: TEdit;
  91.     procedure Button1Click(Sender: TObject);
  92.     procedure Button2Click(Sender: TObject);
  93.     procedure CheckBox1Click(Sender: TObject);
  94.     procedure NMNNTP1Connect(Sender: TObject);
  95.     procedure NMNNTP1GroupListUpdate(Name: String; FirstArticle,
  96.       LastArticle: Integer; Posting: Boolean);
  97.     procedure NMNNTP1GroupListCacheUpdate(var Handled: Boolean;
  98.       Name: String; FirstArticle, LastArticle: Integer; Posting: Boolean);
  99.     procedure Button3Click(Sender: TObject);
  100.     procedure NMNNTP1ConnectionFailed(Sender: TObject);
  101.     procedure NMNNTP1HostResolved(Sender: TComponent);
  102.     procedure NMNNTP1Status(Sender: TComponent; Status: String);
  103.     procedure NMNNTP1Disconnect(Sender: TObject);
  104.     procedure NMNNTP1Abort(Sender: TObject);
  105.     procedure NMNNTP1GroupSelect(Sender: TObject);
  106.     procedure ListBox1DblClick(Sender: TObject);
  107.     procedure NMNNTP1ConnectionRequired(var handled: Boolean);
  108.     procedure NMNNTP1GroupSelectRequired(var handled: Boolean);
  109.     procedure NMNNTP1PostFailed(Sender: TComponent; Errno: Word;
  110.       Errmsg: String);
  111.     procedure NMNNTP1Posted(Sender: TObject);
  112.     procedure NMNNTP1InvalidHost(var handled: Boolean);
  113.     procedure NMNNTP1InvalidArticle(Sender: TObject);
  114.     procedure NMNNTP1HeaderList(Sender: TObject);
  115.     procedure Button4Click(Sender: TObject);
  116.     procedure NMNNTP1Article(Sender: TObject);
  117.     procedure NMNNTP1ArticleCacheUpdate(var Handled: Boolean;
  118.       IdNo: Integer; From, Subject, MsgId, Date: String;
  119.       ArticleNo: Integer);
  120.     procedure NMNNTP1Header(Sender: TObject);
  121.     procedure NMNNTP1BodyCacheUpdate(var handled: Boolean);
  122.     procedure NMNNTP1Body(Sender: TObject);
  123.     procedure NMNNTP1HeaderCacheUpdate(var Handled: Boolean; IdNo: Integer;
  124.       From, Subject, MsgId, Date: String; ArticleNo: Integer);
  125.     procedure NMNNTP1HeaderListCacheUpdate(var handled: Boolean);
  126.     procedure Button5Click(Sender: TObject);
  127.     procedure Button6Click(Sender: TObject);
  128.     procedure Button7Click(Sender: TObject);
  129.     procedure Button8Click(Sender: TObject);
  130.   private
  131.     { Private declarations }
  132.   public
  133.     { Public declarations }
  134.   end;
  135.  
  136. var
  137.   Form1: TForm1;
  138.   GNo: integer;
  139.  
  140. implementation
  141.  
  142. {$R *.DFM}
  143.  
  144. procedure TForm1.Button1Click(Sender: TObject);
  145. begin
  146.   NMNNTP1.ReportLevel := Status_Basic;
  147.   NMNNTP1.TimeOut := 20000;
  148.   NMNNTP1.NewsDir := Edit5.Text;
  149.   NMNNTP1.AttachFilePath := Edit6.Text;
  150.   NMNNTP1.Host := Edit1.Text;
  151.   NMNNTP1.Port := StrToInt(Edit2.Text);
  152.   If Edit3.Text <> '' then
  153.   Begin
  154.     NMNNTP1.UserID := Edit3.Text;
  155.     NMNNTP1.Password := Edit4.Text;
  156.   End;
  157.   If RadioButton1.Checked then
  158.     NMNNTP1.CacheMode := cmLocal;
  159.   If RadioButton2.Checked then
  160.     NMNNTP1.CacheMode := cmMixed;
  161.   If RadioButton3.Checked then
  162.     NMNNTP1.CacheMode := cmRemote;
  163.   If CheckBox1.Checked then
  164.     NMNNTP1.ParseAttachments := TRUE
  165.   else
  166.     NMNNTP1.ParseAttachments := FALSE;
  167.   NMNNTP1.Connect;
  168. end;
  169.  
  170. procedure TForm1.Button2Click(Sender: TObject);
  171. begin
  172.   NMNNTP1.Disconnect;
  173. end;
  174.  
  175. procedure TForm1.CheckBox1Click(Sender: TObject);
  176. begin
  177.   If CheckBox1.Checked then
  178.     NMNNTP1.ParseAttachments := TRUE
  179.   else
  180.     NMNNTP1.ParseAttachments := FALSE;
  181. end;
  182.  
  183. procedure TForm1.NMNNTP1Connect(Sender: TObject);
  184. begin
  185.   StatusBar1.SimpleText := 'Connect';
  186.   GNo :=0;
  187.   NMNNTP1.GetGroupList;
  188. end;
  189.  
  190. procedure TForm1.NMNNTP1GroupListUpdate(Name: String; FirstArticle,
  191.   LastArticle: Integer; Posting: Boolean);
  192. begin
  193.   ListBox1.Items.Add(Name);
  194.   inc (GNo);
  195.   StatusBar1.SimpleText := 'Getting News Group List Group '+ IntToStr(GNo);
  196. end;
  197.  
  198. procedure TForm1.NMNNTP1GroupListCacheUpdate(var Handled: Boolean;
  199.   Name: String; FirstArticle, LastArticle: Integer; Posting: Boolean);
  200. begin
  201.   ListBox1.Items.Add(Name);
  202. end;
  203.  
  204. procedure TForm1.Button3Click(Sender: TObject);
  205. begin
  206.   NMNNTP1.GetArticleList(True,0);
  207. end;
  208.  
  209. procedure TForm1.NMNNTP1ConnectionFailed(Sender: TObject);
  210. begin
  211.   ShowMessage('Connection Failed');
  212. end;
  213.  
  214. procedure TForm1.NMNNTP1HostResolved(Sender: TComponent);
  215. begin
  216.   StatusBar1.SimpleText := 'Host Resolved';
  217. end;
  218.  
  219. procedure TForm1.NMNNTP1Status(Sender: TComponent; Status: String);
  220. begin
  221.   If StatusBar1 <> nil then
  222.     StatusBar1.SimpleText := status;
  223.   If NMNNTP1.ReplyNumber = 200 then
  224.     StatusBar1.SimpleText := 'server ready - posting allowed';
  225. end;
  226.  
  227. procedure TForm1.NMNNTP1Disconnect(Sender: TObject);
  228. begin
  229.   If StatusBar1 <> nil then
  230.     StatusBar1.SimpleText := 'Disconnected';
  231. end;
  232.  
  233. procedure TForm1.NMNNTP1Abort(Sender: TObject);
  234. begin
  235.   StatusBar1.SimpleText := 'Operation aborted';
  236. end;
  237.  
  238. procedure TForm1.NMNNTP1GroupSelect(Sender: TObject);
  239. begin
  240.   Form1.Caption := 'NNTP Demo - ['+NMNNTP1.SelectedGroup+' Lo:'+IntToStr(NMNNTP1.LoMessage)+' Hi:'+IntToStr(NMNNTP1.HiMessage);
  241.   If NMNNTP1.Posting then
  242.     Form1.Caption := Form1.Caption + ' Posting Allowed]'
  243.   else
  244.     Form1.Caption := Form1.Caption + ' Posting Prohibited]';
  245. end;
  246.  
  247. procedure TForm1.ListBox1DblClick(Sender: TObject);
  248. begin
  249.   NMNNTP1.SetGroup(ListBox1.Items[ListBox1.ItemIndex]);
  250. end;
  251.  
  252. procedure TForm1.NMNNTP1ConnectionRequired(var handled: Boolean);
  253. begin
  254.   If MessageDlg('Connection Required. Connect?', mtConfirmation, mbOkCancel, 0) = mrOk then
  255.   Begin
  256.     Handled := TRUE;
  257.     NMNNTP1.ReportLevel := Status_Basic;
  258.     NMNNTP1.TimeOut := 20000;
  259.     NMNNTP1.NewsDir := Edit5.Text;
  260.     NMNNTP1.AttachFilePath := Edit6.Text;
  261.     NMNNTP1.Host := Edit1.Text;
  262.     NMNNTP1.Port := StrToInt(Edit2.Text);
  263.     If Edit3.Text <> '' then
  264.     Begin
  265.       NMNNTP1.UserID := Edit3.Text;
  266.       NMNNTP1.Password := Edit4.Text;
  267.     End;
  268.     If RadioButton1.Checked then
  269.       NMNNTP1.CacheMode := cmLocal;
  270.     If RadioButton2.Checked then
  271.       NMNNTP1.CacheMode := cmMixed;
  272.     If RadioButton3.Checked then
  273.       NMNNTP1.CacheMode := cmRemote;
  274.     If CheckBox1.Checked then
  275.       NMNNTP1.ParseAttachments := TRUE
  276.     else
  277.       NMNNTP1.ParseAttachments := FALSE;
  278.     NMNNTP1.Connect;
  279.   End;
  280. end;
  281. procedure TForm1.NMNNTP1GroupSelectRequired(var handled: Boolean);
  282. var
  283.   TmpStr: String;
  284. begin
  285.   If InputQuery('Newsgroup selection Required!','Enter NewsGroup Name: ', TmpStr) then
  286.   Begin
  287.     NMNNTP1.SetGroup(TmpStr);
  288.     Handled := TRUE;
  289.   End;
  290. end;
  291.  
  292. procedure TForm1.NMNNTP1PostFailed(Sender: TComponent; Errno: Word;
  293.   Errmsg: String);
  294. begin
  295.   ShowMessage('Post Failed. Error: '+IntToStr(Errno)+'; '+Errmsg);
  296. end;
  297.  
  298. procedure TForm1.NMNNTP1Posted(Sender: TObject);
  299. begin
  300.   ShowMessage('Article posted successfully');
  301. end;
  302.  
  303. procedure TForm1.NMNNTP1InvalidHost(var handled: Boolean);
  304. var
  305.   TmpStr: String;
  306. begin
  307.   If InputQuery('Invalid Host!', 'Specify a new host:', TmpStr) then
  308.   Begin
  309.     NMNNTP1.Host := TmpStr;
  310.     Handled := TRUE;
  311.   End;
  312. end;
  313.  
  314. procedure TForm1.NMNNTP1InvalidArticle(Sender: TObject);
  315. begin
  316.   ShowMessage('Article number invalid');
  317. end;
  318.  
  319. procedure TForm1.NMNNTP1HeaderList(Sender: TObject);
  320. begin
  321.   Memo4.Lines.Add('['+IntToStr(NMNNTP1.HeaderRecord.PrArticleId)+'] From: ' + NMNNTP1.HeaderRecord.PrFromAddress);
  322.   Memo4.lines.add('    Subject: ' + NMNNTP1.HeaderRecord.PrSubject);
  323.   Application.ProcessMessages;
  324. end;
  325.  
  326. procedure TForm1.Button4Click(Sender: TObject);
  327. begin
  328.   NMNNTP1.GetArticle(StrToInt(Edit7.Text));
  329. end;
  330.  
  331. procedure TForm1.NMNNTP1Article(Sender: TObject);
  332. begin
  333.   Memo3.Text := NMNNTP1.Header.Text;
  334.   Memo2.Text := NMNNTP1.Body.Text;
  335.   Memo1.Text := NMNNTP1.Attachments.Text;
  336. end;
  337.  
  338. procedure TForm1.NMNNTP1ArticleCacheUpdate(var Handled: Boolean;
  339.   IdNo: Integer; From, Subject, MsgId, Date: String; ArticleNo: Integer);
  340. begin
  341.   Memo3.Text := NMNNTP1.Header.Text;
  342.   Memo2.Text := NMNNTP1.Body.Text;
  343.   Memo1.Text := NMNNTP1.Attachments.Text;
  344.  
  345. end;
  346.  
  347. procedure TForm1.NMNNTP1Header(Sender: TObject);
  348. begin
  349.   Memo3.Text := NMNNTP1.Header.Text;
  350. end;
  351.  
  352. procedure TForm1.NMNNTP1BodyCacheUpdate(var handled: Boolean);
  353. begin
  354.   Memo3.Text := NMNNTP1.Body.Text;
  355. end;
  356.  
  357. procedure TForm1.NMNNTP1Body(Sender: TObject);
  358. begin
  359.   Memo3.Text := NMNNTP1.Body.Text;
  360. end;
  361.  
  362. procedure TForm1.NMNNTP1HeaderCacheUpdate(var Handled: Boolean;
  363.   IdNo: Integer; From, Subject, MsgId, Date: String; ArticleNo: Integer);
  364. begin
  365.   Memo3.Text := NMNNTP1.Header.Text;
  366. end;
  367.  
  368. procedure TForm1.NMNNTP1HeaderListCacheUpdate(var handled: Boolean);
  369. begin
  370.   Memo4.Lines.Add('['+IntToStr(NMNNTP1.HeaderRecord.PrArticleId)+'] From: ' + NMNNTP1.HeaderRecord.PrFromAddress);
  371.   Memo4.lines.add('    Subject: ' + NMNNTP1.HeaderRecord.PrSubject);
  372. end;
  373.  
  374.  
  375. procedure TForm1.Button5Click(Sender: TObject);
  376. begin
  377.   If OpenDialog1.Execute then
  378.     ListBox2.Items.Add(OpenDialog1.Filename);
  379. end;
  380.  
  381. procedure TForm1.Button6Click(Sender: TObject);
  382. begin
  383.   ListBox2.Items.Delete(ListBox2.ItemIndex);
  384. end;
  385.  
  386. procedure TForm1.Button7Click(Sender: TObject);
  387. begin
  388.   NMNNTP1.PostBody.Assign(Memo5.Lines);
  389.   NMNNTP1.PostRecord.PrFromAddress := Edit9.Text;
  390.   NMNNTP1.PostRecord.PrReplyTo := Edit10.Text;
  391.   NMNNTP1.PostRecord.PrSubject := Edit11.Text;
  392.   NMNNTP1.PostRecord.PrNewsGroups := NMNNTP1.SelectedGroup;
  393.   NMNNTP1.Attachments.Assign(ListBox2.Items);
  394.   NMNNTP1.PostArticle;
  395. end;
  396.  
  397. procedure TForm1.Button8Click(Sender: TObject);
  398. begin
  399.   NMNNTP1.Abort;
  400. end;
  401.  
  402.  
  403.  
  404. end.
  405.