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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Помогите написать чат для локалки, Перерыла весь Инет, но ничего дельного.. 
:(
    Опции темы
FelistA
  Дата 9.4.2005, 12:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 9.4.2005
Где: Кирово-Чепецк

Репутация: нет
Всего: нет
Плиз. Помогите. Мне надо написать чат на Делфи для локальной сети. Я перерыле кучу инфы, ничего дельного не нашла. Помогите кто чем может. Ссылки, исходники, советы...
Очень надеюсь на вас. smile
PM MAIL   Вверх
z-END
  Дата 9.4.2005, 13:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


прафесар™
****


Профиль
Группа: Комодератор
Сообщений: 3014
Регистрация: 13.3.2003
Где: Венья, Пиетари

Репутация: 1
Всего: 102
Это, позвольте поинтересоваться, где вы так рыли и чем, что ничего не нашли...
я советую вам зайти сюда вам расскужут и может найдут..
А вообще своетую занглянуть в папку где лежат демосы Delphi -> Demos ->NetChat по моему так (дельфей с собой нет, по этому точнее сказать не могу)...


--------------------
Каждый чилавек пасвоему праф...а памоему НЕТ! 
PM WWW ICQ   Вверх
Poseidon
Дата 9.4.2005, 14:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 4
Всего: 133
Вот была у меня статейка. Я ее не пробовал, то тема та. Может поможет

Цитата
В примера, поставляемых с Delphi, есть пример чата, я взял оттуда только примеры с сокетами, а все остальное переписал сам. Установил, старые, добрые TClientSocket, TServerSocet,

Этот пример модуля для формы, в которой выбираешь локальный комп.

Код 

unit Net;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, Buttons, ImgList;

type
TNetForm = class(TForm)
  ListView1: TListView;
  BitBtn1: TBitBtn;
  BitBtn2: TBitBtn;
  ImageList1: TImageList;
  Label1: TLabel;
  procedure FormShow(Sender: TObject);
  procedure BitBtn2Click(Sender: TObject);
  procedure BitBtn1Click(Sender: TObject);
  procedure ListView1DblClick(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
  Function FillNetLevel(xxx: PNetResource; list: TListItems) : Word;
  function GetComputer:String;
end;

var
NetForm: TNetForm;

implementation

{$R *.DFM}

function TNetForm.FillNetLevel(xxx: PNetResource; List:TListItems): Word;
Type
  PNRArr = ^TNRArr;
  TNRArr = array[0..59] of TNetResource;
Var
  x: PNRArr;
  tnr: TNetResource;
  I : integer;
  EntrReq,
  SizeReq,
  twx: THandle;
  WSName: string;
  LI:TListItem;
begin
    Result :=WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER, xxx, twx);
    If Result = ERROR_NO_NETWORK Then Exit;
    if Result = NO_ERROR then
    begin
          New(x);
          EntrReq := 1;
          SizeReq := SizeOf(TNetResource)*59;
          while (twx <> 0) and
                (WNetEnumResource(twx, EntrReq, x, SizeReq) <> ERROR_NO_MORE_ITEMS) do
          begin
                For i := 0 To EntrReq - 1 do
                begin
                  Move(x^[i], tnr, SizeOf(tnr));
                  case tnr.dwDisplayType of
                  RESOURCEDISPLAYTYPE_SERVER:
                  begin
                      if tnr.lpRemoteName <> '' then
                          WSName:= tnr.lpRemoteName
                          else WSName:= tnr.lpComment;
                      LI:=list.Add;
                      LI.Caption:=copy(WSName,3,length(WSName)-2);
                      //list.Add(WSName);
                  end;
                  else FillNetLevel(@tnr, list);
                  end;
                end;
          end;
          Dispose(x);
          WNetCloseEnum(twx);
    end;
end;


procedure TNetForm.FormShow(Sender: TObject);
begin
ListView1.Items.Clear;
FillNetLevel(nil,ListView1.Items);
end;

function TNetForm.GetComputer: String;
begin
result:='';
if (ShowModal=mrok)and(ListView1.Selected<>nil) then result:=ListView1.Selected.Caption;
end;

procedure TNetForm.BitBtn2Click(Sender: TObject);
begin
ModalResult:=mrcancel;
end;

procedure TNetForm.BitBtn1Click(Sender: TObject);
begin
modalresult:=mrok;
end;

procedure TNetForm.ListView1DblClick(Sender: TObject);
begin
modalresult:=mrok;
end;

end.




Пример использования - нажимаем кнопку sbCopms на главной форме,показываем форму выбора компа, выбираем в листбоксе комп, нажимаем Ок

Код 

procedure TMainForm.sbCopmsClick(Sender: TObject);
begin
edit1.Text:=NetForm.GetComputer;
end;




Код кнопки отправить
ForSend - глобальная переменная типа String

Код 

ForSend:=Memo1.Lines.Text;
ClientSocket1.Close;
ClientSocket1.Host:=edit1.Text;
ClientSocket1.Open;




Код компонента TServerSocket - OnClientRead
memo2 - компонента TRichEdit

Код 

procedure TMainForm.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
vResText :String;
L        :Integer;
begin
//получение текста
//если первый символ равен !, тогда выполняем файл
vResText:=socket.ReceiveText;
begin
  memo2.Lines.Add('>---ПОЛУЧЕНО СООБЩЕНИЕ ОТ: '+socket.RemoteHost+'---');
  L:=Length(Memo2.Text);
  memo2.SelStart:=Length(Memo2.Text);
  memo2.SelAttributes.Color:=clRed;
  memo2.Lines.Add('>'+vResText);
  memo2.SelLength:=L+Length(Memo2.Text);
  memo2.Lines.Add('>---КОНЕЦ СООБЩЕНИЯ-------');

  if not MainForm.Showing then MainForm.Show;
  if MainForm.WindowState=wsMinimized then
    application.Restore;
  SetForeGroundWindow(Application.MainForm.Handle);
  Memo1.SetFocus;
  if vSound then begin
    Windows.Beep(1000,100);
    Windows.Beep(1200,100);
    Windows.Beep(1300,100);
    Windows.Beep(1400,100);
    Windows.Beep(1300,100);
    Windows.Beep(1200,100);
    Windows.Beep(1100,100);
    Windows.Beep(1000,100);
  end;//if cbSound.Checked then begin
end;//else
end;




Для отсылания текста

Код 

procedure TMainForm.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
socket.SendText(ForSend);
//  ForSend:='';
end;




В случае ошибки

Код 

procedure TMainForm.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
showmessage('Невозможно отправить сообщение!'+#13+
              'Возможно программа не запущена на другом компьютере!'+#13+
              'Сообщение будет сохранено на удаленном комппьютере'+#13+
              'и будет прочтено при запуске программы.');
end;



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
FelistA
Дата 9.4.2005, 15:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 9.4.2005
Где: Кирово-Чепецк

Репутация: нет
Всего: нет
Я смотрела пример поставляемый с Делфи. Вопрос вот такой: Что значит там RemotePort, LocalPort, RemoteHost. Я с этим не знакома. Помогите разобраться. smile
PM MAIL   Вверх
dm9
Дата 9.4.2005, 15:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Дмитрий Копытин
****


Профиль
Группа: Vingrad developer
Сообщений: 3876
Регистрация: 22.7.2002
Где: Москва

Репутация: нет
Всего: 137
Borland\Delphi7\Demos\Internet\NetChat

RemotePort - порт удалённой машины, на который будут приниматься сообщения. Оставь его 5000.
LocalPort - порт локальной машины (на который бубут отсылаться сообщения). Тоже оставь 5000.
RemoteHost - IP удлённой машины. Надо заменить. Чат запускается на двух разный машинах, на каждой указывается IP соседа. Чат в этой демке только между двумя машинами.
PM MAIL ICQ   Вверх
FelistA
Дата 9.4.2005, 17:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 9.4.2005
Где: Кирово-Чепецк

Репутация: нет
Всего: нет
А есче вопрос. Я вот книгу скачала. Там написано: "Расположите па форме компонент TServerSocket со страницы Internet палитры компонентов (предварительно должен быть подключен соответствующий пакет)" Как его подключать? Помогите плиз.
PM MAIL   Вверх
dm9
Дата 9.4.2005, 17:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Дмитрий Копытин
****


Профиль
Группа: Vingrad developer
Сообщений: 3876
Регистрация: 22.7.2002
Где: Москва

Репутация: нет
Всего: 137
Это про Тсерверсокет:
http://forum.vingrad.ru/index.php?showtopi...l=tserversocket

А это про чат в локальной чети:
http://forum.vingrad.ru/index.php?showtopi...l=tserversocket

Также, есть замечательная штука "Поиск" smile По запросу tserversocket эта штука выдала небезынтересных топиков десять smile
PM MAIL ICQ   Вверх
FelistA
Дата 9.4.2005, 18:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 9.4.2005
Где: Кирово-Чепецк

Репутация: нет
Всего: нет
Спасибо, посмотрю. Если, что еще вопросы будут, ответишь? Я вижу ты в этом шаришь? smile
PM MAIL   Вверх
FelistA
Дата 9.4.2005, 18:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 9.4.2005
Где: Кирово-Чепецк

Репутация: нет
Всего: нет
Неа, это не то. Я именно пакет не могу установить, и понятия не имею как это делать smile
PM MAIL   Вверх
dm9
Дата 9.4.2005, 18:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Дмитрий Копытин
****


Профиль
Группа: Vingrad developer
Сообщений: 3876
Регистрация: 22.7.2002
Где: Москва

Репутация: нет
Всего: 137
Я тебе давал ссылку выше... там написано

Цитата
You will need to add the dclsockets package to the IDE. To do this go to Component | Install Packages | Add (/bin/dclsockets70.bpl).


Вот только что проделал это.
Идёшь в пункт меню Component | Install Packages.
Жмёшь кнопку Add.
Находишь в папке Borland\Delphi7\Bin файл dclsockets70.bpl, тыкаешь на него, нахимаешь "Open".
Нажимаешь ОК.
Радуешься тому, что на вкладке Internet появились два новых компонента - TClientSocket и TServerSocket.


Цитата(FelistA @ 9.4.2005, 19:13)
Я вижу ты в этом шаришь?


Я в этом не шарю... просто эти вопросы так часто задаются, что я уже выучил ответы наизусть smile
PM MAIL ICQ   Вверх
FelistA
Дата 10.4.2005, 10:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 9.4.2005
Где: Кирово-Чепецк

Репутация: нет
Всего: нет
Ура. Я почти сделала. Вот вопрос такой. У меня с клиента на сервер сообщения отправляются. А с сервара на клиент нет. Что делать?

Листинг клиента.

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    XPManifest1: TXPManifest;
    Memo1: TMemo;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    StatusBar1: TStatusBar;
    Button2: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Server: String;
begin
  if ClientSocket1.Active then ClientSocket1.Active := False;
  {if InputQuery('Установить связь с , Псевдоним IP-адреса:', Server) then
  if Length(Server) > 0 then
  with ClientSocket1 do
  begin
    Host := Server;
    Active := True;
  end;}
  Server:=Edit1.Text;
  ClientSocket1.Host := Server;
  ClientSocket1.Active := True;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
  ClientSocket1.Active := False;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add('Соединение прошло успешно c ' + Socket.LocalHost);
  StatusBar1.Panels[0].Text := 'Соединено с: ' + Socket.LocalHost + ' IP-адрес ' +
  Socket.LocalAddress;
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add('Соединение завершено');
  StatusBar1. Panels [0 ] .Text := 'Соединение завершено ' ;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  Memo2. Lines. Add ('Ошибка соединения с сервером : ' + Edit1.Text);
  ErrorCode := 0;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
  ClientSocket1.Socket.SendText (Memo1. Lines [Memo1. Lines. Count - 1]);
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add('Получен текст: ' + Socket.ReceiveText);
end;

end.


Листинг сервера.

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    StatusBar1: TStatusBar;
    ServerSocket1: TServerSocket;
    XPManifest1: TXPManifest;
    Label1: TLabel;
    Label2: TLabel;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1Accept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
    ServerSocket1.Active := True;
    StatusBar1.Panels[0].Text := 'Прослушивание...';
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add('Соединение прошло успешно c ' + Socket.LocalHost);
end;

procedure TForm1.ServerSocket1Accept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar1.Panels[0].Text := 'Соединено с: ' + Socket.LocalHost + ' IP-адрес ' +
  Socket.LocalAddress;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add('Соединение завершено');
  StatusBar1.Panels[0].Text := 'Прослушивание соединения...';
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
    ServerSocket1.Socket.Connections[0].SendText (Memo1.Lines[Memo1.Lines.Count - 1])
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add('Получен текст: ' +Socket.ReceiveText);
end;

end.



Может кто поможет?
PM MAIL   Вверх
FelistA
Дата 11.4.2005, 06:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 9.4.2005
Где: Кирово-Чепецк

Репутация: нет
Всего: нет
smile HELP!!!! Кто-нибудь знает как мне помоч? Где вы все????
PM MAIL   Вверх
z-END
Дата 11.4.2005, 12:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


прафесар™
****


Профиль
Группа: Комодератор
Сообщений: 3014
Регистрация: 13.3.2003
Где: Венья, Пиетари

Репутация: 1
Всего: 102
Цитата(FelistA @ 10.4.2005, 11:06)
У меня с клиента на сервер сообщения отправляются. А с сервара на клиент нет. Что делать
smile
И не придут... сервер он на то и сервер, чтобы слушать что ему говорят, а клиент глухой он только говорить может...
Блин вообще купите книжку даже не про дельфи а просто про сеть и почитайте, а то писать чат не зная как все это работает смысла нет. (как говорится RTFM)
Ну если совсем лень, то могу намекнуть что для того чтобы сообщения отправлять туда-сюда нужено на каждом конце стаавить по серверу и по клиенту.



--------------------
Каждый чилавек пасвоему праф...а памоему НЕТ! 
PM WWW ICQ   Вверх
FelistA
Дата 18.4.2005, 18:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 9.4.2005
Где: Кирово-Чепецк

Репутация: нет
Всего: нет
Все чат сделан. Спасибо всем кто помог. smile
PM MAIL   Вверх
Akella
Дата 4.5.2005, 12:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


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

Репутация: 4
Всего: 329
Вот реальный пример.
В одном исполняемом файле и сервер и клиент.
Реально работает.
Я, лично, лишнее удалил, немного добавил.

Присоединённый файл ( Кол-во скачиваний: 70 )
Присоединённый файл  RlMess.zip
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

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

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

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

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

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


 




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


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

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