Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

TSeverThead, TServerSocket [D7, WinXP]

Страницы: < 1 2
dozcent © (2008-08-07 19:53:00)
Здравствуйте уважаемые мастера.
Что то у меня не совсем правильно работает мой сервер осованный на TServerSocket. Есть пара вопросов по поводу класса TServerThread. Стоит ли его перегружать внутренними функциями, или лучше сделать большую функцию ClientExecute.
Стоит ли добавлять в класс компоненты, допустим, для связи с бд, или создать их в функции?

Вот код, который работает кривовастенько... Возникают ошибки, прога иногда вылетает, остаются подвешенные потоки,
перестаёт выполнять хранимые процедуры в БД.

constructor TServerThread.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket;
DataBaseName: string; DBUser: string; DBPassword: string);
begin
inherited Create(CreateSuspended, ASocket);
List := TStringList.Create;
LogType := '';
DataBase := TIBDatabase.Create(nil);
Transaction := TIBTransaction.Create(DataBase);
Proc := TIBStoredProc.Create(DataBase);
Query := TIBQuery.Create(DataBase);
try
DataBase.DatabaseName := DataBaseName;
DataBase.Params.Add('user_name=' + DBUser);
DataBase.Params.Add('password=' + DBPassword);
DataBase.LoginPrompt := false;
DataBase.SQLDialect := 1;
DataBase.DefaultTransaction := Transaction;
DataBase.Connected := true;
Transaction.Active := true;
Query.Database := DataBase;
Query.Transaction := Transaction;
Proc.Database := DataBase;
proc.Transaction := Transaction;
except
on e: Exception do
LogError('[' + DateToStr(Now) + ']:::::: ThreadCreate::::' + e.Message);
end;
List.Add('[' + DateToStr(Now) + ']::: Thread created sucefuly');
end;

procedure TServerThread.ClientExecute;
var
i, j: integer;
buf1: array[0..2] of byte;
c, cz, temp: byte;
MessTest: TDisplayMesage;
begin
inherited FreeOnTerminate := TRUE;
try
fSocketStream := TWinSocketStream.Create(ClientSocket, ssTimeOut);
try
while (not Terminated) and (ClientSocket.Connected) do
begin
if (not Terminated) and (not fSocketStream.WaitForData(ssTimeOut)) then
begin
List.Add('[' + DateToStr(Now) + ']::: Thread closed by timeout ');
ClientSocket.Close;
fSocketStream.Free;
Free;
end;
DevNo := ClientSocket.ReceiveText;
DevNo := Trim(DevNo);
List.Add('[' + DateToStr(Now) + ']::: Thread recive number ');
if DevNo = 'TEST' then
ClientSocket.SendText('OK')
else
begin
if DeviceInDB then //function TServerThread.DeviceInDB:Boolean Check board is present =============
begin
if UpdateTime then //function TServerThread.UpdateTime:Boolean Check update time =============
begin
CreatePackedge; //procedure TServerThread.CreatePackedge; Getting record for this board ======
for j := 0 to 18 do //===================== Sending Erase command =============
begin
temp := clear_command[j];
ClientSocket.SendBuf(temp, 1);
end;
List.Add('[' + DateToStr(Now) + ']::: Sending erase command ' + DevNo);
for j := 0 to Length(mess) - 1 do //===================== Sending Messages ==================
for i := 0 to Length(mess[j].PrepereMasage) - 1 do
ClientSocket.SendBuf(mess[j].PrepereMasage[i], 1);
List.Add('[' + DateToStr(Now) + ']::: Sending packadge ' + DevNo);
if (not Terminated) and (not fSocketStream.WaitForData(ssTimeOut * 5)) then //================ Waiting For Answer =====================
begin
List.Add('[' + DateToStr(Now) + ']::: Closed by time out on recive message count ' + DevNo);
ClientSocket.Close;
fSocketStream.Free;
Free;
end;
cz := ClientSocket.ReceiveLength; //================ Reciving Message Count =================
ClientSocket.ReceiveBuf(buf1, cz);
List.Add('[' + DateToStr(Now) + ']::: resived message count ' + DevNo);
if buf1[2] >= MessCount then //================ SetUP update time ======================
begin
SetUpUpdateTime;
logstr := 'Äèñïëåé ïîäêëþ÷èëñÿ è ïîëó÷èë ' + IntToStr(buf1[2]) + ' ôàéëîâ.' + #13#10;
LogType := 'UpdateOK';
LogConnection;
end
else
begin
logstr := 'Äèñïëåé ïîäêëþ÷èëñÿ íî ïîëó÷èë ' + IntToStr(buf1[2]) + ' ôàéëîâ, à íå ' + IntToStr(MessCount + 2);
LogType := 'TrasferFaild';
LogConnection;
end;
end; //================ Closing Conection =================
if LogType = '' then
begin
logstr := 'Äèñïëåé ïîäêëþ÷èëñÿ, íî âðåìÿ îáíîâëåíèÿ åù¸ íå ïðèøëî.';
LogType := 'NoTime';
LogConnection;
end;
end
else
begin
MessTest := TDisplayMesage.Create;
MessTest.CR;
MessTest.PrepMess;
for i := 0 to Length(MessTest.PrepereMasage) - 1 do
ClientSocket.SendBuf(MessTest.PrepereMasage[i], 1);
List.Add('[' + DateToStr(Now) + ']::: Sending number for device out DB ' + DevNo);
end;
if LogType = '' then
begin
logstr := 'Ïîäêëþ÷åííîå óñòðîéñòâî îòñóòñòâóåò â áàçå äàííûõ.';
LogType := 'NoDevice';
LogConnection;
ClientSocket.Close;
end;
List.Add('[' + DateToStr(Now) + ']::: Connection close It''s OK ' + DevNo);
LogServerEvents(List);
ClientSocket.Close;
end;
end;
finally
List.Add('[' + DateToStr(Now) + ']::: Finnaly ' + DevNo);
fSocketStream.Free;
Free;
end;
except
on e: exception do
begin
LogError('[' + DateToStr(Now) + ']::: ThreadExecute::::' + e.Message);
ClientSocket.Close;
Terminate;
end;
end;

