Модераторы: Snowy, Poseidon, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Сокеты, Соединение TCP/IP 
:(
    Опции темы
WERITAS
Дата 29.4.2007, 12:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


********
**


Профиль
Группа: Участник
Сообщений: 582
Регистрация: 2.5.2005
Где: Москва

Репутация: нет
Всего: 5
Сразу скажу, что ни разу не пользовался компонентами Delphi для работы в  сети. Где здесь у меня ошибка:

Для сервера:
Код

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  TcpServer1.LocalHost:= '127.0.0.1';
  TcpServer1.LocalPort:= '1121';
  TcpServer1.Active:= true;

end;
procedure TForm1.TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
begin
  ShowMessage('Hello!');
end;


Для клиента:
Код

procedure TForm1.Button1Click(Sender: TObject);
begin
  TcpClient1.RemoteHost:= '127.0.0.1';
  TcpClient1.RemotePort:= '1121';
  TcpClient1.Active:= true;

  if TcpClient1.Connect then ShowMessage('Connect!');
end;

Не прилетает ни одно из сообщений :(


--------------------
Арт-менеджер клуба, разрешивший концерт Алексея Глызина, уволен с формулировкой "Мудак"
PM MAIL   Вверх
Exai1e
Дата 29.4.2007, 13:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 908
Регистрация: 3.12.2006
Где: Moscow

Репутация: нет
Всего: 30
Сервер
Код

unit UServerMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    Button1: TButton;
    ListBox1: TListBox;
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  ServerSocket1.Active := false;
  ServerSocket1.Close;
  Close;  
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ServerSocket1.Port   := 777;
  ServerSocket1.Active := true;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s : string;
  i : integer;
begin
    s := TimeToStr(now) + ' ' + Socket.ReceiveText;
  //s := TimeToStr(now) +  ' ' + '>' + ' ' + Socket.ReceiveText;
  ListBox1.Items.Add(s);
  for I := 0 to ServerSocket1.Socket.ActiveConnections - 1 do
    if ServerSocket1.Socket.Connections[i].SocketHandle <> Socket.SocketHandle then
      ServerSocket1.Socket.Connections[i].SendText(s);
end;

end.


Клиент
Код

unit UClientMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls;

type
  TForm1 = class(TForm)
    edSendText: TEdit;
    btnConnect: TButton;
    edAdress: TEdit;
    edPort: TEdit;
    btnSend: TButton;
    ClientSocket1: TClientSocket;
    Label1: TLabel;
    Label2: TLabel;
    edName: TEdit;
    Label3: TLabel;
    Memo1: TMemo;
    procedure ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure btnSendClick(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormDestroy(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Nick : string;

implementation

{$R *.dfm}

{Connect}
procedure TForm1.btnConnectClick(Sender: TObject);
begin
  ClientSocket1.Host    := edAdress.Text;
  ClientSocket1.Port    := StrToInt(edPort.Text);
  Nick := edName.Text;
  if not ClientSocket1.Active then ClientSocket1.Active := true;
  edName.Enabled        := false;
  edAdress.Enabled      := false;
  edport.Enabled        := false;
  btnConnect.Enabled    := false;
end;

{Send message}
procedure TForm1.btnSendClick(Sender: TObject);
begin
  if edSendText.Text <> '' then
    begin
      ClientSocket1.Socket.SendText(Nick + ' ' + ' > ' + ' ' + edSendText.Text);
      Memo1.lines.Add(TimeToStr(now) + ' ' + Nick + ' ' + ' > ' + ' ' +  edSendText.Text);
      edSendText.Text := '';
    end;
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.SendText(Nick + ' Вошел в чат');
end;

procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
begin
  Memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClientSocket1.Socket.SendText(Nick + ' Покинул чат');
  ClientSocket1.Active := false;
  ClientSocket1.Close;
  Close;
end;

end.


пасмари, пример рабочий, мб поможет...


--------------------
"Решение зависит от выбранного геморроя" © Snowy
"у нас как в армии - либо работает, либо так и задумано"
PM MAIL ICQ   Вверх
WERITAS
Дата 29.4.2007, 13:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


********
**


Профиль
Группа: Участник
Сообщений: 582
Регистрация: 2.5.2005
Где: Москва

Репутация: нет
Всего: 5
Код

    ServerSocket1: TServerSocket;


Код

    ClientSocket1: TClientSocket;


Что это? У меня в Delphi7 такого нет

Это сообщение отредактировал(а) WERITAS - 29.4.2007, 14:10


--------------------
Арт-менеджер клуба, разрешивший концерт Алексея Глызина, уволен с формулировкой "Мудак"
PM MAIL   Вверх
Exai1e
Дата 29.4.2007, 14:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 908
Регистрация: 3.12.2006
Где: Moscow

Репутация: нет
Всего: 30
Эт я сам делал
вот в архиве


--------------------
"Решение зависит от выбранного геморроя" © Snowy
"у нас как в армии - либо работает, либо так и задумано"
PM MAIL ICQ   Вверх
Sanchezzz
Дата 29.4.2007, 22:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1670
Регистрация: 19.11.2006
Где: Voronezh

Репутация: 1
Всего: 60
сокеты лежат отдельно в папке ...Delphi\bin\dclSocket70.bpl


--------------------
Понравился ответ "+" по репе, не забываем закрывать тему, заказы в LS.
PM MAIL Skype GTalk   Вверх
Exai1e
Дата 29.4.2007, 22:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 908
Регистрация: 3.12.2006
Где: Moscow

Репутация: нет
Всего: 30
WERITAS, Надо было сразу уточнить про что ты... а то 
~
Цитата
Что за зверь такой, у меня в Delphi 7 такого нет



--------------------
"Решение зависит от выбранного геморроя" © Snowy
"у нас как в армии - либо работает, либо так и задумано"
PM MAIL ICQ   Вверх
WERITAS
Дата 30.4.2007, 07:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


********
**


Профиль
Группа: Участник
Сообщений: 582
Регистрация: 2.5.2005
Где: Москва

Репутация: нет
Всего: 5
Exai1e 
А я это и цитировал:
Цитата

Код

     ServerSocket1: TServerSocket;


Код

     ClientSocket1: TClientSocket;


Что это? У меня в Delphi7 такого нет




--------------------
Арт-менеджер клуба, разрешивший концерт Алексея Глызина, уволен с формулировкой "Мудак"
PM MAIL   Вверх
Exai1e
Дата 30.4.2007, 10:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 908
Регистрация: 3.12.2006
Где: Moscow

Репутация: нет
Всего: 30
Exai1e, Ну когда я отписывался цитата была другая smile


--------------------
"Решение зависит от выбранного геморроя" © Snowy
"у нас как в армии - либо работает, либо так и задумано"
PM MAIL ICQ   Вверх
WERITAS
Дата 30.4.2007, 11:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


********
**


Профиль
Группа: Участник
Сообщений: 582
Регистрация: 2.5.2005
Где: Москва

Репутация: нет
Всего: 5
Ну надо было выждать всего полминуты  smile  )))

Всё равно спасибо) Я с компонентов TcpClient/TcpServer перешёл к TClientSocket/TServerSocket smile Так что не зря старался ;-)

