请教简单的多线程问题

Question

小弟写了一个实现产品类别下载的功能，但是当类别数目很多时，下载的时间要很久，在下载的过程中，不能操作其他模块，以下是我的代码，搞了很久，还是不能并行
unit Uncplbxz;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Unfxks, DB, MemDS, DBAccess, MyAccess, StdCtrls, ExtCtrls,
  ComCtrls, ScktComp, AstaCustomSocket, AstaClientSocket, AstaDrv2,
  AstaClientDataset,CommCtrl, Grids, DBGrids,TreeUtils,WinInet,ActiveX;type
  TFmcplbxz = class(TFmfxks)
    AstaClientDataSet1: TAstaClientDataSet;
    AstaClientDataSet2: TAstaClientDataSet;
    AstaClientDataSet3: TAstaClientDataSet;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure tv1Click(Sender: TObject);
  private
    { Private declarations }
    procedure AddTree(MyNode : TTreeNode; PData: PNodeData);
  public
    { Public declarations }
  end;  chanpinxiazai = class(tthread)
  private
    { Private declarations }
  public
    constructor Create; virtual; { 线程构造器 }
    procedure exteriorwork;
    procedure execute;override;
  end;var
  Fmcplbxz: TFmcplbxz;
  thrd:chanpinxiazai;implementation
uses DMFrm,uQsyCommon, uQsyAppUtils,uQsyDBUtils,UnProType1;constructor chanpinxiazai.Create;
begin
  inherited Create(True);
  FreeOnTerminate := False;
end;procedure chanpinxiazai.exteriorwork;
var
  i:Integer;
  currNode: TTreeNode;
  strsql : string;
  amyQuery:tmyquery;
  Item: TTVItem;
begin
  for i:=0 to Fmcplbxz.tv1.Items.Count -1 do
  begin
    currNode := Fmcplbxz.tv1.Items.Item[i];
    //模块选中
    item.mask := TVIF_HANDLE;
    item.hItem := currNode.ItemId;
    TreeView_GetItem(Fmcplbxz.tv1.Handle, item);
    item.mask := TVIF_HANDLE or TVIF_STATE;
    if item.state = (item.state or $2000) and (not $1000) then
    begin
    //0 是根节点
      //先查找本地数据，如果已经下载则不再下载
      Fmcplbxz.qry.Close;
      Fmcplbxz.qry.SQL.Clear;
      Fmcplbxz.qry.SQL.Add('select * from T_PROTYPE where t_proclassid = '
                  + QuotedStr(PNodeData(Fmcplbxz.tv1.Items.Item[i].Data)^.Index));
      //Fmcplbxz.qry.Prepared;
      Fmcplbxz.qry.Open;
      if not Fmcplbxz.qry.IsEmpty then
      begin
        //类别属性要先删除
        amyQuery:=tmyquery.create(nil );
        with amyQuery do
          try
            connection:=Fmcplbxz.qry.Connection;
            sql.Clear;
            sql.Add('select T_TYPEID from T_ATTRIBUTE where T_PROCLASSID = '
                    + QuotedStr(PNodeData(Fmcplbxz.tv1.Items.Item[i].Data)^.Index));
            open;
            while not eof do
            begin
              ExecuteSQL(DM.Con,'delete from T_ATTRIBUTE where T_TYPEID = '
                         + QuotedStr(fieldbyname('T_TYPEID').AsString));
              next;
            end;
          finally
            free;
          end;
        ExecuteSQL(DM.Con,'delete from T_PROTYPE where t_proclassid = '
                   + QuotedStr(PNodeData(Fmcplbxz.tv1.Items.Item[i].Data)^.Index));
      end;
      //开始插入数据
      Fmcplbxz.AstaClientDataSet2.Close;
      Fmcplbxz.AstaClientDataSet2.SQL.Clear;
      Fmcplbxz.AstaClientDataSet2.SQL.Add('select * from T_PROTYPE where proclassid = '
                                  + QuotedStr(PNodeData(Fmcplbxz.tv1.Items.Item[i].Data)^.Index));
      Fmcplbxz.AstaClientDataSet2.Open;
      strsql := 'INSERT INTO T_PROTYPE (t_proclassid,t_cmpid,t_proclassname,'
                 + 'T_PROFCLASSID,T_PROISLAST,T_PROINDEX,T_PROISPUBLIC,T_PROSHOWTYPE'
                 + ') VALUES ('
                 + QuotedStr(Fmcplbxz.AstaClientDataSet2.fieldbyname('proclassid').AsString) + ','
                 + QuotedStr(Fmcplbxz.AstaClientDataSet2.fieldbyname('companyID').AsString) + ','
                 + QuotedStr(Fmcplbxz.AstaClientDataSet2.fieldbyname('proclassname').AsString) + ','
                 + QuotedStr(Fmcplbxz.AstaClientDataSet2.fieldbyname('PROFCLASSID').AsString) + ','
                 + QuotedStr(Fmcplbxz.AstaClientDataSet2.fieldbyname('PROISLAST').AsString) + ','
                 + QuotedStr(Fmcplbxz.AstaClientDataSet2.fieldbyname('PROINDEX').AsString) + ','
                 + QuotedStr(Fmcplbxz.AstaClientDataSet2.fieldbyname('PROISPUBLIC').AsString) + ','
                 + QuotedStr(Fmcplbxz.AstaClientDataSet2.fieldbyname('PROSHOWTYPE').AsString)
                 + ')';
      ExecuteSQL(DM.Con,strsql);
      //类别属性也要下载下来
      Fmcplbxz.AstaClientDataSet3.Close;
      Fmcplbxz.AstaClientDataSet3.SQL.Clear;
      Fmcplbxz.AstaClientDataSet3.SQL.Add('select * from t_attribute where proclassid = '
                                  + QuotedStr(PNodeData(Fmcplbxz.tv1.Items.Item[i].Data)^.Index));
      Fmcplbxz.AstaClientDataSet3.Open;
      while not Fmcplbxz.AstaClientDataSet3.eof do
      begin
        strsql := '';
        strsql := 'INSERT INTO t_attribute (T_TYPEID,T_PROCLASSID,T_PARENTID,'
                   + 'T_ATTNAME,T_ATTORDER,T_ATTSTYLE,T_ATTSIGN,t_ATTINDEX'
                   + ') VALUES ('
                   + QuotedStr(Fmcplbxz.AstaClientDataSet3.fieldbyname('TYPEID').AsString) + ','
                   + QuotedStr(Fmcplbxz.AstaClientDataSet3.fieldbyname('PROCLASSID').AsString) + ','
                   + QuotedStr(Fmcplbxz.AstaClientDataSet3.fieldbyname('typefclassid').AsString) + ','
                   + QuotedStr(Fmcplbxz.AstaClientDataSet3.fieldbyname('ATTNAME').AsString) + ','
                   + QuotedStr(Fmcplbxz.AstaClientDataSet3.fieldbyname('ATTORDER').AsString) + ','
                   + QuotedStr(Fmcplbxz.AstaClientDataSet3.fieldbyname('ATTSTYLE').AsString) + ','
                   + QuotedStr(Fmcplbxz.AstaClientDataSet3.fieldbyname('ATTSIGN').AsString)+ ','
                   + QuotedStr(Fmcplbxz.AstaClientDataSet3.fieldbyname('ATTINDEX').AsString)
                   + ')';
        ExecuteSQL(DM.Con,strsql);
        Fmcplbxz.AstaClientDataSet3.next;
      end;
    end;
  end;
  FmProType1.ds1.DataSet.Refresh;
  FmProType1.ds2.DataSet.Refresh;
  FmProType1.FormInit;
end;procedure chanpinxiazai.Execute;
begin
  { Place thread code here }
  CoInitialize( nil );
  Synchronize(exteriorwork);
  showmessage('下载成功!');
end;
{$R *.dfm}

Answer 1

procedure TFmcplbxz.AddTree(MyNode: TTreeNode; PData: PNodeData);
var
  nNode: TTreeNode;
  PNode: PNodeData;
  strsql : string;
  myAstaClientDataSet : tAstaClientDataSet;
begin  strsql := 'select * from T_PROTYPE where profclassid = ' + quotedstr(PData^.Index);
  myAstaClientDataSet := tAstaClientDataSet.Create(nil);
  myAstaClientDataSet.AstaClientSocket :=  AstaClientDataSet1.AstaClientSocket;
  with myAstaClientDataSet do
  try
    close;
    sql.clear;
    sql.Add(strsql);
    open;
    while Eof = False do
    begin
      New(PNode);
      PNode^.Index := FieldByName('PROCLASSID').AsString;
      PNode^.Caption := FieldByName('PROCLASSNAME').AsString;
      nNode := tv1.Items.AddChildObject(MyNode, PNode^.Caption, PNode);
      nNode.Parent.ImageIndex :=0 ;
      nNode.Parent.SelectedIndex := 0;
      nNode.ImageIndex := 2;
      nNode.SelectedIndex := 3;
      AddTree(nNode, PNode);
      Next;
    end;
    nnode.Expand(false);
    finally
      FreeAndNil(myAstaClientDataSet);;
  end;
end;procedure TFmcplbxz.FormCreate(Sender: TObject);
var
  Node: TTreeNode;
  Ptr: PNodeData;
  dw: dword;
begin
  inherited;  if InternetCheckConnection(PAnsiChar(PAnsiChar(ReadCfg('webip','style'))),   1,   0)  then
  begin
    //if dm.AstaClientSocket1.Active then dm.AstaClientSocket1.Active := Not dm.AstaClientSocket1.Active;
    dm.AstaClientSocket1.Active := True;
    application.ProcessMessages;
    tv1.Items.Clear;
    with astaclientdataset2 do
    begin
      close;
      sql.Clear;
      sql.Add('select * from T_PROTYPE  where proindex = ''_'' order by proindex ');
      open;
      while not eof do
      begin
        New(Ptr);
        Ptr^.Index := astaclientdataset2.FieldByName('PROCLASSID').AsString;
        Ptr^.Caption := astaclientdataset2.FieldByName('PROCLASSNAME').AsString;
        Node := tv1.Items.AddChildObject(nil, Ptr^.Caption, Ptr);
        Node.ImageIndex := 0;
        Node.SelectedIndex := 0;
        //AddTree(Node, Ptr);
        next;
      end;
    end;
    //TreeView带有CheckBox
    dw := GetWindowLong(tv1.Handle, GWL_STYLE);
    dw := dw or TVS_CHECKBOXES;
    SetWindowLong(tv1.Handle, GWL_STYLE, dw);
  end else showmessage('网络未连接！');
end;procedure TFmcplbxz.FormDestroy(Sender: TObject);
begin
  //inherited;  thrd.Terminate; { 销毁之前终止线程执行 }
  thrd.Destroy;
  Fmcplbxz := nil;
end;procedure TFmcplbxz.btn2Click(Sender: TObject);
begin
  inherited;  close;
end;procedure TFmcplbxz.btn1Click(Sender: TObject);
begin
  inherited;  showmessage('下载需要一定时间，请等待');
  thrd := chanpinxiazai.Create;
  thrd.execute;
  self.Close;
end;
procedure TFmcplbxz.tv1Click(Sender: TObject);
begin
  inherited;  if tv1.Selected.HasChildren= false then
  begin
    AddTree(tv1.Selected, tv1.Selected.Data);
    tv1.Selected.Expand(true);
    if tv1.Selected.HasChildren= true then
      NotCheckNode(tv1.Selected);
  end;
end;end.

Answer 2

代码够长的！Delphi自带的Demo里有个Threads的例子，你看看。

Answer 3

看看例子或者书吧。 Delphi自带的Demo里有个Threads的例子，你看看。 

Answer 4

代码是长, 不过问题不在代码里, 这里有几个条件做到了就不会阻了procedure chanpinxiazai.Execute;
begin
  { Place thread code here }
  CoInitialize( nil ); // 这里不对, 要 CoUninitialize 在线程结束
  // 这里不对, 去掉大同步 
  Synchronize(exteriorwork); 
  变成 exteriorwork; 在函数里面实际要更新显示时再同步, 同步时间要短  showmessage('下载成功!');
end; 另外一个问题是, 你不能共用任何线程外的 ADOConnection, 线程中要另外建立一个 ADOConnection, ADOConnection 本身也会阻卡主线运行ClientDataSet 也是同样不行共用 Connection(socket dcom connection )
你必须在线程中新建立一个 connection, ClientDataSet 用这个 connection 连接 server目前我已知的所有 connection 都阻止主线运行, WebService SOAPConnection 不是正真的实时连接, 这个可以

Answer 5

谢谢各位，我写出最简单的了
procedure TForm1.Button1Click(Sender: TObject);
begin
  //建线程并立即运行
  TTestThread.Create(false);
end;
procedure TTestThread.Execute;
var
  i:integer;
begin
  { Place thread code here }
  FreeOnTerminate:=True;
  for i:=0 to 100000 do begin
    if self.Terminated then Break;
    Inc(Answer,Round(Abs(Sin(Sqrt(i)))));
    Synchronize(GiveAnswer);
  end;
end;procedure TTestThread.GiveAnswer;
begin
  Form1.Caption:=IntToStr(Answer);
end;

Answer 6

我还有个问题 线程中怎么另外建立一个 ADOConnection？虽然上面那段程序可以实现线程并行，但是实现下载的程序还是独占模式，是不是因为里面用到了ADOConnection？

Answer 7

注意线程当中不能ShowMessage

Answer 8

可以在线程的Execute当中创建AdoConnection及相关的对象实例，其他如连接串或者数据库地址、用户、密码等等可以通过增加线程类的属性，或者构造(Contrucotr)来传入。这样对于简单的业务，几个线程是没有什么太多问题的，但是如果线程比较多，并且不是每个线程都会用到，或者只是偶尔根据业务需要用到连接数据库(如ADOConnection)，那么可以采用连接池来管理。

Answer 9

线程中最好不用VCL控件.
不要用Synchronize
但是要是用了VCL控件,不用Synchronize(exteriorwork)就不运行exteriorwork函数,就会产生假死的但是一定得用VCL控件的话,最好用指针.不用Synchronize

Answer 10

用了指针也照样需要用Synchronize。只有消息在一定地处理条件下可以替代Synchronize。

Answer 11

还没结贴~~~ShowMessage 可以在线程中用, 不过有可能会到主界面下面, 点不到
把 ShowMessage 部分放到一个函数中,用 Synchronize 调用这个 Synchronize...Synchronize 早在 delphi5 以后版本就不再是一个可选项了, vcl 大部分地方都会自动进入同步, 所以, 调不调用的倒不是强制, 换句话说, vcl 已经有一大部分是线程安全的了, 保持使用 Synchronize 是一个好习惯, 但也不能什么都Synchronize

Answer 12

把 ShowMessage 部分放到一个函数中,用 Synchronize 调用, 上面没说完, 这样做以后就会总在主界面的前端出现了

Answer 13

当然一个ShowMessage并不会有太多的影响。大不了就是那个线程永远卡在那个Message窗口当中。个人不建议在本来就是讨论多线程问题的地方，使用一些没有保障性的代码。线程同步，需要考虑的不仅仅只是内存或者GDI访问冲突的问题，还有一重，那就是死锁。单争论这样一个问题没有实质性意义。我只是指出来有这样的问题。至于个人是接受还是不接受，本人不做太多的干涉。

Answer 14

再请教下在线程类里面动态创建第三方socket连接控件AstaClientSocket等,但是总是不能激活连接

Answer 15

AstaClientSocket具体如何实现的不太清楚，如果它有依赖消息，那么需要在线程的Execute当中处理消息循环。
比如while GetMessage(Msg,...) do begin
  TranslateMessage(Msg);
  DispatchMessage(Msg);
end;
要该线程退出，就PostThreadMessage(Thread.ThreadID,WM_QUIT,0,0);