Add preference option to restrict number of application instances to 1. If the executable is open and called a second time, it's brought to foreground. Plus, if a filename was passed, a new tab is opened. Should fix a part of what is described in issue #1332.

packages/delphi2010/heidisql.dpr

@@ -5,6 +5,7 @@ uses
   Forms,
   SysUtils,
   Dialogs,
+  Windows,
   main in '..\..\source\main.pas' {MainForm},
   about in '..\..\source\about.pas' {AboutBox},
   connections in '..\..\source\connections.pas' {connform},
@@ -40,14 +41,26 @@ uses
 {$R ..\..\res\version.RES}
 {$R ..\..\res\manifest.RES}
 
+var
+  DoStop, prefAllowMultipleInstances: Boolean;
 begin
   debug('perf: All modules loaded.');
-  Application.Initialize;
-  Application.Title := APPNAME;
-  Application.UpdateFormatSettings := False;
-  Application.CreateForm(TMainForm, MainForm);
-  Application.OnMessage := Mainform.OnMessageHandler;
-  debug('perf: Main created.');
-  MainForm.Startup;
-  Application.Run;
+
+  prefAllowMultipleInstances := GetRegValue(REGNAME_MULTI_INSTANCES, DEFAULT_MULTI_INSTANCES);
+  SecondInstMsgId := RegisterWindowMessage(APPNAME);
+  DoStop := False;
+  if not prefAllowMultipleInstances then
+    DoStop := CheckForSecondInstance;
+  if DoStop then
+    Application.Terminate
+  else begin
+    Application.Initialize;
+    Application.Title := APPNAME;
+    Application.UpdateFormatSettings := False;
+    Application.CreateForm(TMainForm, MainForm);
+    Application.OnMessage := Mainform.OnMessageHandler;
+    debug('perf: Main created.');
+    MainForm.Startup;
+    Application.Run;
+  end;
  end.

source/const.inc

@@ -186,6 +186,8 @@ const
   REGNAME_LAST_STATSCALL = 'LastUsageStatisticCall';
   REGNAME_FILTERACTIVE = 'FilterPanel';
   DEFAULT_FILTERACTIVE = False;
+  REGNAME_MULTI_INSTANCES = 'AllowMultipleInstances';
+  DEFAULT_MULTI_INSTANCES = True;
 
   REGNAME_FIELDCOLOR_NUMERIC = 'FieldColor_Numeric';
   REGNAME_FIELDCOLOR_TEXT = 'FieldColor_Text';

source/helpers.pas

@@ -241,9 +241,13 @@ type
   procedure ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList);
   procedure ParseViewStructure(ViewName: String; Columns: TTableColumnList);
   function ReformatSQL(SQL: String): String;
+  function ParamBlobToStr(lpData: Pointer): TStringlist;
+  function ParamStrToBlob(out cbData: DWORD): Pointer;
+  function CheckForSecondInstance: Boolean;
 
 var
   MainReg: TRegistry;
+  MutexHandle: THandle = 0;
   dbgCounter: Integer = 0;
   DecimalSeparatorSystemdefault: Char;
 
@@ -3237,6 +3241,143 @@ begin
 end;
 
 
+
+// Following code taken from OneInst.pas, http://assarbad.net/de/stuff/!import/nico.old/
+// Slightly modified to better integrate that into our code, comments translated from german.
+
+// Fetch and separate command line parameters into strings
+function ParamBlobToStr(lpData: Pointer): TStringlist;
+var
+  pStr: PChar;
+begin
+  Result := TStringlist.Create;
+  pStr := lpData;
+  while pStr[0] <> #0 do
+  begin
+    Result.Add(string(pStr));
+    pStr := @pStr[lstrlen(pStr) + 1];
+  end;
+end;
+
+// Pack current command line parameters
+function ParamStrToBlob(out cbData: DWORD): Pointer;
+var
+  Loop: Integer;
+  pStr: PChar;
+begin
+  for Loop := 1 to ParamCount do
+    cbData := cbData + DWORD(Length(ParamStr(Loop))*2 + 1);
+  cbData := cbData + 2; // include appending #0#0
+  Result := GetMemory(cbData);
+  ZeroMemory(Result, cbData);
+  pStr := Result;
+  for Loop := 1 to ParamCount do
+  begin
+    debug(ParamStr(Loop));
+    lstrcpy(pStr, PChar(ParamStr(Loop)));
+    pStr := @pStr[lstrlen(pStr) + 1];
+  end;
+end;
+
+procedure HandleSecondInstance;
+var
+  Run: DWORD;
+  Now: DWORD;
+  Msg: TMsg;
+  Wnd: HWND;
+  Dat: TCopyDataStruct;
+begin
+  // MessageBox(0, 'already running', nil, MB_ICONINFORMATION);
+  // Send a message to all main windows (HWND_BROADCAST) with the identical,
+  // previously registered message id. We should only get reply from 0 or 1
+  // instances.
+  // (Broadcast should only be called with registered message ids!)
+
+  SendMessage(HWND_BROADCAST, SecondInstMsgId, GetCurrentThreadId, 0);
+
+  // Waiting for reply by first instance. For those of you which didn't knew:
+  // Threads have message queues too ;o)
+  Wnd := 0;
+  Run := GetTickCount;
+  while True do
+  begin
+    if PeekMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId, PM_NOREMOVE) then
+    begin
+      GetMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId);
+      if Msg.message = SecondInstMsgId then
+      begin
+        Wnd := Msg.wParam;
+        Break;
+      end;
+    end;
+    Now := GetTickCount;
+    if Now < Run then
+      Run := Now;  // Avoid overflow, each 48 days.
+    if Now - Run > 5000 then
+      Break;
+  end;
+
+  if (Wnd <> 0) and IsWindow(Wnd) then
+  begin
+    // As a reply we got a handle to which we now send current parameters
+    Dat.dwData := SecondInstMsgId;
+    Dat.lpData := ParamStrToBlob(Dat.cbData);
+    SendMessage(Wnd, WM_COPYDATA, 0, LPARAM(@Dat));
+    FreeMemory(Dat.lpData);
+
+    // Bring first instance to front
+    if not IsWindowVisible(Wnd) then
+      ShowWindow(Wnd, SW_RESTORE);
+    BringWindowToTop(Wnd);
+    SetForegroundWindow(Wnd);
+  end;
+end;
+
+function CheckForSecondInstance: Boolean;
+var
+  Loop: Integer;
+  MutexName: PChar;
+begin
+  // Try to create a system wide named kernel object (mutex). And check if that
+  // already exists.
+  // The name of such a mutex must not be longer than MAX_PATH (260) chars and
+  // can contain all chars but not '\'
+
+  Result := False;
+  MutexName := PChar(APPNAME);
+  for Loop := lstrlen(MutexName) to MAX_PATH - 1 do
+  begin
+    MutexHandle := CreateMutex(nil, False, MutexName);
+    if (MutexHandle = 0) and (GetLastError = INVALID_HANDLE_VALUE) then
+      // Looks like there is already a mutex using this name
+      // Try to solve that by appending an underscore
+      lstrcat(MutexName, '_')
+    else
+      // At least no naming conflict
+      Break;
+  end;
+
+  case GetLastError of
+    0: begin
+        // We created the mutex, so this is the first instance
+      end;
+    ERROR_ALREADY_EXISTS:
+      begin
+        // There is already one instance
+        try
+          HandleSecondInstance;
+        finally
+          // Terminating is done in .dpr file, before Application.Initialize
+          Result := True;
+        end;
+      end;
+  else
+    // No clue why we should get here. Oh, maybe Microsoft has changed rules, again.
+    // However, we return false and let the application start
+  end;
+end;
+
+
 end.
 
 

source/main.pas

@@ -460,6 +460,7 @@ type
     procedure menuConnectionsPopup(Sender: TObject);
     procedure actExitApplicationExecute(Sender: TObject);
     procedure DisplayChange(var msg: TMessage); message WM_DISPLAYCHANGE;
+    procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure Startup;
@@ -575,7 +576,7 @@ type
     procedure InsertDate(Sender: TObject);
     procedure setNULL1Click(Sender: TObject);
     procedure MenuTablelistColumnsClick(Sender: TObject);
-    procedure QueryLoad( filename: String; ReplaceContent: Boolean = true );
+    function QueryLoad( filename: String; ReplaceContent: Boolean = true ): Boolean;
     procedure DataGridChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
     procedure DataGridCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
         Column: TColumnIndex; out EditLink: IVTEditLink);
@@ -878,6 +879,7 @@ type
     procedure SetEditorTabCaption(Editor: TDBObjectEditor; ObjName: String);
     procedure SetWindowCaption;
     procedure OnMessageHandler(var Msg: TMsg; var Handled: Boolean);
+    procedure DefaultHandler(var Message); override;
     function MaskMulti(str: String): String;
     procedure SelectDBObject(Text: String; NodeType: TListNodeType);
     procedure SetupSynEditors;
@@ -887,6 +889,7 @@ end;
 
 var
   MainForm: TMainForm;
+  SecondInstMsgId: UINT = 0;
 
 const
   // Customized messages
@@ -4569,13 +4572,14 @@ end;
 
 
 
-procedure TMainForm.QueryLoad( filename: String; ReplaceContent: Boolean = true );
+function TMainForm.QueryLoad( filename: String; ReplaceContent: Boolean = true ): Boolean;
 
 var
   filecontent      : String;
   msgtext          : String;
   LineBreaks       : TLineBreaks;
 begin
