线程不一致Delphi xe6

Question

所以，在使用delphi xe4-6进行线程处理时，我总是面临严重的问题，无论是来自未执行的线程，还是异常处理导致应用程序崩溃，或者只是on terminate方法永远不会被调用。我已被指示使用的所有变通方法变得非常乏味，在XE6中仍然困扰着我的问题。我的代码通常看起来像这样：

procedure TmLoginForm.LoginClick(Sender: TObject);
var
  l:TLoginThread;
begin
  SyncTimer.Enabled:=true;
  l:=TLoginThread.Create(true);
  l.username:=UsernameEdit.Text;
  l.password:=PasswordEdit.Text;
  l.FreeOnTerminate:=true;
  l.Start;
end;



procedure TLoginThread.Execute;
var
  Success     : Boolean;
  Error       : String;
begin
  inherited;
  Success := True;
  if login(USERNAME,PASSWORD) then
  begin
    // do another network call maybe to get dif data.
  end else
  begin
    Success := False;
    Error   := 'Login Failed. Check User/Pass combo.';
  end; 

  Synchronize(
  procedure
    if success = true then
    begin
      DifferentForm.Show;
    end else
    begin
      ShowMessage('Error: '+SLineBreak+Error);
    end;
    SyncTimer.Enabled := False;
  end);
end;

然后我从Delphi的样本和论坛中看到了这个单元：

unit AnonThread;

interface

uses
  System.Classes, System.SysUtils, System.Generics.Collections;

type
  EAnonymousThreadException = class(Exception);

  TAnonymousThread<T> = class(TThread)
  private
    class var
      CRunningThreads:TList<TThread>;
  private
    FThreadFunc: TFunc<T>;
    FOnErrorProc: TProc<Exception>;
    FOnFinishedProc: TProc<T>;
    FResult: T;
    FStartSuspended: Boolean;
  private
    procedure ThreadTerminate(Sender: TObject);
  protected
    procedure Execute; override;
  public
    constructor Create(AThreadFunc: TFunc<T>; AOnFinishedProc: TProc<T>;
      AOnErrorProc: TProc<Exception>; ACreateSuspended: Boolean = False;
      AFreeOnTerminate: Boolean = True);

    class constructor Create;
    class destructor Destroy;
 end;

implementation

{$IFDEF MACOS}
uses
{$IFDEF IOS}
  iOSapi.Foundation
{$ELSE}
  MacApi.Foundation
{$ENDIF IOS}
  ;
{$ENDIF MACOS}

{ TAnonymousThread }

class constructor TAnonymousThread<T>.Create;
begin
  inherited;
  CRunningThreads := TList<TThread>.Create;
end;

class destructor TAnonymousThread<T>.Destroy;
begin
  CRunningThreads.Free;
  inherited;
end;

constructor TAnonymousThread<T>.Create(AThreadFunc: TFunc<T>; AOnFinishedProc: TProc<T>;
  AOnErrorProc: TProc<Exception>; ACreateSuspended: Boolean = False; AFreeOnTerminate: Boolean = True);
begin
  FOnFinishedProc := AOnFinishedProc;
  FOnErrorProc := AOnErrorProc;
  FThreadFunc := AThreadFunc;
  OnTerminate := ThreadTerminate;
  FreeOnTerminate := AFreeOnTerminate;
  FStartSuspended := ACreateSuspended;

  //Store a reference to this thread instance so it will play nicely in an ARC
  //environment. Failure to do so can result in the TThread.Execute method
  //not executing. See http://qc.embarcadero.com/wc/qcmain.aspx?d=113580
  CRunningThreads.Add(Self);

  inherited Create(ACreateSuspended);
end;

procedure TAnonymousThread<T>.Execute;
{$IFDEF MACOS}
var
  lPool: NSAutoreleasePool;
{$ENDIF}
begin
{$IFDEF MACOS}
  //Need to create an autorelease pool, otherwise any autorelease objects
  //may leak.
  //See https://developer.apple.com/library/ios/#documentation/Cocoa/Conceptual/MemoryMgmt/Articles/mmAutoreleasePools.html#//apple_ref/doc/uid/20000047-CJBFBEDI
  lPool := TNSAutoreleasePool.Create;
  try
{$ENDIF}
    FResult := FThreadFunc;
{$IFDEF MACOS}
  finally
    lPool.drain;
  end;
{$ENDIF}
end;

procedure TAnonymousThread<T>.ThreadTerminate(Sender: TObject);
var
  lException: Exception;
begin
  try
    if Assigned(FatalException) and Assigned(FOnErrorProc) then
    begin
      if FatalException is Exception then
        lException := Exception(FatalException)
      else
        lException := EAnonymousThreadException.Create(FatalException.ClassName);
      FOnErrorProc(lException)
    end
    else if Assigned(FOnFinishedProc) then
      FOnFinishedProc(FResult);
  finally
    CRunningThreads.Remove(Self);
  end;
end;

end.

为什么上面的这个anon线程单元在100％的时间内完美运行并且我的代码有时会崩溃？例如，我可以连续执行6次相同的线程，但是可能在第7次（或者第一次）该时间导致应用程序崩溃。调试时没有例外，所以我不知道从哪里开始修复问题。另外，为什么我需要一个单独的计时器为我的代码调用“CheckSynchronize”以便GUI更新发生但是当我使用anon线程单元时不需要它？

如果不是这个地方，也许有人可以指出我正确的方向在别处问这个问题。对不起，我已经深入了解文档，尽力了解。

这是一个可以连续工作20次但随后导致应用程序崩溃的线程示例

inherited;
    try
      SQL:= 'Some SQL string'; 
      if GetSQL(SQL,XMLData) then
        synchronize(
        procedure
        var
          i:Integer;
        begin
          try
            mTasksForm.TasksListView.BeginUpdate;
            if mTasksForm.TasksListView.Items.Count>0 then
              mTasksForm.TasksListView.Items.Clear;
            XMLDocument := TXMLDocument.Create(nil);
            XMLDocument.Active:=True;
            XMLDocument.Version:='1.0';
            XMLDocument.LoadFromXML(XMLData);
            XMLNode:=XMLDocument.DocumentElement.ChildNodes['Record'];
            i:=0;
            if XMLNode.ChildNodes['ID'].Text <>'' then
            while XMLNode <> nil do
            begin
              LItem := mTasksForm.TasksListView.Items.AddItem;

              with LItem do
              begin
                Text := XMLNode.ChildNodes['LOCATION'].Text;

                Detail := XMLNode.ChildNodes['DESC'].Text +
                            SLineBreak+
                            'Assigned To: '+XMLNode.ChildNodes['NAME'].Text

                tag := StrToInt(XMLNode.ChildNodes['ID'].Text);
                color := TRectangle.Create(nil);
                with color do
                begin
                  if XMLNode.ChildNodes['STATUS'].Text = STATUS_DONE then
                    fill.Color := TAlphaColors.Lime  
                  else if XMLNode.ChildNodes['STATUS'].Text = STATUS_OK then
                    fill.Color := TAlphaColors.Yellow
                  else
                    fill.Color := TAlphaColors.Crimson;
                  stroke.Color := fill.Color;
                  ButtonText := XMLNode.ChildNodes['STATUS'].Text;
                end;
                Bitmap := Color.MakeScreenshot;
              end;
              XMLNode:=XMLNode.NextSibling;
            end;
          finally
            mTasksForm.TasksListView.EndUpdate;
            for i := 0 to mTasksForm.TasksListView.Controls.Count-1 do
            begin
              if mTasksForm.TasksListView.Controls[I].ClassType = TSearchBox then
              begin
                SearchBox := TSearchBox(mTasksForm.TasksListView.Controls[I]);
                Break;
              end;
            end;
            SearchBox.Text:=' ';
            SearchBox.text := ''; //have in here because if the searchbox has text, when attempting to add items then app crashes
          end;
        end)
      else
        error := 'Please check internet connection.';
  finally
    synchronize(
    procedure
    begin
      if error <> '' then
        ShowMessage('Erorr: '+error);

      mTasksForm.Spinner.Visible:=false;
      mTasksForm.SyncTimer.Enabled:=false;
    end);
  end;
end;

这是GETSQL方法

function GetSQL(SQL:String;var XMLData:String):Boolean;
var
  PostResult,
  ReturnCode          : String;
  PostData            : TStringList;
  IdHTTP              : TIdHTTP;
  XMLDocument         : IXMLDocument;
  XMLNode             : IXMLNode;

  Test                : String;
begin
  Result:=False;
  XMLData:='';
  XMLDocument:=TXMLDocument.Create(nil);
  IdHTTP:=TIdHTTP.Create(nil);
  PostData:=TStringList.Create;
  PostData.Add('session='+SessionID);
  PostData.Add('database='+Encode(DATABASE,''));
  PostData.Add('sql='+Encode(SQL,''));
  IdHTTP.Request.ContentEncoding:='UTF-8';
  IdHTTP.Request.ContentType:='application/x-www-form-urlencoded';
  IdHTTP.ConnectTimeout:=100000;
  IdHTTP.ReadTimeout:=1000000;
  try
    PostResult:=IdHTTP.Post(SERVER_URL+GET_METHOD,PostData);
    XMLDocument.Active:=True;
    XMLDocument.Version:='1.0';
    test := Decode(PostResult,'');
    XMLDocument.LoadFromXML(Decode(PostResult,''));
    XMLNode:=XMLDocument.DocumentElement;
    try
      ReturnCode:=XMLNode.ChildNodes['status'].Text;
    except
      ReturnCode:='200';
    end;
    if ReturnCode='' then begin
      ReturnCode:='200';
    end;
    if ReturnCode='200' then begin
      Result:=True;
      XMLData:=Decode(PostResult,'');
    end;
  except
    on E: Exception do begin
      result:=false;
    end;
  end;
  PostData.Free;
  IdHTTP.Free;
end;