Форум программистов, компьютерный форум, киберфорум
Delphi: Сети
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.83/6: Рейтинг темы: голосов - 6, средняя оценка - 4.83
31 / 31 / 16
Регистрация: 02.11.2011
Сообщений: 216
1

Передача группы файлов по локальной сети

28.05.2014, 15:07. Показов 1244. Ответов 3
Метки нет (Все метки)

Добрый день. Мне нужно передать по локальной сети клиентам несколько файлов. Код для передачи нашел в инете, все сделал вроде как надо, но при передачи нескольких файлов вылетает ошибка, а при передаче одного все норм (передачу нескольких файлов попытался сделать в цикле).

Код сервера
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, ComCtrls, StdCtrls,
  ScktComp;
 
type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    Tree: TTreeView;
    Files: TMemo;
    Button1: TButton;
    ServerSocket: TServerSocket;
    Memo1: TMemo;
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure FormActivate(Sender: TObject);
    procedure poisk(name:string; n:integer; view:TTreeView);
    procedure proverka(path,root:string; view:TTreeView);
    procedure TreeClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure delimiter(str, del:string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  i_kol,i,n:integer;
  gPath,tupe:string;
  mas:array [1..1000] of string;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
  FileToSend: String;
  FileSize: Cardinal;
  p: Pointer;
begin
  FileToSend := files.Lines[i_kol];  // тут файл, который мы рассылаем любому попросившему.
  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;
  memo1.Lines.Add('Файл '+FileToSend+' послан') ;
end;
 
procedure tform1.poisk(name:string; n:integer; view:TTreeView);
 var
   SR: TSearchRec;
   m,i:integer;
 
begin
  tupe:='file';
    if FindFirst(name + '\*.*', faAnyFile, SR) = 0 then
         begin
           repeat
             if (SR.Name<>'.') and (SR.Name<>'..') and (Pos(tupe,SR.Name)=0) then
             begin
               view.Items.AddChild(view.Items.Item[n],SR.Name);
               inc(i);
               if (SR.Attr = faDirectory) then
               begin
                m:=n;
                n:=i;
                poisk(name+'\'+SR.Name,n,view);
                n:=m;
               end;
             end;
           until FindNext(SR) <> 0;
           FindClose(SR);
         end;
end;
 
procedure TForm1.FormActivate(Sender: TObject);
begin
  gPath:=ExtractFileDir(Application.ExeName);
  if not DirectoryExists(gPath+'/res') then
    createdir(gPath+'\res');
  proverka(gPath+'\res','ресурсы',Tree);
end;
 
procedure tform1.proverka(path,root:string; view:TTreeView);
begin
  view.Items.Clear;
  view.Items.Add(nil,root);
  i:=0;
  if not DirectoryExists(path) then
    createdir(path)
  else
    poisk(path,0,view);
end;
 
procedure TForm1.TreeClick(Sender: TObject);
var
  Node: TTreeNode;
  s,path,root,tupe,gPathFile: string;
  SR:TSearchRec;
  i,j,kol:integer;
  f:TextFile;
  FileDir,buf,name:string;
  fl:boolean;
begin
  tupe:='file';
  Node := Tree.Selected;
  if (not Tree.Selected.HasChildren) and (pos('.',Node.Text)<>0) then
  begin
    path:=ExtractFileDir(Application.ExeName)+'\res';
    root:='ресурсы';
    s:=Node.Text;
    Name:=s;
    Node:=Node.Parent;
    while Node <> nil do
    begin
      if root=Node.Text then
        s := path+'\'+s
      else
        s := Node.Text+'\'+s;
      Node := Node.Parent;
    end;
    fl:=false;
    for i:=0 to files.Lines.Count do
    if files.Lines[i]=s then
      fl:=true;
    if fl=false then
      files.Lines.Add(s);
end;
i_kol:=-1;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  {for i_kol:=0 to files.Lines.Count-1 do
  begin     }
  for i:= 0 to ServerSocket.Socket.ActiveConnections-1 do
    //if ServerSocket.Socket.Connections[i].RemoteAddress= mas[2] then
    begin
      ServerSocket.Socket.Connections[i].SendText('9|');
      IdTCPServer1.Active:=true;
    end;
 
  memo1.Lines.Add(files.Lines[i_kol]);
  //end;
  inc(i_kol);
end;
 
procedure TForm1.delimiter(str, del:string);
begin
  i:=0;
  while pos(del,str)<>0 do
  begin
    inc(i);
    mas[i]:=copy(str,1,pos(del,str)-1);
    delete(str,1,pos(del,str));
  end;
  n:=i;
end;
 
end.
Код клиента
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls, ScktComp;
 
type
  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    ClientSocket: TClientSocket;
    Memo1: TMemo;
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure delimiter(str, del:string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  mas:array [1..1000] of string;
  i,n:integer;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
var
  FileName: PChar;
  FileSize: Cardinal;
  FS: TFileStream;
  i:integer;
  name:string;
begin
  GetMem(FileName, 256);
  try
    IdTCPClient1.ReadBuffer(FileName^, 256);
    IdTCPClient1.ReadBuffer(FileSize, SizeOf(FileSize));
    FS := TFileStream.Create('incoming\'+FileName, fmCreate); // тут создается файл, я его положил в каталог incoming
    name:=FileName;
    try
      IdTCPClient1.ReadStream(FS, FileSize);
    finally
      FS.Free;
    end;
  finally
    FreeMem(FileName);
  end;
  memo1.Lines.Add('Файл '+Name+' принят');
end;
 
procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  delimiter(Socket.ReceiveText,'|');
  i:=1;
  case strtoint(mas[1]) of
  9:
  begin
    IdTCPClient1.Connect;
    if IdTCPClient1.Connected then
      IdTCPClient1.Disconnect;
  end;
  end;
end;
 
procedure TForm1.delimiter(str, del:string);  
begin
  i:=0;
  while pos(del,str)<>0 do
  begin
    inc(i);
    mas[i]:=copy(str,1,pos(del,str)-1);
    delete(str,1,pos(del,str));
  end;
  n:=i;
end;
end.
Добавлено через 35 минут
И еще такой вопрос: куда и как в код запихнуть progressbar, чтобы можно было наблюдать за процессом сброса
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
28.05.2014, 15:07
Ответы с готовыми решениями:

Передача файлов по локальной сети
Подскажите пожалуйста, какими способами (легче всего) осуществить передачу файлов (синхронизацию...

Передача файлов по локальной сети
Привет всем! Столкнулся с проблемой при принятии и переименовании файла. Я только начинаю во всем...

Передача файлов по локальной сети Delphi
Доброго времени суток) Я начинающий программист, и передо мной возникла проблема передачи файлов...

Передача файлов по сети
добрый вечер. Не могу организовать передачу файлов с помощью TServerSocket и TClientSocket....

3
2646 / 2269 / 278
Регистрация: 24.12.2010
Сообщений: 13,725
28.05.2014, 16:34 2
А что это за выкрутасы с двумя клиентскими компонентами - TClientSocket и TIdTCPClient ?
Тебе что, одного мало ?)
0
31 / 31 / 16
Регистрация: 02.11.2011
Сообщений: 216
28.05.2014, 17:59  [ТС] 3
Можно сказать, что на TClientSocket у меня держится вся программа, а для переброски файлов я начал использовать TIdTCPClient. Это просто отдельная небольшая программка, которую я по структуре сделал другой, в которую мне нужно все это впихнуть)
Переброска нескольких файлов уже не нужна, я решил сделать по-другому, а вот про ProgressBar всё ещё нужен ответ)
0
2646 / 2269 / 278
Регистрация: 24.12.2010
Сообщений: 13,725
28.05.2014, 21:56 4
Цитата Сообщение от sheldon-yura Посмотреть сообщение
а для переброски файлов я начал использовать TIdTCPClient
"Бросаться" файлами с немешьшим успехом можно и средствами того же самого TClientSocket

Цитата Сообщение от sheldon-yura Посмотреть сообщение
про ProgressBar всё ещё нужен ответ
см.события OnWorkBegin, OnWork
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
28.05.2014, 21:56

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Передача файлов по сети!!!
Дело серьёзное - пишу документооборот! Как передавать файлы (в основном текстовые) по локальной...

Передача файлов по сети
Подскажите как передать текстовый файл через сеть?

Передача файлов по сети
Ребят,помогите найти коды для реализации данной проги,может у кого исходники сохранились,накидайте...

Передача файлов по сети
Собственно начал изучать работу делфи с сетями и появились проблемы. Как я понимаю для передачи...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.