Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.12.11;
Скачать: CL | DM;

Вниз

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

 
Irinka ©   (2005-08-29 13:40) [0]

Подскажите пожалуйста, как посылать и принимать файлы по сокетам?
Написала локальный чат типа ICQ на сокетах, теперь очеть хочется и файлы пересылать :-)


 
Digitman ©   (2005-08-29 14:09) [1]


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


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


 
Irinka ©   (2005-08-29 14:32) [2]

Может вам


 
Digitman ©   (2005-08-29 14:37) [3]

и вам того же


 
Irinka ©   (2005-08-29 15:01) [4]

не дописала (жаль нельзя прикреплять файлики) а то исходник бы прикрепила, может кто посмотрел да и помог.

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

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 15:38) [5]

так.
замечательно.
код ты привела.
а теперь рассказывай о проблемах..

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


 
Digitman ©   (2005-08-29 15:43) [6]


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


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


 
Irinka ©   (2005-08-30 06:54) [7]

Простите уважаемый Digitman, но этот код работает, сообщения пользователям посылаются как отдельно взятому пользователю так и всем сразу. (если б можно было скинуть исходник, вы бы убедились в этом сами :-) ) Вотпос в другом: как переслать файл конкретному пользователю? С сообщениями у меня проблем нет.


 
Digitman ©   (2005-08-30 08:20) [8]


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


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


будут.

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


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


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

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


 
Digitman ©   (2005-08-30 08:21) [9]

http://delphimaster.net/view/6-1125327416/


 
Seeker ©   (2005-08-30 11:39) [10]


> типа 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 написано?



Страницы: 1 вся ветка

Текущий архив: 2005.12.11;
Скачать: CL | DM;

Наверх




Память: 0.51 MB
Время: 0.05 c
5-1116325152
Rep
2005-05-17 14:19
2005.12.11
Компонент для работы с базами данных DataSet или DataSource?


14-1132571747
syte_ser78
2005-11-21 14:15
2005.12.11
Как прога зовется?


1-1132152240
VEZ
2005-11-16 17:44
2005.12.11
OnExit всегда


8-1121092399
arhey
2005-07-11 18:33
2005.12.11
изменение фмзичиского размера картинки


2-1133023023
komsomolec
2005-11-26 19:37
2005.12.11
Как проиграть звук определённой частоты