Архитектура имитационной модели глобальной сети

⇐ ПредыдущаяСтр 6 из 6

Имитационная модель глобальной корпоративной сети имитирует пересылку пакета от одного компьютера к другому. При запуске программы на экране возникает схема сети, показанная на рисунке 8. Затем, при нажатии клавиши ENTER, программа переходит в текстовый режим с UNIX-подобным интерфейсом, запрашивая пользователя адрес получателя, адрес отправителя, и данные типа “String”.

Затем каждый компьютер или маршрутизатор, по которому проходит пакет, выводит на экран сообщение о приеме и дальнейшей отправке пакета адресату и время, в которое он получил и отправил пакет. Оптимальный маршрут рассчитывается на основе усовершенствованного алгоритма Форда-Беллмана.

Программа написана на языке Object Pascal 7.0.

Рис.8. Схема глобальной корпоративной сети.

Основные процедуры имитационной модели

Типы данных и переменные основной подпрограммы:

const AdjacencyMatrix: array[1..VertexQuantity, 1..VertexQuantity] of byte =(

(0, 1, 0, 1, 0, 0, 0),

(1, 1, 1, 0, 1, 0, 1),

(0, 1, 0, 1, 0, 0, 0),

(1, 0, 1, 0, 1, 0, 0),

(0, 1, 0, 0, 1, 1, 0),

(0, 0, 0, 0, 1, 0, 1),

(0, 1, 0, 0, 0, 1, 0) ) – матрица смежности маршрутизаторов;

TYPE TAddr = record

router: byte;

domain: byte;

comp: byte;

END - адрес компьютера, состоящий из номера маршрутизатора, номера области данного маршрутизатора и номера компьютера в этой области;

TYPE TBatch = record

from: TAddr;

to_: TAddr;

data: string;

path: array[1..20] of byte; {path is chain of router numbers}

END – пакет, состоящий из адреса отправителя, адреса получателя, данных и пути следования пакета;

TYPE TComp = object - модель компьютера, состоящая из адреса, ячейки памяти для

получения или пересылки пакета;

addr: TAddr;

mem: TBatch;

Procedure Send2Router(batch: TBatch) – процедура посылки пакета на маршрутизатор;

Procedure Send(batch: TBatch) – процедура посылки пакета внутри своей сети;

Procedure Receive(batch: TBatch; byRouter: boolean) – прием пакета;

END;

TYPE TRouter = object - модель маршрутизатора, состоящая из номера маршрутизатора,

его координат, и ячейки памяти;

num : byte;

x, y : integer;

memory: Tbatch;

state: boolean;

VAR computers: array[1..38] of TComp - массив компьютеров глобальной сети;

routers : array[1..7] of TRouter – массив маршрутизаторов;

OptimalPath: array[1..49] of byte – оптимальный путь, рассчитанный

маршрутизатором;

Procedure Receive(routerNum: byte; batch: TBatch) – прием пакета;

Procedure Send2Comp(batch: TBatch) – отправка пакета в своей сети;

Procedure CalcMinPath(sender, target: byte) – вычисление оптимального пути отправки;

Procedure Send2NextRouter(batch: TBatch; currentRouter: byte) – отправка на следующий

маршрутизатор;

END;

Заключение

В данной дипломной работе был получен следующий результат:

1.) Разработана модель сетевого броузера и корпоративной среды;

2.) Создана имитационная модель распределения информации в глобальных сетях.

3.) Написано соответствующее программное обеспечение – сетевой броузер с возможностью доступа как к WWW- протоколу, так и к сервису FTP, почтовому сервису SMTP, а также возможностью обмена символьной информацией между двумя компьютерами в ON-LINE режиме – CHAT и математическая модель корпоративной сети, имитирующая передачу информации в глобальной среде, в которой реализован разработанный усовершенствованный алгоритм поиска оптимального пути между маршрутизаторами.

Список литературы:

1. Блэк Ю. Сети ЭВМ: протоколы, стандарты, интерфейсы. М.: Мир, 1990. –506 с.

2. Донской В.И. Компьютерные сети и сетевые технологии.- Симферополь:

Таврида, 1999. – 135 с.

3. Калверт Ч. Delphi 4. Самоучитель. – К.: ДиаСофт, 1999. – 192 с.

4. Крамлиш К. Азбука Internet. К.: Юниор, 1998. –336 с.

5. Нанс Б. Компьютерные сети. М.: Бином, 1996. –400 с.

6. Нотон П., Шилдт Г. Полный справочник по Java. – К.: Диалектика, 1997. –450 с.

7. Сван Т. Delphi 4 – “Библия” разработчика. –К.: Диалектика, 1998. –500 с.

8. Яблонский С.В. Введение в дискретную математику. –М.: Наука, 1986. –384 с.

9. Журнал «Компьютерное Обозрение», N36 (109) ‘97, N44 (117) ‘97

Приложение 1. Исходный текст программы “броузер”

Файл main.pas

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, Buttons, ToolWin, Isp3;

const

CM_HOMEPAGEREQUEST = WM_USER + $1000;

type

TMainForm = class(TForm)

StatusBar1: TStatusBar;

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

View1: TMenuItem;

DocumentSource1: TMenuItem;

NavigatorImages: TImageList;

NavigatorHotImages: TImageList;

LinksImages: TImageList;

LinksHotImages: TImageList;

CoolBar1: TCoolBar;

ToolBar1: TToolBar;

BackBtn: TToolButton;

ForwardBtn: TToolButton;

StopBtn: TToolButton;

RefreshBtn: TToolButton;

URLs: TComboBox;

HTML1: THTML;

Help1: TMenuItem;

About1: TMenuItem;

N1: TMenuItem;

Toolbar3: TMenuItem;

Statusbar2: TMenuItem;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

ToolButton3: TToolButton;

ToolButton4: TToolButton;

ToolButton9: TToolButton;

SpeedButton1: TSpeedButton;

Animate1: TAnimate;

procedure Exit1Click(Sender: TObject);

procedure About1Click(Sender: TObject);

procedure DocumentSource1Click(Sender: TObject);

procedure StopBtnClick(Sender: TObject);

procedure HTML1BeginRetrieval(Sender: TObject);

procedure HTML1EndRetrieval(Sender: TObject);

procedure URLsKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure FormCreate(Sender: TObject);

procedure LinksClick(Sender: TObject);

procedure RefreshBtnClick(Sender: TObject);

procedure BackBtnClick(Sender: TObject);

procedure ForwardBtnClick(Sender: TObject);

procedure HTML1DoRequestDoc(Sender: TObject; const URL: WideString;

const Element: HTMLElement; const DocInput: DocInput;

var EnableDefault: WordBool);

procedure FormDestroy(Sender: TObject);

procedure URLsClick(Sender: TObject);

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure Toolbar3Click(Sender: TObject);

procedure Statusbar2Click(Sender: TObject);

procedure ToolButton2Click(Sender: TObject);

procedure ToolButton3Click(Sender: TObject);

procedure ToolButton4Click(Sender: TObject);

procedure ToolButton9Click(Sender: TObject);

private

HistoryIndex: Integer;

HistoryList: TStringList;

UpdateCombo: Boolean;

procedure FindAddress;

procedure HomePageRequest(var message: tmessage); message CM_HOMEPAGEREQUEST;

end;

var

MainForm: TMainForm;

implementation

uses DocSrc, About, SMTP, FTP, NNTP, CHAT;

{$R *.DFM}

procedure TMainForm.Exit1Click(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FindAddress;

begin

HTML1.RequestDoc(URLs.Text);

end;

procedure TMainForm.About1Click(Sender: TObject);

begin

ShowAboutBox;

end;

procedure TMainForm.DocumentSource1Click(Sender: TObject);

begin

with DocSourceFrm do

begin

Show;

Memo1.Lines.Clear;

Memo1.Lines.Add(AdjustLineBreaks(HTML1.SourceText));

Memo1.SelStart: = 0;

SendMessage(Memo1.Handle, EM_ScrollCaret, 0, 0);

end;

procedure TMainForm.StopBtnClick(Sender: TObject);

begin

HTML1.Cancel('Cancel');

HTML1EndRetrieval(nil);

end;

procedure TMainForm.HTML1BeginRetrieval(Sender: TObject);

begin

{ Turn the stop button dark red }

StopBtn.ImageIndex: = 4;

{ Play the avi from the first frame indefinitely }

Animate1.Active: = True;

end;

procedure TMainForm.HTML1EndRetrieval(Sender: TObject);

begin

{ Turn the stop button grey }

StopBtn.ImageIndex: = 2;

{ Stop the avi and show the first frame }

Animate1.Active: = False;

end;

procedure TMainForm.URLsKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key = VK_Return then

begin

UpdateCombo: = True;

FindAddress;

end;

procedure TMainForm.URLsClick(Sender: TObject);

begin

UpdateCombo: = True;

FindAddress;

end;

procedure TMainForm.LinksClick(Sender: TObject);

begin

if (Sender as TToolButton).Hint = '' then Exit;

URLs.Text: = (Sender as TToolButton).Hint;

FindAddress;

end;

procedure TMainForm.RefreshBtnClick(Sender: TObject);

begin

FindAddress;

end;

procedure TMainForm.BackBtnClick(Sender: TObject);

begin

URLs.Text: = HistoryList[HistoryIndex - 1];

FindAddress;

end;

procedure TMainForm.ForwardBtnClick(Sender: TObject);

begin

URLs.Text: = HistoryList[HistoryIndex + 1];

FindAddress;

end;

procedure TMainForm.HTML1DoRequestDoc(Sender: TObject;

const URL: WideString; const Element: HTMLElement;

const DocInput: DocInput; var EnableDefault: WordBool);

var

NewIndex: Integer;

begin

NewIndex: = HistoryList.IndexOf(URL);

if NewIndex = -1 then

begin

{ Remove entries in HistoryList between last address and current address }

if (HistoryIndex > = 0) and (HistoryIndex < HistoryList.Count - 1) then

while HistoryList.Count > HistoryIndex do

HistoryList.Delete(HistoryIndex);

HistoryIndex: = HistoryList.Add(URL);

end

else

HistoryIndex: = NewIndex;

if HistoryList.Count > 0 then

begin

ForwardBtn.Enabled: = HistoryIndex < HistoryList.Count - 1;

BackBtn.Enabled: = HistoryIndex > 0;

end

else

begin

ForwardBtn.Enabled: = False;

BackBtn.Enabled: = False;

end;

if UpdateCombo then

begin

UpdateCombo: = False;

NewIndex: = URLs.Items.IndexOf(URL);

if NewIndex = -1 then

URLs.Items.Insert(0, URL)

else

URLs.Items.Move(NewIndex, 0);

end;

URLs.Text: = URL;

Statusbar1.Panels[0].Text: = URL;

end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Shift = [ssAlt] then

if (Key = VK_RIGHT) and ForwardBtn.Enabled then

ForwardBtn.Click

else if (Key = VK_LEFT) and BackBtn.Enabled then

BackBtn.Click;

end;

procedure TMainForm.Toolbar3Click(Sender: TObject);

begin

with Sender as TMenuItem do

begin

Checked: = not Checked;

Coolbar1.Visible: = Checked;

end;

procedure TMainForm.Statusbar2Click(Sender: TObject);

begin

with Sender as TMenuItem do

begin

Checked: = not Checked;

StatusBar1.Visible: = Checked;

end;

procedure TMainForm.HomePageRequest(var Message: TMessage);

begin

URLs.Text: = 'http: //www.altavista.com';

UpdateCombo: = True;

FindAddress;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

HistoryIndex: = -1;

HistoryList: = TStringList.Create;

{ Load the animation from the AVI file in the startup directory. An

alternative to this would be to create a.RES file including the cool.avi

as an AVI resource and use the ResName or ResId properties of Animate1 to

point to it. }

Animate1.FileName: = ExtractFilePath(Application.ExeName) + 'cool.avi';

{ Find the home page - needs to be posted because HTML control hasn't been

registered yet. }

PostMessage(Handle, CM_HOMEPAGEREQUEST, 0, 0);

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

HistoryList.Free;

end;

procedure TMainForm.ToolButton2Click(Sender: TObject);

begin

TMail.create(Application).showmodal;

end;

procedure TMainForm.ToolButton3Click(Sender: TObject);

begin

TMyFtp.create(Application).showmodal;

end;

procedure TMainForm.ToolButton4Click(Sender: TObject);

begin

TNewsForm.create(Application).showmodal;

end;

procedure TMainForm.ToolButton9Click(Sender: TObject);

begin

TChatForm.create(Application).showmodal;

end;

end.

Файл chat.pas

unit chat;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls;

type

TChatForm = class(TForm)

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

FileConnectItem: TMenuItem;

FileListenItem: TMenuItem;

StatusBar1: TStatusBar;

Bevel1: TBevel;

Panel1: TPanel;

Memo1: TMemo;

Memo2: TMemo;

N1: TMenuItem;

SpeedButton1: TSpeedButton;

Disconnect1: TMenuItem;

ServerSocket: TServerSocket;

ClientSocket: TClientSocket;

procedure FileListenItemClick(Sender: TObject);

procedure FileConnectItemClick(Sender: TObject);

procedure Exit1Click(Sender: TObject);

procedure Memo1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure FormCreate(Sender: TObject);

procedure ServerSocketError(Sender: TObject; Number: Smallint;

var Description: string; Scode: Integer; const Source,

HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);

procedure Disconnect1Click(Sender: TObject);

procedure ClientSocketConnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);

procedure ServerSocketClientRead(Sender: TObject;

Socket: TCustomWinSocket);

procedure ServerSocketAccept(Sender: TObject;

Socket: TCustomWinSocket);

procedure ServerSocketClientConnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ClientSocketDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;

ErrorEvent: TErrorEvent; var ErrorCode: Integer);

procedure ServerSocketClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

protected

IsServer: Boolean;

end;

var

ChatForm: TChatForm;

Server: String;

implementation

{$R *.DFM}

procedure TChatForm.FileListenItemClick(Sender: TObject);

begin

FileListenItem.Checked: = not FileListenItem.Checked;

if FileListenItem.Checked then

begin

ClientSocket.Active: = False;

ServerSocket.Active: = True;

Statusbar1.Panels[0].Text: = 'Listening...'

end

else

begin

if ServerSocket.Active then

ServerSocket.Active: = False;

Statusbar1.Panels[0].Text: = '';

end;

procedure TChatForm.FileConnectItemClick(Sender: TObject);

begin

if ClientSocket.Active then ClientSocket.Active: = False;

if InputQuery('Computer to connect to', 'Address Name: ', Server) then

if Length(Server) > 0 then

with ClientSocket do

begin

Host: = Server;

Active: = True;

end;

procedure TChatForm.Exit1Click(Sender: TObject);

begin

ServerSocket.Close;

ClientSocket.Close;

Close;

end;

procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key = VK_Return then

if IsServer then

ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count - 1])

else

ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]);

end;

procedure TChatForm.FormCreate(Sender: TObject);

begin

FileListenItemClick(nil);

end;

procedure TChatForm.ServerSocketError(Sender: TObject; Number: Smallint;

var Description: string; Scode: Integer; const Source, HelpFile: string;

HelpContext: Integer; var CancelDisplay: Wordbool);

begin

ShowMessage(Description);

end;

procedure TChatForm.Disconnect1Click(Sender: TObject);

begin

ClientSocket.Close;

FileListenItemClick(nil);

end;

procedure TChatForm.ClientSocketConnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

Statusbar1.Panels[0].Text: = 'Connected to: ' + Socket.RemoteHost;

end;

procedure TChatForm.ClientSocketRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Add(Socket.ReceiveText);

end;

procedure TChatForm.ServerSocketClientRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Add(Socket.ReceiveText);

end;

procedure TChatForm.ServerSocketAccept(Sender: TObject;

Socket: TCustomWinSocket);

begin

IsServer: = True;

Statusbar1.Panels[0].Text: = 'Connected to: ' + Socket.RemoteAddress;

end;

procedure TChatForm.ServerSocketClientConnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Clear;

end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

FileListenItemClick(nil);

end;

procedure TChatForm.ClientSocketError(Sender: TObject;

Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;

var ErrorCode: Integer);

begin

Memo2.Lines.Add('Error connecting to: ' + Server);

ErrorCode: = 0;

end;

procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ServerSocket.Active: = False;

FileListenItem.Checked: = not FileListenItem.Checked;

FileListenItemClick(nil);

end;

end.

Файл ftp.pas

unit ftp;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Buttons, StdCtrls, ComCtrls, OleCtrls, Menus, ExtCtrls, isp3;

const

FTPServer = 0;

Folder = 1;

OpenFolder = 2;

type

TMyFtp = class(TForm)

Bevel1: TBevel;

Panel1: TPanel;

Panel2: TPanel;

Panel3: TPanel;

StatusBar: TStatusBar;

FileList: TListView;

DirTree: TTreeView;

ConnectBtn: TSpeedButton;

FTP: TFTP;

RefreshBtn: TSpeedButton;

MainMenu1: TMainMenu;

FileMenu: TMenuItem;

FileNewItem: TMenuItem;

FileDeleteItem: TMenuItem;

FileRenameItem: TMenuItem;

N2: TMenuItem;

FileExitItem: TMenuItem;

View1: TMenuItem;

ViewLargeItem: TMenuItem;

ViewSmallItem: TMenuItem;

ViewListItem: TMenuItem;

ViewDetailsItem: TMenuItem;

N1: TMenuItem;

ViewRefreshItem: TMenuItem;

FilePopup: TPopupMenu;

DeleteItem: TMenuItem;

RenameItem: TMenuItem;

CopyItem: TMenuItem;

Bevel2: TBevel;

Label1: TLabel;

Bevel3: TBevel;

Bevel5: TBevel;

Label2: TLabel;

SaveDialog1: TSaveDialog;

CopyButton: TSpeedButton;

LargeBtn: TSpeedButton;

SmallBtn: TSpeedButton;

ListBtn: TSpeedButton;

DetailsBtn: TSpeedButton;

Tools1: TMenuItem;

ToolsConnectItem: TMenuItem;

ToolsDisconnectItem: TMenuItem;

FileCopyItem: TMenuItem;

PasteFromItem: TMenuItem;

OpenDialog1: TOpenDialog;

SmallImages: TImageList;

procedure ConnectBtnClick(Sender: TObject);

procedure FTPProtocolStateChanged(Sender: TObject;

ProtocolState: Smallint);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormCreate(Sender: TObject);

procedure FTPBusy(Sender: TObject; isBusy: Wordbool);

procedure DirTreeChange(Sender: TObject; Node: TTreeNode);

procedure RefreshBtnClick(Sender: TObject);

