⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mysqlthread.pas

📁 MYSQL 连接控件 MYSQL 连接控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  	FStatus := NewStatus;
     FSync.Enter;
     try
     	FLastStatus := NewStatus;
     finally
        FSync.Leave;
     end;
     if (FWndHandle>0) and ReadIniBoolean(FProps,'Main','SilentStatus',True) then PostMessage(FWndHandle,MYSQL_NOTIFY_STATUS,ThreadID,NewStatus);
  end;
end;

function	TMySQLThread.GetStatus: byte;
begin
	FSync.Enter;
  try
		Result := FLastStatus;
  finally
  	FSync.Leave;
  end;
end;

procedure TMySQLThread.Progress;
begin
	if (FWndHandle>0) and ReadIniBoolean(FProps,'Main','SilentProgress',True) then begin
  	PostMessage(FWndHandle, MYSQL_PROGRESS_POS, ThreadID, Current);
  	PostMessage(FWndHandle, MYSQL_PROGRESS_SPEED, ThreadID, Trunc(Speed));
  	PostMessage(FWndHandle, MYSQL_PROGRESS, ThreadID, Total);
  end;
end;

procedure TMySQLThread.SetNotifyTask;
begin
	Notifier.SetEvent;
  if (WndHandle>0) and ReadIniBoolean(Props,'Main','SilentTasks',True) then PostMessage(WndHandle, MYSQL_NOTIFY_TASK, ThreadID, Status)
end;

function TMySQLThread.ThreadExecute: boolean;
begin
	Status := stSQL;
	Result := True;
	Continue := True;
  Notifier.ResetEvent;
  if Suspended then Resume;
end;

procedure	TMySQLThread.Idle;
begin
	Sleep(1);
end;

function	TMySQLThread.GetEvent: boolean;
begin
	Result := False;
end;

procedure	TMySQLThread.HandleEvent;
begin
end;

procedure TMySQLThread.Execute;
begin
   try
      while not Terminated and not(FStatus in [stNone,stDisconnected]) do begin
         try
            GetEvent;
            HandleEvent;
            Idle;
            if Continue and not Terminated and (FStatus in [stIdle]) then Suspend;
         except
            FStatus := stNone;
            if not(ExceptObject is EAbort) then NotifyException(Exception(ExceptObject));
            FNotifier.SetEvent;
         end;
      end;
   finally
      FNotifier.SetEvent;
   end;
end;

//	TMySQLThreadedSQL
function TMySQLThreadedSQL.ThreadExecute;
begin
  FSQL := SQL;
  FServer := AServer;
  Result := inherited ThreadExecute;
  if AWaitFor then Result := Result and (FNotifier.WaitFor(FTimeOut)=wrTimeout);
end;

function TMySQLThreadedSQL.GetEvent: boolean;
begin
	Result := inherited GetEvent;
  try
     FDataset := TMySQLDataset.Create(nil);
     with FDataset do begin
        ShareConnection := False;
        UseCursor := False;
        {$IFNDEF CONSOLEAPP}
        Cursor := crAppStart;
        {$ENDIF}
        Server := FServer;
        DatabaseName := FServer.DatabaseName;
        Options := Options-[doThreadedUpdate];
        if (FMsgType>0) and (WndHandle>0) then begin
           SQL.Text := FSQL;
           Open;
        end else Result := ExecSQL(FSQL);
     end;
  finally
     if (FMsgType>0) and (WndHandle>0) and ReadIniBoolean(FProps,'Main','SilentProgress',True) then
        PostMessage(WndHandle,FMsgType,FRef,Integer(Pointer(FDataset)))
     else
        FDataset.Free;
  end;
end;

procedure TMySQLThreadedSQL.HandleEvent;
begin
	inherited HandleEvent;
  Status := stNone;
	SetNotifyTask;
  Terminate;
end;

//	TMySQLThreadedOpen
function TMySQLThreadedOpen.ThreadExecute;
begin
  FDataset := ADataset;
  Result := inherited ThreadExecute;
  if AWaitFor then WaitFor;
end;

function TMySQLThreadedOpen.GetEvent: boolean;
begin
	Result := inherited GetEvent;
  with FDataset do begin
     ShareConnection := False;
     UseCursor := False;
     {$IFNDEF CONSOLEAPP}
     Cursor := crAppStart;
     {$ENDIF}
     Open;
  end;
end;

procedure TMySQLThreadedOpen.HandleEvent;
begin
	inherited HandleEvent;
  Status := stNone;
	SetNotifyTask;
  Terminate;
end;

function ThreadWaitSQLFree(AServer: TMySQLServer; const ASQL: string; AHandle: HWND = 0): boolean;
begin
	with TMySQLThreadedSQL.Create('[MySQL]'#13#10'TimeOut=30000'#13#10,AHandle) do begin
     Result := ThreadExecute(AServer,ASQL,True);
     Free;
  end;
end;

function ThreadSQLFree(AServer: TMySQLServer; const ASQL: string;ANotify: TNotifyEvent=nil; AHandle: HWND=0): cardinal;
begin
	with TMySQLThreadedSQL.Create('[MySQL]'#13#10'TimeOut=30000'#13#10,AHandle,True) do begin
  	Result := ThreadID;
     OnFin := ANotify;
     ThreadExecute(AServer,ASQL,False);
  end;
end;

procedure ThreadSQLAnswer(AServer: TMySQLServer; const ASQL: string; AHandle: HWND=0; AMsgType: integer=0; ARef: integer=0);
begin
	with TMySQLThreadedSQL.Create('[MySQL]'#13#10'TimeOut=30000'#13#10,AHandle,True) do
  	ThreadExecute(AServer,ASQL,False);
end;

procedure ThreadSQLOpen(AServer: TMySQLServer; const ASQL: string; AHandle: HWND=0; AMsgType: integer=0; ARef: integer=0);
begin
	with TMySQLThreadedSQL.Create('[MySQL]'#13#10'TimeOut=30000'#13#10,AHandle,True) do begin
     FMsgType := AMsgType;
     FRef := ARef;
     ThreadExecute(AServer,ASQL,False);
  end;
end;

procedure ThreadDatasetOpen(ADataset: TMySQLDatasetBase; ANotify: TNotifyEvent=nil; AWaitFor: boolean=False);
begin
	with TMySQLThreadedOpen.Create('[MySQL]'#13#10'TimeOut=30000'#13#10,0,not AWaitFor) do begin
     OnTerminate := ANotify;
		ThreadExecute(ADataset,AWaitFor);
     if AWaitFor then Free;
  end;
end;


//	****************
//	   TMySQLThreaded
//	****************

constructor TMySQLThreaded.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimeOut := 30000;
  FIntervals := 100;
{$IFDEF LINUX}
  FOwnHandle := WinUtils.AllocateHWnd(Self.OwnProc)
{$ENDIF}
{$IFDEF MSWINDOWS}
  {$IFDEF DELPHI5}
  FOwnHandle := Forms.AllocateHWnd(Self.OwnProc)
  {$ELSE}
  FOwnHandle := Classes.AllocateHWnd(Self.OwnProc)
  {$ENDIF}
{$ENDIF}
end;

destructor	TMySQLThreaded.Destroy;
begin
{$IFDEF LINUX}
  if FOwnHandle<>0 then WinUtils.DeallocateHWnd(FOwnHandle);
{$ENDIF}
{$IFDEF MSWINDOWS}
  {$IFDEF DELPHI5}
  if FOwnHandle<>0 then Forms.DeallocateHWnd(FOwnHandle);
  {$ELSE}
  if FOwnHandle<>0 then Classes.DeallocateHWnd(FOwnHandle);
  {$ENDIF}
{$ENDIF}
	inherited;
end;

procedure TMySQLThreaded.OwnProc(var M :TMessage);
begin
  case M.Msg of
      MYSQL_NOTIFY_EXCEPT:
      							try
                             if Assigned(FOnError) then OnError(Self,0,stError,PChar(M.lParam),FLastContinue)
                          finally
  									if M.lParam <> 0 then FreeMem(Pointer(M.lParam));
      							end;
      MYSQL_NOTIFY_MSG: 	try
                             if Assigned(FOnNotify) then OnNotify(Self,0,PChar(M.lParam),FLastContinue)
      							finally
  									if M.lParam <> 0 then FreeMem(Pointer(M.lParam));
      							end;
      MYSQL_NOTIFY_STATUS:	if Assigned(FOnStatus) then OnStatus(Self,M.WParam,M.LParam,'',FLastContinue);
      MYSQL_PROGRESS:		begin
      								FLastTotal := M.LParam;
      								if Assigned(FOnProgress) then OnProgress(Self,M.WParam,FLastTotal,FLastCurrent,FLastSpeed,FLastContinue);
      							end;
      MYSQL_PROGRESS_POS:		FLastCurrent := M.LParam;
      MYSQL_PROGRESS_SPEED:	FLastSpeed := M.LParam;
      MYSQL_NOTIFY_TASK: 		if Assigned(FOnTask) then OnTask(Self,M.WParam,M.LParam,'',FLastContinue);
   end;
end;

procedure	TMySQLThreaded.ExecSQL(AServer: TMySQLServer; const ASQL: string='');
begin
	with TMySQLThreadedSQL.Create('[MySQL]'#13#10'TimeOut='+IntToStr(FTimeOut)+#13#10,FOwnHandle,True) do begin
     ThreadExecute(AServer,ASQL,False);
  end;
end;

procedure	TMySQLThreaded.SetIntervals(Value: word);
begin
	FIntervals := Value;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -