线程！线程！！线程！！！(Delphi版)

Question

以下内容仅供初学者参考看到有的同学对Delphi的线程认识不够深，特开一贴给同学们讲讲。主要给出两种常用的线程形式。1、长等待型线程示例，等待命令，执行不定长的工作，但每个工作的时间不会太长。
2、长工作型线程示例，执行一个很长时间的工作，但可以很快响应取消操作。注：对于在线程中取消存储过程的执行仍然无解以下程序所用的知识为:消息机制以及常用的API函数
主程序Unit1unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,LongWaitTrd;
type
  TForm1 = class(TForm)
    btnSetTask: TButton;
    btnExitThd: TButton;
    btnCreateTrd: TButton;
    procedure btnSetTaskClick(Sender: TObject);
    procedure btnCreateTrdClick(Sender: TObject);
    procedure btnExitThdClick(Sender: TObject);
  private
     LongWaitThread:TLongWaitTrd;
     procedure OnThreadMessage(var Message: TMessage); message WM_USER+2000;
  public
    { Public declarations }
  end;var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnSetTaskClick(Sender: TObject);
begin
   if (LongWaitThread<>nil) then
   PostThreadMessage(LongWaitThread.ThreadID,WM_USER+1000,0,0);
end;procedure TForm1.btnCreateTrdClick(Sender: TObject);
begin
  LongWaitThread:=TLongWaitTrd.Create(true);
  LongWaitThread.MainWin:=Handle;
  LongWaitThread.Resume;
end;procedure TForm1.OnThreadMessage(var Message: TMessage);
begin
  if Message.Msg= WM_USER+2000 then
  begin
    Showmessage(String(message.LParam));
  end;end;procedure TForm1.btnExitThdClick(Sender: TObject);
begin
    if (LongWaitThread<>nil) then
    begin
      if (not LongWaitThread.ExitLongWaitTrd()) then
      ShowMessage('The thread exited time out');
    end;
end;end.线程类：unit LongWaitTrd;interfaceuses
  Classes,Windows,Messages,SyncObjs;type
  TLongWaitTrd = class(TThread)
  private
    FMainWin:THandle;
    QuitEvent: TEvent;
    procedure  SendFeedBackToMainWin();
    procedure  DoTheHardWork();
    
  protected
    procedure Execute; override;
  public
    constructor  Create(CreateSuspended: Boolean);
    destructor   Destroy; override;
    function  ExitLongWaitTrd():Boolean;
  published
    property MainWin:THandle read FMainWin write FMainWin;  end;implementationuses Unit1;constructor TLongWaitTrd.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
end;destructor TLongWaitTrd.Destroy;
begin
  inherited;
end;procedure TLongWaitTrd.DoTheHardWork();
begin
    //to do 
end;procedure TLongWaitTrd.Execute;
var  
  Msg: TMsg;
begin
  FreeOnTerminate:=True;
//1.长等待型线程示例
//  while GetMessage(Msg, 0, 0, 0) do  
//  begin
//     if (Msg.message=WM_USER+1000) then //任务来了
//     begin
//        DoTheHardWork();
//        SendFeedBackToMainWin;
//     end;
//     if (Msg.message=WM_QUIT) then
//     begin
//        QuitEvent.SetEvent;
//        Break;
//     end;
//  end;
//2.长工作型线程示例
//   while(true) do
//   begin
//     if  PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
//     begin
//        if (Msg.message=WM_QUIT) then
//        begin
//          QuitEvent.SetEvent;
//          Break;
//        end;
//     end;
//     DoTheHardWork();
//   end;
   
end;function TLongWaitTrd.ExitLongWaitTrd;
begin
  Result:=true;
  QuitEvent:=TEvent.Create(nil,True,False,'QuitEvent');
  PostThreadMessage(ThreadID,WM_QUIT,0,0);
  if  (QuitEvent.WaitFor(2000)=wrTimeOut) then
       Result:=false;  QuitEvent.Free ;
   
end;procedure TLongWaitTrd.SendFeedBackToMainWin();
var
  Status:String;
begin
   if (MainWin<>0) then
   begin
     Status:='The data has been processed by thread.';
     PostMessage(MainWin,WM_USER+2000,0,Integer(Status))
   end;
   
end;end.

Answer 1

以下内容仅供初学者参考看到有的同学对Delphi的线程认识不够深，特开一贴给同学们讲讲。主要给出两种常用的线程形式。

Answer 2

procedure TLongWaitTrd.SendFeedBackToMainWin();
var
  Status:String;
begin
   if (MainWin<>0) then
   begin
     Status:='The data has been processed by thread.';
     PostMessage(MainWin,WM_USER+2000,0,Integer(Status))
   end;
   
end;
注意上面的Status,当主线程读它的时候,它已经不在了.

Answer 3

翻译自那个bcb的帖子？也是功德无量！
我说一下自己遇到的困惑：
一个 运行命令行程序并截取其标准输出、给它的标准输入发文本 的控件：TDOScommand
（好像最初是一个法国人写的，有一个日本人修改过的版本）
它是创建了一个线程x去控制那个命令行的进程y。
进程y结束，线程x也要触发一个事件并结束；主程序可以发命令中止进程y，然后线程x也会结束
感觉它的实现有问题
法国人写的那个版本有内存泄漏，日本人修改的版本又有别的问题，比较晕

Answer 4

是哦，需要strnew一下再传？
看了一下doscommand的代码，有个：
    FThread.DoTerminate; //terminate the process
是不是不太好？应该让线程自己中断循环才对？

Answer 5

delphi query 查詢線程下面的例子给出了同时进行的两个线程查询。第一次按下按钮时，线程开始执行；以后每次按下按钮时，如果线程处于挂起状态则继续执行，否则挂起线程；线程执行完毕之后将连接 DataSource，查询结果将显示在相应的DBGrid中。 { 这里的多线程同步查询演示程序仅包括一个工程文件和一个单元文件 } 
{ 窗体中放置的组件有： } 
{ 两个Session组件 } 
{ 两个Database组件 } 
{ 两个Query组件 } 
{ 两个DataSource组件 } 
{ 两个DBGrid组件 } 
{ 一个Button组件 } 
{ 除非特别说明，否则上述各组件的属性都取默认值（见各组件注释） } 
{ 对于Database组件，就和一般设置一样，有一个正确的连接即可 } 
{ 对于Query 组件，需要在各自的属性 SQL中添加一些查询语句，为了 } 
{ 看得更清除，建议不要在两个Query 组件中填写相同的查询语句。 } unit Unit1; interface uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
Db, DBTables, Grids, DBGrids, StdCtrls; type 
TForm1 = class(TForm) 
Session1: TSession; { 属性SessionName填写为S1 } 
Database1: TDatabase; { 属性SessionName选择为S1 } 
Query1: TQuery;{ 属性Database选择为Database1；属性SessionName选择为S1 } 
DataSource1: TDataSource; { 属性DataSet设置为空 } 
DBGrid1: TDBGrid; { 属性DataSource选择为DataSource1 } 
Session2: TSession; { 属性SessionName填写为S2 } 
Database2: TDatabase; { 属性SessionName选择为S2 } 
Query2: TQuery;{ 属性Database选择为Database2；属性SessionName选择为S2 } 
DataSource2: TDataSource; { 属性DataSet设置为空 } 
DBGrid2: TDBGrid; { 属性DataSource选择为DataSource2 } 
BtnGoPause: TButton; { 用于执行和挂起线程 } 
procedure FormCreate(Sender: TObject); { 创建窗体时创建线程对象 } 
procedure FormDestroy(Sender: TObject); { 销毁窗体时销毁线程对象 } 
procedure BtnGoPauseClick(Sender: TObject); { 执行线程和挂起线程 } 
private 
public 
end; TThreadQuery = class(TThread) { 声明线程类 } 
private 
FQuery: TQuery; { 线程中的查询组件 } 
FDataSource: TDataSource; { 与查询组件相关的数据感知组件 } 
procedure ConnectDataSource;{ 连接数据查询组件和数据感知组件的方法 } 
protected 
procedure Execute; override;{ 执行线程的方法 } 
public 
constructor Create(Query: TQuery; 
DataSource: TDataSource); virtual; { 线程构造器 } 
end; var 
Form1: TForm1; 
Q1, { 线程查询对象1 } 
Q2: TThreadQuery; { 线程查询对象2 } implementation {$R *.DFM} { TThreadQuery类的实现 } { 连接数据查询组件和数据感知组件} 
procedure TThreadQuery.ConnectDataSource; 
begin 
FDataSource.DataSet := FQuery;{ 该方法在查询结束后才调用 } 
end; procedure TThreadQuery.Execute;{ 执行线程的方法 } 
begin 
try 
FQuery.Open; { 打开查询 } 
Synchronize(ConnectDataSource);{ 线程同步 } 
except 
ShowMessage('Query Error'); { 线程异常 } 
end; 
end; { 线程查询类的构造器 } 
constructor TThreadQuery.Create(Query: TQuery; DataSource: TDataSource); 
begin 
FQuery := Query; 
FDataSource := DataSource; 
inherited Create(True); 
FreeOnTerminate := False; 
end; { 创建窗体时创建线程查询对象 } 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
Q1 := TThreadQuery.Create(Query1, DataSource1); 
Q2 := TThreadQuery.Create(Query2, DataSource2); 
end; { 销毁窗体时销毁线程查询对象 } 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
Q1.Terminate; { 销毁之前终止线程执行 } 
Q1.Destroy; 
Q2.Terminate; { 销毁之前终止线程执行 } 
Q2.Destroy; 
end; { 开始线程、继续执行线程、挂起线程 } 
procedure TForm1.BtnGoPauseClick(Sender: TObject); 
begin 
if Q1.Suspended then Q1.Resume else Q1.Suspend; 
if Q2.Suspended then Q2.Resume else Q2.Suspend; 
end; end.  

Answer 6

要不要把 DoTheHardWork 做成函数指针变量，使用者只需要设置这个 以及 是长等待还是长工作 的模式
还有，SendFeedBackToMainWin要不要带输入参数？能否给DoTheHardWork里的代码使用？还有，如果是长工作 的模式，最后也能让使用者能随时中止工作（当然需要DoTheHardWork自行判断某个标志）？也就是说，这个标志做成通用的，作为线程类的一个属性+方法？

Answer 7

受教吧
只是以簡單的例子把adoquery組件實現線程查詢，簡單闡述線程查詢
注意：应用程序中的线程不是越多越好，因为线程将严重吞噬CPU资源，尽管看上去并不明显。谨慎创建和销毁线程 

Answer 8

Cyber-physical ,有人把垃圾也放到网上。

Answer 9

不错。前几天看到的C语言的，今天是看DELPHI的。学习了。

Answer 10

的确，长等待型线程示例，没有任务时就是一个不断检测消息队列的循环，
循环里没有sleep，会不会很耗cpu？虽然不影响其它线程FreeOnTerminate:=True;
//1.长等待型线程示例
//  while GetMessage(Msg, 0, 0, 0) do  
//  begin
//     if (Msg.message=WM_USER+1000) then //任务来了
//     begin
//        DoTheHardWork();
//        SendFeedBackToMainWin;
//     end;
//     if (Msg.message=WM_QUIT) then
//     begin
//        QuitEvent.SetEvent;
//        Break;
//     end;
//  end;
//2.长工作型线程示例
//   while(true) do
//   begin
//     if  PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
//     begin
//        if (Msg.message=WM_QUIT) then
//        begin
//          QuitEvent.SetEvent;
//          Break;
//        end;
//     end;
//     DoTheHardWork();
//   end;
   

Answer 11

下内容仅供初学者参考看到有的同学对Delphi的线程认识不够深，特开一贴给同学们讲讲。主要给出两种常用的线程形式。