end;

dozcent (2008-08-10 21:52:00) [21]

> TCP - протокол поточный !

В данном контексте ни о чём не говорит....

Сергей М. (2008-08-10 21:10:00) [22]

> if cz <> 17 then//если длинна не равна 17, то это не моё
> устройство!!!

TCP - протокол поточный!

тебе это о чем-то говорит ?

dozcent (2008-08-09 15:14:00) [23]
Вот тут кое что подправил, появилась куча ошибок и вобще что попало..
procedure TServerThread.ClientExecute; var buf1: array[0..2] of byte; c, cz: byte; begin try fSocketStream := TWinSocketStream.Create(ClientSocket, ssTimeOut); try while (not Terminated) and (ClientSocket.Connected) do begin if (not Terminated) and (not fSocketStream.WaitForData(100000)) then begin ClientSocket.Close; end; ConnectToDb; cz := ClientSocket.ReceiveLength; if cz <> 17 then//если длинна не равна 17, то это не моё устройство!!! begin DataBase.Free; ClientSocket.Close; fSocketStream.Free; end; IMEI := ClientSocket.ReceiveText; IMEI := Trim(IMEI); LogServerEvents('event'); LogServerEvents('event'); if DeviceInDB then //Check board is present begin if UpdateTime then // Check update time begin CreatePackedge; // Getting record for this device SendingMessage; if (not Terminated) and (not fSocketStream.WaitForData(1000000)) then begin ClientSocket.Close; end; cz := ClientSocket.ReceiveLength; //Reciving Message Count ClientSocket.ReceiveBuf(buf1, cz); LogServerEvents('event'); if buf1[2] >= MessCount then // SetUP update time begin SetUpUpdateTime; LogConnection(1); ClientSocket.Close; end else begin LogConnection(2); ClientSocket.Close; end; end else begin LogConnection(3); ClientSocket.Close; end; end else begin SendingMessageToNewDevice; LogConnection(4); ClientSocket.Close; end; LogServerEvents('event') end; finally LogServerEvents('event'); DataBase.Free; fSocketStream.Free; end; except on e: exception do begin LogServerEvents('event'); LogError('Error'); DataBase.Free; fSocketStream.Free; ClientSocket.Close; end; end; end;
Что то мне непонятно, когда же эти потоки убиваются!

