防止程序被多次运行(100分)

防止程序被多次运行
我的程序初始化时间比较长 经常以为没有运行而多次点击
造成程序的多次运行 怎么防止？（具体可行实例）另外，
谁知到在运行期间设计报表格式及内容的控件要求有源码
另有些台湾码汉字我用东方快车等内码转换工具转换后还是
乱码 有谁能提供好的？

1.程序启动时间长,建议你加入一splashwindow ,就像delphi与photoshop一样.
2.防止程序被多次运行有很多办法,本论坛已讨论多次,最简单是在project的
application.run前加入判断if findwindow(.... then application.run;
3.你是指由用户参与报表设计?如果是这样的话,可能得自己做了.
4.不知道!

Dream Designer v2.56B2
DreamCompany公司的打印控件,不但可以方便设计报表格式,还允许最终用户设置报表格式,不需要重新编译程序.
主页地址：http://www.dreamcompany.com/
http://www.csdn.net/程序员大本营中也有。

利用全局原子作为程序运行标志，
请参阅 GlobalAddAtom，GlobalDeleteAtom，GlobalFindAtom

在16位的应用程序中，判断程序是否已经运行的方法是根据Winmain函数的
hPrevInstance的值来决定的，可是在32位的应用中，hPrevInstance的值
总为0；
推荐的做法是创建一个拥有唯一名称的Mutex,在程序启动时调用
CreateMutex函数，CreateMutex总能创建成功，但是若Mutex已经存在（当然
是你的程序第二次运行啦），调用GetLastError函数会返回ERROR_ALREADY_EXIST,
这表明你的程序已经在运行了。

只运行一个拷贝需要修改 Dpr 文件，当然也只是需要增加三行（例）：
program MyProg;

uses
Forms, Windows,
UnitStart in 'UnitStart.pas' {frmStart},

{$R *.RES}
var handle:integer; //检测变量
begin
handle:=findwindow('TfrmStart',nil);// Form 的名字是 frmStart,类推
if handle<>0 then halt; //当然是善后工作了，搞定
//注意 在IDE环境里你调试不了，可以暂时屏蔽这几行或 Close frmStart
Application.Initialize;
Application.CreateForm(TfrmStart, frmStart);
Application.Run;
end.

最省力的方法是用控件。有人想要吗？

//用这个更好
begin
if findwindow('TApplication','Test')<>0 then Halt;
//'Test' is Application.Title
Application.Initialize;
Application.Title := 'Test';

...;

Application.Run;
end.

var
Hwnd:Thandle;
begin
Hwnd:=findWindow('Tform1','One Copy');
if Hwnd=0 then
begin
application.Initialize;
application.CreatForm(Tform1,Form1);
application.Run;
end
else
begin
if not IsWindowVisible(Hwnd) then
postMessage(Hwnd,Wm_User,0,0);
SetForegroundWindow(Hwnd);
end;
end;

PostMessage API函数向目标应用程序窗口的消息队列发送了一个消息
由第一个参数表示。在窗体的代码中，可以添加特殊函数来处理该消息：
public
procedure WMUser(var msg:TMessage);
在代码的实现部分:
procedure Tform1.WMUser(var msg:tMessage);
begin
application.Restore;
end;

注意:
该方法将会在应用程序初始化前检查是否该应用程序已经在运行，若是
则不会再次运行，并激活已运行的程序。
但是，如果我们在DELPHI IDE中运行该程序，它可能不会正常工作，因
为FindWindow调用可能会返回一个已经存在的窗口：设计时的窗口。这样
程序将一次也不会运行，除非我们关闭设计窗口及其源代码，或关闭该项目
而在WINDOWS EXPLORER中运行程序。
相应的解决办法有一点复杂，再联络。

我建议还是使用Mutex比较好，我一般在程序中根据程序启动的目录和程序的名称创建Mutex,这样还可以实现不让程序在同一个目录下面重复运行的功能。

1.使用splash启动画面
2.避免二次运行,下面是你要的答案,使用互斥,这样即安全,有可靠,我已用过了.
program Project1;

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

var hw:hwnd;

{$R *.RES}
begin
Application.Initialize;
application.title:='test';//名字自己定义
hw:=createmutex(nil,false,'test');
if getlasterror<>error_already_exists then
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.

下面是我改了一个老外的Component，可以在程序运行过程中
设置Enabled以决定是否可以新运行另一份。考虑到已经运行
了的程序可能需要有保存数据等要求，不在考虑之列。原来
的控件是在运行时如果设置Enabled为true，同时已经有其他
备份在运行，自己就自杀了，但这样就没法保存数据了。

unit RasOneInstComp;
// version 2.0
//
// Alexander Rodigin
//
// RUSSIA 1999
//
// ras@ras.udm.ru
//
interface
uses
Windows, Messages, Classes, Forms, SysUtils;
//--------------------------------------------------
// The following declaration is necessary because of an error in
// the declaration of BroadcastSystemMessage() in the Windows unit
function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;
uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
external 'user32.dll';

type
TrasOneInstComp = class(TComponent)
private
{ Private declarations }
FEnabled: Boolean;
FsMutex : string;
FhMutex : THandle;
FMessage: string;
FMesID : Cardinal;
FHooked : Boolean;
FText : string;
FTitle : string;
FOnAnInst : TNotifyEvent;
function AppWindowHook(var M: TMessage): Boolean;
procedure BroadcastFocusMessage;
protected
{ Protected declarations }
procedure CheckAnotherInstance;
procedure LoadHook;
procedure FreeHook;
procedure Loaded;override;
function MutexExists:Boolean;
procedure SetEnabled(Value:Boolean);
procedure SetMessage(Value:string);
procedure SetMutex(Value:string);
public
{ Public declarations }
constructor Create( AOwner: TComponent ); override;
destructor Destroy;override;
published
{ Published declarations }
property Enabled:Boolean read FEnabled write SetEnabled default True;
property Message:string read FMessage write SetMessage;
property Mutex:string read FsMutex write SetMutex;
property Text:string read FText write FText;
property Title:string read FTitle write FTitle;
property OnAnotherInstance: TNotifyEvent read FOnAnInst write FOnAnInst;
end;

procedure Register;
//--------------------------------------------------
implementation

type
OneInstCompError=class(Exception);
//--------------------------------------------------
constructor TrasOneInstComp.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FsMutex :=DateToStr(Date)+'-mutex';
FMessage:=DateToStr(Date)+'-message';
FEnabled := True;
end; { constructor Create }
//--------------------------------------------------
procedure TrasOneInstComp.Loaded;
begin
inherited;
FMesID:=RegisterWindowMessage(PChar(FMessage));
if(FEnabled) then CheckAnotherInstance;
end; { procedure Loaded }
//--------------------------------------------------
procedure TrasOneInstComp.CheckAnotherInstance;
begin
if FEnabled and not (csDesigning in ComponentState) then
begin
if MutexExists then //Quit application
begin
if Assigned(FOnAnInst)then
FOnAnInst(Self);
BroadcastFocusMessage;
PostQuitMessage(0);
end
else
LoadHook;
end;
end; { procedure CheckAnotherInstance }
//-------------------------------------------------
function TrasOneInstComp.MutexExists:Boolean;
begin
FhMutex:=OpenMutex(MUTEX_ALL_ACCESS,False,PChar(FsMutex));
if FhMutex=0 then //it's a first instance
Result:=False
else //it's a second instance
Result:=True;
end; { function MutexExists }
//--------------------------------------------------
procedure TrasOneInstComp.SetMutex(Value:string);
begin
if (csDesigning in ComponentState)or(csLoading in ComponentState) then
begin
if FsMutex<>Value then
begin
if(Value = '') then
FsMutex :=DateToStr(Date)+'-mutex'
else
FsMutex := Value;
end
end
else
raise OneInstCompError.Create('you can''t change Mutex property at runtime!');
end; { procedure TrasOneInstComp.SetMutex }
//--------------------------------------------------
procedure TrasOneInstComp.SetEnabled(Value:Boolean);
begin
if FEnabled<>Value then
begin
FEnabled := Value;
if not (csDesigning in ComponentState) then
begin
if Value then
LoadHook
else
FreeHook;
end;
end;
end; { procedure SetEnabled }
//-------------------------------------------------
procedure TrasOneInstComp.SetMessage(Value:string);
begin
if (csDesigning in ComponentState)or(csLoading in ComponentState) then
begin
if FMessage<>Value then
begin
if Value='' then
FMessage:=DateToStr(Date)+'-message'
else
FMessage:=Value;
end
end
else
raise OneInstCompError.Create('you can''t change Message property at runtime!');
end; { procedure SetMessage }
//-------------------------------------------------
procedure TrasOneInstComp.BroadcastFocusMessage;
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, FMesID, 0, 0);
end; { procedure BroadcastFocusMessage }
//--------------------------------------------------
function TrasOneInstComp.AppWindowHook(var M: TMessage): Boolean;
begin
if (M.Msg=FMesID) then //our message has arrived
begin
{ if main form is minimized, normalize it }
{ set focus to application }
if IsIconic(Application.Handle) then
begin
Application.MainForm.WindowState := wsNormal;
Application.Restore;
end;
SetForegroundWindow(Application.MainForm.Handle);
if Text <> '' then
begin
if Title='' then FTitle:=Application.Title;
Application.MessageBox(PChar(FText),PChar(FTitle),MB_OK);
end;
Result := True;
end
else //it's not our message-let app to process it
Result := False;
end; { function AppWindowHook }
//--------------------------------------------------
procedure TrasOneInstComp.LoadHook;
begin
if not FHooked then
begin
Application.HookMainWindow(AppWindowHook);
FHooked:=True;
end;

if (FhMutex = 0) or (CloseHandle(FhMutex)) then
begin
FhMutex:=OpenMutex(MUTEX_ALL_ACCESS,False,PChar(FsMutex));
if FhMutex=0 then //it's a first instance
begin
FhMutex:=CreateMutex(nil,False,PChar(FsMutex));
end;
end;
end; { procedure LoadHook }
//--------------------------------------------------
procedure TrasOneInstComp.FreeHook;
begin
if FHooked then
begin
Application.UnhookMainWindow(AppWindowHook);
FHooked:=False;
end;
if(FhMutex <> 0) and CloseHandle(FhMutex) then
FhMutex:=0;
end; { procedure FreeHook }
//-------------------------------------------------
destructor TrasOneInstComp.Destroy;
begin
FreeHook;
inherited Destroy;
end; { destructor Destroy }
//--------------------------------------------------
procedure Register;
begin
RegisterComponents('RAS', [TrasOneInstComp]);
end;

end.

>>
有些台湾码汉字我用东方快车等内码转换工具转换后还是乱码 有谁能提供好的？

Try 两岸通(lat.exe),顾名思义"沟通两岸,舍我其谁?"
许多下载站点和 D版光盘中都有.我经常用,效果挺好,而且小巧玲珑.

内码转换工具我喜欢用: MagicWin98,挺好的.

防止程序用前面提到的:
被多次运行有很多办法,本论坛已讨论多次,
最简单是在project的application.run前加入判断
if findwindow(.... then application.run;

在运行时设计报表要用到动态技术.
可以动态设计报表,当然要用到第三方控件

多人接受答案了。