[大虾帮忙]------------------求一段简单多线程---------的可靠实现代码?

Question

偶在网上找了一些,常出错..因为偶的程序在启动时,会检查网络,但很慢....不能同时执行多任务而不"假死"...如果用简单的多线程封装以下代码?谢..在线等..//检测网络是否在线
function NetStatus: Boolean;
var
    IdHTTP1:TIdHTTP;
begin
    try
        IdHTTP1:=TIdHTTP.Create(nil);
        IdHTTP1.Head('http://www.baidu.com');
        IdHTTP1.ReadTimeout:=5000;  //超时5秒
        if IdHTTP1.Response.ResponseCode=200 then
            Result:=True
        else
            Result:=False;
    except
        Result:=false;        
    end;
    IdHTTP1.Free;
end;

Answer 1

线程的Execute方法写
if NetStatus showmessagee('OK');
调用
thread.create(false)就可以了

Answer 2

你可以自定义一个线程类：TBackgroundWorker = class(TThread)
protected
  procedure Execute; override; // 调用关联的Method
public
  property Method: TMethod...
end;

Answer 3

下面的代码对你可能有所帮助：
unit ThreadPoolUnit;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;type
  TForm3 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    type
      TWorkerColor = class
        FThreadID: Integer;
        FColor: TColor;
        FForm: TForm3;
        procedure PaintLines(Sender: TObject);
        procedure PaintLine;
        constructor Create(AForm: TForm3; AColor: TColor);
      end;
    var
      FIndex: Integer;
  public
    { Public declarations }
  end;  TObjectHelper = class helper for TObject  end;  TThreadPool = class
  private
    type
      TUserWorkItem = class
        FSender: TObject;
        FWorkerEvent: TNotifyEvent;
      end;
    class procedure QueueWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent; Flags: ULONG); overload; static;
  public
    class procedure QueueWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent); overload; static;
    class procedure QueueIOWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent); static;
    class procedure QueueUIWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent); static;
  end;var
  Form3: TForm3;
  ThreadPool: TThreadPool;implementation{$R *.dfm}const
  WT_EXECUTEDEFAULT       = ULONG($00000000);
  WT_EXECUTEINIOTHREAD    = ULONG($00000001);
  WT_EXECUTEINUITHREAD    = ULONG($00000002);
  WT_EXECUTEINWAITTHREAD  = ULONG($00000004);
  WT_EXECUTEONLYONCE      = ULONG($00000008);
  WT_EXECUTEINTIMERTHREAD = ULONG($00000020);
  WT_EXECUTELONGFUNCTION  = ULONG($00000010);
  WT_EXECUTEINPERSISTENTIOTHREAD  = ULONG($00000040);
  WT_EXECUTEINPERSISTENTTHREAD = ULONG($00000080);
  WT_TRANSFER_IMPERSONATION = ULONG($00000100);function QueueUserWorkItem (func: TThreadStartRoutine; Context: Pointer; Flags: ULONG): BOOL; stdcall; external kernel32 name 'QueueUserWorkItem';function InternalThreadFunction(lpThreadParameter: Pointer): Integer; stdcall;
begin
  Result := 0;
  try
    try
      with TThreadPool.TUserWorkItem(lpThreadParameter) do
        if Assigned(FWorkerEvent) then
          FWorkerEvent(FSender);
    finally
      TThreadPool.TUserWorkItem(lpThreadParameter).Free;
    end;
  except  end;
end;{ TThreadPool }class procedure TThreadPool.QueueWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent);
begin
  QueueWorkItem(Sender, WorkerEvent, WT_EXECUTEDEFAULT);
end;class procedure TThreadPool.QueueIOWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent);
begin
  QueueWorkItem(Sender, WorkerEvent, WT_EXECUTEINIOTHREAD);
end;class procedure TThreadPool.QueueUIWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent);
begin
  QueueWorkItem(Sender, WorkerEvent, WT_EXECUTEINUITHREAD);
end;class procedure TThreadPool.QueueWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent; Flags: ULONG);
var
  WorkItem: TUserWorkItem;
begin
  if Assigned(WorkerEvent) then
  begin
    IsMultiThread := True;
    WorkItem := TUserWorkItem.Create;
    try
      WorkItem.FWorkerEvent := WorkerEvent;
      WorkItem.FSender := Sender;
      if not QueueUserWorkItem(InternalThreadFunction, WorkItem, Flags) then
        RaiseLastOSError;
    except
      WorkItem.Free;
      raise;
    end;
 end;
end;procedure TForm3.Button1Click(Sender: TObject);
begin
  FIndex := PaintBox1.Height;
  PaintBox1.Repaint;
  ListBox1.Items.Clear;
  TWorkerColor.Create(Self, clBlue);
  TWorkerColor.Create(Self, clRed);
  TWorkerColor.Create(Self, clYellow);
  TWorkerColor.Create(Self, clLime);
  TWorkerColor.Create(Self, clFuchsia);
  TWorkerColor.Create(Self, clTeal);
end;{ TForm3.TWorkerColor }constructor TForm3.TWorkerColor.Create(AForm: TForm3; AColor: TColor);
begin
  FForm := AForm;
  FColor := AColor;
  TThreadPool.QueueWorkItem(Self, PaintLines);
end;procedure TForm3.TWorkerColor.PaintLines(Sender: TObject);
var
  I: Integer;
begin
  FThreadID := GetCurrentThreadID;
  for I := 0 to 9 do
  begin
    PaintLine;
    //TThread.Synchronize(nil, PaintLine);
    Sleep(100);
  end;
  Destroy;
end;procedure TForm3.TWorkerColor.PaintLine;
begin
  FForm.PaintBox1.Canvas.Lock;
  try
    FForm.ListBox1.Items.Add(IntToStr(FThreadID));
    with FForm.PaintBox1 do
    begin
      Canvas.Pen.Color := FColor;
      Canvas.Polyline([Point(0, FForm.FIndex), Point(Width, FForm.FIndex)]);
      Dec(FForm.FIndex);
      if FForm.FIndex <= 0 then
        FForm.FIndex := 0;
    end;
  finally
    FForm.PaintBox1.Canvas.Unlock;
  end;
end;end.Form(.dfm)文件
object Form3: TForm3
  Left = 0
  Top = 0
  Caption = 'Form3'
  ClientHeight = 346
  ClientWidth = 386
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 8
    Top = 8
    Width = 289
    Height = 330
  end
  object Button1: TButton
    Left = 303
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ListBox1: TListBox
    Left = 303
    Top = 39
    Width = 75
    Height = 299
    ItemHeight = 13
    TabOrder = 1
  end
end

Answer 4

同意2楼，这是最简单的方法
天狼工作室
http://www.j2soft.cn/