Это сообщение отредактировал(а) WERITAS - 30.4.2007, 11:23


--------------------
Арт-менеджер клуба, разрешивший концерт Алексея Глызина, уволен с формулировкой "Мудак"
PM MAIL   Вверх
Saygak
  Дата 2.5.2007, 12:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 15
Регистрация: 2.5.2007

Репутация: нет
Всего: 1
Вопрос, собственно, Exai1e: ты приводишь пример чата и все работает, но при изменении Socket.SendText(...) на Socket.SendStream(...) почему-то возникает ошибка.
промер программы:
Код

procedure TMainForm.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s: String;
begin
  s := Socket.ReceiveText;
  if s='D' then begin
    BitMap.Canvas.CopyRect(R1, DC, R1);
    Image1.Picture.Bitmap := BitMap;
    Image1.Picture.Graphic.SaveToStream(ms);
    ms.Position := 0;
    Socket.SendStream(ms); //вот тут и возникает ошибка
    ms.Clear;
  end;
end;

 smile 
PM MAIL ICQ   Вверх
Snowy
Дата 2.5.2007, 13:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484
А ты попробуй использовать локальные переменные, а не глобальные - всё само пройдёт  smile
Вот где тут ms создаётся? или битмап? и прочие переменные?
И кто их ещё юзает в данный момент?
PM MAIL   Вверх
Saygak
Дата 2.5.2007, 13:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 15
Регистрация: 2.5.2007

