newsrdr1.pas

文件名称：新曦 我的资源 搜索软件 源程序(Borland Delphi 7)说明

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Fran鏾is PIETTE
Description:  This sample program show how to use TNntpCli to write a news
              enabled application.
Creation:     December 24, 1997
Version:      0.94
EMail:        http://www.overbyte.be        http://www.rtfm.be/fpiette
              [e-mail]   [e-mail]
                                            [e-mail]
Support:      Use the mailing list [e-mail]
              Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1997-2002 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: [phone]
              <[e-mail]>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

Updates:
Dec 29, 1997 V0.91 Adapted to be compatible with Delphi 1
Jan 04, 1998 V0.92 Added LIST OVERVIEW.FMT, XOVER and DATE
Jan 31, 1998 V0.93 Added the UserEditBox (used for Post command)
                   Added code to get UserName and EMail from IE settings
Aug 14, 1999 V0.94 Added support for XHDR and MODE READER.
                   Corrected a bug that let Connect and Abort button
                   disabled when DNS lookup failed.

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit NewsRdr1;

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, NntpCli, StdCtrls, ExtCtrls, IniFiles;

type
  TNNTPForm = class(TForm)
    NntpCli1: TNntpCli;
    Panel1: TPanel;
    ServerEdit: TEdit;
    ConnectButton: TButton;
    Label1: TLabel;
    DisplayMemo: TMemo;
    AbortButton: TButton;
    GroupButton: TButton;
    GroupEdit: TEdit;
    ArticleNumEdit: TEdit;
    ArticleByNumberButton: TButton;
    ArticleByIDButton: TButton;
    NextButton: TButton;
    LastButton: TButton;
    HeadByNumberButton: TButton;
    HeadByIDButton: TButton;
    BodyByNumberButton: TButton;
    BodyByIDButton: TButton;
    StatByNumberButton: TButton;
    StatByIDButton: TButton;
    ListButton: TButton;
    ArticleIDEdit: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    PostButton: TButton;
    QuitButton: TButton;
    FileEdit: TEdit;
    Label5: TLabel;
    NewGroupsButton: TButton;
    NewNewsButton: TButton;
    HelpButton: TButton;
    XOverButton: TButton;
    OverViewFmtButton: TButton;
    DateButton: TButton;
    UserEdit: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    UserNameEdit: TEdit;
    Label8: TLabel;
    PasswordEdit: TEdit;
    AuthenticateButton: TButton;
    ModeReaderButton: TButton;
    XHdrButton: TButton;
    procedure ConnectButtonClick(Sender: TObject);
    procedure NntpCli1SessionConnected(Sender: TObject; Error: Word);
    procedure NntpCli1SessionClosed(Sender: TObject; Error: Word);
    procedure AbortButtonClick(Sender: TObject);
    procedure GroupButtonClick(Sender: TObject);
    procedure NntpCli1RequestDone(Sender: TObject; RqType: TNntpRequest; Error: Word);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ArticleByNumberButtonClick(Sender: TObject);
    procedure NntpCli1DataAvailable(Sender: TObject; Error: Word);
    procedure NntpCli1MessageLine(Sender: TObject);
    procedure NntpCli1MessageBegin(Sender: TObject);
    procedure NntpCli1MessageEnd(Sender: TObject);
    procedure ArticleByIDButtonClick(Sender: TObject);
    procedure NextButtonClick(Sender: TObject);
    procedure LastButtonClick(Sender: TObject);
    procedure HeadByIDButtonClick(Sender: TObject);
    procedure HeadByNumberButtonClick(Sender: TObject);
    procedure BodyByIDButtonClick(Sender: TObject);
    procedure BodyByNumberButtonClick(Sender: TObject);
    procedure StatByIDButtonClick(Sender: TObject);
    procedure StatByNumberButtonClick(Sender: TObject);
    procedure ListButtonClick(Sender: TObject);
    procedure PostButtonClick(Sender: TObject);
    procedure QuitButtonClick(Sender: TObject);
    procedure NewGroupsButtonClick(Sender: TObject);
    procedure NewNewsButtonClick(Sender: TObject);
    procedure HelpButtonClick(Sender: TObject);
    procedure XOverButtonClick(Sender: TObject);
    procedure OverViewFmtButtonClick(Sender: TObject);
    procedure DateButtonClick(Sender: TObject);
    procedure AuthenticateButtonClick(Sender: TObject);
    procedure ModeReaderButtonClick(Sender: TObject);
    procedure XHdrButtonClick(Sender: TObject);
    procedure NntpCli1XHdrBegin(Sender: TObject);
    procedure NntpCli1XHdrEnd(Sender: TObject);
    procedure NntpCli1XHdrLine(Sender: TObject);
  private
    FInitialized : Boolean;
    FDataStream  : TStream;
    function  GetStream : TStream;
    procedure Display(Msg : String);
    procedure LineToStream(Buf : String);
  end;

var
  NNTPForm: TNNTPForm;

implementation

{$R *.DFM}

{$IFNDEF VER80}
uses
    Registry;
{$ENDIF}


const
    IniFileName = 'NEWSRDR.INI';

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
function TrimRight(Str : String) : String;
var
    i : Integer;
begin
    i := Length(Str);
    while (i > 0) and (Str[i] = ' ') do
        i := i - 1;
    Result := Copy(Str, 1, i);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TrimLeft(Str : String) : String;
var
    i : Integer;
begin
    if Str[1] <> ' ' then
        Result := Str
    else begin
        i := 1;
        while (i <= Length(Str)) and (Str[i] = ' ') do
            i := i + 1;
        Result := Copy(Str, i, Length(Str) - i + 1);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Trim(Str : String) : String;
begin
    Result := TrimLeft(TrimRight(Str));
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNNTPForm.FormShow(Sender: TObject);
var
    IniFile  : TIniFile;
    EMail    : String;
    UserName : String;
{$IFNDEF VER80}
    Reg      : TRegistry;
    Key      : String;
{$ENDIF}
begin
    if FInitialized then
        Exit;
    FInitialized        := TRUE;

    EMail    := '[e-mail]';
    UserName := 'Your Name';

{$IFNDEF VER80}
    { Get username and EMail from the Internet Explorer settings }
    { Should add code for Netscape Navigator...                  }
    Reg          := TRegistry.Create;
    Reg.RootKey  := HKEY_CURRENT_USER;
    Key          := '\Software\Microsoft\Internet Mail and News\Mail';
    if Reg.OpenKey(Key, FALSE) then begin
        EMail    := Reg.ReadString('Sender EMail');
        UserName := Reg.ReadString('Sender Name');
    end;
    Reg.CloseKey;
    Reg.Free;
{$ENDIF}

    IniFile             := TIniFile.Create(IniFileName);
    Top                 := IniFile.ReadInteger('Window', 'Top',    Top);
    Left                := IniFile.ReadInteger('Window', 'Left',   Left);
    Width               := IniFile.ReadInteger('Window', 'Width',  Width);
    Height              := IniFile.ReadInteger('Window', 'Height', Height);
    ServerEdit.Text     := IniFile.ReadString('Data', 'Server', '');
    ArticleNumEdit.Text := IniFile.ReadString('Data', 'ArticleNum', '');
    ArticleIDEdit.Text  := IniFile.ReadString('Data', 'ArticleID', '');
    FileEdit.Text       := IniFile.ReadString('Data', 'File',   'nntprdr.txt');
    UserNameEdit.Text   := IniFile.ReadString('Data', 'UserName',  '');
    PasswordEdit.Text   := IniFile.ReadString('Data', 'Password',  '');
    UserEdit.Text       := IniFile.ReadString('Data', 'User',
                                              '"' + UserName + '" <' + EMail + '>');
    GroupEdit.Text      := IniFile.ReadString('Data', 'Group',
                                              'borland.public.delphi.thirdparty-tools');
    IniFile.Free;
    DisplayMemo.Clear;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNNTPForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
    IniFile : TIniFile;