dozcent (2008-08-09 15:08:00) [24]
Разъясните тогда пожалуйста, кто когда и почему удаляется в этой конструкции, а то я что-то непойму...
Если у меня
type TServerThread = class(TServerClientThread) .......... private DataBase: TIBDatabase; .......... end;
Я вызываю её создание в ClientExecute, то когда её нужно убить...
И почему нельзя
FreeOnTerminate := TRUE;
Что происходит при ClientSocket.Close кроме закрытия сокета?

Сергей М. (2008-08-08 09:52:00) [25]
Короче говоря, в приведенном коде косяк на косяке косяком погоняет)

Проще выкинуть его в топку и переписать "с нуля" - с чувством, с толком, с расстановкой)

Slym (2008-08-08 09:17:00) [26]
dozcent © (07.08.08 19:53)
PrepereMasage
Мнебы сейчас массажистку...
кОкай языг учiлЪ?

Slym (2008-08-08 09:14:00) [27]
dozcent © (07.08.08 19:53)
Стоит ли его перегружать внутренними функциями
Стоит! без паллитры в этом листинге не разберешься
dozcent © (07.08.08 19:53)
Стоит ли добавлять в класс компоненты
У где они у тебя? наруже? нипорядок!!!
1. нитрогай constructor TServerThread.Create... перенеси все (создание конектов и прочей фегни) в ClientExecute, оставить можешь только присвоение DataBaseName/DBUser/DBPassword во внутренние переменные и пользовать их в ClientExecute...
2. inherited FreeOnTerminate := TRUE; - НИЗЯ!!!
3. Free; - АХТУНГ! НИЗЯ!
4. var buf1: array[0..2] of byte; ... cz := ClientSocket.ReceiveLength;// ОПТИМИСТ, ДА? ClientSocket.ReceiveBuf(buf1, cz);
А я тебе фсе телевидение испорчу :) послав более SizeOf(buf1) и получишь AV или уязвимость с выполнением вредоносного кода
5.
fSocketStream := TWinSocketStream.Create(ClientSocket, ssTimeOut); try ... if (not Terminated) and (not fSocketStream.WaitForData(ssTimeOut)) then ... fSocketStream.Free; Free; end; ... finally ... fSocketStream.Free; Free; end;
итого налицо двойное убийство, с особой тяжестью... приговор отрубление кривых рук сроком на 10 лет :)
6. Протокол основан на честном слове - никаких проверок на размеры и соответствие полей, а в сочетании с сокетами которые умеют клеить и дробить пакеты ты огребеш... и в DevNo := ClientSocket.ReceiveText; ты получиш или пол сообщения или несколько

Сергей М. (2008-08-08 08:29:00) [28]
И вообще - твоя логика работы с методами приема/передачи объекта TCustomWinSocket не выдерживает никакой критики.
И доп.потоки тут ни причем - при такой логике граблей можно нахватать в любом потоке.

Сергей М. (2008-08-08 08:26:00) [29]

> лучше сделать большую функцию ClientExecute

Не функцию, а процедурный метод.
На то он, виртуальный, кстати, и существует, чтобы его можно было перекрыть в наследнике и реализовать в нем свою логику.

> или создать их в функции

Именно.
Особенно в твоем случае с потоконебезопасными объектами доступа к IB.

> DataBase.Connected := true;

Засада поджидает уже в этой строчке - коннект ты осуществляешь в дополнительном слушающем потоке сервера, вызвавшем конструктор, а последующую работу с базой в теле ClientExecute ты осуществляешь уже в другом доп.потоке, ассоциированном со вновь установленным сокетным соединением.

> FreeOnTerminate := TRUE;

Для объектов-наследников TServerClientThread "саморазрушение" недопустимо - сервер сам управляет временами жизни объектов-потоков, регистрируемых им во внутреннем кэше после конструирования.

Страницы: < 1 2

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »