В продолжении темы про сервера и клиенты...
Автор изначального примера реализовал как для клиента на сервере, так и для клиента у пользователя вот такой код. Программа может через три процедуры SendMessage, SendStream, SendFile обмениваться с сервером сообщениями. Процедуры помещают задачу в список, и ниже приведенный код выполняет отправку. Как писал выше, один из багов реализации чтение списка задом наперед. Но это еще не все.
- Код: Выделить всё
procedure TClientThread.Execute;
var
Msg: String;
MsgTyp: Integer;
Params: TStringArray;
Size: Int64;
MS: TMemoryStream;
I: Integer;
FileName: String;
Path: String;
List: TList;
Task: TTask;
FCurPing: QWord;
begin
FLastPing := GetTickCount64;
if FTCPBase.FTCPBaseType = tcpServer then
BroadcastConnection;
while not Terminated do
begin
if (not FBusy) and (not FNeedToBreak) then
begin
FBusy := True;
try
List := FTaskList.TaskList.LockList;
try
for I := List.Count - 1 downto 0 do
begin
if FNeedToBreak then
Break;
if ProcessTask(TTask(List[I])) then
begin
FLastPing := GetTickCount64;
Task := TTask(List.Items[I]);
if Task <> nil then
FTaskList.DeleteTask(Task);
List.Delete(I);
end;
end;
finally
FTaskList.TaskList.UnlockList;
end;
finally
FBusy := False;
end;
end;
if not RecvMessage(500, MsgTyp, Msg, Params) then
begin
DoDisconnect;
Break;
end;
case MsgTyp of
0: begin
FLastPing := GetTickCount64;
if not FTCPBase.FIgnoreMessage then
DoRecv(0, Msg, Params, nil);
end;
1: begin
FLastPing := GetTickCount64;
Size := StrToInt64Def(Params[Length(Params) - 1], -1);
if Size > 0 then
begin
SetLength(Params, Length(Params) - 1);
MS := TMemoryStream.Create;
try
MS.SetSize(Size);
MS.Position := 0;
if RecvStream(MS) then
DoRecv(1, Msg, Params, MS);
finally
MS.Free;
end;
end
end;
2: begin
FLastPing := GetTickCount64;
Size := StrToInt64Def(Params[Length(Params) - 2], -1);
FileName := Params[Length(Params) - 1];
SetLength(Params, Length(Params) - 2);
if Size > 0 then
begin
Path := AddDirSeparator(GetDownloadDir(FTCPBase.FDownloadDirectory));
if DirectoryExists(Path) then
begin
Path := Path + FConnection.FUser + '_' + FileName;
if RecvFile(Path, Size) then
DoRecv(2, Msg, Params, nil, Path)
end
else
DoError(rsInvalidDirectory, 0);
end
else
FileCreate(Params[0] + Params[1]);
end;
end;
if (FTCPBase.FTCPBaseType = tcpServer) then
begin
FCurPing := GetTickCount64;
if (FCurPing - FLastPing > PingTimeoutServer) then
begin
DoDisconnect;
Break;
end;
end
else if (FTCPBase.FTCPBaseType = tcpClient) then
begin
FCurPing := GetTickCount64;
if (FCurPing - FLastPing > PingTimeoutClient) then
FTaskList.AddTask('MESSAGE', 'PING', [], nil, '');
end;
end;
FDisconnected := True;
while not Terminated do
Sleep(100);
end;
Программа в принципе работала, и общалась. Но как то медленно. Я понимал что это странно, но не придавал значения. Для мое задачи скорость не главное.. пока не уперся в одну проблему. О ней чуть позже. А вот тормоза живут здесь
- Код: Выделить всё
if not RecvMessage(500, MsgTyp, Msg, Params) then
Чтение из сокета происходит каждый цикл с ожиданием 500мс. В принципе логично, но медленно. Кто играл в CS поймет. А если пытаться менять параметры таймингов тут и в прочих частях реализации работоспобность падает в ноль.
Сейчас реализация бегает шустро вот с таким вариантом(код черновой).
1. За один цикл производится отправка только одного сообщения из списка
2. За один цикл производится прием только одного сообщения.
3. За счет ниже приведенных SocketActive, SocketCanRead, SocketCanWrite, ReadBeginDialog проверяется живой ли вообще сокет, и есть ли что то в буфере, в случае записи есть ли место куда писать. Если есть работаем по долгому пути и читаем, пишем с длиииинными таймингами. А если все пусто или занято, то идем мимо до следующего повтора.
- Код: Выделить всё
procedure TClientOnServerThread.Execute;
var
Msg : String;
iDebugCicle,
iBadResult,
IdleCounter,
MsgTyp : Integer;
Params : TStringArray;
Size : Int64;
MS : TMemoryStream;
iStart,
I,iWhileCount : Integer;
FileName : String;
Path : String;
List : TList;
Task : TTask;
FLastIdleTick,
FCurIdleTick,
FLastTick,
FCurTick,
FLastTick2,
FCurTick2 : QWord;
DoIdleControl,
DoPing : Boolean;
begin
FCurTick := GetTickCount64;
FLastTick := FCurTick;
FCurTick2 := 0;
FLastTick2 := 0;
FCurIdleTick := FCurTick;
FLastIdleTick := FCurTick;
DoPing := False;
DoIdleControl :=False;
iWhileCount := 100;
if (FTCPBase.TCPBaseType = tcpServer)and(FTCPBase.ActiveOrConnected) then
BroadcastConnection(FConnection.FUser);
while not Terminated do
begin
MsgTyp :=-1;
Msg :='';
Params :=[];
IdleCounter :=0;
FCurTick :=GetTickCount64;
iStart :=0;
if not SocketActive then
begin
DoDisconnect;
Break;
end;
//Write data
if (not FBusy) and (not NeedToBreak) then
begin
FBusy := True;
try
List := FTaskList.TaskList.LockList;
try
iDebugCicle:=0;
//Отправка
if (List.Count>0)and(SocketCanWrite) then
begin
i:=0;
iStart:=SocketActive;
if iStart=1 then
begin
if ProcessTask(TTask(List[I])) then
begin
inc(iDebugCicle);
inc(IdleCounter);
Task := TTask(List.Items[I]);
if Task <> nil then
FTaskList.DeleteTask(Task);
List.Delete(I);
end;
end;
end;
if iDebugCicle>1 then
begin
DoDebugMessage(format('Sended %d messages',[iDebugCicle]));
end;
finally
FTaskList.TaskList.UnlockList;
end;
//Read data
iDebugCicle:=0;
i:=ReadBeginDialog;
if i=1 then
begin
if not RecvMessage(TIMEOUT_LCICLE_RECVMESSAGE, MsgTyp, Msg, Params) then
begin
i:=-1;
DoDisconnect;
Break;
end;
end
else if i=-1 then
begin
DoDisconnect;
Break;
end;
if (i=1)and(not FNeedToBreak) then
begin
inc(iDebugCicle);
case MsgTyp of
0: begin
if ShortCompareText(Msg,'PING')=0 then
begin
if Length(Params)=1 then
begin
if ShortCompareText(Params[0],'BEGIN')=0 then
begin
FTaskList.AddTask('PING', 'PING', ['END'], nil, '');
end
else if ShortCompareText(Params[0],'END')=0 then
begin
DoPing := False;
FCurTick2 := FCurTick;
Ping := FCurTick2 - FLastTick2;
end;
end;
end
else begin
inc(IdleCounter);
DoRecv(0, Msg, Params, nil);
end;
end;
1: begin //stream
inc(IdleCounter);
Size := StrToInt64Def(Params[Length(Params) - 1], -1);
if Size > 0 then
begin
SetLength(Params, Length(Params) - 1);
MS := TMemoryStream.Create;
try
MS.SetSize(Size);
MS.Position := 0;
if RecvStream(MS) then
DoRecv(1, Msg, Params, MS);
finally
MS.Free;
end;
end
end;
2: begin //file
inc(IdleCounter);
Size := StrToInt64Def(Params[Length(Params) - 2], -1);
FileName := Params[Length(Params) - 1];
SetLength(Params, Length(Params) - 2);
if Size > 0 then
begin
Path := AddDirSeparator(GetDownloadDir(FTCPBase.DownloadDirectory));
if DirectoryExists(Path) then
begin
Path := ConcatPaths([Path,FileName]);
if RecvFile(Path, Size) then
DoRecv(2, Msg, Params, nil, Path)
end
else
DoWriteErrorLog(rsInvalidDirectory, 0);
end;
end;
end;
end;
if iDebugCicle>1 then
begin
DoDebugMessage(format('Readed %d messages',[iDebugCicle]));
end;
finally
FBusy := False;
end;
if (FTCPBase.TCPBaseType = tcpServer)and (not NeedToBreak) then
begin
FCurIdleTick := FCurTick;
//Раз в KARINA_PING_PERIODONSERVER программа проверяет свой пинг
if (Ping > KARINA_PING_DISCONNECT) then
begin
DoWriteLog(Format('Disconnect by high ping(Limit %d ms)',[KARINA_PING_DISCONNECT]));
Sleep(10);
DoDisconnect;
Break;
end
else if (DoPing)and(FCurTick - FLastTick > KARINA_PING_PERIODONSERVER) then
begin
DoPing := False;
Ping := 9999;
DoWriteLog(Format('Disconnect by very high ping(Limit %d ms)',[KARINA_PING_PERIODONSERVER]));
Sleep(10);
DoDisconnect;
Break;
end
else if (FCurTick - FLastTick > KARINA_PING_PERIODONSERVER)and (FTCPBase.ClientActionCount=0) then
begin
FLastTick := FCurTick;
FLastTick2 := FCurTick;
DoPing := True;
FTaskList.AddTask('PING', 'PING', ['BEGIN'], nil, '');
end;
end;
end;
Sleep(10);
dec(iWhileCount);
if iWhileCount<=0 then
begin
iWhileCount:=100;
Synchronize(@SynchronizeData);
end;
end; //цикл
if (FTCPBase.TCPBaseType = tcpServer)and(FTCPBase.ActiveOrConnected) then
BroadcastDisconnection(FConnection.FUser);
DoWriteLog(Format(rsMessageClientEndLogStats,[FLogCounterMessage,FLogCounterError,FLogCounterInternal]));
FDisconnected := True;
while not Terminated do
begin
Sleep(100);
end;
end;
- Код: Выделить всё
function TBaseThread.SocketActive: Boolean;
begin
Result := (FBlockSocket.Socket = INVALID_SOCKET) or (FBlockSocket.CanRead(0) and (FBlockSocket.WaitingData = 0));
Result := not Result;
end;
function TBaseThread.SocketCanRead: Boolean;
begin
Result := ((FBlockSocket.Socket <> INVALID_SOCKET) And (FBlockSocket.CanRead(0)));
end;
function TBaseThread.SocketCanWrite: Boolean;
begin
Result := ((FBlockSocket.Socket <> INVALID_SOCKET) And (FBlockSocket.CanWrite(0)));
end;
function TBaseThread.ReadBeginDialog(ATimeOut: Integer): integer;
var
sRead: ShortString;
begin
Result := 0;
if not SocketActive then
begin
Result := -1;
end
else if FBlockSocket.WaitingData>0 then
begin
Result := 1;
end;
end;
Что пока не понимаю....Все работа по циклу с базовыми функциями отправки, но если я хочу сделать к примеру так
- Код: Выделить всё
function TBaseThread.ReadBeginDialog(ATimeOut: Integer): integer;
var
sRead: ShortString;
begin
Result := 0;
sRead := '';
sRead := FBlockSocket.RecvPacket(ATimeOut);
if (FBlockSocket.LastError > 0) and (FBlockSocket.LastError <> WSAETIMEDOUT) then
begin
Result := -1;
end
else begin
if ShortCompareText(sRead,'BEGIN')=0 then
begin
FBlockSocket.SendString('START');
Result := 1;
end;
end;
end;
т.е. клиент прислал короткое BEGIN, сервер ему отвечает START и тем самым переключается в режим "Я ТЕБЯ ВНИМАТЕЛЬНО СЛУШАЮ", то "BEGIN" о казывается и в последующих функциях чтения данных. Хотя по идее его уже извлекли из буфера и он не должен там сидеть. А функция чтения тупит.. и говорит что команду не знает такую. В исходниках работы есть Purge, но толку ноль от него...
вторая беда в частоте команд. Как я понимаю, мы пишем в сокет, если он пустой, если нет то ждем когда освободится. Но на деле кода который копаю получается что(образно) код
- Код: Выделить всё
SendMessage('UPDATE',1,'Поле1','Значение 1');
SendMessage('UPDATE',1,'Поле2','Значение 3');
SendMessage('UPDATE',1,'Поле3','Значение 3');
не полностью доходит, а код
- Код: Выделить всё
SendMessage('UPDATE',1,'Поле1','Значение 1');
Sleep(100);
SendMessage('UPDATE',1,'Поле2','Значение 3');
Sleep(100);
SendMessage('UPDATE',1,'Поле3','Значение 3');
Стабилен. (*Теперь по закону подлости я должен сам пойти и случайно увидеть причину этого всего)
Вот из-за непоняток работы буфера сокета и не полюбил Indy когда то.
В целом пример сделан как p2p приложение по большей части для создания на его базе своей клиент-сервера много приходится порезать и переиграть, но зато гарантированно работает.
