::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2003-03-07 22:14:31, Hit : 6431, Vote : 1366
 mutex를 이용한 중복 실행 방지

unit OneInst;

{

  This code was adapted from the Delphi 2 Developers Guide. It has been
  tested in Delphi 3, 4 and 5 with Windows 95, 98, 98 SE, NT 4 and
  Windows 2000 Professional.

  I have added the re-definition of BroadcastSystemMessage and the code to
  test whether or not the app is minimized.

  (Since this was originally published, The Delphi 4 Developers Guide has been
  released with essentially the same modifications.)

  Randy Haben - Reusable Objects, Inc.
  Last updated and tested: May 30, 2000

  May 30, 2000: Added W2K_SetForegroundWindow. Tested on Windows 2000 and 98 SE.

}

interface

uses Forms, Windows, Dialogs, SysUtils;

const
  MI_NO_ERROR          = 0;
  MI_FAIL_SUBCLASS     = 1;
  MI_FAIL_CREATE_MUTEX = 2;

{ Query this function to determine if error occurred in startup. }
{ Value will be one or more of the MI_* error flags. }
function GetMIError: Integer;

{$EXTERNALSYM BroadcastSystemMessage}
function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;
  uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;

implementation

function BroadcastSystemMessage; external user32 name 'BroadcastSystemMessage';

const
                         // *** Change this for your own app ***
  UniqueAppStr : PChar = 'ReusableObjectsApp';

var
  MessageId: Integer;
  OldWindowProc: TFNWndProc = Nil;
  MutHandle: THandle = 0;
  MIError: Integer = 0;

{ ----------------------------------------------------------------------

   The following fix for Windows 2000 was suggested and published by
   Bob Moore, a Microsoft MVP. He maintains a web site that lists
   tips for NT developers.  This tip was found on the following site:
   http://www.mooremvp.freeserve.co.uk/Win32/w32tip33.htm.

   Theoretically, you should never programmatically give foreground focus
   to a window -- the user should make those choices. But, in this
   case, we don't want a new instance to accept the focus. We want
   an old instance to get it instead. When the original instance gets the
   message that it should be on-stage, it is not likely to actually be the
   active application. In fact, our new instance is still likely to be active
   since it is the one sending the message. So, we have to trick Windows into
   allowing the old instance to hook into the active thread and give itself
   permission to set the foreground window.

   I should note that I have not had any problems with the original code
   setting the foreground window in any 32 bit version of Windows, including
   Windows 2000. But I know that the official Microsoft stance, especially in
   Windows 2000, is that only the active thread can reliably set the
   foreground window. And I've heard of problems with this from enough other
   developers that I have now incorporated this technique as the "standard"
   way of forcing the issue.  (OK, maybe not problems, since the idea is to
   prevent a user from spontaneously typing into an unexpected window -- something
   that drives me crazy, too, but that M$ and others still do even in Win2K.)

   Hopefully this hasn't introduced new problems.  ---- May 30, 2000 --- RLH

}


function W2K_SetForegroundWindow (hWndToForce : HWND) : Boolean;
var
   hCurrWnd  : HWND;
   iMyTID    ,
   iCurrTID  : Integer;
   sBuffer  : String;
begin
   hCurrWnd := GetForegroundWindow ();
   iMyTID   := GetCurrentThreadId ();
   iCurrTID := GetWindowThreadProcessId (hCurrWnd, nil);

   // Connect to the current process.
   AttachThreadInput (iMyTID, iCurrTID, True);

   // Now we look like the foreground process, we can set the
   // foreground window.
   Result := SetForegroundWindow (hWndToForce);

   if (Result = False) then
   begin
     sBuffer := Format('Error %u from SetForegroundWindow', [GetLastError]);
     OutputDebugString (PChar(sBuffer));
   end;

   // Now detach.
   AttachThreadInput (iMyTID, iCurrTID, False);
end;

function GetMIError: Integer;
begin
  Result := MIError;
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam,
                    lParam: Longint): Longint; StdCall;
begin

  { If this is the registered message... }
  if Msg = MessageID then begin
    if IsIconic(Application.Handle) then  // Is app minimized?
    begin
      Application.MainForm.WindowState := wsNormal;
      Application.Restore;
    end;
    if Assigned(Application.MainForm) then  // Just in case
      W2K_SetForegroundWindow(Application.MainForm.Handle);
    Result := 0;  // Satisfy the compiler
  end
  { Otherwise, pass message on to old window proc }
  else
    Result := CallWindowProc(OldWindowProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassApplication;
begin
  { We subclass Application window procedure so that }
  { Application.OnMessage remains available for user. }
  OldWindowProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
                                    Longint(@NewWndProc)));
  { Set appropriate error flag if error condition occurred }
  if OldWindowProc = Nil then
    MIError := MIError or MI_FAIL_SUBCLASS;
end;

procedure DoFirstInstance;
begin
  SubClassApplication;
  MutHandle := CreateMutex(Nil, False, UniqueAppStr);
  if MutHandle = 0 then
    MIError := MIError or MI_FAIL_CREATE_MUTEX;
end;

procedure BroadcastFocusMessage;
{ This is called when there is already an instance running. }
var
  BSMRecipients: DWORD;
begin
  { Don't flash main form }
  Application.ShowMainForm := False;
  { Post message and inform other instance to focus itself }
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
                         @BSMRecipients, MessageID, 0, 0);
  Application.Terminate;
end;

procedure InitInstance;
begin
  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
  if MutHandle = 0 then
    { Mutex object has not yet been created, meaning that no previous }
    { instance has been created. }
    DoFirstInstance
  else
    BroadcastFocusMessage;
end;

initialization
  MessageID := RegisterWindowMessage(UniqueAppStr);
  InitInstance;
finalization
  if OldWindowProc <> Nil then
    { Restore old window procedure }
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end.





651   [일반/컴포넌트] RichEdit 에 URL link 만들기  김영대 2004/08/04 5761 1286
650   [일반/컴포넌트] TOpenDialog 의 '선택','취소' 버튼 이름 바꾸기  김영대 2003/03/07 4151 1286
649   [윈도우즈 API] 다른 프로그램의 구동 디렉토리 알아내기  김영대 2003/03/07 4760 1285
648   [윈도우즈 API] Windows Desktop에 직접 그림을 그리고(draw) 지우기(refresh)  김영대 2003/03/04 4567 1285
647   [윈도우즈 API] 윈도우즈 탐색기에서 "Copy" 될 파일목록 구하기  김영대 2003/03/07 4855 1284
646   [시스템] 윈도우즈 화면 잠그기  김영대 2004/08/03 5050 1283
645   [시스템] 절약형 모니터의 켜기/끄기  김영대 2003/03/04 4663 1282
644   [일반/컴포넌트] Access Violation at address ?????? 로부터 소스위치 알기  김영대 2003/03/07 6346 1281
643   [시스템] 파일이 다른 프로그램에 의해 사용중인지 검사  김영대 2003/03/07 5656 1280
642   [일반/컴포넌트] Treeview의 수평 스크롤바 감추고 스크롤 막기  김영대 2006/03/22 5589 1278
641   [네트웍/인터넷] FTP로 특정 파일의 권한(site chmod) 변경하기  김영대 2004/10/09 5592 1278
640   [시스템] 드라이브 포맷(Format) API 함수  김영대 2003/03/04 4706 1278
639   [윈도우즈 API] PrintScreen(PrtSc)키의 동작 막기  김영대 2003/03/07 5695 1277
638   [일반/컴포넌트] 객체의 valid검사 Assigned() 대체  김영대 2005/07/29 4861 1276
637   [COM/OLE] 윈도우즈 "인터넷 등록 정보" 화면  김영대 2004/07/25 4094 1276
636   [시스템] 프로그램에서 화면모드 변경하기  김영대 2003/03/04 4652 1276
635   [일반/컴포넌트] ListView의 타이틀 폰트 바꾸기  김영대 2005/03/31 5335 1274
634   [일반/컴포넌트] MIME 타입에 해당하는 파일 확장자 구하기  김영대 2004/11/18 4764 1274
633   [윈도우즈 API] 전체 화면(Full Screen) 만들기  김영대 2003/03/29 4976 1273
632   [일반/컴포넌트] 명령행 인자(command line argument) 사용하기  김영대 2003/03/05 4651 1273
631   [일반/컴포넌트] StringGrid의 Cell에 입력 값 제한 하기  김영대 2003/03/04 5784 1272
630   [시스템] 파일의 소유자와 도메인 구하기2  김영대 2004/09/25 4688 1271
629   [일반/컴포넌트] 해상도(screen resolution)를 변경했는지 검사  김영대 2003/03/07 4466 1271
628   [윈도우즈 API] 4가지 윈도우즈 관련 폴더의 path 구하기  김영대 2003/04/08 5620 1270
627   [윈도우즈 API] Canvas의 색상수  김영대 2003/03/04 4093 1269
626   [COM/OLE] TWebBrowser에서 JavaScript 호출하기2  김영대 2004/10/10 6075 1268
625   [COM/OLE] IE의 속성을 변경하여 뛰우기  김영대 2006/02/28 5418 1266
624   [네트웍/인터넷] 네트워크 공유 설정/공유 사용 권한/해제 하기 (Windows NT/2000)  김영대 2004/11/06 5474 1266
623   [COM/OLE] ActiveForm의 OnDestroy 대용  김영대 2005/04/21 5399 1265
622   [시스템] 윈도우즈에 설치된 모든 인증서(certificate) 정보 읽어오기  김영대 2004/10/29 5660 1264
621   [윈도우즈 API] 화면캡처하기 Delphi3.0에서...  김영대 2003/03/04 4688 1264
620   [윈도우즈 API] 떠있는 모든 Microsoft Internet Explorer 죽이기  김영대 2003/03/29 4467 1262
619   [시스템] 한글 한 음절을 초성,중성,종성 음소로 분해하기('김' => 'ㄱ'+'ㅣ'+'ㅁ')  김영대 2004/10/22 7829 1261
618   [일반/컴포넌트] TPanel, TImage 에 Gradient 효과 주기  김영대 2003/03/07 4333 1261
617   [COM/OLE] TWebBroswer 에서 오른쪽 마우스 클릭 막기  김영대 2004/11/24 5056 1260
616   [일반/컴포넌트] 키보드의 Shift+Tab 이 눌린것처럼 처리하기  김영대 2003/04/14 4560 1260
615   [윈도우즈 API] Windows error beep 켜기/끄기  김영대 2003/03/07 4421 1260
614   [데이터베이스] Stored Procedure 작성을 어떻게 하나  김영대 2003/03/04 4884 1260
613   [시스템] 로컬 가상 드라이버(substitution device) 만들고 제거하기  김영대 2004/07/25 5469 1259
612   [일반/컴포넌트] 두개의 RichEdit 사이에 내용 복사하기  김영대 2003/03/06 5359 1259

[1][2][3][4][5][6][7][8] 9 [10]..[25] [다음 10개]
 

Copyright 1999-2019 Zeroboard / skin by zero