Код, который вы показали, не будет работать как на клиент и сервер из-за нескольких ошибок в коде.
Когда TClientSocket установлен в режим ctNonBlocking (который, как я полагаю, вы используете), Open() не будет вызывать событие OnConnect до тех пор, пока не выйдет btnLoginClick() и поток не вернется в очередь сообщений. Недопустимо считывать или записывать данные из сокета до тех пор, пока не произойдет событие OnConnect. Поэтому вы должны перенести свой код отправки в само событие OnConnect. Также необходимо учитывать, что SendBuf() не может отправлять все данные в одном пакете. Если SendBuf() возвращает -1 и WSAGetLastError() возвращает WSAEWOULDBLOCK (это всегда будет true, если событие OnError не было запущено), данные не были отправлены полностью. Вы должны где-то буферизовать какие-либо неиспользуемые байты, а затем дождаться, когда событие OnWrite начнет срабатывать, прежде чем пытаться записать буферизованные байты снова или что-либо еще для этого вопроса в сокет.
Что касается кода сервера, вы пытаетесь записать исходящие данные в неправильный объект. Вы должны читать и записывать данные с помощью объекта TCustomWinSocket, который предоставляется в OnRead. Вместо этого вы пытаетесь записать данные на объект TServerWinSocket сервера, который не представляет допустимую конечную точку сокета для любого подключенного клиента. Вам также нужно посмотреть возвращаемое значение ReceiveBuf(), чтобы обрабатывать частичные передачи.
Попробуйте что-нибудь еще, как следующее:
Общие:
type
// helper class that holds buffered input/output data
SocketBuffers = class
public
constructor Create;
destructor Destroy;
Inbound: TMemoryStream;
Outbound: TMemoryStream;
end;
constructor SocketBuffers.Create;
begin
inherited;
Inbound := TMemoryStream.Create;
Outbound := TMemoryStream.Create;
end;
destructor SocketBuffers.Destroy;
begin
Inbound.Free;
Outbound.Free;
inherited;
end;
// removes processed bytes from a buffer
procedure CompactBuffer(Buffer: TMemoryStream);
begin
if Buffer.Position > 0 then
begin
// bytes have been processed, remove them from the buffer...
if Buffer.Position < Buffer.Size then
begin
// move unprocessed bytes to the front of the buffer...
Move(Pointer(Longint(Buffer.Memory)+Buffer.Position)^, Buffer.Memory^, Buffer.Size - Buffer.Position);
// reduce the buffer size just the remaining bytes...
Buffer.Size := Buffer.Size - Buffer.Position;
end else
begin
// all bytes have been processed, clear the buffer...
Buffer.Clear;
end;
end;
end;
// sends raw bytes to the specified socket, buffering any unsent bytes
function SendDataToSocket(Socket: TCustomWinSocket; Data: Pointer; DataSize: Integer; Buffer: TMemoryStream): Integer;
var
DataPtr: PByte;
NumSent: Integer;
begin
Result := 0;
DataPtr := PByte(Data);
if DataSize > 0 then
begin
if Buffer.Size = 0 then
begin
// the buffer is empty, send as many bytes as possible...
repeat
NumSent := Socket.SendBuf(DataPtr^, DataSize);
if NumSent <= 0 then Break; // error or disconnected
Inc(DataPtr, NumSent);
Dec(DataSize, NumSent);
Inc(Result, NumSent);
until DataSize = 0;
if DataSize = 0 then Exit; // nothing left to send or buffer
end;
// add unsent bytes to the end of the buffer...
Buffer.Seek(0, soFromEnd);
Buffer.WriteBuf(DataPtr^, DataSize);
Inc(Result, DataSize);
end;
end;
// sends buffered bytes to the specified socket
procedure SendBufferToSocket(Socket: TCustomWinSocket; Buffer: TMemoryStream);
var
DataPtr: PByte;
NumSent: Integer;
begin
// start at the beginning of the buffer
Buffer.Position := 0;
DataPtr := PByte(Buffer.Memory);
while Buffer.Position < Buffer.Size do
begin
NumSent := Socket.SendBuf(DataPtr^, Buffer.Size - Buffer.Position);
if NumSent <= 0 then Break; // error or disconnected
Inc(DataPtr, NumSent);
Buffer.Seek(NumSent, soFromCurrent);
end;
// remove bytes that were sent...
CompactBuffer(Buffer);
end;
// reads raw bytes from the specified socket ands buffers them
procedure ReadBufferFromSocket(Socket: TCustomWinSocket; Buffer: TMemoryStream);
var
NumRecv: Integer;
OldSize: Integer;
begin
repeat
NumRecv := Socket.ReceiveLength;
if NumRecv <= 0 then Exit; // error or no data available
// increase the size of the buffer
OldSize := Buffer.Size;
Buffer.Size := Buffer.Size + NumRecv;
// read bytes into the new memory space
NumRecv := Socket.ReceiveBuf(Pointer(Longint(Buffer.Memory)+OldSize)^, NumRecv);
if NumRecv <= 0 then
begin
// nothing read, free the unused memory
Buffer.Size := OldSize;
Exit;
end;
until False;
end;
Клиент:
var
Buffers: SocketBuffers = nil;
procedure TLogin_Form.FormCreate(Sender: TObject);
begin
Buffers := SocketBuffers.Create;
end;
procedure TLogin_Form.FormDestroy(Sender: TObject);
begin
LoginSocket.Close;
Buffers.Free;
end;
procedure TLogin_Form.btnLoginClick(Sender: TObject);
begin
if not LoginSocket.Active then
begin
Buffers.Inbound.Clear;
Buffers.Outbound.Clear;
LoginSocket.Open;
end;
end;
procedure TLogin_Form.LoginSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
var
LoginQuery: TQuery;
begin
LoginQuery.Login := ledtName.Text;
LoginQuery.Passwort := ledtPasswort.Text;
LoginQuery.IP := LoginSocket.Socket.LocalAddress;
// send query, buffering unsent bytes if needed...
SendDataToSocket(Socket, @LoginQuery, SizeOf(LoginQuery), Buffers.Outbound);
end;
procedure TLogin_Form.LoginSocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TmemoryStream;
Available: Integer;
Query: TQuery;
begin
Buffer := Buffers.Inbound;
// read available bytes into the buffer...
ReadBufferFromSocket(Socket, Buffer);
// process complete queries, ignore unfinished queries until later...
Buffer.Position := 0;
repeat
Available := Buffer.Size - Buffer.Position;
if Available < SizeOf(Query) then Break;
Buffer.ReadBuf(Query, SizeOf(Query));
// process query as needed ...
until False;
// remove processed bytes from the buffer...
CompactBuffer(Buffer);
end;
procedure TLogin_Form.LoginSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
// can send any buffered bytes now...
SendBufferToSocket(Socket, Buffers.Outbound);
end;
Сервер:
procedure TServer_Form.btnStartStopClick(Sender: TObject);
begin
if not ServerSocket.Active then
begin
btnStartStop.Caption := 'stop server';
ServerSocket.Open;
end
else if ServerSocket.Socket.ActiveConnections > 0 then
begin
ShowMessage('Clients still logged in');
end
else
begin
ServerSocket.Close;
end;
end;
procedure UserCheckExist(Socket: TCustomWinSocket; Login, Password: string);
var
LoginReply: TReply;
begin
...
LoginReply.Value := ...;
// send query, buffering unsent bytes if needed...
SendDataToSocket(Socket, @LoginReply, Sizeof(LoginReply), SocketBuffers(Socket.Data).Outbound);
...
end;
procedure TServer_Form.ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := SocketBuffers.Create;
end;
procedure TServer_Form.ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
SocketBuffers(Socket.Data).Free;
Socket.Data := nil;
end;
procedure TServer_Form.ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TmemoryStream;
Available: Integer;
Query: TQuery;
begin
Buffer := SocketBuffers(Socket.Data).Inbound;
// read available bytes into the buffer...
ReadBufferFromSocket(Socket, Buffer);
// process complete queries, ignore unfinished queries until later...
Buffer.Position := 0;
repeat
Available := Buffer.Size - Buffer.Position;
if Available < SizeOf(Query) then Break;
Buffer.ReadBuf(Query, SizeOf(Query));
// process query as needed ...
case Query.Action of
0: UserCheckExist(Socket, Query.Login, Query.Password);
...
end;
until False;
// remove processed bytes from the buffer...
CompactBuffer(Buffer);
end;
procedure TServer_Form.ServerSocketClientWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
// can send any buffered bytes now...
SendBufferToSocket(Socket, SocketBuffers(Socket.Data).Outbound);
end;
Могли бы вы вставить некоторые комментарии? Особенно на общей части? – Acron
Я добавил комментарии сейчас. –
LoginReply - это на самом деле запись. Если я объявляю в записи, что Message: string; и заполнить эту строку данными из файла (10 МБ) и попытаться отправить их, я получаю нарушение доступа на сервере. – Acron