[巨难]Socket的包头(200分)

二进制包头定义如下：
type Tpush_head=packed record
mytype:word;
mylength:word;
end;

包头共4个字节，接受时需要对两个字段做ntohs处理，发送时要htons处理

包体内容是“what i can do ”

请问如何用socket编程完成client端和server端的通讯过程，如果能用Clientsocket控件完成最好。

最好有源码，谢谢！！！

function BuildPacket(var Buf; BufSize: Integer; ACmdType: Word; const AData: string): Integer;
var
L: Integer;
cnt: PChar;
hdr: ^TPush_head;
begin
L := Length(AData);
Result := SizeOf(TPush_head) + L;
if BufSize < Result then
begin
Result := 0;
Exit;
end;
hdr := @Buf;
hdr.myType := htons(ACmdType);
hdr.myLength := htons(Result);
if L > 0 then
begin
cnt := PChar(hdr) + sizeof(TPush_head);
Move(AData[1], cnt^, L);
end;
end;

send:
var
buf: array [0..4095] of Byte;
size: Integer;
begin
size := BuildPacket(Buf[0], SizeOf(Buf), $00000001, 'hello world');
if size > 0 then
Clientsocket.socket.send(buf^, size);
end;

感谢errorcode老大的热心帮助，

又应该如何读取这个封包的内容？

要取得包体里的mytype属性。

您那是封包过成，拆包过程又该怎么写呢？ntohs、htons函数从那里来呢(是来自winsock)？

万分感谢。

.........

htons, ntohs是winsock单元，
uses WinSock;即可。


//
// result = 0，表示buf里面的数据不完整
// result > 0, buf数据包正常
// if size > result, 表示buf里面有N个数据包。
//
function GetPacket(const Buf; Size: Integer; var ACmdType: Word; var AData: string): Integer;
var
L: Integer;
cnt: PChar;
hdr: ^TPush_head;
begin
Result := 0;
if Size < SizeOf(TPush_head) then Exit;
hdr := @Buf;
L := ntohs(hdr.myLength);
if Size < SizeOf(TPush_head) + L then Exit;
Result ;= SizeOf(TPush_head) + L;
ACmdType := ntohs(hdr.myType);
cnt := PChar(hdr) + sizeof(TPush_head);
SetString(AData, cnt, L);
end;


recv:

OnClientConnect事件中写上：
var
DataBuffer: PString;
begin
New(DataBuffer);
DataBuffer^ := '';
Socket.Data := DataBuffer;
end;

OnClientDisconnect:
var
DataBuffer: PString;
begin
DataBuffer := Socket.Data;
if DataBuffer <> nil then
begin
Dispose(DataBuffer);
Socket.Data := nil;
end;

OnClientRecv:

procedure WriteBuffer(ABuffer: PString; Data: PChar; Size: Integer);
begin

end;

var
DataBuffer: PString;
Buffer: array [0..1023] of Char;
Size, PacketSize: Integer;
CmdType: Word;
Data: string;
begin
DataBuffer := ClientSocket.socket.data;

// 按理应该不停的去收，这里只写一个收处理，自己改成循环收，只到size=socket_error
size := ClientSocket.socket.recvbuf(buffer[0], sizeof(buffer));
if size > 0 then
WriteBuffer(DataBuffer, buffer, size);

PacketSize := GetPacket(PChar(DataBuffer^), Length(DataBuffer^), CmdType, Data);
// 处理TCP数据流粘包问题。
while PacketSize > 0 do
begin
// OK, 取出CmdType, Data
....

// 删除取出的数据包
Delete(DataBuffer^, 1, PacketSize);
// 再取下一个包
PacketSize := GetPacket(PChar(DataBuffer^), Length(DataBuffer^), CmdType, Data);
end;
end;

万分感谢！！

procedure WriteBuffer(ABuffer: PString; Data: PChar; Size: Integer);
var
L: Integer;
begin
L := Length(ABuffer^);
SetLength(ABuffer^, L + Size);
Move(Data^, ABuffer^[L], Size);
end;

GetPacket(PChar(DataBuffer^), Length(DataBuffer^), CmdType, Data);
>>
GetPacket(PChar(DataBuffer^)^, Length(DataBuffer^), CmdType, Data);

sigh,测试失败。。。。。

我用的是delphi7, ClientSocket.socket.recvbuf 我换成了socket.ReceiveBuf

这应该不是问题啊。

errorcode,查了下，处理粘包的时候有问题。

procedure WriteBuffer(ABuffer: PString; Data: PChar; Size: Integer);
var
L: Integer;
begin
L := Length(ABuffer^);
SetLength(ABuffer^, L + Size);
Move(Data^, ABuffer^[L], Size);
end;

这无法通过。