{$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('/');

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17