-------请问，如何把这个代码改成简单多线程？------------

Question

本帖最后由 cowbo 于 2011-06-28 23:12:41 编辑

Answer 1

procedure  Download();procedure TMainForm.Download;
Var
    UnitName,PathName:String;
    IDHTTP:   TIDHttp;     
begin
    Inc(i); 
    screen.Cursor:=crHourGlass;
    
    IDHTTP:=   TIDHTTP.Create(nil);
    IDHTTP.OnWork:=Form1.IdHTTPWork;
    try
        try
        htm:=IdHTTP.Get('http://www.baidu.com');    
        except
            showmessage( '网络出错未能下载完成！ ');
            Exit;
        end;
    finally
        IDHTTP.Free;
    end;
    screen.Cursor:=crDefault;
    Timer1.Enabled:=true;
end;
type
  TMyDownLoad= class(TThread)
    public
      Link,htmlStr:string;
    protected
      procedure Execute; override;
end;procedure TMyDownLoad.Execute;
begin
FreeOnTerminate := True;
Synchronize(Download);
end;//以上代码摘抄自网上，具体是哪的，忘了。procedure TMainForm.Timer1Timer(Sender: TObject);
begin
        Timer1.Enabled:=false;
        TMyDownLoad.Create(false);  //多线程
end; 

Answer 2

创建一个
TThread，把htmlStr:=IdHTTP1.Get(links);    放到里面

Answer 3

放到线程的时候 要初始化CoInitializeprocedure TGetInfo.Execute;
begin
  try
    CoInitialize(nil);
    FLock.Enter;
    while not Terminated do
    begin
      GetBillInfo;//这里替换成你的Get
    end;
  finally
    FLock.Leave;
    CoUninitialize;
  end;
end;

Answer 4

放在一个线程里有就行了么，干嘛还要timer+线程？写两个过程
procedure QueryDB;   这里面查询数据库，需要下载的时候调用DownLoad;
proceudre DownLoad; 然后在线程的Execute的时候，调用QueryDB就行了~

Answer 5

htmlStr:=IdHTTP1.Get(links);      //如何在这里改成多线程，而且能传入Links这个值。=>type
  TMyDownLoad = class(TThread)
  private
    FLink: string;
  protected
    procedure Execute;override;
    procedure Download;
  public
    constructor Create(ALink: string); overload;
  end;{ TMyDownLoad }constructor TMyDownLoad.Create(ALink: string);
begin
  inherited Create(True);
  FreeOnTerminate := True;  FLink := ALink;
end;var
   Link,htmlStr:string;
   DownloadThread: TMyDownLoad;
        if RecordCount>0 then
        while not eof do
        begin
          Link:=     VarToStr(FieldValues['Link']);          DownloadThread := TMyDownLoad.Create(Link);
          {$IFDEF VER210}
          DownloadThread.Start;
          {$ELSE}
          DownloadThread.Resume;
          {$ENDIF}
            //取得网页代码
            //htmlStr:=IdHTTP1.Get(links);      //如何在这里改成多线程，而且能传入Links这个值。
       end

Answer 6

我是楼主，晕，报错了。我把多线程放在QueryDB里面，但一编译执行到idhttp.get就报错。请问上什么原因？？unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, IdAntiFreezeBase, ComCtrls;type  TMyDownLoad=class(TThread)
        private
            FLink: string;        protected
            procedure   Execute;override;
            procedure   Download;
             
            
        constructor 
            Create(ALink: string); overload;
 
end; 
TForm1 = class(TForm)Edit1: TEdit;
Timer1: TTimer;
Button1: TButton;
    Memo1: TMemo;
    StatusBar1: TStatusBar;procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);     
procedure FormCreate(Sender: TObject);
procedure   QueryDB;    
 
privatepublic
    procedure IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
end;var
    Form1: TForm1;
    i:Integer;
    htm:string;
    Link,htmlStr:string;
    DownloadThread: TMyDownLoad;
implementationuses Data;{$R *.dfm}procedure TForm1.IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
    Application.ProcessMessages; 
end;
constructor TMyDownLoad.Create(ALink: string);
begin
  inherited Create(True);
  
  FreeOnTerminate := True;
  FLink := ALink;
  
end;
procedure   TMyDownLoad.Download;
Var
    UnitName,PathName:String;
    IDHTTP:   TIDHttp;     
begin
    Inc(i); 
    screen.Cursor:=crHourGlass;
    
    IDHTTP:=   TIDHTTP.Create(nil);
    IDHTTP.OnWork:=Form1.IdHTTPWork;
    try
        try
        htm:=IdHTTP.Get(FLink);  //下载网页  
        except
            showmessage( '网络出错未能下载完成！ ');
            Exit;
        end;
    finally
        IDHTTP.Free;
    end;
       
    screen.Cursor:=crDefault;end;
procedure   TMyDownLoad.Execute;
begin
    inherited;
    try
      while not Terminated do
      begin
        Download; 
      end;
    finally    end;end; 
procedure   TForm1.QueryDB;
begin
        Form1.Timer1.Enabled:=false;
        with DataM.Q3 do
        begin
            Close;
            SQL.Clear;
            SQL.Add('Select * from LastView where Status<>''Stoped'' ');
            Open;
            if RecordCount>0 then
            while not eof do
            begin
                DownloadThread := TMyDownLoad.Create(Link);
                {$IFDEF VER210}
                DownloadThread.Start;
                {$ELSE}
                DownloadThread.Resume;
                {$ENDIF}            end;
         Form1.Timer1.Enabled:=true;
       end;
end; procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=true;
  QueryDB;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
    i:=0;
end;end.

Answer 7

您写这个代码初看有多个地方有问题啊，这里列出部分：
1.线程里面不能直接showmessage，一般这么写：
procedure TMyThread.DoShowmessage;
begin
   showmessage( '网络出错未能下载完成！ ');
end;
procedure TMyThread.OtherProc;
begin
   Synchronize(DoShowmessage);//同步让主线程执行可视化窗口的代码
end;
2.用了二次循环，逻辑很乱：
第一次是在time事件中不停的创建线程
第二个MyDownLoad.Execute不停调用Download，而Download里面又不停的创建消毁IDHTTP;建议每个线程只要创建一个IDHTTP就可以了，IDHTTP随着线程创建和消毁，下载一个或者几个网址结束，这个都可控制，这样可实现多线程同时下载。3.使用线程的话不需要调用Application.ProcessMessages，使用多线程时卡住的其实只是分线程，而不是主线程，所以下载的过程IdHTTPWork里面不用在那不停的处理消息。4.程序里面设置 FreeOnTerminate := True，这个是说线程对象在线程执行完毕自动free，在释放线程对象时线程事件（准确的说应该是ThreadProc函数）可能还在执行，这时候可在Destroy里面调用WaitFor让事件执行完毕再释放线程所占用的所有资源。综合分析帮您把代码重新整理如下：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, IdHTTP, ComCtrls, activex;const
  WM_SUCCED = WM_USER + 1;type  TMyDownLoad = class(TThread)
  private
    FLink: string;
    FIDHTTP: TIDHTTP;
  public
    procedure Execute; override;
    procedure DoShowmessage;
    procedure Download;
    constructor Create(ALink: string); overload;
    destructor Destroy; override;
  end;  TForm1 = class(TForm)    Edit1: TEdit;
    Timer1: TTimer;
    Button1: TButton;
    Memo1: TMemo;
    StatusBar1: TStatusBar;    // procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure QueryDB;  private    procedure ProcessSucessed(var message: TMessage); message WM_SUCCED;
  public
    // procedure IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
  end;var
  Form1: TForm1;
  // i: Integer;
  htm: string;
  // Link, htmlStr: string;
  DownloadThread: TMyDownLoad;implementation uses data;{$R *.dfm}constructor TMyDownLoad.Create(ALink: string);
begin
  inherited Create(True);
  CoInitialize(nil);
  FreeOnTerminate := True;
  FLink := ALink;
  FIDHTTP := TIDHTTP.Create(Form1);
end;destructor TMyDownLoad.Destroy;
begin
  Terminate; // 线程自己free的时候重置FTerminated状态，让Execute执行完毕
  WaitFor; // 等待Execute执行完毕才释放该线程创建的所有资源，不然会报错  FreeAndNil(FIDHTTP);
  CoUninitialize;
  inherited;
end;procedure TMyDownLoad.DoShowmessage;
begin
  showmessage('网络出错未能下载完成！ ');
end;procedure TMyDownLoad.Download;
begin
  try
    htm := FIDHTTP.Get(FLink); // 下载网页
    FIDHTTP.Disconnect;
    PostMessage(Form1.Handle, WM_SUCCED, 0, 0); // 下载完成告诉主线程
  except
    Synchronize(DoShowmessage); // 让主线程执行可视化窗口的代码
  end;
end;{ //下面这个供参数，可实现定时调用函数，可随时调用FreeAndnil(DownloadThread) 中止线程执行
  procedure TMyDownLoad.Execute;
  var
  i: Integer;
  FFinished: Boolean;
  begin
  FFinished := False;
  while not terminated do begin
  for i := 0 to 600 do //比如1分钟 下载一次
  if not Terminated then //采用时间片段是为了判断这个变量
  Sleep(100)
  else begin
  FFinished := true;
  Break;
  end;  if FFinished then Break;  Download; // 每隔1分钟调用一次，遇到手动中止或者free线程对象的时候退出
  end;
  end; }procedure TMyDownLoad.Execute;
begin
  Synchronize(Download); // 如果只让线程下载一次，直接调用即可。
end;procedure TForm1.QueryDB;
begin
  Form1.Timer1.Enabled := false;
  with DataM.Q3 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('Select * from LastView where Status<>''Stoped'' ');
    Open;
    first;  //从第一条开始
    if RecordCount > 0 then
      while not eof do
      begin
        DownloadThread := TMyDownLoad.Create('http://wap.baidu.com/');
{$IFDEF VER210}
        DownloadThread.Start;
{$ELSE}
        DownloadThread.Resume;
{$ENDIF}
        Next; //这样才会取到下一条
      end;
  end;
  Form1.Timer1.Enabled := True;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled := True;
  QueryDB;
end;procedure TForm1.ProcessSucessed(var message: TMessage);
begin
  Memo1.Text := UTF8decode(htm);
end;end.

Answer 8

谢谢各位指点，特别是楼上的大虾。我有两个问题想请问一下：
1.为什么 DownloadThread := TMyDownLoad.Create('http://wap.baidu.com/') 在测试时有些网页取不到数据，直接显示 showmessage('网络出错未能下载完成！ ') ？2.由于在SQL里查到的link（超链接）是很多条，程序的功能是需要下载完这个link后再去下另一个，但如果改成下面那样的话，循环是循环了，但显示不了结果呢？
    if RecordCount > 0 then
      while not eof do
      begin
        link:=FieldValues['Link'];
        Edit1.Text:=link;
        DownloadThread := TMyDownLoad.Create(link);  //****修改了这里
        {$IFDEF VER210}
        DownloadThread.Start;
        {$ELSE}
        DownloadThread.Resume;    //**循环到第二次时跳到了这里
        {$ENDIF}
        Next; //这样才会取到下一条
      end;

Answer 9

你为啥不先将所有的Link保存一下，然后再在一个线程里直接依次的下载呢，没必要每一个Link都创建一个线程。

Answer 10

你这个代码是循环一次创建一个线程，因为你对线程的理解不深入造成的程序逻辑混乱~要是以前没有用过线程的话，建议你花点时间看一些基础的文章，至少对线程基础有个概念，然后再来做。纯粹抱着解决问题的态度求一些代码，然后糊上去不是好的心态。
话说delphi的线程模型还是相当简单的，仔细研究1个小时，一定可以搞定你的问题了。你可以先从简单的来，比如求1到100万的和，怎么用线程去解决。怎么在计算过程中把计算结果实时显示在界面上。搞定这个问题你就对线程入门了~

Answer 11

1.其实你创建一个线程可以了，在线程里面去循环执行，定时调用 Download下载，Download里面又可以顺序提取data里面的link2.第二个问题，有些网站需要预设cookies等参数才能访问，另外IDHTTP一些参数也需要修改。单线程定时循环读取全部地址代码如下：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, IdHTTP, ComCtrls, activex;const
  WM_SUCCED = WM_USER + 1;type  TMyDownLoad = class(TThread)
  private
    FLink: string;
    FEof: Boolean;
    FIDHTTP: TIDHTTP;
    procedure OpenLink;
    function GetnextLink: string;
    procedure DoGetnextLink;
    procedure DoShowmessage;
    function Download: Boolean; //返回值判断是否出错
  protected
    procedure Execute; override;
  public
//    constructor Create(ALink: string); overload;
    constructor Create; overload;
    destructor Destroy; override;
  end;  TForm1 = class(TForm)    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    Button2: TButton;
    Button3: TButton;    // procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure QueryDB;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);  private
    procedure OnTerminate(Sender: TObject);
    procedure ProcessSucessed(var message: TMessage); message WM_SUCCED;
  public
    // procedure IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
  end;var
  Form1: TForm1;
  // i: Integer;
  htm: string;
  // Link, htmlStr: string;
  DownloadThread: TMyDownLoad;implementationuses data;{$R *.dfm}//constructor TMyDownLoad.Create(ALink: string);
//begin
//  inherited Create(True);
//  CoInitialize(nil);
//  FreeOnTerminate := True;
//  FLink := ALink;
//  FIDHTTP := TIDHTTP.Create(Form1);
//end;constructor TMyDownLoad.Create;
begin
  inherited Create(True);
  CoInitialize(nil);
  FreeOnTerminate := False; //不自动删除，调用FreeAndNil(DownloadThread)时不需要再自动删除
  FIDHTTP := TIDHTTP.Create(nil);
  FIDHTTP.Request.UserAgent := 'Mozilla/4.0'; //某些网站设置这个才能访问
end;destructor TMyDownLoad.Destroy;
begin
  Terminate; // 线程自己free的时候重置FTerminated状态，让Execute执行完毕
  WaitFor; // 等待Execute执行完毕才释放该线程创建的所有资源，不然会报错  FreeAndNil(FIDHTTP);
  CoUninitialize;
  inherited;
end;procedure TMyDownLoad.DoShowmessage;
begin
  showmessage('网络出错未能下载完成！ ');
end;procedure TMyDownLoad.OpenLink;
begin
  with DataM.Q3 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('Select * from LastView where Status<>''Stoped''');
    Open;
    first; //从第一条开始
    Flink := fieldbyname('Link').asstring;
  end;
end;function TMyDownLoad.GetnextLink: string;
begin
  with DataM.Q3 do
  begin
    Next; //这样才会取到下一条    if not Eof then begin
      Result := fieldbyname('Link').asstring;
    end else
      FEof := True;
  end;
end;procedure TMyDownLoad.DoGetnextLink;
begin
  Flink := GetnextLink;
end;function TMyDownLoad.Download: Boolean; //返回值判断是否出错
begin
  Result := True;
  FEof := False;
  Synchronize(OpenLink);  with FIDHTTP do
    while not FEof do //循环提取记录并下载
    try
      htm := Get(Flink); // 下载网页
//      Disconnect;
      PostMessage(Form1.Handle, WM_SUCCED, 0, 0); // 下载完成告诉主线程
      Synchronize(DoGetnextLink);
    except
      Synchronize(DoShowmessage); // 让主线程执行可视化窗口的代码
      Break; //出错中止
      Result := False;
    end;
end; //下面这个供参数，可实现定时调用函数，可随时调用FreeAndnil(DownloadThread) 中止线程执行procedure TMyDownLoad.Execute;
var
  i: Integer;
  FFinished: Boolean;
begin
  FFinished := False;
  while not terminated do begin
    if not Download then Break; // 每隔1分钟调用一次，遇到手动中止或者free线程对象的时候退出，当然这个函数执行也会占用一段时间    for i := 0 to 600 do //比如1分钟 循环下载一次
      if not Terminated then //采用时间片段是为了判断这个变量
        Sleep(100)
      else begin
        FFinished := true;
        Break;
      end;    if FFinished then
      Break;
  end;
end;procedure TForm1.QueryDB;
begin
//  Form1.Timer1.Enabled := false;
//  with DataM.Q3 do
//  begin
//    Close;
//    SQL.Clear;
//    SQL.Add('Select * from LastView where Status<>''Stoped'' ');
//    Open;
//    first;  //从第一条开始
//    if RecordCount > 0 then
//      while not eof do
//      begin
  if DownloadThread = nil then begin //开始运行或者继续
    DownloadThread := TMyDownLoad.Create;
    DownloadThread.OnTerminate := OnTerminate;
  end;
{$IFDEF VER210}
  DownloadThread.Start;
{$ELSE}
  DownloadThread.Resume;
{$ENDIF}
//        Next; //这样才会取到下一条
//      end;
//  end;
//  Form1.Timer1.Enabled := True;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
//  Timer1.Enabled := True;
  QueryDB;
end;procedure TForm1.ProcessSucessed(var message: TMessage);
begin
//  Memo1.Text := UTF8decode(htm);
  Memo1.Text := htm;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  if DownloadThread <> nil then
    DownloadThread.Suspend; //暂停运行
end;procedure TForm1.Button3Click(Sender: TObject);
begin
  if DownloadThread <> nil then begin
    if DownloadThread.Suspended then
      DownloadThread.Resume; //线程的事件继续执行的时候才可以中止，以免卡住
    FreeAndNil(DownloadThread); //中止运行无需Terminate，直接释放即可
  end;
end;procedure TForm1.OnTerminate(Sender: TObject);
begin
  ShowMessage('OK');
end;
end.