- Можно ли загадать желание, если сидишь между двумя программистами?
- Можно! Только глючить будет.
Продолжим разговор о реализации моего клиента и сервера. В этой статье я дам описание как получать список файлов и каталогов с заданной директории на сервере и как их показать в клиенте. Рассмотрим кусок кода моего сервера с http://www.danil.dp.ua/dtr_s13s.zip
Здесь вроде все понятно - устанавливаем текущий каталог, в случае ошибки, текущим каталогом будет C:\, и вызываем процу, которая описана в строчках с 2288 по 2330 ("dtr13_s.asm"):
; FilePath
MyFilePath PROC
; Обнуляем буфер отправки
invoke lstrcpy, addr BufStr0, addr NilStr
invoke rtrim, addr BufStr0, addr BufStr0
; В буфере отправки в начале ставим "[[[ListFile "
invoke lstrcat, addr BufStr0, addr ListFileStr02
invoke lstrcat, addr BufStr0, addr path
invoke lstrcat, addr BufStr0, addr ListFileStr3
invoke lstrlen, addr path
invoke lstrcpy, addr CommandStr3, addr path
invoke lstrcat, addr CommandStr3, addr wcs
; Вызываем FindFirstFile. Функция FindFirstFile находит ; первый файл или каталог в текущей директории. FindNextFile ; находит остальные. В случае ошибки или если файлы закончились,; в eax у нас INVALID_HANDLE_VALUE
invoke FindFirstFile, addr CommandStr3, addr Finfo
mov cmd, eax
.IF eax != INVALID_HANDLE_VALUE
; Запускаем цикл поиска файлов
.WHILE TRUE
invoke lstrcpy, addr CommandStr1, addr Finfo.cFileName
mov eax, Finfo.dwFileAttributes
and eax, FILE_ATTRIBUTE_DIRECTORY
; Если каталог, то выделяем
.IF (eax != 0)
invoke lstrcat, addr BufStr0, addr ListFileStr04
invoke lstrcat, addr BufStr0, addr CommandStr1
.ELSE
; Если файл то получаем размер
invoke lstrcat, addr BufStr0, addr CommandStr1
mov eax, Finfo.nFileSizeLow
invoke dwtoa, eax, addr CommandStr2
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr bkl
invoke lstrcat, addr BufStr0, addr CommandStr2
.ENDIF
; Добавляем строку в буфер отправки
invoke lstrcat, addr BufStr0, addr ListFileStr3
; Вызываем FindNextFile
invoke FindNextFile, cmd, addr Finfo
; Выходим если ошибка или файлы закончились
.BREAK .IF (eax == 0)
invoke lstrlen, addr BufStr0
; Выходим если достигли макс. размера буфера
.BREAK .IF (eax > 6400)
.ENDW
invoke FindClose, cmd
; Отправляем список файлов клиенту
invoke send,client,addr BufStr0,sizeof BufStr0,0
invoke Sleep,10
.ENDIF
ret
MyFilePath ENDP
Посмотрим в сервере участок кода, возвращающий список дисков в строках с 688 по 745:
Теперь о клиенте. От сервера мы можем получить список файлов и дисков. В начале стоит "[[[ListFile path_#13_..." или "[[[ListDrvr ..." соответственно. Потом идут строки с именами файлов, каталогов или дисков, разделенных символом с кодом 13. Теперь откроем наш клиент. В "Form1" в "ToolBar1" создадим кнопку и назвем ее "Файловый менеджер" и будет она называться "ToolButton2" (см. мои предыдущие статьи). Нажмем на нее 2 раза. В "Unit1.pas" запишем :
//Файловый менеджерprocedure TForm1.ToolButton2Click(Sender: TObject);
begin
Form3.Visible := true;
if Form3.WindowState = wsMinimized then
Form3.WindowState := wsNormal;
Form3.MyRefresh;
end;
По нажатию нашей кнопки у нас будет проявляться окно файлового менеджера. Создадим новую форму ("Form3"). Процедура "MyRefresh" будет объявлена в "Unit3.pas". На форме "Form3", создадим:
ToolBar1 (Win32)
панель управления;
ToolButton1
кнопка для обновить;
Edit1 (Standart)
текущий диск на сервере;
ListBox1 (Standart)
для списка файлов;
Button1 (Standart)
показать список зарегистр. на сервере дисков.
В свойстве "Sorted" "ListBox1" ставим "true". В "MaxLen " "Edit1" ставим 1. Выбираем собития "onChange" в "Edit1" (смена диска), "onDblClick" в "ListBox1" (сменить каталог), "onClick" в "ToolButton1" и "Button1" (обновить список файлов и вывести список дисков), "onCreat" в "Form3". Переходим в раздел кода "Unit3.pas":
unit Unit3;
interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ToolWin, ComCtrls;
type
TForm3 = class(TForm)
ToolBar1: TToolBar;
Edit1: TEdit;
Label1: TLabel;
ListBox1: TListBox;
Button1: TButton;
ToolButton1: TToolButton;
procedure FormCreate(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
private{ Private declarations }public{ Public declarations }//Получить список с сервераprocedure MyRefresh;
end;
var
Form3: TForm3;
// Переменные с текущим каталогом
DopNDir: string;
DopDDir: string;
implementationuses
Unit1;
{$R *.DFM}//При создании формыprocedure TForm3.FormCreate(Sender: TObject);
begin// Текущий каталог в начале - C:\
DopDDir := 'C:\';
DopNDir := 'C:\';
Form3.Edit1.Text := 'C';
end;
//Сменить дискprocedure TForm3.Edit1Change(Sender: TObject);
beginif trim(Form3.Edit1.Text) <> copy(DopNDir, 1, 1) thenbegin
DopNDir := trim(Form3.Edit1.Text) + ':\';
Form3.MyRefresh;
end;
end;
//Обновитьprocedure TForm3.ToolButton1Click(Sender: TObject);
begin
Form3.MyRefresh;
end;
//Получить список с сервераprocedure TForm3.MyRefresh;
begin
Form3.ListBox1.Items.Clear;
if Form1.ClientSocket1.Active then
Form1.ClientSocket1.Socket.SendText('ld ' + trim(DopNDir));
end;
// Войти в каталогprocedure TForm3.ListBox1DblClick(Sender: TObject);
var
DopS01, DopS02, DopS03: string;
I: Integer;
beginif (Form1.ClientSocket1.Active)and(Form3.ListBox1.Items.Count>0) thenbeginif (Form3.ListBox1.ItemIndex<2)and(length(trim(DopNDir))>3) thenbeginif length(DopNDir)>3 thenbegin// Если в начало дискаif Form3.ListBox1.ItemIndex = 0 then
Form1.ClientSocket1.Socket.SendText('ld ' + copy(DopNDir, 1, 3) + #0)
elsebegin// Если на каталог назад
DopS01 := trim(DopNDir);
DopS02 := '';
DopS03 := '';
I := 1;
repeat
DopS02 := DopS02 + DopS01[I];
if DopS01[I] = '\' thenbegin
DopS03 := DopS03 + DopS02;
DopS02 := '';
end;
inc(I);
until
I = length(DopS01);
Form1.ClientSocket1.Socket.SendText('ld '+trim(DopS03)+#0);
end;
end;
endelse// Если войти в каталогif copy(Form3.ListBox1.Items.Strings[Form3.ListBox1.ItemIndex], 1, 8) = ' DIR: ' then
Form1.ClientSocket1.Socket.SendText('ld '+trim(DopNDir)+trim(copy (Form3.ListBox1.Items.Strings[Form3.ListBox1.ItemIndex],9,length (Form3.ListBox1.Items.Strings[Form3.ListBox1.ItemIndex])-1))+'\'+#0);
end;
end;
// Показать список зарегистр. на сервере дисковprocedure TForm3.Button1Click(Sender: TObject);
begin
Form1.ClientSocket1.Socket.SendText('ld');
end;
end.
Переходим в раздел кода "Unit1.pas", находим процедуру обработки очереди "TRecvThread.CommandRecvThread". Для файлового менеджера перепишем ее так:
// обработка очередиprocedure TRecvThread.CommandRecvThread;
var
LstRdop: TLstRecv;
i: Integer;
DopS, Dop1, Dop2: string;
label
ex;
begin
LstRdop := LstRbeg;
if LstRdop <> nilthenbegintry
DopS := '';
DopS := LstRdop^.BufIn;
// Если в начале "[[[ListFile "if copy(DopS, 1, 12) = '[[[ListFile ' thenbegin
Form3.ListBox1.Items.Clear;
Form3.Enabled := false;
I := 13;
Dop1 := '';
// Получаем текущий каталогwhilenot(ord(DopS[I])<30) dobegin
Dop1 := Dop1 + DopS[I];
inc(I);
end;
inc(I);
DopNDir := Dop1;
// Пишем текущий диск
Form3.Edit1.Text := copy(Dop1,1,1);
// Получаем все, кроме "[[[ListFile " и текущего диска
Dop1 := copy(DopS, I, length(DopS) - I + 1);
// И пишем в "ListBox1"
Form3.ListBox1.Items.Text := Dop1;
if Form3.Visible thenbeginif Form3.WindowState = wsMinimized then
Form3.WindowState := wsNormal;
Form3.SetFocus;
Form3.ListBox1.SetFocus;
Form3.ListBox1.ItemIndex := 0;
end;
Form3.Enabled := true;
goto ex;
end;
// Если вначале "[[[ListDrvr "if copy(DopS, 1, 12) = '[[[ListDrvr ' thenbegin
I := 13;
Dop1 := '';
whilenot(ord(DopS[I]) < 30) dobegin
Dop1 := Dop1 + DopS[I];
inc(I);
end;
inc(I);
Dop2 := copy(DopS, I, length(DopS) - I + 1);
// Выводим окно со списком дисков
Application.MessageBox(PChar(Dop2), PChar(Dop1), mb_Ok + mb_IconAsterisk + mb_ApplModal);
goto ex;
end;
// Если не список файлов и дисковif trim(DopS) <> '' then
Form1.Memo1.Lines.Add(DopS + #13);
ex :
finallyif LstRDop^.Point <> nilthen
LstRbeg := LstRDop^.Point
else
LstRbeg := nil;
if LstRbeg = nilthen
LstRend := nil;
Dispose(LstRdop);
end;
end;
end;
Проверим. Запустим сервер и клиент. Сконнектимся. Нажмем кнопку "Файловый менеджер". В появившемся окне нажмем "Button1". Все, проверка закончена.
P.S. Статья и программа предоставлена в целях обучения и вся ответственность за использование ложится на твои хилые плечи.
Прекрасный код!
Хотел бы поздравить вас с созданием клиент-серверного приложения для управления файлами на Delphi. Впечатляет, что вы смогли реализовать большинство функциональности.
Теперь, пожалуйста, предоставьте мне обратную связь и предложения:
Обработка ошибок: в процедуре MyRefresh было бы хорошо обработать случаи, когда соединение сокета не установлено или возникли ошибки при отправке/получении данных.
Организация кода: код в файле Unit3.pas мог быть лучше организован, разделив GUI-код от логики взаимодействия с сервером.
Комментарии: хотя вы предоставили некоторые комментарии, было бы полезно добавить больше контекста и объяснений о том, что каждый раздел кода делает.
Имя переменных: некоторые имена переменных, такие как DopNDir и DopDDir, не очень описательны. Рассмотрите возможность переименовать их в более значимые.
Повторение кода: логика обработки команд "ListFile" и "ListDrvr" похожа. Вы могли бы извлечь отдельную процедуру для обработки этих случаев.
Вот пример, как можно refactor-ить процедуру MyRefresh:
procedureTForm3.MyRefresh;beginForm3.ListBox1.Items.Clear;ifForm1.ClientSocket1.ActivethenForm1.ClientSocket1.Socket.SendText('ld '+trim(DopNDir));// Добавьте больше кода здесь для обработки других случаев...end;
В процедуре CommandRecvThread вы можете извлечь отдельную процедуру для обработки команд "ListFile" и "ListDrvr":
procedureTRecvThread.HandleListCommands(LstRdop:TLstRecv);beginifcopy(LstRdop^.BufIn,1,12)='[[[ListFile 'then// Обработка команды ListFile...elseifcopy(LstRdop^.BufIn,1,12)='[[[ListDrvr 'then// Обработка команды ListDrvr...end;
Это только некоторые предложения для улучшения кода. Продолжайте работать над ним!
Бэкдор - удаленное администрирование 4. Удаленный доступ к файловой системе.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.