Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2009.11.08;
Скачать: [xml.tar.bz2];

Вниз

Оценить поток на основе TClientSocket   Найти похожие ветки 

 
FearG0 ©   (2007-09-30 01:48) [0]

Для своего приложения я использую поток. Просьба оценить его безглючность и возможные утечки в памяти.

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.



 
Slym ©   (2007-10-01 04:31) [1]

Pesтеs... В топку код..
1. Работа в НЕБЛОКИРУЮЩИМ сокетом в отдельном! потоке!
2. Ржунимагу:
begin
inherited Create(true);
....
if createSuspennded = false then resume;
end;

гораздо проще
....
inherited Create(createSuspennded);
end;

3. Ты уверен что FSock всегда здесь существует? я нет :)
destructor TActivationThread.Destroy;
begin
FSock.Free;
inherited;
end;


 
Сергей М. ©   (2007-10-01 08:19) [2]


> FearG0 ©   (30.09.07 01:48)


Во избежание утечек и AV следует делать так:

procedure TActivationThread.Execute;
..
begin
..
//создаем гнездо
 FSock := TClientSocket.Create(..);
 try
.. работа с гнездом ..
 finally
   FSock.Free; //безусловно уничтожаем гнездо
 end;
..
..
end;



> TranslateMessage(Msg);


Это лишнее.


> Slym ©   (01.10.07 04:31) [1]
>
> Pesтеs... В топку код..
> 1. Работа в НЕБЛОКИРУЮЩИМ сокетом в отдельном! потоке!


И что ? Почему бы и нет ?


 
Slym ©   (2007-10-01 11:35) [3]

Сергей М. ©   (01.10.07 8:19) [2]
И что ? Почему бы и нет ?

Ничего криминального, но масломаслянное...


 
Сергей М. ©   (2007-10-01 11:39) [4]


> Slym ©   (01.10.07 11:35) [3]


То что для тривиальной задачи автора это неоправданное излишество, я согласен.

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


 
Slym ©   (2007-10-01 11:39) [5]

Slym ©   (01.10.07 11:35) [3]
while GetMessage(Msg,0,0,0) do

всеравно блокируется до сообщения, уж проще сразу в блок режиме работать


 
Сергей М. ©   (2007-10-01 11:52) [6]


> всеравно блокируется до сообщения


Ну и что ?
А вдруг автору потребуется реакция потока на какие-то сообщения, кроме собственно гнездовых ?


> уж проще сразу в блок режиме работать


Тогда придется выносить наружу хэндл гнезда, чтобы можно было при необходимости извне снять с выполнения блок.операцию.

Это не всегда удобно и не всегда оправдано.


 
Slym ©   (2007-10-01 12:25) [7]

Сергей М. ©   (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 12:30) [8]


> можно написать свой AbortAndTerminate в котором клозить
> сокет и терминироваться.


Нафиг он нужен ?

Все это расчудесно делается в деструкторе.


 
Slym ©   (2007-10-01 12:51) [9]

Сергей М. ©   (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;


 
DiamondShark ©   (2007-10-01 13:18) [10]

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


 
Сергей М. ©   (2007-10-01 14:13) [11]


> ТУТ И ЗАВИСАЕМ


Ты забыл, что деструктор виртуальный)


 
FearG0 ©   (2007-10-02 03:22) [12]

1. Иногда бывает что на этом цикле зависает:

while GetMessage(Msg,0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);  
  end;
Причем при отладке последний брейкпоинт на DispatchMessage(Msg);  и после этого вообще ничего не происходит.
От чего может быть?

2. Иногда бывает что сервер отдает контент не полностью, особенно когда страница размером 300 - 400 Кбайт. Как в этом случае поступать? Создавать новый поток на докачку?

3. Такая конструкция была выбрана именно из-за маштабируемости. Помимо активации в программе еще несколько функций активно взаимодействующих с интернетом.


 
Slym ©   (2007-10-02 04:15) [13]

Сергей М. ©   (01.10.07 14:13) [11]
Ты забыл, что деструктор виртуальный

падкалол... об этом не подумал...


 
Сергей М. ©   (2007-10-02 08:31) [14]


> 1. Иногда бывает что на этом цикле зависает:


При каком поступившем конкретном сообщении ?


> 2. Иногда бывает что сервер отдает контент не полностью,
>  особенно когда страница размером 300 - 400 Кбайт


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


> Создавать новый поток на докачку?


И как ты себе это мыслишь ?


 
FearG0 ©   (2007-10-02 14:50) [15]


> И как ты себе это мыслишь ?

Поток посылает в программу код ошибки, в программе его обработать и создать новый поток где в заголовке будет Range с указанием с какого байта выдать контент


 
Сергей М. ©   (2007-10-02 14:59) [16]


> в заголовке будет Range с указанием с какого байта выдать
> контент


А если серверу по барабану твое "указание с какого байта выдать" ? Если сервер отдает либо все либо ничего ?


> Иногда бывает что сервер отдает контент не полностью


Типа "Лениво мне, серверу, сегодня тебе, клиенту, все 400кб передавать, на вот тебе шматок в 300кб, остальные 100кб завтра как высплюсь так и передам, если захочешь" ?

Так что ли ?)


 
FearG0 ©   (2007-10-02 15:10) [17]


> Типа "Лениво мне, серверу, сегодня тебе, клиенту, все 400кб
> передавать, на вот тебе шматок в 300кб, остальные 100кб
> завтра как высплюсь так и передам, если захочешь" ?

Ну по ходу да. Попробуй зарегистрировать сайт на народе, там на втором шаге показывается капча. Сохрани ее на диск. Открой в обычном виндовском просмотровщике. Картинка будет искаженной в 70% случаев, потому что сервак яндексовский никогда ее полностью не отдает. Лень ему наврное. Но это не страшно.

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


 
Сергей М. ©   (2007-10-02 15:11) [18]


> FearG0 ©   (02.10.07 15:10) [17]


А теперь все тоже самое , но без доморощенного жаргона ...


 
FearG0 ©   (2007-10-02 15:49) [19]

Короче: факт есть факт, данные не всегда приходят от сервера полностью, это касается не конкретно оей реализаци, просто так бывает. Не важно из-за чего - глюковатость сервера, проблемы на линии или ошибки при передаче.

Осталось придумать как мою реализацию потока доработать, чтобы решить эту проблему.


 
Сергей М. ©   (2007-10-02 16:02) [20]


> Осталось придумать как мою реализацию потока доработать,
>  чтобы решить эту проблему


Если "глюкавый" сервер не поддерживает дозагрузку, то - хоть из штанов выпрыгни - "проблему" ты не решишь.


 
glebbest   (2008-05-01 20:42) [21]

Как-то глюкаво работает TWinSocketStream в связке с TClientSocket. Конкретно: SockStream.Read при активном чтении (SockStream.WaitForData(1)) и частых однобайтовых посылках с клиента выдеёт уже прочитанное предыдущей командой SockStream.Read. Увидел - охренел. Delphi 5.


 
Сергей М,   (2008-05-01 21:14) [22]


> Увидел - охренел


Я тоже.
Глядючи на тебя, глюкавого.



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2009.11.08;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.52 MB
Время: 0.006 c
15-1252345693
oldman
2009-09-07 21:48
2009.11.08
Поиск и группировка файлов по "тэгам"


2-1253624052
faiwer
2009-09-22 16:54
2009.11.08
Trace Into


15-1252640404
Дмитрий С
2009-09-11 07:40
2009.11.08
Символ неразрывного пробела


15-1252568155
tesseract
2009-09-10 11:35
2009.11.08
Репетиция дня пргораммиста


15-1252517257
TUser
2009-09-09 21:27
2009.11.08
Сегодня - годовщина первого бага





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский