| ← Декабрь 2011 → | ||||||
|
1
|
2
|
3
|
4
|
|||
|---|---|---|---|---|---|---|
|
5
|
6
|
9
|
10
|
11
|
||
|
12
|
13
|
14
|
15
|
16
|
17
|
18
|
|
19
|
21
|
22
|
23
|
24
|
||
|
26
|
27
|
28
|
29
|
30
|
31
|
|
За последние 60 дней ни разу не выходила
Сайт рассылки:
http://rusfaq.ru/
Открыта:
14-03-2002
Статистика
0 за неделю
RFpro.ru: Программирование на Delphi и Lazarus
Хостинг портала RFpro.ru: РАССЫЛКИ ПОРТАЛА RFPRO.RU
Лучшие эксперты по данной тематике
/ КОМПЬЮТЕРЫ И СОФТ / Программирование / Delphi и Lazarus
Консультация # 184655: Здравствуйте! У меня возникли сложности с такой программой. Требуется написать приложение клиент и приложение сервер на DELPHI 7 с использованием протокола TCP и стандартного модуля WINSOCK в DELPHI. Клиент отправляет файлы(только файлы, если в директории каталоги - их игнорируем) из директории на сервер с указанием пути к директории. Серв... Здравствуйте! У меня возникли сложности с такой программой.
Дата отправки: 02.12.2011, 21:51 Консультирует Киселёва Алёна aka Verena (Профессор): Здравствуйте, Невалёный В.! Код : var
Form1: TForm1;
WSA:TWSADATA;
Sock, lst_sock:TSocket;
addr:TSockAddr;
implementation
{$R *.dfm}
procedure serversocket;
begin
WSAStartup(MakeWord(1, 1), WSA);
sock := socket(PF_INET, SOCK_STREAM, 0);
addr.sin_family := PF_INET;
addr.sin_port := htons(2222);
addr.sin_addr.s_addr := INADDR_ANY;
bind(sock, addr, sizeof(addr));
listen(sock, SOMAXCONN);
end;
procedure TForm1.Button1Click(Sender: TObject); //кнопка Запустить сервер
begin
serversocket;
end;
procedure SaveFile (filename: string);
var f: file;
buf: array [1..256] of byte;
k, s, c: integer;
begin
assign (f, filename);
rewrite (f, 1);
recv (lst_sock, c, sizeof(c), 0); //получаем размер файла
k:= 1; s:= 0;
while (k>0) and (k<>SOCKET_ERROR) and (s<c) do //пока читается и не достигнут размер файла
begin
k := recv (lst_sock, buf, sizeof(buf), 0); //читаем блок
s:= s+k; //суммируем длину
if (k>0) then BlockWrite (f, buf, k); //пишем в файл
end;
close (f);
end;
procedure TForm1.Button2Click(Sender: TObject); //кнопка Ожидать клиента
begin
lst_sock := accept (sock, nil, nil); //ожидание подключения
ShowMessage('Подключен клиент');
SaveFile ('C:\socket');
end;Клиент: Код : var
Form1: TForm1;
s:TSocket;
WSA:TWSAData;
addr:TSockAddr;
implementation
{$R *.dfm}
procedure SendFile(filename:string); //отправляем файл
var
MyFile : file;
buf: array [1..256] of byte;
k: integer;
begin
assign (myfile, filename);
reset (myfile, 1);
k:= FileSize(myfile); //получаем размер
send (s, k, sizeof(k), 0); //шлём размер
repeat
BlockRead (myfile, buf, sizeof(buf), k); //читаем блок
if (k>0) then send (s, buf, k, 0); //шлём блок
until k=0;
close (myfile);
end;
procedure CloseConnection;
begin
CloseSocket(s);
WSACleanup;
end;
function TForm1.InstallConnect : boolean;
begin
WSAStartup(MakeWord(1, 1), WSA); //создаем сокет
s := Socket(PF_INET, SOCK_STREAM, 0);
addr.sin_family := AF_INET;
addr.sin_port := htons(2222);//StrToInt (LabeledEdit2.Text));
addr.sin_addr.S_addr := inet_addr(PAnsiChar('127.0.0.1'));//LabeledEdit1.Text));
if (connect(s, Addr, SizeOf(Addr)) = SOCKET_ERROR) then begin
CloseConnection;
result:=false end
else result:=true;
end;
procedure TForm1.Button1Click(Sender: TObject); //кнопка Отослать
begin
SendFile ('C:\script.txt');
end;
procedure TForm1.BitBtn2Click(Sender: TObject); //кнопка Соединиться
begin
If InstallConnect then
ShowMessage('Соединение установлено')
else ShowMessage ('Не удалось установить соединение');
end;Вам соответственно остаётся привязать к интерфейсу и сделать просмотр папки. Удачи!
Оценить выпуск | Задать вопрос экспертам
главная страница
|
стать участником
|
получить консультацию
© 2001-2011, Портал RFPRO.RU, Россия
Авторское право: ООО "Мастер-Эксперт Про" Калашников О.А. | Гладенюк А.Г. Хостинг: Компания "Московский хостер" Версия системы: 2011.6.33 от 10.09.2011 |
| В избранное | ||
