unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Psock, NMNNTP, ComCtrls,FileCtrl;type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label3: TLabel;
ListBox1: TListBox;
Label4: TLabel;
ListBox2: TListBox;
StatusBar1: TStatusBar;
NMNNTP1: TNMNNTP;
Timer1: TTimer;
Timer2: TTimer;
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label5: TLabel;
Label6: TLabel;
Serveur: TComboBox;
Label7: TLabel;
Label8: TLabel;
procedure NMNNTP1Abort(Sender: TObject);
procedure NMNNTP1Article(Sender: TObject);
procedure NMNNTP1ArticleCacheUpdate(var Handled: Boolean;
IdNo: Integer; From, Subject, MsgId, Date: String;
ArticleNo: Integer);
procedure NMNNTP1Connect(Sender: TObject);
procedure NMNNTP1ConnectionFailed(Sender: TObject);
procedure NMNNTP1ConnectionRequired(var Handled: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure NMNNTP1GroupListCacheUpdate(var Handled: Boolean;
name: String; FirstArticle, LastArticle: Integer; Posting: Boolean);
procedure NMNNTP1GroupListUpdate(name: String; FirstArticle,
LastArticle: Integer; Posting: Boolean);
procedure NMNNTP1HeaderList(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure NMNNTP1HeaderListCacheUpdate(var Handled: Boolean);
procedure NMNNTP1HostResolved(Sender: TComponent);
procedure NMNNTP1InvalidArticle(Sender: TObject);
procedure NMNNTP1InvalidHost(var Handled: Boolean);
procedure NMNNTP1Status(Sender: TComponent; Status: String);
procedure Timer1Timer(Sender: TObject);
private
{ D閏larations priv閑s }
public
{ D閏larations publiques }
end;var
Form1: TForm1;
a,i,GNo: integer;
inProgress,Finish: boolean;
implementation{$R *.DFM}procedure TForm1.NMNNTP1Abort(Sender: TObject);
begin
StatusBar1.SimpleText := 'Operation annuler';
end;procedure TForm1.NMNNTP1Article(Sender: TObject);
begin
finish := true;
Memo1.Text := NMNNTP1.Body.Text;
end;procedure TForm1.NMNNTP1ArticleCacheUpdate(var Handled: Boolean;
IdNo: Integer; From, Subject, MsgId, Date: String; ArticleNo: Integer);
begin
Memo1.Text := NMNNTP1.Body.Text;
end;procedure TForm1.NMNNTP1Connect(Sender: TObject);
begin
StatusBar1.SimpleText := 'Connexion r閡ssie';
GNo :=0;
NMNNTP1.GetGroupList;
end;procedure TForm1.NMNNTP1ConnectionFailed(Sender: TObject);
begin
ShowMessage('Connection Failed');
StatusBar1.SimpleText := 'Echec de connexion';
end;procedure TForm1.NMNNTP1ConnectionRequired(var Handled: Boolean);
begin
If MessageDlg('Connexion perdu, connecter de nouveau ?', mtConfirmation, mbOkCancel, 0) = mrOk then
Begin
Handled := TRUE;
NMNNTP1.ReportLevel := Status_Basic;
NMNNTP1.TimeOut := 20000;
NMNNTP1.NewsDir := 'c:\News';
NMNNTP1.Host := Serveur.Text;
NMNNTP1.Port := (StrToInt('119'));
NMNNTP1.CacheMode := cmMixed;
NMNNTP1.ParseAttachments := FALSE; NMNNTP1.Connect;
End;end;procedure TForm1.Button1Click(Sender: TObject);
begin
halt(1);
end;procedure TForm1.Button3Click(Sender: TObject);
begin
showmessage ('Little software to Crowl thes forums servers. http://www.onecor.com');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
finish := true;
Memo1.Clear;
a:=0;
end;procedure TForm1.NMNNTP1GroupListCacheUpdate(var Handled: Boolean;
name: String; FirstArticle, LastArticle: Integer; Posting: Boolean);
begin
ListBox1.Items.Add(Name);
if not DirectoryExists (Name) then
begin
mkdir(Name);
end;
end;procedure TForm1.NMNNTP1GroupListUpdate(name: String; FirstArticle,
LastArticle: Integer; Posting: Boolean);
begin
ListBox1.Items.Add(Name);
if not DirectoryExists (Name) then
begin
mkdir(Name);
end;
inc (GNo);
Label8.caption:= IntToStr(GNo);end;procedure TForm1.NMNNTP1HeaderList(Sender: TObject);
begin
ListBox2.Items.Add(IntToStr(NMNNTP1.HeaderRecord.PrArticleId));Application.ProcessMessages;end;procedure TForm1.Button2Click(Sender: TObject);
begin
if DirectoryExists ('c:\News') then
begin
chdir('c:\News');
end
else
mkdir ('c:\News');
chdir('c:\News');
NMNNTP1.ReportLevel := Status_Basic;
NMNNTP1.TimeOut := 40000;
NMNNTP1.NewsDir := ('c:\News');
NMNNTP1.Host := Serveur.Text;
NMNNTP1.Port := (StrToInt('119'));
NMNNTP1.CacheMode := cmMixed;
NMNNTP1.ParseAttachments := FALSE;
NMNNTP1.Connect;
// except
// NMNNTP1.Connect;
// end;
end;procedure TForm1.Timer2Timer(Sender: TObject);
begin
// Si il-y-a des groupes alors on quite
If listbox1.Items.Count=0 then
begin
exit;
end;// Si il-y-a des article allors le travail commence
if listbox2.Items.Count > 0 then
begin
// Si L'Article est egale ?ZERO Alors on Efface tous les articles
If (ListBox2.Items[ListBox2.TopIndex])=('0') then
begin
ListBox2.Clear;
Exit;
end;
// Compteur du temps de lecture d'un article
inc (a);// Si L'evenement est TRUE alors on lit l'article
if finish then
begin
finish := false;
NMNNTP1.GetArticle(StrToInt(ListBox2.items[Listbox2.TopIndex]));
end;// Si le delai est de 20 secondes alors on efface la groupe
if a=20 then
begin
a:=0;
Finish:=true;
ListBox2.Items.Delete((ListBox2.TopIndex));
end;// Si L'evenement est TRUE alors on sauvegarde le contenu de
// l'article et on passe au suivante.
if finish then
begin
a:=0;
Memo1.Lines.SaveToFile(IntToStr(NMNNTP1.HeaderRecord.PrArticleId)+'.txt');
if ListBox2.Items.Count=0 then exit;
ListBox2.Items.Delete((ListBox2.TopIndex));end;
Timer2.Interval:=500;
end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
NMNNTP1.SetGroup(ListBox1.Items[ListBox1.TopIndex]);
NMNNTP1.GetArticleList(True,0);
end;procedure TForm1.NMNNTP1HeaderListCacheUpdate(var Handled: Boolean);
begin
ListBox2.Items.Add(IntToStr(NMNNTP1.HeaderRecord.PrArticleId));
end;procedure TForm1.NMNNTP1HostResolved(Sender: TComponent);
begin
StatusBar1.SimpleText := 'Serveur trouver ...';
end;procedure TForm1.NMNNTP1InvalidArticle(Sender: TObject);
begin StatusBar1.SimpleText := 'Num閞o d''article est incorrect';
end;procedure TForm1.NMNNTP1InvalidHost(var Handled: Boolean);
var
TmpStr: String;
begin
If InputQuery('Serveur Inconnue!', 'Veuillez entr閑 de nouveau le nom de serveur:', TmpStr) then
Begin
NMNNTP1.Host := TmpStr;
Handled := TRUE;
End;
end;procedure TForm1.NMNNTP1Status(Sender: TComponent; Status: String);
begin
If StatusBar1 <> nil then
StatusBar1.SimpleText := status;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
// Si Il-y-a des articles alors variable est ?FALSE
If listbox2.Items.Count>0 then
begin
inProgress := false;
exit;
end;
//Si Il-y-a des groupe mais pas des article alors on passe
//au groupe suivante.
If (ListBox1.Items.Count>0) and (ListBox2.Items.Count<1) then
begin
inProgress := true;
ListBox1.Items.Delete(ListBox1.TopIndex);
chdir ('c:\News');
chdir (ListBox1.items[Listbox1.TopIndex]);
NMNNTP1.SetGroup(ListBox1.Items[ListBox1.TopIndex]);
NMNNTP1.GetArticleList(True,0);
end;
end;
end.
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Psock, NMNNTP, ComCtrls,FileCtrl;type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label3: TLabel;
ListBox1: TListBox;
Label4: TLabel;
ListBox2: TListBox;
StatusBar1: TStatusBar;
NMNNTP1: TNMNNTP;
Timer1: TTimer;
Timer2: TTimer;
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label5: TLabel;
Label6: TLabel;
Serveur: TComboBox;
Label7: TLabel;
Label8: TLabel;
procedure NMNNTP1Abort(Sender: TObject);
procedure NMNNTP1Article(Sender: TObject);
procedure NMNNTP1ArticleCacheUpdate(var Handled: Boolean;
IdNo: Integer; From, Subject, MsgId, Date: String;
ArticleNo: Integer);
procedure NMNNTP1Connect(Sender: TObject);
procedure NMNNTP1ConnectionFailed(Sender: TObject);
procedure NMNNTP1ConnectionRequired(var Handled: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure NMNNTP1GroupListCacheUpdate(var Handled: Boolean;
name: String; FirstArticle, LastArticle: Integer; Posting: Boolean);
procedure NMNNTP1GroupListUpdate(name: String; FirstArticle,
LastArticle: Integer; Posting: Boolean);
procedure NMNNTP1HeaderList(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure NMNNTP1HeaderListCacheUpdate(var Handled: Boolean);
procedure NMNNTP1HostResolved(Sender: TComponent);
procedure NMNNTP1InvalidArticle(Sender: TObject);
procedure NMNNTP1InvalidHost(var Handled: Boolean);
procedure NMNNTP1Status(Sender: TComponent; Status: String);
procedure Timer1Timer(Sender: TObject);
private
{ D閏larations priv閑s }
public
{ D閏larations publiques }
end;var
Form1: TForm1;
a,i,GNo: integer;
inProgress,Finish: boolean;
implementation{$R *.DFM}procedure TForm1.NMNNTP1Abort(Sender: TObject);
begin
StatusBar1.SimpleText := 'Operation annuler';
end;procedure TForm1.NMNNTP1Article(Sender: TObject);
begin
finish := true;
Memo1.Text := NMNNTP1.Body.Text;
end;procedure TForm1.NMNNTP1ArticleCacheUpdate(var Handled: Boolean;
IdNo: Integer; From, Subject, MsgId, Date: String; ArticleNo: Integer);
begin
Memo1.Text := NMNNTP1.Body.Text;
end;procedure TForm1.NMNNTP1Connect(Sender: TObject);
begin
StatusBar1.SimpleText := 'Connexion r閡ssie';
GNo :=0;
NMNNTP1.GetGroupList;
end;procedure TForm1.NMNNTP1ConnectionFailed(Sender: TObject);
begin
ShowMessage('Connection Failed');
StatusBar1.SimpleText := 'Echec de connexion';
end;procedure TForm1.NMNNTP1ConnectionRequired(var Handled: Boolean);
begin
If MessageDlg('Connexion perdu, connecter de nouveau ?', mtConfirmation, mbOkCancel, 0) = mrOk then
Begin
Handled := TRUE;
NMNNTP1.ReportLevel := Status_Basic;
NMNNTP1.TimeOut := 20000;
NMNNTP1.NewsDir := 'c:\News';
NMNNTP1.Host := Serveur.Text;
NMNNTP1.Port := (StrToInt('119'));
NMNNTP1.CacheMode := cmMixed;
NMNNTP1.ParseAttachments := FALSE; NMNNTP1.Connect;
End;end;procedure TForm1.Button1Click(Sender: TObject);
begin
halt(1);
end;procedure TForm1.Button3Click(Sender: TObject);
begin
showmessage ('Little software to Crowl thes forums servers. http://www.onecor.com');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
finish := true;
Memo1.Clear;
a:=0;
end;procedure TForm1.NMNNTP1GroupListCacheUpdate(var Handled: Boolean;
name: String; FirstArticle, LastArticle: Integer; Posting: Boolean);
begin
ListBox1.Items.Add(Name);
if not DirectoryExists (Name) then
begin
mkdir(Name);
end;
end;procedure TForm1.NMNNTP1GroupListUpdate(name: String; FirstArticle,
LastArticle: Integer; Posting: Boolean);
begin
ListBox1.Items.Add(Name);
if not DirectoryExists (Name) then
begin
mkdir(Name);
end;
inc (GNo);
Label8.caption:= IntToStr(GNo);end;procedure TForm1.NMNNTP1HeaderList(Sender: TObject);
begin
ListBox2.Items.Add(IntToStr(NMNNTP1.HeaderRecord.PrArticleId));Application.ProcessMessages;end;procedure TForm1.Button2Click(Sender: TObject);
begin
if DirectoryExists ('c:\News') then
begin
chdir('c:\News');
end
else
mkdir ('c:\News');
chdir('c:\News');
NMNNTP1.ReportLevel := Status_Basic;
NMNNTP1.TimeOut := 40000;
NMNNTP1.NewsDir := ('c:\News');
NMNNTP1.Host := Serveur.Text;
NMNNTP1.Port := (StrToInt('119'));
NMNNTP1.CacheMode := cmMixed;
NMNNTP1.ParseAttachments := FALSE;
NMNNTP1.Connect;
// except
// NMNNTP1.Connect;
// end;
end;procedure TForm1.Timer2Timer(Sender: TObject);
begin
// Si il-y-a des groupes alors on quite
If listbox1.Items.Count=0 then
begin
exit;
end;// Si il-y-a des article allors le travail commence
if listbox2.Items.Count > 0 then
begin
// Si L'Article est egale ?ZERO Alors on Efface tous les articles
If (ListBox2.Items[ListBox2.TopIndex])=('0') then
begin
ListBox2.Clear;
Exit;
end;
// Compteur du temps de lecture d'un article
inc (a);// Si L'evenement est TRUE alors on lit l'article
if finish then
begin
finish := false;
NMNNTP1.GetArticle(StrToInt(ListBox2.items[Listbox2.TopIndex]));
end;// Si le delai est de 20 secondes alors on efface la groupe
if a=20 then
begin
a:=0;
Finish:=true;
ListBox2.Items.Delete((ListBox2.TopIndex));
end;// Si L'evenement est TRUE alors on sauvegarde le contenu de
// l'article et on passe au suivante.
if finish then
begin
a:=0;
Memo1.Lines.SaveToFile(IntToStr(NMNNTP1.HeaderRecord.PrArticleId)+'.txt');
if ListBox2.Items.Count=0 then exit;
ListBox2.Items.Delete((ListBox2.TopIndex));end;
Timer2.Interval:=500;
end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
NMNNTP1.SetGroup(ListBox1.Items[ListBox1.TopIndex]);
NMNNTP1.GetArticleList(True,0);
end;procedure TForm1.NMNNTP1HeaderListCacheUpdate(var Handled: Boolean);
begin
ListBox2.Items.Add(IntToStr(NMNNTP1.HeaderRecord.PrArticleId));
end;procedure TForm1.NMNNTP1HostResolved(Sender: TComponent);
begin
StatusBar1.SimpleText := 'Serveur trouver ...';
end;procedure TForm1.NMNNTP1InvalidArticle(Sender: TObject);
begin StatusBar1.SimpleText := 'Num閞o d''article est incorrect';
end;procedure TForm1.NMNNTP1InvalidHost(var Handled: Boolean);
var
TmpStr: String;
begin
If InputQuery('Serveur Inconnue!', 'Veuillez entr閑 de nouveau le nom de serveur:', TmpStr) then
Begin
NMNNTP1.Host := TmpStr;
Handled := TRUE;
End;
end;procedure TForm1.NMNNTP1Status(Sender: TComponent; Status: String);
begin
If StatusBar1 <> nil then
StatusBar1.SimpleText := status;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
// Si Il-y-a des articles alors variable est ?FALSE
If listbox2.Items.Count>0 then
begin
inProgress := false;
exit;
end;
//Si Il-y-a des groupe mais pas des article alors on passe
//au groupe suivante.
If (ListBox1.Items.Count>0) and (ListBox2.Items.Count<1) then
begin
inProgress := true;
ListBox1.Items.Delete(ListBox1.TopIndex);
chdir ('c:\News');
chdir (ListBox1.items[Listbox1.TopIndex]);
NMNNTP1.SetGroup(ListBox1.Items[ListBox1.TopIndex]);
NMNNTP1.GetArticleList(True,0);
end;
end;
end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货