begin
    IniFile := TIniFile.Create(IniFileName);
    IniFile.WriteString('Data',    'Server',  ServerEdit.Text);
    IniFile.WriteString('Data',    'Group',   GroupEdit.Text);
    IniFile.WriteString('Data',    'ArticleNum', ArticleNumEdit.Text);
    IniFile.WriteString('Data',    'ArticleID',  ArticleIDEdit.Text);
    IniFile.WriteString('Data',    'File',       FileEdit.Text);
    IniFile.WriteString('Data',    'User',       UserEdit.Text);
    IniFile.WriteString('Data',    'UserName',   UserNameEdit.Text);
    IniFile.WriteString('Data',    'Password',   PasswordEdit.Text);
    IniFile.WriteInteger('Window', 'Top',    Top);
    IniFile.WriteInteger('Window', 'Left',   Left);
    IniFile.WriteInteger('Window', 'Width',  Width);
    IniFile.WriteInteger('Window', 'Height', Height);
    IniFile.Free;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNNTPForm.Display(Msg : String);
begin
    { Limit the memo to 100 lines }
    while DisplayMemo.Lines.Count > 100 do
         DisplayMemo.Lines.Delete(1);
    DisplayMemo.Lines.Add(Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNNTPForm.NntpCli1SessionConnected(Sender: TObject; Error: Word);
begin
    AbortButton.Enabled := TRUE;
    Display('Connected, StatusCode = ' + IntToStr(NntpCli1.StatusCode));
    if NntpCli1.PostingPermited then
        Display('Posting permited')
    else
        Display('Posting not permited');
    Display(NntpCli1.LastResponse);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TNNTPForm.NntpCli1SessionClosed(Sender: TObject; Error: Word);
begin
    AbortButton.Enabled   := FALSE;
    ConnectButton.Enabled := TRUE;
    Display('Connection closed');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is called for each NNTP command when the command has   }
{ been exected (correctly or not).                                          }
procedure TNNTPForm.NntpCli1RequestDone(
    Sender: TObject;
    RqType: TNntpRequest;
    Error: Word);
begin
    Display('Request done. LastResponse = ' +
                          NntpCli1.LastResponse);

    if Error = 0 then
        Display('No error')
    else
        Display('Error #' + IntToStr(Error));

    case RqType of
    nntpConnect:
        begin
            if Error <> 0 then begin
                AbortButton.Enabled   := FALSE;
                ConnectButton.Enabled := TRUE;
                Display('Connect failed');
            end;
        end;
    nntpGroup:
        begin
            Display('ArticleEstimated = ' + IntToStr(NntpCli1.ArticleEstimated));
            Display('ArticleFirst     = ' + IntToStr(NntpCli1.ArticleFirst));
            Display('ArticleLast      = ' + IntToStr(NntpCli1.ArticleLast));
            ArticleNumEdit.Text := IntToStr(NntpCli1.ArticleFirst);
        end;
    nntpPost, nntpQuit, nntpAbort, nntpHelp, nntpNewGroups, nntpNewNews,
    nntpXOver, nntpListOverViewFmt, nntpAuthenticate, nntpModeReader,
    nntpXHdr:
        begin
            { Nothing to do }
        end;
    nntpDate:
        begin
            Display('Server Date is ' + DateTimeToStr(NntpCli1.ServerDate));
        end;
    nntpStatByNumber,    nntpStatByID,
    nntpHeadByNumber,    nntpHeadByID,
    nntpBodyByNumber,    nntpBodyByID,
    nntpArticleByNumber, nntpArticleByID,
    nntpNext,            nntpLast:
        begin
            Display('ArticleNumber    = ' +
                                  IntToStr(NntpCli1.ArticleNumber));
            Display('ArticleID        = ' +
                                  '<' + NntpCli1.ArticleID + '>');
            if Error = 0 then begin
                ArticleNumEdit.Text := IntToStr(NntpCli1.ArticleNumber);
                ArticleIDEdit.Text  := NntpCli1.ArticleID;
            end;
        end;
    else