Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Пересылка и получение файлов с помощью сокетов

Irinka © (2005-08-29 13:40:00)
Подскажите пожалуйста, как посылать и принимать файлы по сокетам?
Написала локальный чат типа ICQ на сокетах, теперь очеть хочется и файлы пересылать :-)

Seeker (2005-08-30 11:39:00) [1]

> типа ICQ

Тогда Вы наверное ознакомились с протоколом ICQ или другого месенжера? Если нет, то стоит посмотреть...
Если да, то Вы наверно заметили, что любой пакет отправляемый ICQ-месенжером в сеть, начинается с заголовка размером 6 байт который содержит:

2A byte FLAP id byte
xx byte FLAP channel
xx xx word FLAP datagram seq number
xx xx word FLAP data size

channel - можно использовать так: $01-передача сообщений, $02- передача файлов и т.д.
datagram seq number - не буду объяснять зачем это нужно, если интересно, можно посмотреть в описании протокола.
FLAP data size - размер передаваемых данных.
Как принимать сообщения, я думаю, разберетесь...
С файлами в ICQ все обстаит сложнее.
Все передаваемые сообщения проходят через сервер, а для передачи файлов, нужно установить прямое соединение.Но я думаю у Вас все получиться...

> ...на сокетах

а на "чем", интересно, ICQ написано?

Digitman (2005-08-30 08:21:00) [2]
http://www.delphimaster.ru/cgi-bin/forum.pl?id=1125327416&n=4

Digitman (2005-08-30 08:20:00) [3]

> этот код работает

> С сообщениями у меня проблем нет

будут.

Если передающая сторона один или более раз выполнила Socket.SendText('ТЕКСТ'), это вовсе негарантирует, что на принимающей стороне в результате s := Socket.ReceiveText в переменной s окажется текст 'ТЕКСТ' - там может оказаться и 'Т', и 'ТЕКСТТЕК', и 'ТЕКСТ', и 'ТЕК' ... ты эту ситуацию никак не прогнозируешь и не обрабатываешь, а она рано или поздно возникнет, и тогда весь этот алгоритм - коту под хвост ..

> как переслать файл

очень просто - передаешь строку, содержащую имя файла, затем передаешь размер файла, затем собственно содержимое файла (SendStream(FileStream))

на принимающей стороне получаешь сначала строку с именем файла, далее получаешь размер файла, далее создаешь FileStream и записываешь в него полученные файловые данные известного размера

Irinka (2005-08-30 06:54:00) [4]
Простите уважаемый Digitman, но этот код работает, сообщения пользователям посылаются как отдельно взятому пользователю так и всем сразу. (если б можно было скинуть исходник, вы бы убедились в этом сами :-) ) Вотпос в другом: как переслать файл конкретному пользователю? С сообщениями у меня проблем нет.

Digitman (2005-08-29 15:43:00) [5]

> {Посылаем все это добро по сокету}
> ClientSocket1.Socket.SendText(s);

"посылку" всего этого "добра" в условиях глоб.сети в режиме ctNonBlocking (так как она выглядит в этом коде) можно смело выкинуть в мусор - ЭТО работать не будет НИКОГДА.

Digitman (2005-08-29 15:38:00) [6]
так.
замечательно.
код ты привела.
а теперь рассказывай о проблемах..

p.s.
код "содран".
совершенно бездумно.

Irinka (2005-08-29 15:01:00) [7]
не дописала (жаль нельзя прикреплять файлики) а то исходник бы прикрепила, может кто посмотрел да и помог.

поскольку такой возможноси нет, то главный модуль:

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ScktComp,IniFiles,ShellAPI, ImgList, Buttons;

const
WM_MYTRAYNOTIFY = WM_USER + 123;
public
{ Public declarations }
procedure MyShowHint(var HintStr: string; var CanShow: Boolean;var HintInfo: THintInfo);
end;

var
Form1: TForm1;
nickname: string;
iconindex: integer;
implementation

uses conn;

{$R *.DFM}

procedure Sound(Frequency, Duration: Integer);
//-----описание sound
end;

procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
var
i: integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is THintWindow then
with THintWindow(Application.Components[i]).Canvas do
begin
Font.name:='Monotype Corsiva';
Font.Size:=20;
Font.Color:=clNavy;
HintInfo.HintColor:=clWhite;
end;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
{Если произошла ошибка, выводим ее код в Memo1}
{Insert вставляет строку в указанную позицию (в данном случае - 0 - в начало)}
Memo1.Lines.Insert(0,'Socket error ('+IntToStr(ErrorCode)+')');
end;

procedure TForm1.ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
begin
{Сообщаем о том, что идет поиск хоста}
Memo1.Lines.Insert(0,'Looking up for server...');
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
{соединяемся...}
Memo1.Lines.Insert(0,'connecting...');
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
{соединились!}
Memo1.Lines.Insert(0,'connected!');
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
{отсоединились :(}
Memo1.Lines.Insert(0,'disconnected');
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var s,from_,to_: string;

begin

{присваиваем s полученную от сервера строку}
s := Socket.ReceiveText;
{Если сервер посылает нам User List}
if Copy(s,1,2) = '#U' then begin
Delete(s,1,2);
{Чистим ListBox1}
ListBox1.Items.Clear;
{Добавляем по одному юзеру в список. Имена юзеров разделены знаком ";"}
while Pos(';',s) > 0 do begin
ListBox1.Items.Add(Copy(s,1,Pos(';',s)-1));
Delete(s,1,Pos(';',s));
end;
Exit;
end;
{Если нам прислали общее сообщение (видимое для всех юзеров)}
if Copy(s,1,2) = '#M' then begin
Delete(s,1,2);
{Добавляем его в Memo1}
Memo1.Lines.Insert(0,Copy(s,1,Pos(';',s)-1)+'> '+
Copy(s,Pos(';',s)+1,Length(s)-Pos(';',s)));

if Application.Active=false then // Если окно в данный момент неактивно, то
FlashWindow(Application.Handle, True); // Мигает значек на панели задач
//FlashWindow(Application.Handle, True);
Sound(40,5);

Exit;
end;
{Если нам прислали запрос на наше имя юзера}
if Copy(s,1,2) = '#N' then begin
{Посылаем ответ}
Socket.SendText('#N'+nickname);
Exit;
end;
{Если нам прислали приватное сообщение (или не нам :) )}
if Copy(s,1,2) = '#P' then begin
Delete(s,1,2);
{Выделяем в to_ - кому оно предназначено}
to_ := Copy(s,1,Pos(';',s)-1);
Delete(s,1,Pos(';',s));
{Выделяем в from_ - кем отправлено}
from_ := Copy(s,1,Pos(';',s)-1);
Delete(s,1,Pos(';',s));
{Если оно для нас, или написано нами - добавляем в Memo1
(иногда полезно убрать этот оператор if :) )}
if (to_ = nickname)or(from_ = nickname) then
Memo1.Lines.Insert(0,from_+' (private) > '+s);
if (to_ = nickname) then
begin
if Application.Active=false then // Если окно в данный момент неактивно, то
FlashWindow(Application.Handle, True); // Мигает значек на панели задач
//FlashWindow(Application.Handle, True);
Sound(40,5);
end;
Exit;

end;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
{Если была нажата Enter (для тех, кто с мышами не дружит) - тоже не
отказываемся послать сообщение}
if Key = VK_RETURN then
SpeedButton3.Click;
// Button1.Click;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var do_connect: Boolean;
host,port: string;
MyIniFile:TIniFile;
begin
MyIniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'\Myini.ini');
host:=MyIniFile.ReadString('Hst','Host','');
port:=MyIniFile.ReadString('Prt','Port','');
nickname:=MyIniFile.ReadString('NcNm','NicName','');
MyIniFile.Free;
Form1.Caption:='Client Socket Chat ('+nickname+')';

if (host='') or (port='') or (nickname='') then
begin

{Показываем окно установки соединения с сервером}
Form2 := TForm2.Create(Application);
{do_connect = True, если была нажата кнопка Connect}
do_connect := (Form2.ShowModal = mrOk);
{заполнение переменных до того, как мы уничтожим форму}
host := Form2.Edit1.Text;
port := Form2.Edit2.Text;
nickname := Form2.Edit3.Text;

MyIniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'\Myini.ini');
MyIniFile.WriteString('Hst','Host',host);
MyIniFile.WriteString('Prt','Port',port);
MyIniFile.WriteString('NcNm','NicName',nickname);
MyIniFile.Free;
Form1.Caption:='Client Socket Chat ('+nickname+')';

{Уничтожаем форму}
Form2.Free;
{Если была нажата кнопка Cancel, то уходим отсюда}
if not do_connect then
Exit;

end;

{Если соединение уже установлено, то обрываем его}
if ClientSocket1.Active then
ClientSocket1.Close;
{Устанавливаем свойства Host и Port}
ClientSocket1.Host := host;
ClientSocket1.Port := StrToInt(port);
{Пытаемся соединиться}
ClientSocket1.Open;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
{Закрываем соединение (если оно установлено)}
if ClientSocket1.Active then
ClientSocket1.Close;
Form1.Caption:='Client Socket Chat';
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var s: string;
begin
{Если мы хотим послать приватное сообщение, но не выбрали адресата -
нас покарают замечанием :) и выгонят из обработчика}
if (CheckBox1.Checked)and(ListBox1.ItemIndex < 0) then begin
ShowMessage('Сначала Вы должны выбрать пользователя в User List!');
Exit;
end;
{Если это приватное сообщение}
if CheckBox1.Checked then
s := '#P'+ListBox1.Items[ListBox1.ItemIndex]+';' {добавляем спец.команду и адресат}
else {А если не очень приватное?}
s := '#M'; {Просто спец.команду}
{Добавляем наше имя (от кого) и само сообщение}
s := s+nickname+';'+Edit1.Text;
{Посылаем все это добро по сокету}
ClientSocket1.Socket.SendText(s);
{И снова ждем ввода в уже чистом TEdit-е}
Edit1.Text := '';
ActiveControl := Edit1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ShowWindow(Application.Handle, sw_Hide);
Application.OnShowHint := MyShowHint;
end;

end.

Digitman (2005-08-29 14:37:00) [8]
и вам того же

Irinka (2005-08-29 14:32:00) [9]
Может вам

Digitman (2005-08-29 14:09:00) [10]

> посылать и принимать файлы по сокетам

можно передать ИМЯ файла (строковый тип данных), а следом СОДЕРЖИМОЕ файла (поток байт)

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »