[Delphi] Проблема с потоками

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by shadowrun, 2 Oct 2012.

  1. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    842
    Likes Received:
    170
    Reputations:
    84
    Где-то тухнут потоки при проходе цикла. Не могу доглядеть :confused:

    PHP:
    unit Unit2;

    interface

    uses
      Classes
    ,unit1,IdHTTP,SyncObjs;

    type
      Thrd 
    = class(TThread)
      private
        
    CurrAccString;
        
    StmpString;
      protected
        
    procedure Executeoverride;
        
    procedure UpdMemo2;
        
    procedure UpdMemo3;
        
    procedure UpdMemo4;
      
    end;

    implementation


    var DoWorkBoolean True;

    procedure thrd.UpdMemo2;
     
    begin
       Form1
    .Memo2.Lines.Add(CurrAcc);
     
    end;

    procedure thrd.UpdMemo3;
     
    begin
      Form1
    .Memo3.Lines.Add(CurrAcc);
     
    end;

    procedure thrd.UpdMemo4;
     
    begin
       Form1
    .Memo4.Lines.Add(CurrAcc);
     
    end;

    procedure Thrd.Execute;
    var 
    HTTPTIdHTTP;
        
    SRTStringStream;
        
    tmp,keyString;
        
    i:integer;
     
    begin
         
    While DoWork True do
            
    begin
              CS
    .Enter;
               try
                 try
                    if 
    Logins.Count <= 0
                      then
                        
    exit;
                   
    CurrAcc := logins[0];
                   
    Logins.Delete(0);
                 
    except
                 end
    ;
               finally
                
    CS.Leave;
               
    end;
             try
               try
                 
    HTTP := TIdHTTP.Create(nil);
                 
    SR := TStringStream.Create('');
                 
    HTTP.Get('http://site',SR);
                 
    HTTP.Disconnect;
                 
    tmp := Utf8ToAnsi(SR.DataString);
               
    except
                HTTP
    .Free;
                
    SR.Free;
                Continue;
               
    end;
             finally
               
    SR.Free;
             
    end;
             
    key := Copy(tmp,Pos('key  = ',tmp)+19,22);
             try
              try
                
    tmp := HTTP.Get('http://site&key='+key);
                
    HTTP.Disconnect;
              
    except
              end
    ;
             finally
              
    HTTP.Free;
             
    end;
              if 
    Pos('occupied',tmp) <> 0
                then
                  Synchronize
    (UpdMemo3)
                else
                  if 
    Pos('free',tmp) <> 0
                    then
                      Synchronize
    (UpdMemo2)
                    else
                      
    Synchronize(UpdMemo4);
       
    end;
    end;


    end.
     
  2. 2echnoman

    2echnoman New Member

    Joined:
    3 Jul 2012
    Messages:
    54
    Likes Received:
    0
    Reputations:
    0
    На get-ах виснут.
     
  3. xophet

    xophet Member

    Joined:
    16 Apr 2011
    Messages:
    617
    Likes Received:
    49
    Reputations:
    5
    Code:
    try 
       HTTP := TIdHTTP.Create(nil); 
    except 
    [COLOR=DarkRed]   HTTP.Free; [/COLOR]
    end; 
    try 
       try 
    [COLOR=DarkRed]     tmp := HTTP.Get('http://site&key='+key); [/COLOR]
         HTTP.Disconnect; 
       except 
       end; 
    finally 
       HTTP.Free; 
    end;
    Догадался?)
     
  4. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    842
    Likes Received:
    170
    Reputations:
    84
    Ну это да, но у меня в обработке continue стоит, по идее программа туда не доходит а начинает новый проход цикла, если возбуждается исключение. Или как? :cool:
     
  5. Jingo Bo

    Jingo Bo Member

    Joined:
    25 Oct 2009
    Messages:
    368
    Likes Received:
    51
    Reputations:
    7
    Вот так должно быть верно, логику программы не менял, только подправил работу с try..except и try...finally
    Code:
    procedure Thrd.Execute;
    var sr: TStringStream;
        tmp, key: String;
        i: integer;
    begin
        while DoWork do
        begin
            with CS do
            Begin
               Enter;
               try
                 if (Logins.Count <= 0) then
                   Break;
                 CurrAcc := logins[0];
                 Logins.Delete(0);
               finally
                 Leave;
               end;
            end;
            with TIdHTTP.Create(nil) do
            try
              sr := TStringStream.Create('');
              try
                try
                  Get('http://site', sr);
                  Disconnect;
                  tmp := Utf8ToAnsi(sr.DataString);
                except
                  Continue;
                end;
              finally
                sr.Free;
              end;
              key := Copy(tmp,Pos('key  = ',tmp)+19,22);
              try
                tmp := Get('http://site&key='+key);
                Disconnect;
              except
    
              end;
            finally
              Free;
            end;
            if Pos('occupied',tmp) <> 0 then
              Synchronize(UpdMemo3) else
              if Pos('free',tmp) <> 0 then
                Synchronize(UpdMemo2) else
                Synchronize(UpdMemo4);
       end;
    end;
     
    2 people like this.
  6. Tip.the.besT

    Tip.the.besT Member

    Joined:
    24 Jun 2009
    Messages:
    267
    Likes Received:
    10
    Reputations:
    4
    получается, что если ошибка при создании, то ты освобождаешь то, что не создалось вообще, и потом ещё раз освобождаешь то чего нет.

    В этом отношение синапс грамотней сделан. Если запрос не прошёл или ошибка произошла, то он просто значение false возвращает. И нет необходимости так часто впихивать исключения, достаточно поставить цикл. вот так бы выглядел запрос на синапсе:
    Code:
    repeat
    http.headers.clear;
    http.document.clear;
    {что - то присваиваем}
    until http.httpmethod('GET{или POST}',http://achat.com/);
    
    При таком построение, никогда не выбьет поток, да и никогда не пропустит никакой запрос. ;)
     
    1 person likes this.
  7. Chrome~

    Chrome~ Elder - Старейшина

    Joined:
    13 Dec 2008
    Messages:
    936
    Likes Received:
    162
    Reputations:
    27
    Грамотней, не грамотней - дело не в этом. Если правильно обрабатывать исключения, тогда все правильно будет работать.
     
  8. Tip.the.besT

    Tip.the.besT Member

    Joined:
    24 Jun 2009
    Messages:
    267
    Likes Received:
    10
    Reputations:
    4
    Нет, индеец вполне себе компонент, но нормальную работу прокси, я на нём сколько пытался так и не сделал. А вот на synapse с пол пинка. Но есть и свои минусы конечно. Всё нужно в ручную чистить. POST запросы чуть сложнее формировать. Но всё окупается отсутствием ошибок и ещё кучей приятных мелочей.
    Я не хочу агитировать, но придерживаюсь правила - "Критикуя - предлагай!".
     
  9. Jingo Bo

    Jingo Bo Member

    Joined:
    25 Oct 2009
    Messages:
    368
    Likes Received:
    51
    Reputations:
    7
    Ну не знаю, на счет прокси. Да, версия Indy которая стояла по умолчанию в Delphi 7 была чудовищна, приходилось фиксить просто кучу всего. Перешел на Delphi XE, все устраивает, достаточно годно. А вот на счет исключений, тут да...в более менее серьезном проекте обработка одних только всевозможных исключений Indy тянет не на одну сотню строк.