Разработка АРМ специалиста по сопровождению Интернет–представительства

{$R *.dfm}

procedure TfrmSelFTPDir_.tvSelectFTPDirChange(Sender: TObject;

Node: TTreeNode);

begin

PathStr_:=Node.Text;

end;

procedure TfrmSelFTPDir_.btnOKClick(Sender: TObject);

begin

ModalResult := mrOk

end;

procedure TfrmSelFTPDir_.btnCancelClick(Sender: TObject);

begin

ModalResult := mrCancel

end;

procedure TfrmSelFTPDir_.tvSelectFTPDirGetSelectedIndex(Sender: TObject;

Node: TTreeNode);

var DirPathStr: String;

CurrNode: TTreeNode;

begin

CurrNode := Node;

While CurrNode.Level<>0 do

begin

DirPathStr := '/' + CurrNode.Text + DirPathStr;

CurrNode := CurrNode.Parent;

end;

PathStr_ := DirPathStr + '/';

end;

procedure TfrmSelFTPDir_.FormShow(Sender: TObject);

Var

TreeNodes : TTreeNodes;

TreeNode : TTreeNode;

begin

if not frmMainForm_.nmftpMain.Connected then

Try

frmMainForm_.nmftpMain.Connect;

Except

MessageBox(0,PChar('Не удаётся подключиться к серверу "'+

frmMainForm_.nmftpMain.Host+'"'),

'Передача файлов',MB_OK+MB_ICONERROR+MB_TOPMOST);

Exit;

end;

frmMainForm_.nmftpMain.Mode(MODE_IMAGE);

TreeNodes:=tvSelectFTPDir.Items;

TreeNodes.Clear;

TreeNode:=TreeNodes.Add(Nil,'ftp://'+frmMainForm_.nmftpMain.Host+'/');

TreeNodes.AddChild(TreeNode,'Здесь пока ничего нет');

TreeNode.Expand(False)

end;

procedure TfrmSelFTPDir_.FormHide(Sender: TObject);

begin

frmMainForm_.nmftpMain.Disconnect;

end;

procedure TfrmSelFTPDir_.tvSelectFTPDirExpanded(Sender: TObject;

Node: TTreeNode);

Var

I : Integer;

TreeNodes : TTreeNodes;

Names : TStringList;

FTPDirectoryList : TFTPDirectoryList;

begin

If (Node.Count>0) and (CompareText(Node[0].Text,'Здесь пока ничего нет')=0) then

Node[0].Free

else Exit;

Try GoToDir(Node)

Except On FTPException do Exit end;

BuildFTPDirList;

FTPDirectoryList:=frmMainForm_.nmftpMain.FTPDirectoryList;

Names:=FTPDirectoryList.name;

TreeNodes:=tvSelectFTPDir.Items;

For I:=0 to Names.Count-1 do

If CompareText(FTPDirectoryList.Attribute[I][1],'D')=0 then

TreeNodes.AddChild(TreeNodes.AddChild(Node,Names[I]),'Здесь пока ничего '+

'нет')

end;

end.

unit Share_;

interface

Uses

ComCtrls, NMFTP, SysUtils, Classes, Windows;

type TCoding = (cDOS,cWindows);

Procedure GoToRoot(ANMFTP : TNMFTP);

Procedure GoToDir(ATreeNode : TTreeNode);

Procedure BuildFTPDirList;

Function Translate(S : String;AForServer : Boolean) : String;

implementation

uses Main_;

Procedure GoToRoot;

begin

Repeat

Try ANMFTP.ChangeDir('..') Except On FTPException do Exit end

Until CompareText('/',ANMFTP.CurrentDir)=0

end;

Procedure GoToDir;

Var

Folders : TStringList;

I : Integer;

TreeNode : TTreeNode;

begin

GoToRoot(frmMainForm_.nmftpMain);

Folders:=TStringList.Create;

Try

TreeNode:=ATreeNode;

While TreeNode.Level<>0 do

begin Folders.Add(TreeNode.Text); TreeNode:=TreeNode.Parent end;

For I:=Folders.Count-1 DownTo 0 do

frmMainForm_.nmftpMain.ChangeDir(Translate(Folders[I],True))

Finally Folders.Free

end

end;

Procedure BuildFTPDirList;

Var

NMFTP : TNMFTP;

S : PChar;

I,J,DOSChars,WindowsChars : Integer;

Names : TStringList;

Coding : TCoding;

FTPDirectoryList : TFTPDirectoryList;

Label

mlRetry;

begin

NMFTP:=frmMainForm_.nmftpMain;

NMFTP.List;

FTPDirectoryList:=NMFTP.FTPDirectoryList;

Names:=FTPDirectoryList.name;

mlRetry:

For I:=0 to Names.Count-1 do

begin

S:=PChar(Names[I]);

DOSChars:=0;

WindowsChars:=0;

For J:=0 to Length(S)-1 do

begin

If Ord(S[J]) in [128..175] then Inc(DOSChars);

If Ord(S[J]) in [192..223,242..255] then Inc(WindowsChars)

end;

If WindowsChars>DOSChars then Coding:=cWindows else Coding:=cDOS;

If Coding=cDOS then

begin

OEMToChar(S,S);

Names[I]:=S

end

end;

end;

Function Translate;

Var

C : PChar;

S0 : String;

Length,J,DOSChars,WindowsChars : Integer;

Coding : TCoding;

begin

Length:=System.Length(S);

SetLength(S0,Length);

Move(S[1],S0[1],Length);

C:=PChar(S0);

DOSChars:=0;

WindowsChars:=0;

For J:=0 to Length-1 do

begin

If Ord(S[J]) in [128..175] then Inc(DOSChars);

If Ord(S[J]) in [192..223,242..255] then Inc(WindowsChars)

end;

If WindowsChars>DOSChars then Coding:=cWindows else Coding:=cDOS;

If Coding=cDOS then OEMToChar(C,C);

Result:=C;

For J:=1 to Length do If Result[J]='\' then Result[J]:='/'

end;

end.

Размещено на Allbest.ru