+  Result := False;
   // Ask for action when loading a big file
   if FileExists(filename) and (_GetFileSize( filename ) > 5*SIZE_MB) then
   begin
@@ -4642,6 +4646,7 @@ begin
     SetTabCaption(PageControlMain.ActivePageIndex, sstr(ExtractFilename(filename), 70));
     ActiveQueryMemo.Modified := False;
     ActiveQueryTab.MemoFilename := filename;
+    Result := True;
   except on E:Exception do
     // File does not exist, is locked or broken
     MessageDlg(E.message, mtError, [mbOK], 0);
@@ -9062,5 +9067,34 @@ begin
 end;
 
 
+procedure TMainForm.WMCopyData(var Msg: TWMCopyData);
+var
+  Params: TStringlist;
+begin
+  // Probably a second instance is posting its command line parameters here
+  if (Msg.CopyDataStruct.dwData = SecondInstMsgId) and (SecondInstMsgId <> 0) then begin
+    Params := ParamBlobToStr(Msg.CopyDataStruct.lpData);
+    if Params.Count = 1 then begin
+      actNewQueryTabExecute(self);
+      if not QueryLoad(Params[0]) then
+        actCloseQueryTabExecute(Self);
+    end;
+  end else
+    // Not the right message id
+    inherited;
+end;
+
+
+procedure TMainForm.DefaultHandler(var Message);
+begin
+  if TMessage(Message).Msg = SecondInstMsgId then begin
+    // A second instance asked for our handle. Post that into its message queue.
+    PostThreadMessage(TMessage(Message).WParam, SecondInstMsgId, Handle, 0);
+  end else
+    // Otherwise do what would happen without this overridden procedure
+    inherited;
+end;
+
+
 end.
 

source/options.dfm

@@ -62,7 +62,7 @@ object optionsform: Toptionsform
       end
       object chkAutoReconnect: TCheckBox
         Left = 16
-        Top = 16
+        Top = 32
         Width = 334
         Height = 17
         Caption = 'Automatically reconnect to last session-account on startup'
@@ -93,7 +93,7 @@ object optionsform: Toptionsform
       end
       object chkRestoreLastDB: TCheckBox
         Left = 16
-        Top = 40
+        Top = 56
         Width = 297
         Height = 17
         Caption = 'Restore last used database on startup'
@@ -198,6 +198,16 @@ object optionsform: Toptionsform
         WordWrap = True
         OnClick = Modified
       end
+      object chkAllowMultiInstances: TCheckBox
+        Left = 16
+        Top = 9
+        Width = 379
+        Height = 17
+        Caption = 'Allow multiple application instances'
+        Checked = True
+        State = cbChecked
+        TabOrder = 13
+      end
     end
     object tabSQL: TTabSheet
       BorderWidth = 5

source/options.pas

@@ -119,6 +119,7 @@ type
     editSQLTabWidth: TEdit;
     updownSQLTabWidth: TUpDown;
     chkExportLocaleNumbers: TCheckBox;
+    chkAllowMultiInstances: TCheckBox;
     procedure FormShow(Sender: TObject);
     procedure Modified(Sender: TObject);
     procedure Apply(Sender: TObject);
@@ -205,6 +206,7 @@ begin
 
   // Save values
   MainReg.WriteBool(REGNAME_AUTORECONNECT, chkAutoReconnect.Checked);
+  MainReg.WriteBool(REGNAME_MULTI_INSTANCES, chkAllowMultiInstances.Checked);
   MainReg.WriteBool(REGNAME_RESTORELASTUSEDDB, chkRestoreLastDB.Checked);
   MainReg.WriteString(REGNAME_FONTNAME, comboSQLFontName.Text);
   MainReg.WriteInteger(REGNAME_FONTSIZE, updownSQLFontSize.Position);
@@ -370,6 +372,7 @@ begin
   datafontname := GetRegValue(REGNAME_DATAFONTNAME, DEFAULT_DATAFONTNAME);
   datafontsize := GetRegValue(REGNAME_DATAFONTSIZE, DEFAULT_DATAFONTSIZE);
   chkAutoReconnect.Checked := GetRegValue(REGNAME_AUTORECONNECT, DEFAULT_AUTORECONNECT);
+  chkAllowMultiInstances.Checked := GetRegValue(REGNAME_MULTI_INSTANCES, DEFAULT_MULTI_INSTANCES);
   chkRestoreLastDB.Checked := GetRegValue(REGNAME_RESTORELASTUSEDDB, DEFAULT_RESTORELASTUSEDDB);
   updownLogLines.Position := GetRegValue(REGNAME_LOGSQLNUM, DEFAULT_LOGSQLNUM);
   updownLogSnip.Position := GetRegValue(REGNAME_LOGSQLWIDTH, DEFAULT_LOGSQLWIDTH);