procedure DirTreeChanging(Sender: TObject; Node: TTreeNode;

var AllowChange: Boolean);

procedure FTPStateChanged(Sender: TObject; State: Smallint);

procedure Open1Click(Sender: TObject);

procedure FileExitItemClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure ViewLargeItemClick(Sender: TObject);

procedure ViewSmallItemClick(Sender: TObject);

procedure ViewListItemClick(Sender: TObject);

procedure ViewDetailsItemClick(Sender: TObject);

procedure ViewRefreshItemClick(Sender: TObject);

procedure CopyItemClick(Sender: TObject);

procedure ToolsDisconnectItemClick(Sender: TObject);

procedure FileNewItemClick(Sender: TObject);

procedure DeleteItemClick(Sender: TObject);

procedure PasteFromItemClick(Sender: TObject);

procedure FilePopupPopup(Sender: TObject);

procedure FileMenuClick(Sender: TObject);

procedure FileDeleteItemClick(Sender: TObject);

procedure FTPListItem(Sender: TObject; const Item: FTPDirItem);

private

Root: TTreeNode;

function CreateItem(const FileName, Attributes, Size, Date: Variant): TListItem;

procedure Disconnect;

public

function NodePath(Node: TTreeNode): String;

end;

var

Myftp: TMyFtp;

UserName,

Pwd: String;

implementation

{$R *.DFM}

uses ShellAPI, UsrInfo;

function FixCase(Path: String): String;

var

OrdValue: byte;

begin

if Length(Path) = 0 then exit;

OrdValue: = Ord(Path[1]);

if (OrdValue > = Ord('a')) and (OrdValue < = Ord('z')) then

Result: = Path

else

begin

Result: = AnsiLowerCaseFileName(Path);

Result[1]: = UpCase(Result[1]);

end;

procedure TMyFtp.ConnectBtnClick(Sender: TObject);

begin

if FTP.State = prcConnected then

Disconnect;

ConnectForm: = TConnectForm.Create(Self);

try

if ConnectForm.ShowModal = mrOk then

with FTP, ConnectForm do

begin

UserName: = UserNameEdit.Text;

Pwd: = PasswordEdit.Text;

RemoteHost: = RemoteHostEdit.Text;

RemotePort: = StrToInt(RemotePortEdit.Text);

Connect(RemoteHost, RemotePort);

Root: = DirTree.Items.AddChild(nil, RemoteHost);

Root.ImageIndex: = FTPServer;

Root.SelectedIndex: = FTPServer;

DirTree.Selected: = Root;

end;

finally

ConnectForm.Free;

end;

procedure TMyFtp.FTPProtocolStateChanged(Sender: TObject;

ProtocolState: Smallint);

begin

case ProtocolState of

ftpAuthentication: FTP.Authenticate(UserName, Pwd);

ftpTransaction: FTP.List('/');

end;

procedure TMyFtp.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if FTP.Busy then

begin

FTP.Cancel;

FTP.Quit;

while FTP.Busy do

Application.ProcessMessages;

end;

function TMyFtp.CreateItem(const FileName, Attributes, Size, Date: Variant): TListItem;

var

Ext: String;

ShFileInfo: TSHFILEINFO;

begin

Result: = FileList.Items.Add;

with Result do

begin

Caption: = FixCase(Trim(FileName));

if Size > 0 then

begin

if Size div 1024 < > 0 then

begin

SubItems.Add(IntToStr(Size div 1024));

SubItems[0]: = SubItems[0] + 'KB';

end

else

SubItems.Add(Size);

end

else

SubItems.Add('');

if Attributes = '1' then

begin

SubItems.Add('File Folder');

ImageIndex: = 3;

end

else

begin

Ext: = ExtractFileExt(FileName);

ShGetFileInfo(PChar('c: \*' + Ext), 0, SHFileInfo, SizeOf(SHFileInfo),

SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME);

if Length(SHFileInfo.szTypeName) = 0 then

begin

if Length(Ext) > 0 then

begin

System.Delete(Ext, 1, 1);

SubItems.Add(Ext + ' File');

end

else

SubItems.Add('File');

end

else

SubItems.Add(SHFileInfo.szTypeName);

ImageIndex: = SHFileInfo.iIcon;

end;

SubItems.Add(Date);

end;

procedure TMyFtp.Disconnect;

begin

FTP.Quit;

Application.ProcessMessages;

end;

procedure TMyFtp.FormCreate(Sender: TObject);

var

SHFileInfo: TSHFileInfo;

begin

with DirTree do

begin

DirTree.Images: = SmallImages;

SmallImages.ResourceLoad(rtBitmap, 'IMAGES', clOlive);

end;

with FileList do

begin

SmallImages: = TImageList.CreateSize(16, 16);

SmallImages.ShareImages: = True;

