Снова мучаюсь с сокетами, не могу передать запись через сокет, вот мои класы и процедуры обработки:
класс и константы
const
cmdAuth = 1;
cmdMessage = 2;
cmdExit = 255;
type TNetPack = record
Cmd:byte;
UserID: ShortString;
Pswd: ShortString;
Param1:String;
end;
Процедура авторизации
procedure TfrmClient.btnAuthClick(Sender: TObject);
var NetPack:TNetPack;
begin
// Авторизация
NetPack.Cmd:=cmdAuth;
NetPack.UserID:=String(edUsername.Text);
ClientSocket1.Socket.SendBuf(NetPack,SizeOf(NetPack));
end;
Отсылка сообщения серверу
procedure TfrmClient.Button2Click(Sender: TObject);
var buf:TNetPack;
begin
Buf.Cmd:=cmdMessage;
Buf.Param1:=String(edTextToSend.Text);
ClientSocket1.Socket.SendBuf(Buf,SizeOf(Buf));
end;
Обработка сообщения сервером
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
ClientID:integer;
buf:TNetPack;
begin
// Получены данные от клиента
ClientID:=GetClientIDBySocketHandle(Socket.Handle);
Socket.ReceiveBuf(Buf,Socket.ReceiveLength);
case Buf.Cmd of
{ Регистрация пользователя }
cmdAuth:
begin
if ClientID > -1 then TTUsers[ClientID]:=Buf.UserID;
UpdateUserList;
end;
{ Текстовое сообщение серверу }
cmdMessage:
begin
mmLog.Lines.Add(
TTUsers[ClientID]+': '+
Buf.Param1
)
end;
end;
Когда делаю сервер и клиент на одной форме все отлично работает, а если делаю клиент отдельно, то при авторизации все нормально а при приеме сообщения Accec violation
помогите разобраться
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
Здравствуйте, BazaroffMA, Вы писали:
BMA>Снова мучаюсь с сокетами, не могу передать запись через сокет, вот мои класы и процедуры обработки:
BMA>класс и константы
BMA>BMA>const
BMA>cmdAuth = 1;
BMA>cmdMessage = 2;
BMA>cmdExit = 255;
BMA> type TNetPack = record
BMA> Cmd:byte;
BMA> UserID: ShortString;
BMA> Pswd: ShortString;
BMA> Param1:String;
BMA> end;
BMA>
BMA>Когда делаю сервер и клиент на одной форме все отлично работает, а если делаю клиент отдельно, то при авторизации все нормально а при приеме сообщения Accec violation
BMA>помогите разобраться
Да тут все просто: String — это довольно сложный класс, в частности, внутри него хранится указатель на данные строки. Когда ты передаешь record, содержащую String, то у тебя передается только указатель, а не сами данные. Когда читаешь record, то, естественно, считывается только указатель, если принимаешь и посылаешь данные в разных процессах то естественно происходит ошибка, т.к. указатель, полученный в одном процессе, не имеет совершенно никакого смысла в другом. Если на одной форме работает, то это просто случайность, что полученный указатель указывает на данные отправленной строки.
В общем, при пересылке данных надо быть осторожным, и не пересылать указатели. Вместо этого надо пересылать данные объекта, на которые указывает указатель, например, в виде массива байт.
... << RSDN@Home 1.2.0 alpha rev. 786>>
Здравствуйте, BazaroffMA, Вы писали:
BMA>Снова мучаюсь с сокетами, не могу передать запись через сокет, вот мои класы и процедуры обработки:
BMA>класс и константы
BMA>BMA>const
BMA>cmdAuth = 1;
BMA>cmdMessage = 2;
BMA>cmdExit = 255;
BMA> type TNetPack = record
BMA> Cmd:byte;
BMA> UserID: ShortString;
BMA> Pswd: ShortString;
BMA> Param1:String;
BMA> end;
BMA>
...
BMA>Когда делаю сервер и клиент на одной форме все отлично работает, а если делаю клиент отдельно, то при авторизации все нормально а при приеме сообщения Accec violation
BMA>помогите разобраться
на коленке, 10 минут:
program see_memory;
{$APPTYPE CONSOLE}
uses
windows,
SysUtils;
type
TNetPack = record
Cmd: byte;
UserID: ShortString;
Pswd: ShortString;
Param1: string;
end;
procedure dmp_mem(addr: Pbyte; len: Integer);
var
ws: string;
i: Cardinal;
begin
if IsBadReadPtr(addr, len) then
begin
writeln('Error: read pointer is BAD!');
exit;
end;
for i := 0 to pred(len) do
begin
if (i and $F) = 0 then
begin
write(inttohex(cardinal(addr), 8) + ': ');
ws := ' ';
end;
write(inttohex(addr^, 2));
if (addr^ < 32) then ws := ws + '.' else ws := ws + chr(addr^);
if (i and $F) = $F then writeln(ws) else write(' ');
inc(addr);
end;
i := 16 - (len and $F);
if i > 0 then
begin
while i > 0 do
begin
if i > 1 then write(' ') else write(' ');
dec(i);
end;
writeln(ws);
end;
end;
var
NetPack: TNetPack;
begin
NetPack.Cmd := 1;
NetPack.UserID := 'user';
NetPack.Pswd := 'password';
NetPack.Param1 := '12345';
dmp_mem(@NetPack, sizeof(NetPack));
readln;
end.
даст при запуске:
0040A798: 01 04 75 73 65 72 00 00 00 00 00 00 00 00 00 00 ..user..........
0040A7A8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A7B8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A7C8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A7D8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A7E8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A7F8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A808: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A818: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A828: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A838: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A848: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A858: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A868: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A878: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A888: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A898: 00 08 70 61 73 73 77 6F 72 64 00 00 00 00 00 00 ..password......
0040A8A8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A8B8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A8C8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A8D8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A8E8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A8F8: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A908: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A918: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A928: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A938: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A948: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A958: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A968: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A978: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A988: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
0040A998: 00 00 00 00 28 08 86 00 ....(.Ж.
самое главное — последние 4 байта. бывают строки, а бывают указатели на строки. в случае shortstring это будет вся строка в структуре, а в случае string — указатель на строку, в которой кроме самой строки есть еще счетчик ссылок для динамической сборки мусора.
на мой взгляд поля userid и password избыточны;
мне кажется, правильнее описать структуру и передавать ее приблизительно так:
type
TNetPackHdr = record
Cmd: byte;
UserID: String[30];
Pswd: String[30];
end;
TNetPack = record
hdr: TNetPackHdr;
body: string;
end;
...
procedure TfrmClient.Button2Click(Sender: TObject);
var
buf:TNetPack;
slen: Cardinal;
begin
Buf.Hdr.Cmd:=cmdMessage;
Buf.body:=String(edTextToSend.Text);
slen := length(buf.body);
ClientSocket1.Socket.SendBuf(Buf.hdr,SizeOf(TNetPackHdr));
ClientSocket1.Socket.SendBuf(slen,sizeof(slen));
ClientSocket1.Socket.SendBuf(pchar(buf.body)^,slen);
end;
или вообще сериализовать всю структуру в текст и так передавать (например в XML или JSON).
