?愁死我了!!!防止程序的二次的运行-可是怎么就是不行呢???????(100分)

  • 主题发起人 主题发起人 dongliang110
  • 开始时间 开始时间
D

dongliang110

Unregistered / Unconfirmed
GUEST, unregistred user!
请教一下众位,我做了一个程序,为了防止一个程序有多个实例同时运行,
我加入了(1)-(5)代码,我分别放到三个程序中,可是有一个程序执行时此代码没有产生作用,
我找了很长时间也没有找到原因。请问还应注意哪些方面?
program prjcheckaccount;

uses
Forms,
windows,
messages,

untcheckaccount in 'untcheckaccount.pas' {frmcheckaccount};

{$R *.RES}
var
ls_hwnd:THandle;

begin
Application.Initialize;
(1) ls_hwnd:=FindWindowW('Tfrmcheckaccount','frmcheckaccount');
(2)if ls_hwnd<>0 then
(3) begin
(4) if not IsWindowVisible(ls_hwnd) then
(5) PostMessage(ls_hwnd,wm_user,0,0);
(5) SetForegroundWindow(ls_hwnd);
end
else
Application.CreateForm(Tfrmcheckaccount, frmcheckaccount);
Application.Run;
end.
 
用CreateMutex嘛!
 
用一下代码试试.
program Project1;

uses
Forms,Windows, Messages,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}
var
hmutex:hwnd;
ret:integer;

begin
Application.Initialize;
hmutex:=createmutex(nil,false,'project1');
ret:=getlasterror;
if ret<>error_already_exists then
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end else begin
messagedlg('程序已运行。',mtinformation,[mbok],0);
releasemutex(hmutex);
end;
end.
 
[:(!][^]
var
Handle: Integer;
begin
handle := findwindow('TLYMain',nil);// 解决程序重入问题
if handle <> 0 then halt; // 当然是善后工作了,搞定 Application.Initialize;
Application.CreateForm(TLYMain, LYMain);
Application.Run;
end;
 
你可能没有向Windows注册窗口类'TFrmcheckaccount‘,你应该重载Tfrmcheckaccount的CreateParams
如:
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WinClassName := 'My Delphi Program!';
end;

另外我向你介绍另外一个方法:
请看:
unit prevcode;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

function DoIExist(WndTitle : String) : Boolean;
var
Form1: TForm1;

implementation

{$R *.DFM}

{===================================================================================
This is a different twist on finding a previous instance of an application in a
32-bit environment. It uses a semaphore (although you could also use a mutex object)
instead of performing an EnumWindows to find a previous instance, like you would
have done in a 16-bit environment. This is more in line with multi-threaded app
design.
===================================================================================}
function DoIExist(WndTitle : String) : Boolean;
var
hSem : THandle;
hWndMe,hWndPrev : HWnd;
semNm,wTtl : Array[0..256] of Char;
begin

Result := False;

//Initialize arrays
StrPCopy(semNm, 'SemaphoreName');
StrPCopy(wTtl, WndTitle);

//Create a Semaphore in memory - If this is the first instance, then
//it should be 0.
hSem := CreateSemaphore(nil, 0, 1, semNm);

//Now, check to see if the semaphore exists
if ((hSem <> 0) AND (GetLastError() = ERROR_ALREADY_EXISTS)) then begin
CloseHandle(hSem);

//We'll first get the currently executing window's handle then change its title
//so we can look for the other instance
hWndMe := FindWindow(nil, wTtl);
SetWindowText(hWndMe, 'zzzzzzz');

//What we want to do now is search for the other instance of this window
//then bring it to the top of the Z-order stack.
hWndMe := FindWindow(nil, wTtl);
if (hWndMe <> 0) then begin
if IsIconic(hWndMe) then
ShowWindow(hWndMe, SW_SHOWNORMAL)
else
SetForegroundWindow(hWndMe);
end;

Result := True;

//Could put the Halt here, instead of in the FormCreate method,
//unless you want to do some extra processing.

//Halt;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if DoIExist(Self.Caption) then
Halt;
end;

end.
 
老赵,liao6373,多谢你们,但是我想查出我的问题是出在哪里,
别外我以发现当我用F7执行程序时程序就能执行,但是用F8执行时程序就运行不起来。
多谢帮帮忙找出原因。我会多加100分。
对了(1)-(5)行代码是在程序已经编写完后加进去的,是不是我的程序别的地方的设置
影响的。
 
Delphi4开发大全上有个单元,只需在项目文件中加一个引用,完全达到你所有的效果.
 
楼上兄弟说的delphi4大全上就有介绍的,copy过来比较一下,比买那本书不值得.去书店
看两眼就可以了,比你的代码要少
 
原因出在(1)的那一句。Delphi对应用程序的封装使用了一个隐藏(或者说看不到的Form)
那就是Application,所以(1)句应该该为
hWnd = FindWindow('TApplication', PChar(Application.Title));
 
按类型或类名的查找在Win32下并不推荐。再说,进程隔离,未必别的窗口一定会响应你的消息。
以下是D4大全中的代码。
在项目单元和主窗体单元的interface部分的uses中分别加入本单元的引用即可。
unit Checks;

interface

uses
Forms, Windows, SysUtils, Classes, Dialogs;

function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;
uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint;
stdcall; external 'user32.dll';

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

function GetMIError: Integer;

implementation

const
UniqueAppStr = 'Kingway Remote InterBase Service';

var
MessageID: Integer;
WProc: TFNWndProc = nil;
MutHandle: THandle = 0;
MIError: Integer = 0;

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

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
Longint; stdcall;
begin
if Msg = MessageID then
begin
Result := 0;
if IsIconic(Application.Handle) then
begin
Application.MainForm.WindowState := wsNormal;
Application.Restore;
end;
SetForegroundWindow(Application.MainForm.Handle);
end
else
Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure InitInstance;
var
BSMRecipients: DWORD;
begin
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
if MutHandle = 0 then
begin
WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
Longint(@NewWndProc)));
if WProc = nil then
MIError := MIError or MI_FAIL_SUBCLASS;
MutHandle := CreateMutex(nil, False, UniqueAppStr);
if MutHandle = 0 then
MIError := MIError or MI_FAIL_CREATE_MUTEX;
end
else
begin
Application.ShowMainForm := False;
BSMRecipients := BSM_APPLICATIONS;
BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, MessageID, 0, 0);
Application.Terminate;
end;
end;

initialization
MessageID := RegisterWindowMessage(UniqueAppStr);
InitInstance;
finalization
if WProc <> nil then
SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(WProc));
end.
 
谢谢各位的支持,答案已接受。
 
后退
顶部