SmallImages.Handle: = ShGetFileInfo('*.*', 0, SHFileInfo,

SizeOf(SHFileInfo), SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

LargeImages: = TImageList.Create(nil);

LargeImages.ShareImages: = True;

LargeImages.Handle: = ShGetFileInfo('*.*', 0, SHFileInfo,

SizeOf(SHFileInfo), SHGFI_LARGEICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

end;

procedure TMyFtp.FTPBusy(Sender: TObject; isBusy: Wordbool);

begin

if isBusy then

begin

Screen.Cursor: = crHourGlass;

FileList.Items.BeginUpdate;

FileList.Items.Clear;

end

else

begin

Screen.Cursor: = crDefault;

FileList.Items.EndUpdate;

end;

function TMyFtp.NodePath(Node: TTreeNode): String;

begin

if Node = Root then

Result: = '.'

else

Result: = NodePath(Node.Parent) + '/' + Node.Text;

end;

procedure TMyFtp.DirTreeChange(Sender: TObject; Node: TTreeNode);

var

NP: String;

begin

if (FTP.State < > prcConnected) or FTP.Busy then exit;

if Node < > nil then

begin

NP: = NodePath(DirTree.Selected);

FTP.List(NP);

Label2.Caption: = Format('Contents of: ''%s/''', [NP]);

end;

procedure TMyFtp.RefreshBtnClick(Sender: TObject);

begin

FTP.List(NodePath(DirTree.Selected));

end;

procedure TMyFtp.DirTreeChanging(Sender: TObject; Node: TTreeNode;

var AllowChange: Boolean);

begin

AllowChange: = not FTP.Busy;

end;

procedure TMyFtp.FTPStateChanged(Sender: TObject; State: Smallint);

begin

with FTP, Statusbar.Panels[0] do

case State of

prcConnecting: Text: = 'Connecting';

prcResolvingHost: Text: = 'Connecting';

prcHostResolved: Text: = 'Host resolved';

prcConnected:

begin

Text: = 'Connected to: ' + RemoteHost;

ConnectBtn.Hint: = 'Disconnect';

FileNewItem.Enabled: = True;

ViewLargeItem.Enabled: = True;

ViewSmallItem.Enabled: = True;

ViewListItem.Enabled: = True;

ViewDetailsItem.Enabled: = True;

ViewRefreshItem.Enabled: = True;

ToolsDisconnectItem.Enabled: = True;

LargeBtn.Enabled: = True;

SmallBtn.Enabled: = True;

ListBtn.Enabled: = True;

DetailsBtn.Enabled: = True;

RefreshBtn.Enabled: = True;

end;

prcDisconnecting: Text: = 'Disconnecting';

prcDisconnected:

begin

Text: = 'Disconnected';

ConnectBtn.Hint: = 'Connect';

DirTree.Items.Clear;

FileNewItem.Enabled: = False;

ViewLargeItem.Enabled: = False;

ViewSmallItem.Enabled: = False;

ViewListItem.Enabled: = False;

ViewDetailsItem.Enabled: = False;

ViewRefreshItem.Enabled: = False;

ToolsDisconnectItem.Enabled: = False;

LargeBtn.Enabled: = False;

SmallBtn.Enabled: = False;

ListBtn.Enabled: = False;

DetailsBtn.Enabled: = False;

RefreshBtn.Enabled: = False;

end;

procedure TMyFtp.Open1Click(Sender: TObject);

begin

FTP.Quit;

DirTree.Items.BeginUpdate;

try

DirTree.Items.Clear;

finally

DirTree.Items.EndUpdate;

end;

procedure TMyFtp.FileExitItemClick(Sender: TObject);

begin

Close;

end;

procedure TMyFtp.FormResize(Sender: TObject);

begin

Statusbar.Panels[0].Width: = Width - 150;

end;

procedure TMyFtp.ViewLargeItemClick(Sender: TObject);

begin

FileList.ViewStyle: = vsIcon;

end;

procedure TMyFtp.ViewSmallItemClick(Sender: TObject);

begin

FileList.ViewStyle: = vsSmallIcon;

end;

procedure TMyFtp.ViewListItemClick(Sender: TObject);

begin

FileList.ViewStyle: = vsList;

end;

procedure TMyFtp.ViewDetailsItemClick(Sender: TObject);

begin

FileList.ViewStyle: = vsReport;

end;

procedure TMyFtp.ViewRefreshItemClick(Sender: TObject);

begin

DirTreeChange(nil, DirTree.Selected);

end;

procedure TMyFtp.CopyItemClick(Sender: TObject);

begin

SaveDialog1.FileName: = FileList.Selected.Caption;

if SaveDialog1.Execute then

FTP.GetFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption,

SaveDialog1.FileName);

end;

procedure TMyFtp.ToolsDisconnectItemClick(Sender: TObject);

begin

DisConnect;

end;

procedure TMyFtp.FileNewItemClick(Sender: TObject);

var

DirName: String;

begin

if InputQuery('Input Box', 'Prompt', DirName) then

FTP.CreateDir(NodePath(DirTree.Selected) + '/' + DirName);

end;

procedure TMyFtp.DeleteItemClick(Sender: TObject);

begin

if ActiveControl = DirTree then

FTP.DeleteDir(NodePath(DirTree.Selected));

if ActiveControl = FileList then

FTP.DeleteFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption);

end;

procedure TMyFtp.PasteFromItemClick(Sender: TObject);

begin

if OpenDialog1.Execute then

FTP.PutFile(OpenDialog1.FileName, NodePath(DirTree.Selected));

end;

procedure TMyFtp.FilePopupPopup(Sender: TObject);

begin

CopyItem.Enabled: = (ActiveControl = FileList) and (FileList.Selected < > nil);

PasteFromItem.Enabled: = (ActiveControl = DirTree) and (DirTree.Selected < > nil);

DeleteItem.Enabled: = (ActiveControl = FileList) and (FileList.Selected < > nil);

RenameItem.Enabled: = (ActiveControl = FileList) and (FileList.Selected < > nil);

end;

procedure TMyFtp.FileMenuClick(Sender: TObject);

begin

FileCopyItem.Enabled: = (ActiveControl = FileList) and (FileList.Selected < > nil);

FileDeleteItem.Enabled: = (ActiveControl = FileList) and (FileList.Selected < > nil);

FileRenameItem.Enabled: = (ActiveControl = FileList) and (FileList.Selected < > nil);

end;

procedure TMyFtp.FileDeleteItemClick(Sender: TObject);

begin

if (DirTree.Selected < > nil) and (FileList.Selected < > nil) then

FTP.DeleteFile(FileList.Selected.Caption);

end;

procedure TMyFtp.FTPListItem(Sender: TObject; const Item: FTPDirItem);

var

Node: TTreeNode;

begin

CreateItem(Item.FileName, Item.Attributes, Item.Size, Item.Date);

if Item.Attributes = 1 then

if DirTree.Selected < > nil then

begin

if DirTree.Selected < > nil then

Node: = DirTree.Selected.GetFirstChild

else

Node: = nil;

while Node < > nil do

if AnsiCompareFileName(Node.Text, Item.FileName) = 0 then

exit

else

Node: = DirTree.Selected.GetNextChild(Node);

if Node = nil then

begin

Node: = DirTree.Items.AddChild(DirTree.Selected,

Item.FileName);

Node.ImageIndex: = Folder;

Node.SelectedIndex: = OpenFolder;

end;

end

else

DirTree.Items.AddChild(Root, Item.FileName);

end;

end.

Файл nntp.pas

unit nntp;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Menus, OleCtrls, StdCtrls, ComCtrls, ExtCtrls, Buttons, ActiveX, isp3;

const

efListGroups = 0;

efGetArticleHeaders = 1;

efGetArticleNumbers = 2;

efGetArticle = 3;

type

TNewsForm = class(TForm)

NNTP1: TNNTP;

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

N1: TMenuItem;

FileDisconnectItem: TMenuItem;

FileConnectItem: TMenuItem;

Panel1: TPanel;

Bevel1: TBevel;

StatusBar: TStatusBar;

SmallImages: TImageList;

Panel2: TPanel;

NewsGroups: TTreeView;

Bevel2: TBevel;

Panel3: TPanel;

Memo1: TMemo;

Panel5: TPanel;

Panel4: TPanel;

ConnectBtn: TSpeedButton;

RefreshBtn: TSpeedButton;

Bevel3: TBevel;

MsgHeaders: TListBox;

Label1: TLabel;

Label2: TLabel;

procedure FileConnectItemClick(Sender: TObject);

procedure NNTP1ProtocolStateChanged(Sender: TObject;

ProtocolState: Smallint);

procedure NNTP1StateChanged(Sender: TObject; State: Smallint);

procedure Exit1Click(Sender: TObject);

procedure MsgHeadersDblClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure NewsGroupsChange(Sender: TObject; Node: TTreeNode);

procedure RefreshBtnClick(Sender: TObject);

procedure FileDisconnectItemClick(Sender: TObject);

procedure NNTP1Banner(Sender: TObject; const Banner: WideString);

procedure NNTP1DocOutput(Sender: TObject; const DocOutput: DocOutput);

procedure NNTP1Error(Sender: TObject; Number: Smallint;

var Description: WideString; Scode: Integer; const Source,

HelpFile: WideString; HelpContext: Integer;

var CancelDisplay: WordBool);

procedure NNTP1SelectGroup(Sender: TObject;

const groupName: WideString; firstMessage, lastMessage,

msgCount: Integer);

private

EventFlag: Integer;

function NodePath(Node: TTreeNode): String;

public

Data: String;

end;

var

NewsForm: TNewsForm;

Remainder: String;

Nodes: TStringList;

CurrentGroup: String;

GroupCount: Integer;

implementation

uses Connect;

{$R *.DFM}

{ TParser }

type

TToken = (etEnd, etSymbol, etName, etLiteral);

TParser = class

private

FFlags: Integer;

FText: string;

FSourcePtr: PChar;

FSourceLine: Integer;

FTokenPtr: PChar;

FTokenString: string;

FToken: TToken;

procedure SkipBlanks;

procedure NextToken;

public

constructor Create(const Text: string; Groups: Boolean);

end;

const

sfAllowSpaces = 1;

constructor TParser.Create(const Text: string; Groups: Boolean);

begin

FText: = Text;

FSourceLine: = 1;

FSourcePtr: = PChar(Text);

if Groups then

FFlags: = sfAllowSpaces

else

FFlags: = 0;

NextToken;

end;

procedure TParser.SkipBlanks;

begin

while True do

begin

case FSourcePtr^ of

#0:

begin

if FSourcePtr^ = #0 then Exit;

Continue;

end;

#10:

Inc(FSourceLine);

#33..#255:

Exit;

end;

Inc(FSourcePtr);

end;

procedure TParser.NextToken;

var

P, TokenStart: PChar;

begin

SkipBlanks;

FTokenString: = '';

P: = FSourcePtr;

while (P^ < > #0) and (P^ < = ' ') do Inc(P);

FTokenPtr: = P;

case P^ of

'0'..'9':

begin

TokenStart: = P;

Inc(P);

while P^ in ['0'..'9'] do Inc(P);

SetString(FTokenString, TokenStart, P - TokenStart);

FToken: = etLiteral;

end;

#13: Inc(FSourceLine);

#0:

FToken: = etEnd;

else

begin

TokenStart: = P;

Inc(P);

if FFlags = sfAllowSpaces then

while not (P^ in [#0, #13, ' ']) do Inc(P)

else

while not (P^ in [#0, #13]) do Inc(P);

SetString(FTokenString, TokenStart, P - TokenStart);

FToken: = etSymbol;

end;

FSourcePtr: = P;

end;

function FirstItem(var ItemList: ShortString): ShortString;

var

P: Integer;

begin

P: = AnsiPos('.', ItemList);

if P = 0 then

begin

Result: = ItemList;

P: = Length(ItemList);

end

else

Result: = Copy(ItemList, 1, P - 1);

Delete(ItemList, 1, P);

end;

procedure AddItem(GroupName: ShortString);

var

Index, i: Integer;

Groups: Integer;

Item: ShortString;

TheNodes: TStringList;

begin

Groups: = 1;

for i: = 0 to Length(GroupName) do

if GroupName[i] = '.' then

Inc(Groups);

TheNodes: = Nodes;

for i: = 0 to Groups - 1 do

begin

Item: = FirstItem(GroupName);

Index: = TheNodes.IndexOf(Item);

if Index = -1 then

begin

Index: = TheNodes.AddObject(Item, TStringList.Create);

TheNodes: = TStringList(TheNodes.Objects[Index]);

TheNodes.Sorted: = True;

end

else

TheNodes: = TStringList(TheNodes.Objects[Index]);

end;

Inc(GroupCount);

end;

procedure ParseGroups(Data: String);

var

Parser: TParser;

OldSrcLine: Integer;

begin

Parser: = TParser.Create(Data, True);

OldSrcLine: = 0;

while Parser.FToken < > etEnd do

begin

if Parser.FSourceLine < > OldSrcLine then

begin

AddItem(Parser.FTokenString);

OldSrcLine: = Parser.FSourceLine;

end;

Parser.NextToken;

end;

procedure ParseHeaders(Data: String);

var

Parser: TParser;

MsgNo: LongInt;

Header: String;

OldSrcLine: Integer;

begin

Parser: = TParser.Create(Data, False);

while Parser.FToken < > etEnd do

begin

MsgNo: = StrToInt(Parser.FTokenString);

OldSrcLine: = Parser.FSourceLine;

Parser.NextToken;

Header: = '';

while (OldSrcLine = Parser.FSourceLine) do

begin

Header: = Header + ' ' + Parser.FTokenString;

Parser.NextToken;

if Parser.FToken = etEnd then

Break;

end;

NewsForm.MsgHeaders.Items.AddObject(Header, Pointer(MsgNo));

end;

procedure DestroyList(AList: TStringList);

var

i: Integer;

begin

for i: = 0 to AList.Count - 1 do

if AList.Objects[i] < > nil then

DestroyList(TStringList(AList.Objects[i]));

AList.Free;

end;

procedure BuildTree(Parent: TTreeNode; List: TStrings);

var

i: Integer;

Node: TTreeNode;

begin

for i: = 0 to List.Count - 1 do

if List.Objects[i] < > nil then

begin

Node: = NewsForm.NewsGroups.Items.AddChild(Parent, List[i]);

Node.ImageIndex: = 0;

Node.SelectedIndex: = 1;

BuildTree(Node, TStrings(List.Objects[i]));

end

else

NewsForm.NewsGroups.Items.AddChild(Parent, List[i]);

end;

function TNewsForm.NodePath(Node: TTreeNode): String;

begin

if Node.Parent = nil then

Result: = Node.Text

else

Result: = NodePath(Node.Parent) + '.' + Node.Text;

end;

procedure TNewsForm.FileConnectItemClick(Sender: TObject);

begin

ConnectDlg: = TConnectDlg.Create(Self);

try

if ConnectDlg.ShowModal = mrOk then

with NNTP1 do

Connect(ConnectDlg.ServerEdit.Text, RemotePort);

finally

ConnectDlg.Free;

end;

procedure TNewsForm.NNTP1ProtocolStateChanged(Sender: TObject;

ProtocolState: Smallint);

begin

case ProtocolState of

nntpBase: ;

nntpTransaction:

begin

EventFlag: = efListGroups;

Nodes: = TStringList.Create;

Nodes.Sorted: = True;

NNTP1.ListGroups;

end;

procedure TNewsForm.NNTP1StateChanged(Sender: TObject; State: Smallint);

begin

with Memo1.Lines do

case NNTP1.State of

prcConnecting: Add('Connecting');

prcResolvingHost: Add('Resolving Host: ' + NNTP1.RemoteHost);

prcHostResolved: Add('Host resolved');

prcConnected:

begin

Add('Connected to: ' + NNTP1.RemoteHost);

Statusbar.Panels[0].Text: = 'Connected to: ' + NNTP1.RemoteHost;

ConnectBtn.Enabled: = False;

FileConnectItem.Enabled: = False;

RefreshBtn.Enabled: = True;

end;

prcDisconnecting: Text: = NNTP1.ReplyString;

prcDisconnected:

begin

Statusbar.Panels[0].Text: = 'Disconnected';

Caption: = 'News Reader';

Label1.Caption: = '';

ConnectBtn.Enabled: = True;

FileConnectItem.Enabled: = True;

RefreshBtn.Enabled: = False;

end;

procedure TNewsForm.Exit1Click(Sender: TObject);

begin

if NNTP1.State < > prcDisconnected then

begin

if NNTP1.Busy then NNTP1.Cancel;

NNTP1.Quit;

while NNTP1.State < > prcDisconnected do

Application.ProcessMessages;

end;

Close;

end;

procedure TNewsForm.MsgHeadersDblClick(Sender: TObject);

var

Article: Integer;

begin

if NNTP1.Busy then exit;

EventFlag: = efGetArticle;

Memo1.Clear;

if MsgHeaders.ItemIndex = -1 then exit;

Caption: = 'News Reader: ' + MsgHeaders.Items[MsgHeaders.ItemIndex];

Article: = Integer(MsgHeaders.Items.Objects[MsgHeaders.ItemIndex]);

NNTP1.GetArticlebyArticleNumber(Article);

end;

procedure TNewsForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if NNTP1.State < > prcDisconnected then

begin

if NNTP1.Busy then NNTP1.Cancel;

NNTP1.Quit;

while NNTP1.State < > prcDisconnected do

Application.ProcessMessages;

end;

procedure TNewsForm.NewsGroupsChange(Sender: TObject; Node: TTreeNode);

var

NP: String;

begin

if (NNTP1.State = prcConnected) and not NNTP1.Busy then

with MsgHeaders do

begin

Items.BeginUpdate;

try

Items.Clear;

Memo1.Lines.Clear;

NP: = NodePath(NewsGroups.Selected);

Statusbar.Panels[2].Text: = 'Bytes: 0';

Statusbar.Panels[1].Text: = '0 Article(s)';

if NNTP1.Busy then

NNTP1.Cancel;

NNTP1.SelectGroup(NP);

Label1.Caption: = 'Contents of ''' + NP + '''';

finally

Items.EndUpdate;

end;

procedure TNewsForm.RefreshBtnClick(Sender: TObject);

begin

if NewsGroups.Selected < > nil then

NewsGroupsChange(nil, NewsGroups.Selected);

end;

procedure TNewsForm.FileDisconnectItemClick(Sender: TObject);

begin

if NNTP1.Busy then NNTP1.Cancel;

NNTP1.Quit;

while NNTP1.Busy do

Application.ProcessMessages;

with NewsGroups.Items do

begin

BeginUpdate;

Clear;

EndUpdate;

end;

MsgHeaders.Items.Clear;

Memo1.Lines.Clear;

end;

procedure TNewsForm.NNTP1Banner(Sender: TObject; const Banner: WideString);

begin

Memo1.Lines.Add(Banner);

end;

procedure TNewsForm.NNTP1DocOutput(Sender: TObject;

const DocOutput: DocOutput);

begin

Statusbar.Panels[2].Text: = Format('Bytes: %d', [DocOutput.BytesTransferred]);

case DocOutput.State of

icDocBegin:

begin

if EventFlag = efListGroups then

Memo1.Lines.Add('Retrieving news groups...');

Data: = '';

GroupCount: = 0;

end;

icDocData:

begin

Data: = Data + DocOutput.DataString;

if EventFlag = efGetArticle then

Memo1.Lines.Add(Data);

end;

icDocEnd:

begin

case EventFlag of

efListGroups:

begin

ParseGroups(Data);

Memo1.Lines.Add('Done.'#13#10'Building news group tree...');

NewsGroups.Items.BeginUpdate;

try

BuildTree(nil, Nodes);

DestroyList(Nodes);

Statusbar.Panels[1].Text: = Format('%d Groups', [GroupCount]);

finally

NewsGroups.Items.EndUpdate;

Memo1.Lines.Add('Done.');

end;

efGetArticleHeaders: ParseHeaders(Data);

efGetArticle:

begin

Memo1.SelStart: = 0;

SendMessage(Memo1.Handle, EM_ScrollCaret, 0, 0);

end;

SetLength(Data, 0);

end;

Refresh;

end;

procedure TNewsForm.NNTP1Error(Sender: TObject; Number: Smallint;

var Description: WideString; Scode: Integer; const Source,

HelpFile: WideString; HelpContext: Integer; var CancelDisplay: WordBool);

begin

// MessageDlg(Description, mtError, [mbOk], 0);

end;

procedure TNewsForm.NNTP1SelectGroup(Sender: TObject;

const groupName: WideString; firstMessage, lastMessage,

msgCount: Integer);

begin

EventFlag: = efGetArticleHeaders;

Statusbar.Panels[1].Text: = Format('%d Article(s)', [msgCount]);

NNTP1.GetArticleHeaders('subject', FirstMessage, lastMessage);

end;

end.

Файл smtp.pas

unit Smtp;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,

StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, OleCtrls,

ISP3;

type

TMail = class(TForm)

OpenDialog: TOpenDialog;

SMTP1: TSMTP;

POP1: TPOP;

PageControl1: TPageControl;

SendPage: TTabSheet;

RecvPage: TTabSheet;

ConPage: TTabSheet;

Panel1: TPanel;

Label1: TLabel;

Label3: TLabel;

Label2: TLabel;

eTo: TEdit;

eCC: TEdit;

eSubject: TEdit;

SendBtn: TButton;

ClearBtn: TButton;

reMessageText: TRichEdit;

SMTPStatus: TStatusBar;

Panel3: TPanel;

mReadMessage: TMemo;

POPStatus: TStatusBar;

cbSendFile: TCheckBox;

GroupBox1: TGroupBox;

ePOPServer: TEdit;

Label6: TLabel;

Label5: TLabel;

eUserName: TEdit;

ePassword: TEdit;

Label4: TLabel;

GroupBox2: TGroupBox;

Label7: TLabel;

eSMTPServer: TEdit;

SMTPConnectBtn: TButton;

POPConnectBtn: TButton;

eHomeAddr: TEdit;

Label8: TLabel;

Panel2: TPanel;

Label9: TLabel;

lMessageCount: TLabel;

Label10: TLabel;

eCurMessage: TEdit;

udCurMessage: TUpDown;

ConnectStatus: TStatusBar;

procedure FormCreate(Sender: TObject);

procedure POP1StateChanged(Sender: TObject; State: Smallint);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure SMTP1StateChanged(Sender: TObject; State: Smallint);

procedure FormResize(Sender: TObject);

procedure ClearBtnClick(Sender: TObject);

procedure SMTP1Verify(Sender: TObject);

procedure SendBtnClick(Sender: TObject);

procedure POP1ProtocolStateChanged(Sender: TObject;

ProtocolState: Smallint);

procedure SMTPConnectBtnClick(Sender: TObject);

procedure POPConnectBtnClick(Sender: TObject);

procedure eSMTPServerChange(Sender: TObject);

procedure ePOPServerChange(Sender: TObject);

procedure cbSendFileClick(Sender: TObject);

procedure udCurMessageClick(Sender: TObject; Button: TUDBtnType);

procedure POP1RefreshMessageCount(Sender: TObject; Number: Integer);

procedure POP1DocOutput(Sender: TObject; const DocOutput: DocOutput);

procedure POP1Error(Sender: TObject; Number: Smallint;

var Description: WideString; Scode: Integer; const Source,

HelpFile: WideString; HelpContext: Integer;

var CancelDisplay: WordBool);

procedure SMTP1DocInput(Sender: TObject; const DocInput: DocInput);

procedure SMTP1Error(Sender: TObject; Number: Smallint;

var Description: WideString; Scode: Integer; const Source,

HelpFile: WideString; HelpContext: Integer;

var CancelDisplay: WordBool);

private

RecvVerified,

SMTPError,

POPError: Boolean;

FMessageCount: Integer;

procedure SendFile(Filename: string);

procedure SendMessage;

procedure CreateHeaders;

end;

var

Mail: TMail;

implementation

{$R *.DFM}

const

icDocBegin = 1;

icDocHeaders = 2;

icDocData = 3;

icDocEnd = 5;

{When calling a component method which maps onto an OLE call, NoParam substitutes

for an optional parameter. As an alternative to calling the component method, you

may access the component's OLEObject directly -

i.e., Component.OLEObject.MethodName(, Foo,, Bar)}

function NoParam: Variant;

begin

TVarData(Result).VType: = varError;

TVarData(Result).VError: = DISP_E_PARAMNOTFOUND;

end;

procedure TMail.FormCreate(Sender: TObject);

begin

SMTPError: = False;

POPError: = False;

FMessageCount: = 0;

end;

procedure TMail.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if POP1.State = prcConnected then POP1.Quit;

if SMTP1.State = prcConnected then SMTP1.Quit;

end;

procedure TMail.FormResize(Sender: TObject);

begin

SendBtn.Left: = ClientWidth - SendBtn.Width - 10;

ClearBtn.Left: = ClientWidth - ClearBtn.Width - 10;

cbSendFile.Left: = ClientWidth - cbSendFile.Width - 10;

eTo.Width: = SendBtn.Left - eTo.Left - 10;

eCC.Width: = SendBtn.Left - eCC.Left - 10;

eSubject.Width: = SendBtn.Left - eSubject.Left - 10;

end;

procedure TMail.ClearBtnClick(Sender: TObject);

begin

eTo.Text: = '';

eCC.Text: = '';

eSubject.Text: = '';

OpenDialog.Filename: = '';

reMessageText.Lines.Clear;

end;

procedure TMail.eSMTPServerChange(Sender: TObject);

begin

SMTPConnectBtn.Enabled: = (eSMTPServer.Text < > '') and (eHomeAddr.Text < > '');

end;

procedure TMail.ePOPServerChange(Sender: TObject);

begin

POPConnectBtn.Enabled: = (ePOPServer.Text < > '') and (eUsername.Text < > '')

and (ePassword.Text < > '');

end;

procedure TMail.cbSendFileClick(Sender: TObject);

begin

if cbSendFile.Checked then

begin

if OpenDialog.Execute then

cbSendFile.Caption: = cbSendFile.Caption + ': '+OpenDialog.Filename

else

cbSendFile.Checked: = False;

end

⇐ Предыдущая 1 2 3 4 56

Последнее изменение этой страницы: 2019-10-03; Просмотров: 174; Нарушение авторского права страницы