{-----------------------------------------------------------------------------
                          ---> Project DelphiWorks <---
                                   Version 1.4
 -----------------------------------------------------------------------------
 Unit:        dwApplication.pas
 Description: Application helpers
 Author:      Codehunter Works
 Release:     1.4
 State:       Stable
 Date:        16.08.2004
 Created:     14.12.2002
 Last mod.:   14.02.2005
 History:     n/a
-----------------------------------------------------------------------------}


unit dwApplication;

interface                       

uses Windows;

function dwAppExec(const CmdLine, CmdParams: String; const CmdShow: Integer): Boolean;
function dwAppIsResponding(const ClassName: String; const TimeOut: Cardinal): Boolean;
function dwDelphiIsRunning: Boolean;
function dwFlashTaskButton(hWndOwner: HWND; const FlashCount, TimeOut: DWord): Boolean;
function dwFlashWindowCaption(hWnd: HWND; const FlashCount, TimeOut: DWord): Boolean;
function dwMasterPath: String;

procedure dwAppRestart;
procedure dwBringMyAppToFront(AppHandle: THandle);
procedure dwDelay(const WaitTime: DWord);
procedure dwExecAndWait(const FileName, Params: String; const CmdShow: Integer);
procedure dwProcessMessages;

implementation

uses dwInternal,
	  Dialogs, Messages, ShellAPI, SysUtils;

function dwAppExec(const CmdLine, CmdParams: String; const CmdShow: Integer): Boolean;
begin
   result:= (ShellExecute(GetCurrentProcess,
                         'open',
                         PChar(CmdLine),
                         PChar(CmdParams),
                         '',
                         CmdShow)>32);
end;

function dwAppIsResponding(const ClassName: String; const TimeOut: Cardinal): Boolean;
var
  Res: DWORD;
  h: HWND;
  bClassFound,
  bSendMessage: Boolean;
begin
  bSendMessage:= FALSE;
  h:= FindWindow(PChar(ClassName), nil);
  bClassFound:= (h <> 0);
  if bClassFound then
    bSendMessage:= (SendMessageTimeout(H,
      WM_NULL,
      0,
      0,
      SMTO_NORMAL or SMTO_ABORTIFHUNG,
      TIMEOUT,
      Res) <> 0);
   result:= (bClassFound and bSendMessage);
end;

{-----------------------------------------------------------------------------
 Procedures
-----------------------------------------------------------------------------}
procedure dwAppRestart;
begin
  dwAppExec(ParamStr(0), '', SW_SHOW);
  TerminateProcess(GetCurrentProcess, 0);
end;

procedure dwBringMyAppToFront(AppHandle: THandle);
var
  Th1, Th2: Cardinal;
begin
  Th1 := GetCurrentThreadId;
  Th2 := GetWindowThreadProcessId(GetForegroundWindow, NIL);
  AttachThreadInput(Th2, Th1, TRUE);
  try
    SetForegroundWindow(AppHandle);
  finally
    AttachThreadInput(Th2, Th1, TRUE);
  end;
end;

procedure dwDelay(const WaitTime: DWord);
var
  Start: DWord;
begin
  Start := GetTickCount;
  repeat
    dwProcessMessages;
  until (GetTickCount - Start) > WaitTime;
end;

function dwDelphiIsRunning: Boolean;
var
 Delphi : HWND;
begin
 Delphi := FindWindow('TAppBuilder', nil);
 if Delphi <> 0 then Result:=True
 else Result:=False;
end;

function dwFlashTaskButton(hWndOwner: HWND; const FlashCount, TimeOut: DWord): Boolean;
begin
	result:= dwiFlashApplicationSpecific(hWndOwner, FLASHW_TRAY, FlashCount, TimeOut);
end;

function dwFlashWindowCaption(hWnd: HWND; const FlashCount, TimeOut: DWord): Boolean;
begin
	result:= dwiFlashApplicationSpecific(hWnd, FLASHW_CAPTION, FlashCount, TimeOut);
end;

function dwMasterPath: String;
begin
   result:= UpperCase(IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))));
end;

procedure dwExecAndWait(const FileName, Params: String; const CmdShow: Integer);
var
  exInfo: TShellExecuteInfo;
  Ph: DWORD;
begin
  FillChar(exInfo, SizeOf(exInfo), 0);
  with exInfo do
  begin
    cbSize := SizeOf(exInfo);
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    Wnd := GetActiveWindow();
    ExInfo.lpVerb := 'open';
    ExInfo.lpParameters := PChar(Params);
    lpFile := PChar(FileName);
    nShow := CmdShow;
  end;
  if ShellExecuteEx(@exInfo) then
    Ph := exInfo.HProcess
  else
  begin
    ShowMessage(SysErrorMessage(GetLastError));
    Exit;
  end;
  while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
    dwProcessMessages;
  CloseHandle(Ph);
end;

procedure dwProcessMessages;
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, GetCurrentProcess, 0, 0, PM_REMOVE) do
    //if not IsDialogMessage(Dlg, Msg) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
end;

end.