Доброго времени суток! Я реализую передачу файлов по Tcp. С помощью статей про данный компонент я накалюкал наконец - то данный код:
//код на клиенте
Код:
function TFClient.SendFile(const FileName: String): Cardinal;
const
SocketSize = 1024;
var
Buffer: array [1..SocketSize] of Byte;
TMStream: TFileMemoryStream;
Size, SockSize: Int64;
begin
Result := SF_SUCCESS;
if not FileExists(FileName) then
Result := SF_NOTEXISTS;
if Result = SF_SUCCESS then
try try
TMStream := TFileMemoryStream.Create;
TMStream.LoadFromFile(FileName);
TMStream.Position := 0;
Size := TMStream.Size;
if Size < 0 then
Result := SF_STREAMERROR;
if Result = SF_SUCCESS then
begin
TcpClient.RemoteHost := IPServ;
if not TcpClient.Active then
TcpClient.Open;
TcpClient.SendLn(CombinedString(['File', ExtractFileName(FileName),
IntToStr(Size), IntToStr(SocketSize)], '[#]'));
if TcpClient.ReceiveLn <> 'OK' then
Result := SF_NOTCONNECT;
while (Size > 0) and (Result = SF_SUCCESS) do
begin
if Size >= SocketSize then
SockSize := SocketSize
else
SockSize := Size;
Application.ProcessMessages;
TcpClient.SendLn('PART');
TMStream.ReadBuffer(Buffer, SockSize);
TcpClient.SendBuf(Buffer, SockSize);
if TcpClient.ReceiveLn <> 'OK' then
Result := SF_DISCONNECT;
Dec(Size, SockSize);
end;
if TcpClient.ReceiveLn <> 'OK' then
Result := SF_DISCONNECT;
end;
except
Result := SF_ERROR;
end;
finally
if TcpClient.Active then
TcpClient.Close;
if Assigned(TMStream) then
TMStream.Destroy;
end;
end;
//код на сервере
procedure TFServ.TcpServerAccept;
const
MaxSocketSize = 1024;
var
Buff: TStrArray;
Buffer: array [1..MaxSocketSize] of Byte;
Int, Int1, SockSize: Int64;
begin
try
Buff := SplitString(AnsiLowerCase(ClientSocket.ReceiveLn), '[#]');
Int := Length(Buff);
Int1 := -1;
if (Int = 3) then
begin
if Assigned(CritSect) then
CritSect.TryEnter;
begin
<тут другие комманды>
end;
if Assigned(CritSect) then
CritSect.Leave;
end;
if (Int = 4) then
begin
if Assigned(CritSect) then
CritSect.TryEnter;
if (Buff[0] = 'file') and (Buff[1] <> '') and TryStrToInt64(Buff[2], Int)
and TryStrToInt64(Buff[3], Int1) and (Int >= 0) and (Int1 > 0)
and (Int1 <= MaxSocketSize) then
begin
TMStream.Clear;
TMStream.SetSize(Int);
TMStream.Position := 0;
ClientSocket.SendLn('OK');
while Int > 0 do
begin
if Int >= Int1 then
SockSize := Int1
else
SockSize := Int;
Application.ProcessMessages;
if ClientSocket.ReceiveLn = 'PART' then
begin
ClientSocket.ReceiveBuf(Buffer, SockSize);
TMStream.WriteBuffer(Buffer, SockSize);
ClientSocket.SendLn('OK');
Dec(Int, SockSize);
end
else
Int := -1;
end;
if Int = 0 then
begin
HIPF := NameByIPAddr(ClientSocket.RemoteHost);
TMStream.FileName := Buff[1];
PostMessage(Handle, WM_MY, 4, 0);
ClientSocket.SendLn('OK');
end;
end;
if Assigned(CritSect) then
CritSect.Leave;
end;
except
if Assigned(CritSect) then
CritSect.Leave;
end;
end;
procedure TFServ.GetMess(var Msg: TMessage); message WM_MY;
begin
case Msg.WParam of
0: ...
1: ...
2: ...
4: AcceptFile(TMStream, TMStream.FileName, HIPF);
end;
end;
procedure AcceptFile(Stream: TMemoryStream; FileName, IPName: String);
begin
Stream.SaveToFile(IPName + FileName);
end;
//IP сервера устанавливается автоматически.
Так вот... Этот код у меня работает, если я дело имею с файлами 5 - 6 кб. Если файл весит хотя-бы 500 кб - то ничего не происходит. Но очень странно то, что если взять этот файл 500кб и прогнать его на отладчике(Shift + F8) файл передается нормально и даже без глюков. Причем что еще страннее, я уже писал похожий код, и он у меня нормально работал, а этот код я почти скопировал со старого образца, (вырезал только работу с некоторыми vsl - компонентами). + Так код работает на разных машинах, а если же я запускаю программы на одном компьютере, то сервер отказывается принимать сообщения от клиента, хотя IP что у него, что у TcpClient.RemoteHost одинаковы.
Помогите разобратся в причине сей странного случая, а лучше объясните мне принцип работы TcpServer/tcpClient , а то я ничего не смыслю в данном вопросе.
Если что -то непонятно в заданном мною вопросе, я поясню корректнее. Заранее спасибо.