线程

unit UMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DB, MemDS, DBAccess, Ora,UThread;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    OraSession1: TOraSession;
    OraQuery1: TOraQuery;
    BitBtn3: TBitBtn;
    Memo1: TMemo;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetDBResult(ret:integer):Integer;

  end;

var
  Form1: TForm1;

   mymsg :TUserMsg;

implementation

 

{$R *.dfm}

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  sid, ServerIp, Username, Password: string;
begin

  Username := 'platform';
  Password := '1';
  ServerIp := '127.0.0.1';
  sid := 'orcl';

  try
    OraSession1.Options.Net := True;
    OraSession1.connected := False;
    OraSession1.ConnectPrompt := False;
    OraSession1.ConnectString := Trim(Username) + '/' + Trim(Password) + '@' + Trim(ServerIp) + ':1521:' + Trim(sid);
    OraSession1.connected := True;
  except on E: Exception do
    begin
      showmessage('连接数据库失败，原因：' + E.Message);
      Exit;
    end;
  end;
 
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  EndThrd();
  CreateThrd();
  ResumThrd();
end;

function TForm1.GetDBResult(ret:integer):Integer;
begin
  Memo1.Lines.Add('线程回调函数返回值：'+IntToStr(ret));
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  call:PCallBK;
begin

  mymsg.QryStr := 'select count(*) from  accountant_base';
  mymsg.QrySet := @OraQuery1 ;

  call := GetDBResult;
 
  PostThreadMessage(GetThdID,UM_EXECUTE,Integer(@mymsg),Integer(@call));
end;

end.

 

 

unit UThread;

interface

uses
  DB, ADODB, Classes, Variants, Messages, SyncObjs,Ora;

const
{------------------------------------------------------------------------------}
  // 线程异步处理时自定义消息
  UM_QUERY   = WM_USER + 150;  // 表示调用Query函数的消息
  UM_EXECUTE = WM_USER + 151;  // 表示调用Execute函数的消息
  UM_EXECBAT = WM_USER + 152;  // 表示调用ExecBat函数的消息
{------------------------------------------------------------------------------}
  // 操作错误信息
  AE_SUCCESS  = 1;          // 成功
  AE_OTHERERR = 0;          // 其它错误（未发现数据和影响行数为零）
  AE_TYPEERR  = -1;         // 类型不匹配
  AE_SQLERR = -2;           // SQL错误
  AE_QUERRYERR = -4;        // 查询失败
  AE_EXECERR = -8;          // 事务失败

type
{------------------------------------------------------------------------------}
  // 表示自定义消息的参数结构
  TUserMsg = record
    QryStr: string;
    SqlLst: TStringList;
    QrySet: ^TOraQuery;
  end;
  PUserMsg = ^TUserMsg;

  PQuery = ^TOraQuery;
{------------------------------------------------------------------------------}
// 回调函数
  PCallBK = function(Res: Integer): Integer of object;
{------------------------------------------------------------------------------}

 
function BsADOListen(pADO: Pointer): Integer;

function GetHandle: THandle;
function GetThdID: Cardinal;

function CreateThrd(): Thandle; // 创建线程并提供句柄
function SuspendThrd(): Integer; // 挂起线程
function ResumThrd(): Integer; // 运行线程
function EndThrd(): Integer; // 终止线程

 

var
  Hdl: THandle; // 定义线程的句柄
  ThdID: Cardinal; // 线程ID号

 
implementation

uses
  Windows, SysUtils, WinSock;

{-------------------------------线程入口函数-----------------------------------}

function BsADOListen(pADO: Pointer): Integer;
var
  Msg: TMsg;
  Temp: PUserMsg;
  ptADO: PQuery;
  Res: Integer;
  CallBK: PCallBK;
begin
  Result := AE_OTHERERR;

  // 开始无限循环，截获消息
  while (True) do
  begin
    //*---------------PeekMessage获取消息-------------------*//
    if (PeekMessage(Msg, 0, UM_QUERY, UM_EXECBAT, PM_REMOVE)) then
    begin
      case Msg.message of
        UM_QUERY:
          begin
            Temp := PUserMsg(Msg.wParam);
            ptADO :=PQuery(Temp^.QrySet );
            ptADO^.Close;
            ptADO^.SQL.Clear;
            ptADO^.SQL.Text := Temp^.QryStr ;
            ptADO^.ExecSQL;

            Res := ptADO^.RowsAffected;

            if (Msg.lParam <> 0) then
            begin
              @CallBK := Pointer(Msg.lParam); //*--使用回调--*//
              CallBK(Res);
            end;
          end;
        UM_EXECUTE:
          begin
            Temp := PUserMsg(Msg.wParam);
            ptADO :=PQuery(Temp^.QrySet );
            ptADO^.Close;
            ptADO^.SQL.Clear;
            ptADO^.SQL.Text := Temp^.QryStr ;
            ptADO^.ExecSQL;

            Res := ptADO^.RowsAffected;
            if (Msg.lParam <> 0) then
            begin
              @CallBK := Pointer(Msg.lParam); //*--使用回调--*//
              CallBK(Res);
            end;
          end;
        UM_EXECBAT:
          begin
            Temp := PUserMsg(Msg.wParam);
            //未完善
            //Res := ptADO^.ExecBat(Temp^.SqlLst);
            if (Msg.lParam <> 0) then
            begin
              @CallBK := Pointer(Msg.lParam); //*--使用回调--*//
              CallBK(Res);
            end;
          end;
      else
        ;
      end; //  end case.
    end; //  end if.

    Sleep(20); // 延迟20ms，避免过多占用CPU资源
  end; // end while.
end;
{------------------------------------------------------------------------------}

{--------------------------------获取异步句柄----------------------------------}

function GetHandle: THandle;
begin
  Result := Hdl;
end;
{------------------------------------------------------------------------------}

function GetThdID: Cardinal;
begin
  Result := ThdID;
end;
{------------------------------------------------------------------------------}

{----------------------------创建线程并提供句柄--------------------------------}

function CreateThrd(): THandle;
begin
  Hdl := BeginThread(nil, 0, @BsADOListen, nil, CREATE_SUSPENDED, ThdID);
  Result := Hdl;
end;
{------------------------------------------------------------------------------}

{-----------------------------挂起线程-----------------------------------------}

function SuspendThrd(): Integer;
begin
  Result := 1;
  try
    if (Hdl <> 0) then
      SuspendThread(Hdl)
    else
      Result := 0;
  except
    Result := 0;
  end;
end;
{------------------------------------------------------------------------------}

{----------------------------运行线程------------------------------------------}

function ResumThrd(): Integer;
begin
  Result := AE_SUCCESS;
  try
    if (Hdl <> 0) then
      ResumeThread(Hdl)
    else
      Result := AE_OTHERERR;
  except
    Result := AE_OTHERERR;
  end;
end;
{------------------------------------------------------------------------------}

{----------------------------终止线程------------------------------------------}

function EndThrd(): Integer;
begin
  Result := AE_SUCCESS;
  try
    if (Hdl <> 0) then
      TerminateThread(Hdl, 0)
    else
      Result := AE_OTHERERR;
  except
    Result := AE_OTHERERR;
  end;
end;
{------------------------------------------------------------------------------}

end.