![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Оценить поток на основе TClientSocket
FearG0 © (2007-09-30 01:48:00)Для своего приложения я использую поток. Просьба оценить его безглючность и возможные утечки в памяти.
unit ActivationThread;
interface
uses
Windows, SysUtils, Classes,dialogs,ScktComp,messages;
type
TActivationThread = class(TThread)
private
{ Private declarations }
FSock: TClientSocket;
Freceived,Frequest: string;
FHandle: HWND;
FUsername,Femail,FActivationCode:String ;
FcodeError:integer;
procedure OnConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure OnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure OnWrite(Sender: TObject; Socket: TCustomWinSocket);
procedure OnError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ReadEvent(Sender: TObject; Socket: TCustomWinSocket);
protected
procedure Execute; override;
public
constructor Create(CreateSuspennded: Boolean;AUsername,Aemail,AActivationCode:String; const AHandle:HWND);
destructor Destroy; override;
end;
implementation
constructor TActivationThread.Create(CreateSuspennded: Boolean;AUsername,Aemail,AActivationCode:String; const AHandle:HWND);
begin
inherited Create(true);
FUsername:= AUsername ;
Femail:= Aemail ;
FActivationCode:= AActivationCode ;
FHandle:= AHandle;
FreeOnTerminate:=true;
if createSuspennded = false then resume;
end;
destructor TActivationThread.Destroy;
begin
FSock.Free;
inherited;
end;
procedure TActivationThread.OnConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Freceived:='';
Socket.SendText(FRequest);
end;
procedure TActivationThread.OnDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
PostThreadMessage(ThreadId,WM_CLOSE,0,0);
end;
procedure TActivationThread.OnError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
FCodeError := ErrorCode;
ErrorCode := 0;
Socket.Close;
end;
procedure TActivationThread.OnWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
//Socket.Close;
end;
procedure TActivationThread.ReadEvent(Sender: TObject;
Socket: TCustomWinSocket);
begin
FReceived:=FReceived+Socket.ReceiveText;
end;
procedure TActivationThread.Execute;
var
Msg: TMsg;
i,j:integer;
FContent,SitePortion:string;
StartTime:TDatetime; SecondsCount: integer;
arr:stringarray;
ResState:boolean;
begin
try
SetLength(arr,0);
FSock := TClientSocket.Create(nil);
//ShowMessage(GetAddress(Furl));
FSock.Host:= 'www.xxxxx.ru';
FSock.Port := 80;
FSock.OnConnect := OnConnect;
FSock.OnDisconnect := OnDisconnect;
FSock.OnWrite := OnWrite;
FSock.OnError := OnError;
FSock.OnRead := ReadEvent;
FContent:='username='+HTTPTran(FuserName)+'&email='+HTTPTran(Femail)+'&ActivationCode='+HTTPTran(FActivationCode);
FContent:=
'Content-Length: '+IntToStr(Length(FContent))+#13#10+#13#10+FContent+#13#10;
FRequest:='POST /activation.exe HTTP/1.0'+#13#10+
'Content-Type: application/x-www-form-urlencoded'#13#10+
'Accept: */*'+#13#10+
'Accept-Language: ru-RU;q=1.0,en;q=0.5'+#13#10+
'User-Agent: MSIE 6.0'+#13#10+
'Host: www.xxxxx.ru'+#13#10+
'Connection: Close'+#13#10+FContent;
PeekMessage(Msg,0,0,0,PM_REMOVE);
StartTime:=Now;
Freceived:='';
FSock.Open;
while GetMessage(Msg,0,0,0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
if Msg.message=WM_CLOSE then break;
if Terminated then exit;
if SecondsBetween(Now,StartTime)>30 then
begin
FSock.Close;
SendMessage(FHandle,WM_USER + 3260,0,-2);
exit;
end;
end;
FSock.Close;
Freceived:=UTF8ToStrSmart(Freceived);
Freceived:=RemoveHeader(Freceived);
SendMessage(FHandle,WM_USER + 3260,0,StrToInt(Freceived));
except
SendMessage(FHandle,WM_USER + 3260,0,-2);
end;
end;
end.
Сергей М, (2008-05-01 21:14:00) [1]
> Увидел - охренел
Я тоже.
Глядючи на тебя, глюкавого.
glebbest (2008-05-01 20:42:00) [2]Как-то глюкаво работает TWinSocketStream в связке с TClientSocket. Конкретно: SockStream.Read при активном чтении (SockStream.WaitForData(1)) и частых однобайтовых посылках с клиента выдеёт уже прочитанное предыдущей командой SockStream.Read. Увидел - охренел. Delphi 5.
Сергей М. (2007-10-02 16:02:00) [3]
> Осталось придумать как мою реализацию потока доработать,
> чтобы решить эту проблему
Если "глюкавый" сервер не поддерживает дозагрузку, то - хоть из штанов выпрыгни - "проблему" ты не решишь.
FearG0 (2007-10-02 15:49:00) [4]Короче: факт есть факт, данные не всегда приходят от сервера полностью, это касается не конкретно оей реализаци, просто так бывает. Не важно из-за чего - глюковатость сервера, проблемы на линии или ошибки при передаче.
Осталось придумать как мою реализацию потока доработать, чтобы решить эту проблему.
Сергей М. (2007-10-02 15:11:00) [5]
> FearG0 © (02.10.07 15:10) [17]
А теперь все тоже самое , но без доморощенного жаргона ...
FearG0 (2007-10-02 15:10:00) [6]
> Типа "Лениво мне, серверу, сегодня тебе, клиенту, все 400кб
> передавать, на вот тебе шматок в 300кб, остальные 100кб
> завтра как высплюсь так и передам, если захочешь" ?
Ну по ходу да. Попробуй зарегистрировать сайт на народе, там на втором шаге показывается капча. Сохрани ее на диск. Открой в обычном виндовском просмотровщике. Картинка будет искаженной в 70% случаев, потому что сервак яндексовский никогда ее полностью не отдает. Лень ему наврное. Но это не страшно.
Гораздо страшнее, когда сервак яху через свой интерфейс отдает поисковую выдачу не полностью и мой анализатор теряет часть данных....
Вот надо побороть.
Сергей М. (2007-10-02 14:59:00) [7]
> в заголовке будет Range с указанием с какого байта выдать
> контент
А если серверу по барабану твое "указание с какого байта выдать" ? Если сервер отдает либо все либо ничего ?
> Иногда бывает что сервер отдает контент не полностью
Типа "Лениво мне, серверу, сегодня тебе, клиенту, все 400кб передавать, на вот тебе шматок в 300кб, остальные 100кб завтра как высплюсь так и передам, если захочешь" ?
Так что ли ?)
FearG0 (2007-10-02 14:50:00) [8]
> И как ты себе это мыслишь ?
Поток посылает в программу код ошибки, в программе его обработать и создать новый поток где в заголовке будет Range с указанием с какого байта выдать контент
Сергей М. (2007-10-02 08:31:00) [9]
> 1. Иногда бывает что на этом цикле зависает:
При каком поступившем конкретномсообщении ?
> 2. Иногда бывает что сервер отдает контент не полностью,
> особенно когда страница размером 300 - 400 Кбайт
TCP - поточныйпротокол.
> Создавать новый поток на докачку?
И как ты себе это мыслишь ?
Slym (2007-10-02 04:15:00) [10]Сергей М. © (01.10.07 14:13) [11]
Ты забыл, что деструктор виртуальный
падкалол... об этом не подумал...
FearG0 (2007-10-02 03:22:00) [11]1. Иногда бывает что на этом цикле зависает:
while GetMessage(Msg,0,0,0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
Причем при отладке последний брейкпоинт на DispatchMessage(Msg); и после этого вообще ничего не происходит.
От чего может быть?
2. Иногда бывает что сервер отдает контент не полностью, особенно когда страница размером 300 - 400 Кбайт. Как в этом случае поступать? Создавать новый поток на докачку?
3. Такая конструкция была выбрана именно из-за маштабируемости. Помимо активации в программе еще несколько функций активно взаимодействующих с интернетом.
Сергей М. (2007-10-01 14:13:00) [12]
> ТУТ И ЗАВИСАЕМ
Ты забыл, что деструктор виртуальный)
DiamondShark (2007-10-01 13:18:00) [13]Неблокирующий режим -- это тяжёлое наследство царского режима, тобишь кооперативной многозадачности.
В среде с вытесняющей многозадачностью есть такие прекрасные средства, как потоки и overlapped-операции.
Slym (2007-10-01 12:51:00) [14]Сергей М. © (01.10.07 12:30) [8]
Все это расчудесно делается в деструкторе
А деструктор вызывает
Terminate;
if FCreateSuspended then
Resume;
WaitFor;// <-ТУТ И ЗАВИСАЕМ
а еслибы procedure Terminate; virtual;
тадабы я сделал так
procedure CancelBlockingOperations;
begin
Sock.Close;
end;
procedure Terminate; override;
begin
inherited;
CancelBlockingOperations;
end;
Сергей М. (2007-10-01 12:30:00) [15]
> можно написать свой AbortAndTerminate в котором клозить
> сокет и терминироваться.
Нафиг он нужен ?
Все это расчудесно делается в деструкторе.
Slym (2007-10-01 12:25:00) [16]Сергей М. © (01.10.07 11:52) [6]
снять с выполнения блок.операцию
почему terminate не сделали виртуальным :(
Но можно написать свой AbortAndTerminate в котором клозить сокет и терминироваться.
Мой простенький вариант :) -
unit Unit2;
interface
uses
Windows, SysUtils, Classes,dialogs,ScktComp,messages;
type
TActivationThread = class(TThread)
private
FHandle: HWND;
FUsername,Femail,FActivationCode:String;
protected
procedure Execute; override;
public
constructor Create(CreateSuspennded: Boolean;const AUsername,Aemail,AActivationCode:String; const AHandle:HWND);
end;
implementation
constructor TActivationThread.Create(CreateSuspennded: Boolean;const AUsername,Aemail,AActivationCode:String; const AHandle:HWND);
begin
FUsername:=AUsername;
Femail:=Aemail;
FActivationCode:=AActivationCode;
FHandle:= AHandle;
FreeOnTerminate:=true;
inherited Create(CreateSuspennded);
end;
procedure TActivationThread.Execute;
var
Sock: TClientSocket;
SockStream:TWinSocketStream;
Content,Request,Received,Chunk:string;
StartTime:dword;
arr:array of string;
begin
try
SetLength(arr,0);
Sock := TClientSocket.Create(nil);
try
Sock.ClientType:=ctBlocking;
Sock.Host:= 'www.xxxxx.ru';
Sock.Port:= 80;
//Content:='username='+HTTPTran(FuserName)+'&email='+HTTPTran(Femail)+'&ActivationCode='+HTTPTran(FActivationCode);
Request:='POST /activation.exe HTTP/1.0'#13#10+
'Content-Type: application/x-www-form-urlencoded'#13#10+
'Accept: */*'#13#10+
'Accept-Language: ru-RU;q=1.0,en;q=0.5'#13#10+
'User-Agent: MSIE 6.0'#13#10+
'Host: www.xxxxx.ru'#13#10+
'Connection: Close'#13#10+
'Content-Length: '+IntToStr(Length(Content))+#13#10#13#10+Content;
StartTime:=GetTickCount;
Received:='';
Sock.Open;
SockStream:=TWinSocketStream.Create(Sock.Socket,30*1000);
try
SockStream.WriteBuffer(PChar(Request)^,length(Request));
while SockStream.WaitForData(SockStream.TimeOut-(GetTickCount-StartTime)) do
begin
SetLength(Chunk,256);
SetLength(Chunk,SockStream.Read(PChar(Chunk)^,Length(Chunk)));
if length(Chunk)=0 then break;
Received:=Received+Chunk;
end;
finally
SockStream.Free;
end;
finally
Sock.Free;
end;
if Received='' then abort;
//Received:=UTF8ToStrSmart(Received);
//Received:=RemoveHeader(Received);
SendMessage(FHandle,WM_USER + 3260,0,StrToInt(Received));
except
SendMessage(FHandle,WM_USER + 3260,0,-2);
end;
end;
end.
Сергей М. (2007-10-01 11:52:00) [17]
> всеравно блокируется до сообщения
Ну и что ?
А вдруг автору потребуется реакция потока на какие-то сообщения, кроме собственно гнездовых ?
> уж проще сразу в блок режиме работать
Тогда придется выносить наружу хэндл гнезда, чтобы можно было при необходимости извне снять с выполнения блок.операцию.
Это не всегда удобно и не всегда оправдано.
Slym (2007-10-01 11:39:00) [18]Slym © (01.10.07 11:35) [3]
while GetMessage(Msg,0,0,0) do
всеравно блокируется до сообщения, уж проще сразу в блок режиме работать
Сергей М. (2007-10-01 11:39:00) [19]
> Slym © (01.10.07 11:35) [3]
То что для тривиальной задачи автора это неоправданное излишество, я согласен.
Но не исключено, что он осознанно выбрал этот режим, исходя из потенциального наращивания функциональности потока
Slym (2007-10-01 11:35:00) [20]Сергей М. © (01.10.07 8:19) [2]
И что ? Почему бы и нет ?
Ничего криминального, но масломаслянное...