dcthread.pas

DiskControls.v3.8.Full.Source 控制磁盘的控件 包括源代码

function TdcEventThread.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 TdcEventThread.SetPriority(Value: TThreadPriority);
begin
  SetThreadPriority(FHandle, Priorities[Value]);
end;

procedure TdcEventThread.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 TdcEventThread.SetSuspended(Value: Boolean);
begin
  if Value <> FSuspended then
   if Value then
     Suspend
   else
     Resume;
end;

procedure TdcEventThread.Suspend;
begin
  FSuspended := True;
  SuspendThread(FHandle);
end;

procedure TdcEventThread.Resume;
begin
  if ResumeThread(FHandle) = 1 then
    FSuspended := False;
end;

procedure TdcEventThread.Terminate;
begin
  FTerminated := True;
end;

function TdcEventThread.WaitFor:{$IFDEF D4}LongWord{$ELSE}Integer{$ENDIF};
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 TdcEventThread.CreateThread: TdcEventThread;
begin
  Result := TdcEventThread.Create(Owner);
  try
    Result.Priority := Priority;
    Result.FOnTerminate := FOnTerminate;
    Result.FOnExecute := FOnExecute;
    Result.FOnException := FOnException;
  except
    Result.Free;
    raise;
  end;
end;

function TdcEventThread.RecreateThread: TdcEventThread;
begin
  TerminateThread(Handle, 0);
  Result := CreateThread;
  Free;
end;

procedure TdcEventThread.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);

  // next lines should be proceed ONLY if FreeOwnerOnTerminate is True  
  if FreeOwnerOnTerminate then
   with Owner do
    if Owner <> nil then
     begin
      FThread := CreateThread; // create new thread instead this, which will be automatically destroyed
      Owner.Free;              // destroy owner (which will destroy the thread)
     end;
end;

procedure TdcEventThread.CallException;
begin
  if not (csDestroying in Owner.ComponentState) and Assigned(FOnException) then
    FOnException(Owner);
end;

procedure TdcEventThread.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;


{ TdcThread }
constructor TdcCustomThread.Create(aOwner: TComponent);
begin
  inherited;
  FDesignSuspended := True;  
  FHandleExceptions := True;
  FThread := TdcEventThread.Create(Self);
end;

destructor TdcCustomThread.Destroy;
begin
  if FThread.FRunning then Terminate(True);
  FThread.Free;
  inherited;
end;

procedure TdcCustomThread.Loaded;
begin
  inherited;
  SetSuspended(FDesignSuspended);
end;

procedure TdcCustomThread.DoWaitTimeoutExpired;
begin
  Terminate(True);
  if Assigned(FOnWaitTimeoutExpired) then
    FOnWaitTimeoutExpired(Self);
end;


{ methods }
function TdcCustomThread.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 TdcCustomThread.Suspend;
begin
  FThread.Suspend;
end;

procedure TdcCustomThread.Resume;
begin
  FThread.Resume;
end;

procedure TdcCustomThread.Synchronize(Method: TThreadMethod);
begin
  if not (csDestroying in Owner.ComponentState) then
    FThread.Synchronize(Method);
end;

procedure TdcCustomThread.InternalSynchronization;
begin
  if not (csDestroying in Owner.ComponentState) then
    FSyncMethod(FSyncParams);
end;

procedure TdcCustomThread.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 TdcCustomThread.Terminate(Imediately: Boolean);
begin
  if not Assigned(FThread) then Exit;

  if Imediately then
    FThread := FThread.RecreateThread
  else
    FThread.Terminate;
end;

function TdcCustomThread.WaitFor:{$IFDEF D4}LongWord{$ELSE}Integer{$ENDIF};
begin
  Terminate(True);
  Result := FThread.WaitFor;
end;


function  TdcCustomThread.GetHandle: THandle;
begin
  Result := FThread.FHandle;
end;

function  TdcCustomThread.GetReturnValue: Integer;
begin
  Result := FThread.ReturnValue;
end;

procedure TdcCustomThread.SetReturnValue(Value: Integer);
begin
  FThread.ReturnValue := Value;
end;


{ properties }
function TdcCustomThread.GetPriority: TThreadPriority;
begin
  Result := FThread.Priority;
end;

procedure TdcCustomThread.SetPriority(Value: TThreadPriority);
begin
  FThread.Priority := Value;
end;

function TdcCustomThread.GetSuspended: Boolean;
begin
  if csDesigning in ComponentState then
    Result := FDesignSuspended
  else
    Result := FThread.Suspended;
end;

procedure TdcCustomThread.SetSuspended(Value: Boolean);
begin
  if csDesigning in ComponentState then
    FDesignSuspended := Value
  else
   begin
    FDesignSuspended := Value;
    FThread.Suspended := Value;
   end; 
end;

function TdcCustomThread.GetRunning: Boolean;
begin
  Result := FThread.FRunning;
end;

function TdcCustomThread.GetTerminated: Boolean;
begin
  Result := FThread.FTerminated;
end;

function  TdcCustomThread.GetThreadID: THandle;
begin
  Result := FThread.ThreadID;
end;


// events
function  TdcCustomThread.GetOnException: TNotifyEvent;
begin
  Result := FThread.FOnException;
end;

procedure TdcCustomThread.SetOnException(Value: TNotifyEvent);
begin
  FThread.FOnException := Value;
end;

function  TdcCustomThread.GetOnExecute: TNotifyEvent;
begin
  Result := FThread.FOnExecute;
end;

procedure TdcCustomThread.SetOnExecute(Value: TNotifyEvent);
begin
  FThread.FOnExecute := Value;
end;

function  TdcCustomThread.GetOnTerminate: TNotifyEvent;
begin
  Result := FThread.FOnTerminate;
end;

procedure TdcCustomThread.SetOnTerminate(Value: TNotifyEvent);
begin
  FThread.FOnTerminate := Value;
end;

initialization
  InitializeCriticalSection(ThreadLock);

finalization
  DeleteCriticalSection(ThreadLock);

end.