Текущий архив: 2006.01.15;
Скачать: CL | DM;

Вниз

Корректное вынужденное терминирование потока.   Найти похожие ветки 

← →
SergP ©   (2005-12-11 22:28) [0]

Имеется форма, где пользователь вводит данные, затем нажимает на кнопку, при этом запускается доп. поток, в котором средствами WININET отправляется запрос и закачивается контент.

Но если по каким-либо причинам (соединение с сервером происходит долго, или еще чего) пользователь не хочет ждать завершения заботы потока, и хочет закрыть форму, то как мне нужно  терминировать поток, иначе если учесть то что при закрытии форма уничтожается (free, либо action:=cafree), а доп. поток после закачки контента должен будет работать со свойствами формы, либо передавать данные в основной поток (SendMessage(FormX.Handle, .....), т.е. получается фигня..

Вобщем поток нужно терминировать и уничтожить до уничтожения формы.

Возникает вопрос: как его правильно терминировать.


procedure LoadSpend;
begin
 with TSpendThread.Create(true) do
 begin
   FreeOnTerminate:=true;
   Suspended:=false;
 end;
end;

procedure TSpendThread.Execute;
var
 s:string;
begin
 s:=OpenURL("GET",SpendRequest,SVparam.proxy);
// Здесь Либо передача s в основной поток, либо дальнейшая
//обработка. Скорее всего первое. Но это не важно, так как
//проблемы с терминированием имеют место при выполнении
//функции OpenURL, так как она может долго выполняться.

end;



Код функции OpenURL:


function OpenURL(Metod, URL:string; proxy:string="";Data:string=""; Header:string=""): string;
var
FSession, FConnect, FRequest: HINTERNET;
FMetod,FURL,Cookies:string;
BytesRead,BuffSize:cardinal;
Buff:String;
dwFlag:Cardinal;
gotIt: boolean;
URLC:TURLComponents;
tout:Integer;
HostName,UrlPath:array[1..INTERNET_MAX_PATH_LENGTH] of char;
ExtraInfo:array[1..$ffff] of char;
begin
if trim(Metod) = "" then FMetod:="GET" else FMetod:=Trim(UpperCase(Metod));
Result:="";
if pos("://",URL)= 0 then
FURL:="http://"
else FURL:="";
FURL:=FURL+URL;
FillChar(URLC,SizeOf(TURLComponents),0);
with URLC do
begin
dwStructSize := sizeOf(TURLComponents);
lpSzExtraInfo := @ExtraInfo[1];
dwExtraInfoLength := INTERNET_MAX_PATH_LENGTH;
lpSzHostName := @HostName[1];
dwHostNameLength := INTERNET_MAX_PATH_LENGTH;
lpszUrlPath := @UrlPath[1];
dwUrlPathLength := INTERNET_MAX_PATH_LENGTH;
end;
InternetCrackUrl(PChar(FURL),0,ICU_ESCAPE, URLC);
FSession := InternetOpen("Keeper", INTERNET_OPEN_TYPE_PROXY, pchar(proxy), nil, 0);
if Assigned(FSession) then
begin
  try
    tout:=10*1000;
    InternetSetOption(FSession, timeout,@tout,SizeOf(tout));
    FConnect := InternetConnect(FSession,
                                URLC.lpszHostName,
                                URLC.nPort,
                                nil,
                                nil,
                                INTERNET_SERVICE_HTTP,
                                0,
                                0);
    if Assigned(FConnect) then
      begin
        try
          if URLC.nPort = 443 then
            dwFlag := INTERNET_FLAG_SECURE
                      or INTERNET_FLAG_IGNORE_CERT_CN_INVALID
                      or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
          else
            dwFlag := 0;
          dwFlag := dwFlag or INTERNET_FLAG_RELOAD;
          StrCat(URLC.lpSzUrlPath, URLC.lpszExtraInfo);
          URLC.lpSzExtraInfo := #0;
          URLC.dwExtraInfoLength := 0;
          if FMetod = "GET" then
            begin
              if Data <> "" then
                begin
                  if pos("?", URLC.lpszUrlPath) = 0 then
                    Data:="?"+Data
                  else
                    Data:="&"+Data ;
                StrCat(URLC.lpszUrlPath,PAnsiChar(Data));
                Data:="";
               end;
             end;
          URLC.dwUrlPathLength:=length(URLC.lpszUrlPath);
          FRequest := HttpOpenRequest(FConnect, PChar(FMetod), URLC.lpszUrlPath, "HTTP/1.0",
                                      nil,
                                      nil,
                                      dwFlag,
                                      0);
          if Assigned(FRequest) then
            begin
              if pos("?", URLC.lpSzExtraInfo) = 1 then
                begin
                  inc(URLC.lpSzExtraInfo);
                  dec(URLC.dwExtraInfoLength);
                end;
              if Data <> "" then
                begin
                   URLC.lpszExtraInfo:=PAnsiChar(Data);
                   Data:="";
                end;
            URLC.dwExtraInfoLength := length(URLC.lpSzExtraInfo);
            if FMetod="POST" then
              Header:="Content-Type: application/x-www-form-urlencoded";
            if Cookies <> "" then
              begin
                if pos("Cookies: ",Cookies) = 0 then
                if Header <>"" then
                    Header:=Header+ #13#10+"Cookie: "+Cookies
                else
                    Header:="Cookie: "+Cookies ;
              end;
              try
                if HttpSendRequest(FRequest,PChar(Header), Length(Header), URLC.lpszExtraInfo, URLC.dwExtraInfoLength) then
                  begin
                    //Read file
                    BuffSize:=1024;
                    repeat
                    BytesRead:=0;
                    SetLength(buff,BuffSize);
                    gotIt := InternetReadFile(FRequest, @Buff[1], BuffSize, bytesRead);
                    Setlength(Buff,BytesRead);
                    Result:=Result+Buff;
                    until (gotIt and (bytesRead = 0));
                  end
                else
                  begin
                    Result:="#E1";
                  end;
              finally
                InternetCloseHandle(FRequest);
              end;
            end
          else
            begin

            end;
        finally
          InternetCloseHandle(FConnect);
        end;
      end
    else
      begin

      end;
  finally
    InternetCloseHandle(FSession);
  end;
end
else
begin

end;
end;


---

← →
Verg ©   (2005-12-11 23:33) [1]

> Корректное вынужденное терминирование потока.


В таких случаях это сводится к корректному прерыванию блокирующего API вызова. Попробуй в случае необходимости закрыть главную управляющую структуру этого вызова. В данном случае - FRequest.

---

← →
SergP ©   (2005-12-11 23:51) [2]

> Verg ©   (11.12.05 23:33) [1]
>
> > Корректное вынужденное терминирование потока.
>
>
> В таких случаях это сводится к корректному прерыванию блокирующего
> API вызова. Попробуй в случае необходимости закрыть главную
> управляющую структуру этого вызова. В данном случае - FRequest.
>


Имеется ввиду сделать  InternetCloseHandle(FRequest) из основного потока?
Так ли я понял?

---

← →
Verg ©   (2005-12-12 09:11) [3]

Да, так.

1. Надо сделать FRequest глобальной переменной( или полем объекта)
2. Я бы ввел еще одну глоб. переменную - StopFlag : boolean;
3. Нужна крит. секция Cs.
4. Открытие :
procedure openRequest;
begin
  Cs.Enter;
  if not StopFlag then
     FRequest := HttpOpenRequest(...и т.д...);
  Cs.Leave;
end;

5. Закрывание
procedure closeRequest( Abort : boolean );
begin
  Cs.Enter;
  if FRequest <> 0 then
  begin
     InternetCloseHandle(FRequest);
     FRequest := 0;
  end;
  if Abort then
     StopFlag := true;
  Cs.Leave;
end;

6. Часть цикла чтения:
  gotIt := InternetReadFile(FRequest, @Buff[1], BuffSize, bytesRead);
  if StopFlag then break;
  И далее, там где InternetCloseHandle поменять на
  closeRequest( false)

7. Прерывание операции из другого потока:
  closeRequest( true );

Что-то в этом духе...

---

← →
SergP ©   (2005-12-14 04:24) [4]

Вот написал, но пока не пробовал.
Просто ранее не приходилось использовать КС
Правильно ли я делаю здесь: (в первую очередь имеется ввиду создание и уничтожение КС):
(на всякий случай привожу весь код)


unit MyInet;

interface

uses Classes,WinInet,syncobjs,sysutils,messages,windows;

const
 TimeOut=10;
 WM_EVENT_ON_WORK_END=WM_USER+2;

type TNEWorkEnd=procedure(Str:string;ErrorCode:integer);

type TLoadHttp = class(TThread)
 public
   FWorkEnd:TNEWorkEnd;
   constructor OpenUrl(UserAgent, Method, URL:string;proxy:string="";Data:string=""; Header:string="");
   destructor Destroy; override;
   procedure Start;
   procedure Abort;
 private
   cs:TCriticalSection;
   FSession, FConnect, FRequest: HINTERNET;
   VFUserAgent,VFMethod,VFURL,VFProxy,VFData,VFHeader:string;
   StopFlag:boolean;
   procedure CloseRequest(Abort:boolean);
   procedure Event_on_end_work(var M : TMessage); message WM_EVENT_ON_WORK_END;
 protected
   procedure Execute; override;
end;

implementation

constructor TLoadHttp.OpenUrl(UserAgent, Method, URL:string;proxy:string="";Data:string=""; Header:string="");
begin
 create(true);
 VFUserAgent:=UserAgent;
 VFMethod:=Method;
 VFURL:=URL;
 VFProxy:=Proxy;
 VFData:=Data;
 VFHeader:=Header;
 FWorkEnd:=nil;
 StopFlag:=false;
 cs:=TCriticalSection.Create;
 FreeOnTerminate:=true;
end;

procedure TLoadHttp.Start;
begin
 Suspended:=false;
end;

destructor TLoadHttp.Destroy;
begin
 cs.Free;
 inherited Destroy;
end;

procedure TLoadHttp.Event_on_end_work(var M : TMessage);
begin
 if assigned(FWorkEnd) then FWorkEnd(String(M.WParam),M.WParam);
end;

procedure TLoadHttp.CloseRequest( Abort : boolean );
begin
 Cs.Enter;
 if FRequest<>nil then
 begin
    InternetCloseHandle(FRequest);
    FRequest := nil;
 end;
 if Abort then StopFlag := true;
 Cs.Leave;
end;

procedure TLoadHttp.Abort;
begin
 CloseRequest(true);
end;

procedure TLoadHttp.Execute;
var
FMetod,FURL,Cookies:string;
BytesRead,BuffSize:cardinal;
Buff:String;
dwFlag:Cardinal;
gotIt: boolean;
URLC:TURLComponents;
tout:Integer;
HostName,UrlPath:array[1..INTERNET_MAX_PATH_LENGTH] of char;
ExtraInfo:array[1..$ffff] of char;
Str:String;
ErrorCode:integer;
begin
 ErrorCode:=0;
 if trim(VFMethod) = "" then FMetod:="GET" else FMetod:=Trim(UpperCase(VFMethod));
 Str:="";
 if pos("://",VFURL)= 0 then FURL:="http://" else FURL:="";
 FURL:=FURL+VFURL;
 FillChar(URLC,SizeOf(TURLComponents),0);
 with URLC do
   begin
   dwStructSize := sizeOf(TURLComponents);
   lpSzExtraInfo := @ExtraInfo[1];
   dwExtraInfoLength := INTERNET_MAX_PATH_LENGTH;
   lpSzHostName := @HostName[1];
   dwHostNameLength := INTERNET_MAX_PATH_LENGTH;
   lpszUrlPath := @UrlPath[1];
   dwUrlPathLength := INTERNET_MAX_PATH_LENGTH;
 end;
 InternetCrackUrl(PChar(FURL),0,ICU_ESCAPE, URLC);
 FSession := InternetOpen(pchar(VFUserAgent), INTERNET_OPEN_TYPE_PROXY, pchar(VFproxy), nil, 0);
 if Assigned(FSession) then
   begin
   try
     tout:=10*1000;
     InternetSetOption(FSession, timeout,@tout,SizeOf(tout));
     FConnect := InternetConnect(FSession,URLC.lpszHostName,URLC.nPort,nil,nil,INTERNET_SERVICE_HTTP,0,0);
     if Assigned(FConnect) then
       begin
       try
         if URLC.nPort = 443 then dwFlag := INTERNET_FLAG_SECURE or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID else dwFlag := 0;
         dwFlag := dwFlag or INTERNET_FLAG_RELOAD;
         StrCat(URLC.lpSzUrlPath, URLC.lpszExtraInfo);
         URLC.lpSzExtraInfo := #0;
         URLC.dwExtraInfoLength := 0;
         if FMetod = "GET" then
           begin
           if VFData <> "" then
             begin
             if pos("?", URLC.lpszUrlPath) = 0 then VFData:="?"+VFData else VFData:="&"+VFData;
             StrCat(URLC.lpszUrlPath,PAnsiChar(VFData));
             VFData:="";
             end;
           end;
         URLC.dwUrlPathLength:=length(URLC.lpszUrlPath);
         Cs.Enter;
         if not StopFlag then FRequest := HttpOpenRequest(FConnect, PChar(FMetod), URLC.lpszUrlPath, "HTTP/1.0",nil,nil,dwFlag,0);
         Cs.Leave;
         if Assigned(FRequest) then
           begin
           if pos("?", URLC.lpSzExtraInfo) = 1 then
             begin
             inc(URLC.lpSzExtraInfo);
             dec(URLC.dwExtraInfoLength);
             end;
           if VFData <> "" then
             begin
             URLC.lpszExtraInfo:=PAnsiChar(VFData);
             VFData:="";
             end;
           URLC.dwExtraInfoLength := length(URLC.lpSzExtraInfo);
           if FMetod="POST" then VFHeader:="Content-Type: application/x-www-form-urlencoded";
           if Cookies <> "" then
             if pos("Cookies: ",Cookies) = 0 then
               if VFHeader <>"" then VFHeader:=VFHeader+ #13#10+"Cookie: "+Cookies else VFHeader:="Cookie: "+Cookies;

           try
             if HttpSendRequest(FRequest,PChar(VFHeader), Length(VFHeader), URLC.lpszExtraInfo, URLC.dwExtraInfoLength) then
               begin
               //Read file
               BuffSize:=1024;
               repeat
                 BytesRead:=0;
                 SetLength(buff,BuffSize);
                 gotIt := InternetReadFile(FRequest, @Buff[1], BuffSize, bytesRead);
                 if StopFlag then break;
                 Setlength(Buff,BytesRead);
                 Str:=Str+Buff;
               until (gotIt and (bytesRead = 0));
               end else ErrorCode:=ErrorCode or 1;
           finally
             CloseRequest(false);
           end;
           end else ErrorCode:=ErrorCode or 2;
       finally
         InternetCloseHandle(FConnect);
       end;
       end else ErrorCode:=ErrorCode or 4;
   finally
     InternetCloseHandle(FSession);
   end;
   end else ErrorCode:=ErrorCode or 8;
 if StopFlag then ErrorCode:=16;
 SendMessage(Handle, WM_EVENT_ON_WORK_END, ErrorCode, Integer(str));
end;
end.


---

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

Текущий архив: 2006.01.15;
Скачать: CL | DM;

Наверх

Память: 0.53 MB
Время: 0.061 c