46231 (588394), страница 2

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 2)

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;

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;

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;

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;

end;

procedure TMyFtp.FTPProtocolStateChanged(Sender: TObject;

ProtocolState: Smallint);

begin

case ProtocolState of

ftpAuthentication: FTP.Authenticate(UserName, Pwd);

ftpTransaction: FTP.List('/');

end;

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;

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;

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;

Характеристики

Список файлов ВКР