Собственно сабж.
» ServerSocket/ClientSocket в Delphi
Пример кода ?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
ClientSocket1: TClientSocket;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Button3Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Active:=true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerSocket1.Active:=false;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ServerSocket1.Active:=false;
end;
procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode := 0;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var msg : string;
begin
msg:=Socket.ReceiveText;
label1.Caption:=msg;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Active:=true;
Application.ProcessMessages;
ClientSocket1.Socket.SendText('hello server');
Application.ProcessMessages;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode := 0;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ServerSocket1.Socket.SendText('Hello client');
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var msg : string;
begin
msg:=socket.ReceiveText;
label2.Caption:=msg;
end;
end.
Вот мой исходник.
При попытке отправить сообщение от сервера к клиенту выдаёт ошибку.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
ClientSocket1: TClientSocket;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Button3Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Active:=true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerSocket1.Active:=false;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ServerSocket1.Active:=false;
end;
procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode := 0;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var msg : string;
begin
msg:=Socket.ReceiveText;
label1.Caption:=msg;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Active:=true;
Application.ProcessMessages;
ClientSocket1.Socket.SendText('hello server');
Application.ProcessMessages;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode := 0;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ServerSocket1.Socket.SendText('Hello client');
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var msg : string;
begin
msg:=socket.ReceiveText;
label2.Caption:=msg;
end;
end.
Вот мой исходник.
При попытке отправить сообщение от сервера к клиенту выдаёт ошибку.
Логика, теория и практика подсказывают, что отправлять сообщения от сервера к клиенту нужно не от ServerSocket1.Socket, покольку у сервера может быть одновременно несколько клиентов, а от Socket, который был получен в обработчике события OnAccept компонента ServerSocket1, когда собственно клиент подключился и соединение было установлено.
Отправлять я научился
Только вот и вправду возник вопро что сделать когда клиентов много
Вот мой новый исходник (весь)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ShellApi,
ExtCtrls, daADStanIntf, daADStanOption, daADStanDef, daADPhysIntf,
daADDatSManager, daADStanParam, daADDAptIntf, DB, daADPhysManager,
daADPhysMySQL, daADCompDataSet, daADCompClient, Grids, DBGrids,
daADGUIxFormsWait, daADGUIxFormsfError, jpeg;
type
TSendPack = record
meta : Tstrings;
dest,time_col,time_ed : string;
end;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
ListBox1: TListBox;
Edit1: TEdit;
Memo1: TMemo;
Edit2: TEdit;
ADConnection1: TADConnection;
ADQuery1: TADQuery;
ADGUIxWaitCursor1: TADGUIxWaitCursor;
ADPhysMySQLDriverLink1: TADPhysMySQLDriverLink;
DataSource1: TDataSource;
Label1: TLabel;
DataSource2: TDataSource;
ADQuery2: TADQuery;
Image1: TImage;
Button1: TButton;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button1Click(Sender: TObject);
procedure ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ID_USER : string;
implementation
{$R *.dfm}
function BMSearch(StartPos: Integer; const S, P: string): Integer;
type
TBMTable = array[0..255] of Integer;
var
Pos, lp, i: Integer;
BMT: TBMTable;
begin
for i := 0 to 255 do
BMT[i] := Length(P);
for i := Length(P) downto 1 do
if BMT[Byte(P[i])] = Length(P) then
BMT[Byte(P[i])] := Length(P) - i;
lp := Length(P);
Pos := StartPos + lp - 1;
while Pos <= Length(S) do
if P[lp] <> S[Pos] then
Pos := Pos + BMT[Byte(S[Pos])]
else if lp = 1 then
begin
Result := Pos;
Exit;
end
else
for i := lp - 1 downto 1 do
if P[i] <> S[Pos - lp + i] then
begin
Inc(Pos);
Break;
end
else if i = 1 then
begin
Result := Pos - lp + 1;
Exit;
end;
Result := 0;
end;
function copystr(str : string; first : integer; last : integer):string;
var i : integer;
buf : string;
chbuf : char;
begin
for i := first to last do
begin
chbuf:=str[i];
buf:=buf+chbuf;
end;
result:=buf;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Serversocket1.Active := False;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Serversocket1.Active := False;
end;
procedure TForm1.ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
errorcode := 0;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
msg, ip, bufstring,ID,pass,login : string;
time : _SYSTEMTIME;
buf : TSendPack;
pos, bufpos, bufend, i : integer;
begin
ip := socket.RemoteAddress;
GetSystemTime(time);
msg:=Socket.ReceiveText;
case msg[1] of
'1':
begin
msg := ip+' time '+inttostr(time.wHour+3)+':'+inttostr(time.wMinute)+':'+inttostr(time.wSecond);
ListBox1.AddItem(msg,Sender);
end;
'2':
begin
pos:=BMSearch(2,msg,'|');
bufpos:=pos;
buf.dest:=copystr(msg,2,bufpos-1);
pos:=BMSearch(bufpos+1,msg,'|');
bufend:=bufpos;
bufpos:=pos;
bufstring:=copystr(msg,bufend+1,bufpos-1);
pos:=BMSearch(bufpos+1,msg,'|');
bufend:=bufpos;
bufpos:=pos;
buf.time_col:=copystr(msg,bufend+1,bufpos-1);
buf.time_ed:=copystr(msg,bufpos+1,length(msg));
edit1.Text:=buf.dest;
edit2.Text:='Íà '+buf.time_col+' '+buf.time_ed;
memo1.Lines.SetText(PAnsiChar(bufstring));
ADQuery1.SQL.Clear;
ADQuery1.SQL.Add('SELECT `ID` FROM `users` WHERE `IP`="'+Socket.RemoteAddress+'"');
if not ADQuery1.Active then
ADQuery1.Active:=true
else
ADQuery1.ExecSQL;
ID:=ADQuery1.Fields.FindField('ID').Text;
ADQuery1.SQL.Clear;
ADQuery1.SQL.Add('INSERT INTO `log` VALUES (NULL , "'+ID+'", "'+buf.dest+'", "'+bufstring+'", "'+buf.time_col+' '+buf.time_ed+'", "'+inttostr(time.wHour)+':'+inttostr(time.wMinute)+'", "'+inttostr(time.wDay)+'/'+inttostr(time.wMonth)+'/'+inttostr(time.wYear)+'")');
ADQuery1.ExecSQL;
end;
'3':
begin
// ADQuery1.SQL.Clear;
// ADQuery1.SQL.Add('SELECT `PHOTO` FROM `users` WHERE `IP`="'+Socket.RemoteAddress+'"');
// ADQuery1.ExecSQL;
end;
'4':
begin
pos:=BMSearch(3,msg,'|');
bufpos:=pos;
login:=copystr(msg,3,bufpos-1);
pass:=copystr(msg,bufpos+1,length(msg));
ADQuery1.SQL.Clear;
ADQuery1.SQL.Add('SELECT `ID` FROM `users` WHERE `LOGIN`="'+login+'" AND `PASS`="'+pass+'"');
if not ADQuery1.Active then
ADQuery1.Active:=true
else
ADQuery1.ExecSQL;
ID_USER:=ADQuery1.Fields.FindField('ID').Text;
if ID_USER <>'' then
begin
for I:= 0 to self.ServerSocket1.Socket.ActiveConnections -1 do
begin
ServerSocket1.Socket.Connections[I].SendText('ok');
end;
label1.Caption:=ID_USER+' ok';
end
else
begin
for I:= 0 to self.ServerSocket1.Socket.ActiveConnections -1 do
begin
ServerSocket1.Socket.Connections[I].SendText('bad');
end;
label1.Caption:=ID_USER+' bad';
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Active:=true;
ServerSocket1.Open;
end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
listBox1.Clear;
ListBox1.AddItem('Client connect',Sender);
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
ListBox1.AddItem('Client diconnect',Sender);
end;
end.
в процедуре ServerSocket1ClientRead мой сурвер по первому символу полученной строки определяет что нужно делать дальше. Когда приходит строка с первым символом 4 сервер делает запрос в базу данных проверяет на валидность введённые данные (логин/пароль) и должен отослать ответ либо ok либо bad. Но когда несколько клиентов пытаються вводить свои данные они все получают один ответ как и говорил Anseltis. Так вот у меня вопрос как это всё разграничить. Чтобы каждому пользователю отсылались свои пакеты. Желательно пример, если можно. А то я с сокетами первый раз работаю, ещё толком не разобрался.
Только вот и вправду возник вопро что сделать когда клиентов много
Вот мой новый исходник (весь)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ShellApi,
ExtCtrls, daADStanIntf, daADStanOption, daADStanDef, daADPhysIntf,
daADDatSManager, daADStanParam, daADDAptIntf, DB, daADPhysManager,
daADPhysMySQL, daADCompDataSet, daADCompClient, Grids, DBGrids,
daADGUIxFormsWait, daADGUIxFormsfError, jpeg;
type
TSendPack = record
meta : Tstrings;
dest,time_col,time_ed : string;
end;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
ListBox1: TListBox;
Edit1: TEdit;
Memo1: TMemo;
Edit2: TEdit;
ADConnection1: TADConnection;
ADQuery1: TADQuery;
ADGUIxWaitCursor1: TADGUIxWaitCursor;
ADPhysMySQLDriverLink1: TADPhysMySQLDriverLink;
DataSource1: TDataSource;
Label1: TLabel;
DataSource2: TDataSource;
ADQuery2: TADQuery;
Image1: TImage;
Button1: TButton;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button1Click(Sender: TObject);
procedure ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ID_USER : string;
implementation
{$R *.dfm}
function BMSearch(StartPos: Integer; const S, P: string): Integer;
type
TBMTable = array[0..255] of Integer;
var
Pos, lp, i: Integer;
BMT: TBMTable;
begin
for i := 0 to 255 do
BMT[i] := Length(P);
for i := Length(P) downto 1 do
if BMT[Byte(P[i])] = Length(P) then
BMT[Byte(P[i])] := Length(P) - i;
lp := Length(P);
Pos := StartPos + lp - 1;
while Pos <= Length(S) do
if P[lp] <> S[Pos] then
Pos := Pos + BMT[Byte(S[Pos])]
else if lp = 1 then
begin
Result := Pos;
Exit;
end
else
for i := lp - 1 downto 1 do
if P[i] <> S[Pos - lp + i] then
begin
Inc(Pos);
Break;
end
else if i = 1 then
begin
Result := Pos - lp + 1;
Exit;
end;
Result := 0;
end;
function copystr(str : string; first : integer; last : integer):string;
var i : integer;
buf : string;
chbuf : char;
begin
for i := first to last do
begin
chbuf:=str[i];
buf:=buf+chbuf;
end;
result:=buf;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Serversocket1.Active := False;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Serversocket1.Active := False;
end;
procedure TForm1.ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
errorcode := 0;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
msg, ip, bufstring,ID,pass,login : string;
time : _SYSTEMTIME;
buf : TSendPack;
pos, bufpos, bufend, i : integer;
begin
ip := socket.RemoteAddress;
GetSystemTime(time);
msg:=Socket.ReceiveText;
case msg[1] of
'1':
begin
msg := ip+' time '+inttostr(time.wHour+3)+':'+inttostr(time.wMinute)+':'+inttostr(time.wSecond);
ListBox1.AddItem(msg,Sender);
end;
'2':
begin
pos:=BMSearch(2,msg,'|');
bufpos:=pos;
buf.dest:=copystr(msg,2,bufpos-1);
pos:=BMSearch(bufpos+1,msg,'|');
bufend:=bufpos;
bufpos:=pos;
bufstring:=copystr(msg,bufend+1,bufpos-1);
pos:=BMSearch(bufpos+1,msg,'|');
bufend:=bufpos;
bufpos:=pos;
buf.time_col:=copystr(msg,bufend+1,bufpos-1);
buf.time_ed:=copystr(msg,bufpos+1,length(msg));
edit1.Text:=buf.dest;
edit2.Text:='Íà '+buf.time_col+' '+buf.time_ed;
memo1.Lines.SetText(PAnsiChar(bufstring));
ADQuery1.SQL.Clear;
ADQuery1.SQL.Add('SELECT `ID` FROM `users` WHERE `IP`="'+Socket.RemoteAddress+'"');
if not ADQuery1.Active then
ADQuery1.Active:=true
else
ADQuery1.ExecSQL;
ID:=ADQuery1.Fields.FindField('ID').Text;
ADQuery1.SQL.Clear;
ADQuery1.SQL.Add('INSERT INTO `log` VALUES (NULL , "'+ID+'", "'+buf.dest+'", "'+bufstring+'", "'+buf.time_col+' '+buf.time_ed+'", "'+inttostr(time.wHour)+':'+inttostr(time.wMinute)+'", "'+inttostr(time.wDay)+'/'+inttostr(time.wMonth)+'/'+inttostr(time.wYear)+'")');
ADQuery1.ExecSQL;
end;
'3':
begin
// ADQuery1.SQL.Clear;
// ADQuery1.SQL.Add('SELECT `PHOTO` FROM `users` WHERE `IP`="'+Socket.RemoteAddress+'"');
// ADQuery1.ExecSQL;
end;
'4':
begin
pos:=BMSearch(3,msg,'|');
bufpos:=pos;
login:=copystr(msg,3,bufpos-1);
pass:=copystr(msg,bufpos+1,length(msg));
ADQuery1.SQL.Clear;
ADQuery1.SQL.Add('SELECT `ID` FROM `users` WHERE `LOGIN`="'+login+'" AND `PASS`="'+pass+'"');
if not ADQuery1.Active then
ADQuery1.Active:=true
else
ADQuery1.ExecSQL;
ID_USER:=ADQuery1.Fields.FindField('ID').Text;
if ID_USER <>'' then
begin
for I:= 0 to self.ServerSocket1.Socket.ActiveConnections -1 do
begin
ServerSocket1.Socket.Connections[I].SendText('ok');
end;
label1.Caption:=ID_USER+' ok';
end
else
begin
for I:= 0 to self.ServerSocket1.Socket.ActiveConnections -1 do
begin
ServerSocket1.Socket.Connections[I].SendText('bad');
end;
label1.Caption:=ID_USER+' bad';
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Active:=true;
ServerSocket1.Open;
end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
listBox1.Clear;
ListBox1.AddItem('Client connect',Sender);
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
ListBox1.AddItem('Client diconnect',Sender);
end;
end.
в процедуре ServerSocket1ClientRead мой сурвер по первому символу полученной строки определяет что нужно делать дальше. Когда приходит строка с первым символом 4 сервер делает запрос в базу данных проверяет на валидность введённые данные (логин/пароль) и должен отослать ответ либо ok либо bad. Но когда несколько клиентов пытаються вводить свои данные они все получают один ответ как и говорил Anseltis. Так вот у меня вопрос как это всё разграничить. Чтобы каждому пользователю отсылались свои пакеты. Желательно пример, если можно. А то я с сокетами первый раз работаю, ещё толком не разобрался.
Просто отличаем каждый клиент по его ip-адресу и исходному порту, с которого пришло сообщение. Даже если на одном компьютере запустить 20 клиентов, они должны будут забиндить себе разные порты или не смогут работать (точнее будет работать один из них - тот, кто занял соответствующий порт первым). Т. е. связка ip+port позволит вам однозначно идентифицировать каждый клиент.
А стандартными средствами ServerSocket/ClientSocket никак нельзя различать что куда посылать. И мне в принциепе не надо 20 клиентов на одной машине запускать.
Добавлено:
Да у меня ещё вопросик, для чего именно нужно событие OnAccept компонента ServerSocket?
Добавлено:
Да у меня ещё вопросик, для чего именно нужно событие OnAccept компонента ServerSocket?
Страницы: 1
Предыдущая тема: Макрос Excel
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.