Репутация: нет
Всего: 1
Snowy: щас приведу полный код.
Сервер:
Код

unit UServerMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ComCtrls, ActnList, StdActns, Menus,
  ExtCtrls;

type
  TMainForm = class(TForm)
    ServerSocket1: TServerSocket;
    StatusBar1: TStatusBar;
    Button1: TButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    ActionList1: TActionList;
    FileExit1: TFileExit;
    ServerStart1: TAction;
    ServerStop1: TAction;
    Option1: TMenuItem;
    Preference1: TAction;
    Start1: TMenuItem;
    Stop1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Preference2: TMenuItem;
    Button2: TButton;
    Image1: TImage;
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Preference1Execute(Sender: TObject);
    procedure ServerSocketPortChange(Sender: TObject);
    procedure ServerStart1Execute(Sender: TObject);
    procedure ServerStop1Execute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    BitMap: Graphics.TBitmap;
    DC: TCanvas;
    R1: TRect;
    ms: TMemoryStream;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses fPreffForm;

{$R *.dfm}

procedure TMainForm.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s: String;

begin
  s := Socket.ReceiveText;
  if s='D' then begin
    BitMap.Canvas.CopyRect(R1, DC, R1);
    Image1.Picture.Bitmap := BitMap;
    Image1.Picture.Graphic.SaveToStream(ms);
    ms.Position := 0;
    Socket.SendStream(ms);
    ms.Clear;
  end;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ServerStop1.Enabled then ServerStop1.Execute;
end;

procedure TMainForm.Preference1Execute(Sender: TObject);
begin
  PreffForm.ShowModal;
end;

procedure TMainForm.ServerSocketPortChange(Sender: TObject);
begin
  if ServerSocket1.Active then
   begin
     ServerStop1.Execute;
     ServerSocket1.Port := PreffForm.Port;
     ServerStart1.Execute;
   end
  else ServerSocket1.Port := PreffForm.Port;
end;

procedure TMainForm.ServerStart1Execute(Sender: TObject);
begin
  ServerSocket1.Active := True;
  StatusBar1.SimpleText := Format('Status: Runing on %d port',[ServerSocket1.Port]);
  ServerStart1.Enabled := False;
  ServerStop1.Enabled := True;
end;

procedure TMainForm.ServerStop1Execute(Sender: TObject);
begin
  ServerSocket1.Active := False;
  StatusBar1.SimpleText := 'Status: Stoped';
  ServerStart1.Enabled := True;
  ServerStop1.Enabled := False;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  R1 := Rect(0,0,Monitor.Width, Monitor.Height);
  DC := TCanvas.Create;
  DC.Handle := GetDC(0);
  BitMap := TBitmap.Create;
  BitMap.Width := R1.Bottom;
  BitMap.Height := R1.Right;
  ms := TMemoryStream.Create;
  ServerStart1.Execute;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  ms.Free;
  BitMap.Free;
  DC.Free;
end;

end.


Клиент:
Код

unit UClientMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ExtCtrls;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    Memo1: TMemo;
    btnConnect: TButton;
    edSendText: TEdit;
    edAdress: TEdit;
    edPort: TEdit;
    btnSend: TButton;
    edName: TEdit;
    Image1: TImage;
    procedure btnSendClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FNick: String;
    ms: TMemoryStream;
    procedure SetNick(const Value: String);
  public
    { Public declarations }
    property Nick: String read FNick write SetNick;
  end;

var
  Form1: TForm1;
//  Nick : string;
  
implementation

{$R *.dfm}

procedure TForm1.btnSendClick(Sender: TObject);
begin
  ClientSocket1.Socket.SendText('D');
end;

procedure TForm1.btnConnectClick(Sender: TObject);
begin
  ClientSocket1.Host    := edAdress.Text;
  ClientSocket1.Port    := StrToInt(edPort.Text);
  Nick := edName.Text;
  if not ClientSocket1.Active then ClientSocket1.Active := true;
  edName.Enabled        := false;
  edAdress.Enabled      := false;
  edport.Enabled        := false;
  btnConnect.Enabled    := false;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  buf: PByte;
  len: Integer;
begin
  len := Socket.ReceiveLength;
  buf := GetMemory(len);
  Socket.ReceiveBuf(buf, len);
  ms.Position := 0;
  ms.WriteBuffer(buf, len);
  ms.Position := 0;
  Image1.Picture.Graphic.LoadFromStream(ms);
  FreeMemory(buf);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ms.Free;
  ClientSocket1.Active := false;
  ClientSocket1.Close;
  Close;
end;

procedure TForm1.SetNick(const Value: String);
begin
  FNick := Value;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ms := TMemoryStream.Create;
end;

end.

там еще у сервера 2 форма с предполагаемыми настройками сервера...
Надеюсь понятно, что я копирую рабочий стол на канву битмапа, сохраняю в поток и отправляю клиенту...

Добавлено через 2 минуты и 12 секунд
Некоторые участки были написаны с использованием Delphi Russian Knowledge Base...

Добавлено через 11 минут и 7 секунд
а переменные ms, DC и BitMap не локальные для того, чтобы не тратить время на их создание и уничтожение при каждом обтащении клиета
PM MAIL ICQ   Вверх
Snowy
Дата 2.5.2007, 13:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484
Просто для теста, создай стрим локально, загрузи в него битмап с диска и отправь.
PM MAIL   Вверх
Saygak
  Дата 2.5.2007, 15:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 15
Регистрация: 2.5.2007

Репутация: нет
Всего: 1
все время возился...
нашел, только что ClientCoket получает данные порциями (у меня 4096 б). Попробовал исправить передачу и получение данных. 
Сначала отправляю строку на сервере:
Код

...
Socket.SendText('Size:'+IntToStr(MemoryStream.Size)+#0);
Socket.SendStream(MemoryStream);
...


На клиенте:
Код

...
var
  s, s1: String;
begin
try
  s := ClientSocket1.Socket.ReceiveText;
  if Reciving then
   begin
     ms.Write(s[1], length(s));
     if ms.Size = DataSize then
      begin
        Reciving := False;
        BitMap.LoadFromStream(ms);  //Все равно в этой строке не сохраняется данные
        ms.Free;
        Image1.Picture.Bitmap := BitMap;
        BitMap.SaveToFile('temp.bmp'); // т.к. получаемый файл нулевой длинны...
      end;
   end
  else if copy(s, 1, 5)='Size:' then
   begin
     s1 := copy(s, 6, Pos(#0, s)-6);
     DataSize := StrToInt(s1);
     Delete(s, 1,Pos(#0, s));
     Reciving := true;
     ms := TMemoryStream.Create;
     ms.Write(s[1], length(s));
   end;
...

(код подсмотрел в книге "Программирование в Delphi глазами хакера")
 smile 
Snowy, инициализация переменных внутри процедур (локально) у меня ничего не дает. Теперь ситуация такая: Данные передает (вродебы), но куда они деваются непонятно...
PS. Как говорил один из пилотов: "Ничего не понимаю"... smile 
PM MAIL ICQ   Вверх
Saygak
Дата 2.5.2007, 16:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 15
Регистрация: 2.5.2007

Репутация: нет
Всего: 1
фух, работает. 
Snowy, спасибо за совет:
Цитата
создай стрим локально, загрузи в него битмап с диска и отправь

Не сразу догадаешься, что этот стрим сам удаляется (наверно)...
А получать данные пришлось всетаки как я указывал раньше (по частям)...
программы вроде работают и ладно, будем улучшать...
PM MAIL ICQ   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0647 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.