?? uathread.~pas
字號:
Terminate;
WaitFor;
end;
if FHandle <> 0 then CloseHandle(FHandle);
inherited;
RemoveThread;
end;
procedure TUAEventThread.DoTerminate;
begin
if Assigned(FOnTerminate) then
Synchronize(CallTerminate);
end;
function TUAEventThread.GetPriority: TThreadPriority;
var
P: Integer;
I: TThreadPriority;
begin
P := GetThreadPriority(FHandle);
Result := tpNormal;
for I := Low(TThreadPriority) to High(TThreadPriority) do
if Priorities[I] = P then
Result := I;
end;
procedure TUAEventThread.SetPriority(Value: TThreadPriority);
begin
SetThreadPriority(FHandle, Priorities[Value]);
end;
procedure TUAEventThread.Synchronize(Method: TThreadMethod);
begin
FSynchronizeException := nil;
FMethod := Method;
SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self));
if Assigned(FSynchronizeException) and not Owner.FHandleExceptions then
raise FSynchronizeException;
end;
procedure TUAEventThread.SetSuspended(Value: Boolean);
begin
if Value <> FSuspended then
if Value then
Suspend
else
Resume;
end;
procedure TUAEventThread.Suspend;
begin
FSuspended := True;
SuspendThread(FHandle);
end;
procedure TUAEventThread.Resume;
begin
if ResumeThread(FHandle) = 1 then
FSuspended := False;
end;
procedure TUAEventThread.Terminate;
begin
FTerminated := True;
end;
function TUAEventThread.WaitFor:Cardinal;
var
Msg: TMsg;
H: THandle;
begin
H := FHandle;
if GetCurrentThreadID = MainThreadID then
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
else
WaitForSingleObject(H, INFINITE);
GetExitCodeThread(H, Result);
end;
function TUAEventThread.CreateThread: TUAEventThread;
begin
Result := TUAEventThread.Create(Owner);
try
Result.Priority := Priority;
Result.FOnTerminate := FOnTerminate;
Result.FOnExecute := FOnExecute;
Result.FOnException := FOnException;
except
Result.Free;
raise;
end;
end;
function TUAEventThread.RecreateThread: TUAEventThread;
begin
TerminateThread(Handle, 0);
Result := CreateThread;
Free;
end;
procedure TUAEventThread.CallTerminate;
var
FreeOwnerOnTerminate: Boolean;
begin
FreeOwnerOnTerminate := Owner.FFreeOwnerOnTerminate;
if Assigned(FOnTerminate) and not (csDestroying in Owner.ComponentState) then
if Owner.FHandleExceptions then
try
FOnTerminate(Owner);
except
if Assigned(FOnException) and not (csDestroying in Owner.ComponentState) then
CallException;
end
else
FOnTerminate(Owner);
if FreeOwnerOnTerminate then
with Owner do
if Owner <> nil then
begin
FThread := CreateThread;
Owner.Free;
end;
end;
procedure TUAEventThread.CallException;
begin
if not (csDestroying in Owner.ComponentState) and Assigned(FOnException) then
FOnException(Owner);
end;
procedure TUAEventThread.Execute;
begin
if Assigned(FOnExecute) and not (csDestroying in Owner.ComponentState) then
if Owner.FHandleExceptions then
try
FOnExecute(Owner); // ????
except
if Assigned(FOnException) and not (csDestroying in Owner.ComponentState) then
Synchronize(CallException);
end
else
FOnExecute(Owner);
end;
{ TUACustomThread }
constructor TUACustomThread.Create(aOwner: TComponent);
begin
inherited;
FDesignSuspended := True;
FHandleExceptions := True;
FThread := TUAEventThread.Create(Self);
end;
destructor TUACustomThread.Destroy;
begin
if FThread.FRunning then Terminate(True);
FThread.Free;
inherited;
end;
procedure TUACustomThread.Loaded;
begin
inherited;
SetSuspended(FDesignSuspended);
end;
procedure TUACustomThread.DoWaitTimeoutExpired;
begin
Terminate(True);
if Assigned(FOnWaitTimeoutExpired) then
//FOnWaitTimeoutExpired(Self);
FOnWaitTimeoutExpired(Self)
else
begin
//----- add by vinson zeng 2004-09-10...etc
//在應用服務器中,如果有事務執行超時,必須寫入日志,前提是沒有上面的Event process
end;
end;
function TUACustomThread.Execute: Boolean;
var
CurrentThreadHandle: THandle;
TempWaitTimeout, WaitResult: DWord;
begin
Terminate(True);
if FFreeOwnerOnTerminate then
FThread.FreeOnTerminate := True;
FThread.Resume;
Result := True;
if FWaitThread then
begin
CurrentThreadHandle := FThread.FHandle;
if FWaitTimeout = 0 then
TempWaitTimeout := INFINITE
else
TempWaitTimeout := FWaitTimeout;
repeat
WaitResult := MsgWaitForMultipleObjects(1, CurrentThreadHandle, False, TempWaitTimeout, QS_ALLINPUT);
if WaitResult = WAIT_TIMEOUT then
begin
Terminate(True);
if Assigned(FOnWaitTimeoutExpired) then
FOnWaitTimeoutExpired(Self);
Result := False;
Exit;
end;
Application.ProcessMessages;
until (WaitResult <> WAIT_OBJECT_0 + 1) or (csDestroying in ComponentState) or Application.Terminated;
end;
end;
procedure TUACustomThread.Suspend;
begin
FThread.Suspend;
end;
procedure TUACustomThread.Resume;
begin
FThread.Resume;
end;
procedure TUACustomThread.Synchronize(Method: TThreadMethod);
begin
if not (csDestroying in Owner.ComponentState) then
FThread.Synchronize(Method);
end;
procedure TUACustomThread.InternalSynchronization;
begin
if not (csDestroying in Owner.ComponentState) then
FSyncMethod(FSyncParams);
end;
procedure TUACustomThread.SynchronizeEx(Method: TNotifyEvent; Params: Pointer);
begin
if not (csDestroying in Owner.ComponentState) and
Assigned(Method) then
begin
FSyncMethod := Method;
FSyncParams := Params;
FThread.Synchronize(InternalSynchronization);
end;
end;
procedure TUACustomThread.Terminate(Imediately: Boolean);
begin
if not Assigned(FThread) then Exit;
if Imediately then
FThread := FThread.RecreateThread
else
FThread.Terminate;
end;
function TUACustomThread.WaitFor:Cardinal;
begin
Terminate(True);
Result := FThread.WaitFor;
end;
function TUACustomThread.GetHandle: THandle;
begin
Result := FThread.FHandle;
end;
function TUACustomThread.GetReturnValue: Integer;
begin
Result := FThread.ReturnValue;
end;
procedure TUACustomThread.SetReturnValue(Value: Integer);
begin
FThread.ReturnValue := Value;
end;
function TUACustomThread.GetPriority: TThreadPriority;
begin
Result := FThread.Priority;
end;
procedure TUACustomThread.SetPriority(Value: TThreadPriority);
begin
FThread.Priority := Value;
end;
function TUACustomThread.GetSuspended: Boolean;
begin
if csDesigning in ComponentState then
Result := FDesignSuspended
else
Result := FThread.Suspended;
end;
procedure TUACustomThread.SetSuspended(Value: Boolean);
begin
if csDesigning in ComponentState then
FDesignSuspended := Value
else
begin
FDesignSuspended := Value;
FThread.Suspended := Value;
end;
end;
function TUACustomThread.GetRunning: Boolean;
begin
Result := FThread.FRunning;
end;
function TUACustomThread.GetTerminated: Boolean;
begin
Result := FThread.FTerminated;
end;
function TUACustomThread.GetThreadID: THandle;
begin
Result := FThread.ThreadID;
end;
function TUACustomThread.GetOnException: TNotifyEvent;
begin
Result := FThread.FOnException;
end;
procedure TUACustomThread.SetOnException(Value: TNotifyEvent);
begin
FThread.FOnException := Value;
end;
function TUACustomThread.GetOnExecute: TNotifyEvent;
begin
Result := FThread.FOnExecute;
end;
procedure TUACustomThread.SetOnExecute(Value: TNotifyEvent);
begin
FThread.FOnExecute := Value;
end;
function TUACustomThread.GetOnTerminate: TNotifyEvent;
begin
Result := FThread.FOnTerminate;
end;
procedure TUACustomThread.SetOnTerminate(Value: TNotifyEvent);
begin
FThread.FOnTerminate := Value;
end;
initialization
InitializeCriticalSection(ThreadLock);
finalization
DeleteCriticalSection(ThreadLock);
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -