📄 mysqlthread.pas
字号:
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 + -