VPF::Очень медленная передача данных через сокеты

karataev

Дата 14.3.2006, 18:22 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 56
Регистрация: 28.1.2006
Где: Россия, Нижний Но вгород

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

У меня такая проблема: пишу чат для локальной сети. Все впринципе работает, если не учитывать того, что скорость передачи одного текстового сообщения около 10-20 секунд при скорости сети 100Мбит/сек =)

Помогите пожалуйста решить эту проблему! Вот код:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, WinSock, ExtCtrls, CoolTrayIcon, XPMan,
  Menus, ImgList, ComCtrls, dateutils, Buttons;

type
  TMain = class(TForm)
    client: TClientSocket;
    server: TServerSocket;
    list: TListBox;
    timer1: TTimer;
    trayicon: TCoolTrayIcon;
    label1: TLabel;
    label2: TLabel;
    attention: TCheckBox;
    shiftenter: TCheckBox;
    menu: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    images: TImageList;
    window: TRichEdit;
    edit: TRichEdit;
    Label3: TLabel;
    send: TButton;
    Timer2: TTimer;
    procedure timer1Timer(Sender: TObject);
    procedure listClick(Sender: TObject);
    procedure trayiconClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N4Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    function GetComputerNetName:string;
    procedure FormCreate(Sender: TObject);
    procedure shiftenterClick(Sender: TObject);
    procedure attentionClick(Sender: TObject);
    procedure sendClick(Sender: TObject);
    procedure listDblClick(Sender: TObject);
    procedure serverClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Timer2Timer(Sender: TObject);
    procedure windowChange(Sender: TObject);
    procedure clientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure clientConnect(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Main: TMain; sobesednik: string;

implementation

{$R *.dfm}

uses unit2;

function tmain.GetComputerNetName: string;
var
  buffer: array[0..255] of char;
  size: dword;
begin
  size := 256;
  if GetComputerName(buffer, size) then
    Result := buffer
  else
    Result := ''
end;

procedure TMain.timer1Timer(Sender: TObject);
begin
main.FormCreate(timer1);
if (application.Active) and (visible=true) then
 begin
 trayicon.CycleIcons:=false;
 trayicon.Icon:=application.Icon;
 end;
end;

procedure TMain.listClick(Sender: TObject);
begin
try
client.Active:=false;
client.Host:=list.Items[list.itemindex];
client.Active:=true;
sobesednik:=list.Items[list.ItemIndex];
label3.Caption:='Ñîîáùåíèå äëÿ '+sobesednik+':';
except
end;
edit.Enabled:=false;
end;

procedure TMain.trayiconClick(Sender: TObject);
begin
if visible=true then
 trayicon.HideMainForm
else
 trayicon.ShowMainForm;
end;

procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if visible=true then
 begin
 trayicon.HideMainForm;
 canclose:=false;
 end
else
 canclose:=true; 
end;

procedure TMain.N4Click(Sender: TObject);
begin
close;
close;
end;

procedure TMain.FormShow(Sender: TObject);
begin
edit.SetFocus;
end;

procedure TMain.FormCreate(Sender: TObject);
var Listxxx: TServerList;
    i:word;
    e:byte;
begin
list.Clear;
try
Listxxx := TServerList.Create('', '', SV_TYPE_ALL);
for i := 0 to Listxxx.Count - 1 do
 with Listxxx[i] do
 { if svr_Name<>getcomputernetname then}
   list.AddItem(lowercase(svr_Name),list);
for i:=0 to list.Count-1 do
 if list.Items[i]=sobesednik then
  begin
  list.Selected[i]:=true;
  e:=1;
  end;
except
end;
if e=1 then
 edit.ReadOnly:=false
else
 edit.ReadOnly:=true; 
end;

procedure TMain.shiftenterClick(Sender: TObject);
begin
edit.SetFocus;
end;

procedure TMain.attentionClick(Sender: TObject);
begin
edit.SetFocus;
end;

procedure TMain.sendClick(Sender: TObject);
var i:byte;
begin
client.Socket.SendText(edit.text);
window.Text:=window.text+#10+#10+lowercase(getcomputernetname)+' ('+timetostr(time)+' '+
             datetostr(date)+')'+chr(10)+edit.text;
while window.Lines[0]=#10 do
 window.Lines.Delete(0);
edit.Clear;
edit.SetFocus;
end;

procedure TMain.listDblClick(Sender: TObject);
begin
main.listClick(list); 
end;

procedure TMain.serverClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
window.Text:=window.text+#10+#10+lowercase(socket.RemoteHost)+' ('+timetostr(time)+' '+
             datetostr(date)+')'+chr(10)+socket.ReceiveText;
while window.Lines[0]=#10 do
 window.Lines.Delete(0);
if main.Visible=false then
 begin
 trayicon.IconList:=images;
 trayicon.CycleIcons:=true;
 end;
end;

procedure TMain.Timer2Timer(Sender: TObject);
begin
with window do 
begin
  SelStart := Length(Text);
  Perform(EM_SCROLLCARET, 0, 0);
timer2.Enabled:=false;
end;
end;

procedure TMain.windowChange(Sender: TObject);
begin
timer2.Enabled:=true;
end;

procedure TMain.clientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
edit.enabled:=false;
edit.text:='Ó ýòîãî ïîëüçîâàòåëÿ íå çàïóùåíà ïðîãðàììà LAN-Chat.';
errorcode:=0;
end;

procedure TMain.clientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
edit.Clear;
edit.Enabled:=true;
edit.SetFocus;
end;

end.

karataev

Дата 30.3.2006, 07:03 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Ну что, совсем никто не подскажет? smile

Romikgy

Дата 31.3.2006, 15:04 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 3
Всего: 146

Имхо код никакой ( без обид)

Код


procedure TMain.timer1Timer(Sender: TObject);    
begin    
main.FormCreate(timer1);    
if (application.Active) and (visible=true) then    
 begin    
 trayicon.CycleIcons:=false;    
 trayicon.Icon:=application.Icon;    
 end;    
end;

с какой скоростью вызывается этот таймер???? мож из-за него тормоза?

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

karataev

Дата 27.4.2006, 02:15 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

5 секунд. Но при чем тут этот таймер???

Демо

Дата 27.4.2006, 08:32 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

Репутация: 3
Всего: 50

Цитата(karataev @ 14.3.2006, 18:22

)

что скорость передачи одного текстового сообщения около 10-20 секунд

Скорость на каком участке? От клиент-отправителя до сервера? От сервера до клиента-получателя?
Если второе, то где код сервера?
Если первое, то опять же где код сервера?

--------------------

karataev

Дата 3.5.2006, 22:32 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Я организовал сразу и клиент и сервер в одной программе. А что, разве так делать нельзя?

Вот отправка данных клиентом:

Код


procedure TMain.sendClick(Sender: TObject);    
var i:byte;    
begin    
client.Socket.SendText(edit.text);    
window.Text:=window.text+#10+#10+lowercase(getcomputernetname)+' ('+timetostr(time)+' '+    
             datetostr(date)+')'+chr(10)+edit.text;    
while window.Lines[0]=#10 do    
 window.Lines.Delete(0);    
edit.Clear;    
edit.SetFocus;    
end;

Вот обработка получения данных сервером:

Код


procedure TMain.serverClientRead(Sender: TObject;    
  Socket: TCustomWinSocket);    
begin    
window.Text:=window.text+#10+#10+lowercase(socket.RemoteHost)+' ('+timetostr(time)+' '+    
             datetostr(date)+')'+chr(10)+socket.ReceiveText;    
while window.Lines[0]=#10 do    
 window.Lines.Delete(0);    
if main.Visible=false then    
 begin    
 trayicon.IconList:=images;    
 trayicon.CycleIcons:=true;    
 end;    
end;

А вот еще свойства клиента и сервера:

Код


object client: TClientSocket
    Active = False
    ClientType = ctNonBlocking
    Port = 555
    OnConnect = clientConnect
    OnError = clientError
    Left = 136
    Top = 56
end

object server: TServerSocket
    Active = True
    Port = 555
    ServerType = stNonBlocking
    OnClientRead = serverClientRead
    Left = 168
    Top = 56
end

Добавлено @ 22:46

Цитата(Romikgy @ 31.3.2006, 15:04)

Имхо код никакой ( без обид)

Почему? Что именно то непонравилось?

Это сообщение отредактировал(а) karataev - 3.5.2006, 22:44

Romikgy

Дата 3.5.2006, 23:20 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 3
Всего: 146

Цитата(karataev @ 3.5.2006, 21:32

)

Почему? Что именно то непонравилось?

Не помнюуже , давно смотрел код твой, снова смотреть харит, .... мож стиль его не понравился smile

не помню

M
Girder

Не флуди!

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »