someone at MySQL...

... would have my balls for breakfast if he/she saw this ;-)

Fulfills rfe #383.

components/zeosdbo/src/component/ZConnection.pas

@@ -180,6 +180,7 @@ type
     procedure Connect; virtual;
     procedure Disconnect; virtual;
     procedure Reconnect;
+    procedure CancelQuery; virtual;
     function Ping: Boolean; virtual;
     function GetAffectedRowsFromLastPost: Int64;
     function GetThreadId: Cardinal;
@@ -671,6 +672,15 @@ begin
 end;
 
 
+{**
+  Cancel a query running in another thread.
+}
+procedure TZConnection.CancelQuery;
+begin
+  if (FConnection <> nil) then FConnection.CancelQuery;
+end;
+
+
 {**
   Sends a ping to the server.
 }

components/zeosdbo/src/dbc/ZDbcConnection.pas

@@ -173,6 +173,7 @@ type
     procedure Open; virtual;
     procedure Close; virtual;
     function IsClosed: Boolean; virtual;
+    procedure CancelQuery; virtual;
     function Ping: Boolean; virtual;
     function GetAffectedRowsFromLastPost: Int64; virtual;
     function GetThreadId: Cardinal; virtual;
@@ -778,6 +779,14 @@ begin
   Result := FClosed;
 end;
 
+{**
+  Cancels a running query in another thread.
+}
+procedure TZAbstractConnection.CancelQuery;
+begin
+  raise Exception.Create('CancelQuery() is unsupported by this particular DB driver.');
+end;
+
 {**
   Returns true if a network ping to the database server succeeds.
   @return true if a network ping to the database server succeeds

components/zeosdbo/src/dbc/ZDbcIntfs.pas

@@ -243,6 +243,7 @@ type
     procedure Open;
     procedure Close;
     function IsClosed: Boolean;
+    procedure CancelQuery;
     function Ping: Boolean;
     function GetAffectedRowsFromLastPost: Int64;
     function GetThreadId: Cardinal;

components/zeosdbo/src/dbc/ZDbcMySql.pas

@@ -130,6 +130,8 @@ type
     function GetThreadId: Cardinal; override;
     function GetEscapeString(const Value: string): string; override;
 
+    procedure CancelQuery; override;
+
     procedure SetCatalog(const Catalog: string); override;
     function GetCatalog: string; override;
 
@@ -463,6 +465,11 @@ begin
   inherited Open;
 end;
 
+procedure TZMySQLConnection.CancelQuery;
+begin
+  if not Closed then FPlainDriver.CancelQuery(FHandle);
+end;
+
 {**
   Ping Current Connection's server, if client was disconnected,
   the connection is resumed.

components/zeosdbo/src/plain/ZPlainMySqlDriver.pas

@@ -64,7 +64,8 @@ interface
 
 uses Classes, ZClasses, ZPlainDriver, ZCompatibility, ZPlainMysqlConstants,
      {$IFDEF ENABLE_MYSQL_DEPRECATED} ZPlainMySql320, ZPlainMySql323, ZPlainMySql40,{$ENDIF}
-     ZPlainMySql41, ZPlainMySql5;
+     ZPlainMySql41, ZPlainMySql5,
+     Winsock;
 
 const
 
@@ -157,6 +158,20 @@ const
   // a new driver returns when connected to a pre-4.1 server.
   COLLATION_NONE   =  0;
 
+type
+  TZMySQLNet = record
+    { From: mysql-source/include/mysql_com.h }
+    sock: TSocket;
+    { ... more unused ABI here ... }
+  end;
+  PZMySQLNet = ^TZMySQLNet;
+  TZMySQLConnect = record
+    { From: mysql-source/include/mysql.h }
+    net: PZMySQLNet;
+    { ... more unused ABI here ... }
+  end;
+  PZMySQLConnectPeek = ^TZMySQLConnect;
+
 type
   PZMySQLConnect = Pointer;
   PZMySQLResult = Pointer;
@@ -194,6 +209,7 @@ type
     function GetAffectedRows(Handle: PZMySQLConnect): Int64;
     // char_set_name
     procedure SetCharacterSet(Handle: PZMySQLConnect; const CharSet: PChar);
+    procedure CancelQuery(Handle: PZMySQLConnect);
     procedure Close(Handle: PZMySQLConnect);
     function Connect(Handle: PZMySQLConnect; const Host, User, Password: PChar): PZMySQLConnect;
     function CreateDatabase(Handle: PZMySQLConnect; const Database: PChar): Integer;
@@ -355,6 +371,7 @@ type
     function RealConnect(Handle: PZMySQLConnect;
       const Host, User, Password, Db: PChar; Port: Cardinal;
       UnixSocket: PChar; ClientFlag: Cardinal): PZMySQLConnect;
+    procedure CancelQuery(Handle: PZMySQLConnect);
     procedure Close(Handle: PZMySQLConnect);
 
     function ExecQuery(Handle: PZMySQLConnect; const Query: PChar): Integer;
@@ -479,6 +496,7 @@ type
     function RealConnect(Handle: PZMySQLConnect;
       const Host, User, Password, Db: PChar; Port: Cardinal;
       UnixSocket: PChar; ClientFlag: Cardinal): PZMySQLConnect;
+    procedure CancelQuery(Handle: PZMySQLConnect);
     procedure Close(Handle: PZMySQLConnect);
 
     function ExecQuery(Handle: PZMySQLConnect; const Query: PChar): Integer;
@@ -602,6 +620,7 @@ type
     function RealConnect(Handle: PZMySQLConnect;
       const Host, User, Password, Db: PChar; Port: Cardinal;
       UnixSocket: PChar; ClientFlag: Cardinal): PZMySQLConnect;
+    procedure CancelQuery(Handle: PZMySQLConnect);
     procedure Close(Handle: PZMySQLConnect);
 
     function ExecQuery(Handle: PZMySQLConnect; const Query: PChar): Integer;
@@ -735,6 +754,7 @@ type
     function RealConnect(Handle: PZMySQLConnect;
       const Host, User, Password, Db: PChar; Port: Cardinal;
       UnixSocket: PChar; ClientFlag: Cardinal): PZMySQLConnect;
+    procedure CancelQuery(Handle: PZMySQLConnect);
     procedure Close(Handle: PZMySQLConnect);
 
     function ExecQuery(Handle: PZMySQLConnect; const Query: PChar): Integer;
@@ -870,6 +890,7 @@ type
     function RealConnect(Handle: PZMySQLConnect;
       const Host, User, Password, Db: PChar; Port: Cardinal;
       UnixSocket: PChar; ClientFlag: Cardinal): PZMySQLConnect;
+    procedure CancelQuery(Handle: PZMySQLConnect);
     procedure Close(Handle: PZMySQLConnect);
 
     function ExecQuery(Handle: PZMySQLConnect; const Query: PChar): Integer;
@@ -980,7 +1001,7 @@ type
   end;
 
 implementation
-uses SysUtils, ZMessages;
+uses SysUtils, ZMessages, Windows;
 
 var
   ServerArgs: array of PChar;
@@ -1038,6 +1059,11 @@ begin
   MYSQL_API := ZPlainMySql320.LibraryLoader.api_rec;
 end;
 
+procedure TZMySQL320PlainDriver.CancelQuery(Handle: PZMySQLConnect);
+begin
+  raise Exception.Create('This driver version does not support cancelling a query.');
+end;
+
 procedure TZMySQL320PlainDriver.Close(Handle: PZMySQLConnect);
 begin
   MYSQL_API.mysql_close(Handle);
@@ -1545,6 +1571,11 @@ begin
   MYSQL_API := ZPlainMySql323.LibraryLoader.api_rec;
 end;
 
+procedure TZMySQL323PlainDriver.CancelQuery(Handle: PZMySQLConnect);
+begin
+  raise Exception.Create('This driver version does not support cancelling a query.');
+end;
+
 procedure TZMySQL323PlainDriver.Close(Handle: PZMySQLConnect);
 begin
   MYSQL_API.mysql_close(Handle);
@@ -2051,6 +2082,11 @@ begin
   MYSQL_API := ZPlainMySql40.LibraryLoader.api_rec;
 end;
 
+procedure TZMySQL40PlainDriver.CancelQuery(Handle: PZMySQLConnect);
+begin
+  raise Exception.Create('This driver version does not support cancelling a query.');
+end;
+
 procedure TZMySQL40PlainDriver.Close(Handle: PZMySQLConnect);
 begin
   MYSQL_API.mysql_close(Handle);
@@ -2589,6 +2625,11 @@ begin
   MYSQL_API := ZPlainMySql41.LibraryLoader.api_rec;
 end;
 
+procedure TZMySQL41PlainDriver.CancelQuery(Handle: PZMySQLConnect);
+begin
+  raise Exception.Create('This driver version does not support cancelling a query.');
+end;
+
 procedure TZMySQL41PlainDriver.Close(Handle: PZMySQLConnect);
 begin
   MYSQL_API.mysql_close(Handle);
@@ -3133,6 +3174,19 @@ begin
   MYSQL_API := ZPlainMySql5.LibraryLoader.api_rec;
 end;
 
+procedure TZMySQL5PlainDriver.CancelQuery(Handle: PZMySQLConnect);
+var
+  peek: PZMySQLConnectPeek;
+  res: Integer;
+begin
+  peek := Handle;
+  OutputDebugString(PChar('Tearing connection.'));
+  res := Winsock.shutdown(peek.net.sock, SD_BOTH);
+  if (res <> 0) then OutputDebugString(PChar(Format('Shutdown failed: %d', [WSAGetLastError()])));
+  res := Winsock.closesocket(peek.net.sock);
+  if (res <> 0) then OutputDebugString(PChar(Format('Close failed: %d', [WSAGetLastError()])));
+end;
+
 procedure TZMySQL5PlainDriver.Close(Handle: PZMySQLConnect);
 begin
   MYSQL_API.mysql_close(Handle);

source/main.pas

@@ -628,6 +628,7 @@ type
       HandleErrors: Boolean = false; DisplayErrors: Boolean = false ) : WideStrings.TWideStringList;
     procedure ZSQLMonitor1LogTrace(Sender: TObject; Event: TZLoggingEvent);
     procedure MenuTablelistColumnsClick(Sender: TObject);
+    procedure CancelQuery;
     procedure CheckConnection();
     procedure QueryLoad( filename: String; ReplaceContent: Boolean = true );
     procedure ExecuteNonQuery(SQLQuery: String);
@@ -795,6 +796,7 @@ type
     procedure AutoCalcColWidths(Tree: TVirtualStringTree; PrevLayout: Widestrings.TWideStringlist = nil);
     procedure FocusGridCol(Grid: TBaseVirtualTree; Column: TColumnIndex);
   public
+    cancelling: Boolean;
     virtualDesktopName: string;
     MaintenanceForm: TOptimize;
     ViewForm: TfrmView;
@@ -3864,6 +3866,7 @@ var
   signal: Cardinal;
 begin
   debug( 'Waiting for query to complete.' );
+  cancelling := false;
   if ForceDialog then begin
     debug( 'Showing progress form.' );
     WaitForm.ShowModal();
@@ -5801,6 +5804,13 @@ begin
 end;
 
 
+procedure TMainForm.CancelQuery;
+begin
+  cancelling := true;
+  MysqlConn.Connection.CancelQuery;
+end;
+
+
 // Searchbox unfocused
 procedure TMainForm.CheckConnection;
 begin

source/mysqlquerythread.pas

@@ -252,7 +252,16 @@ begin
       if E.Message = SCanNotOpenResultSet then begin
         Result := true;
         FreeAndNil(ADataset);
-      end else AExceptionData := GetExceptionData(E);
+      end else if MainForm.cancelling then begin
+        AExceptionData := GetExceptionData(Exception.Create('Cancelled by user.'));
+        try
+          FMysqlConn.Reconnect;
+        finally
+          MainForm.cancelling := false;
+        end;
+      end else begin
+        AExceptionData := GetExceptionData(E);
+      end;
     end;
   end;
 end;
@@ -273,8 +282,18 @@ begin
     q.DoAsyncExecSql();
     Result := True;
   except
-    On E: Exception do
-      AExceptionData := GetExceptionData(E);
+    On E: Exception do begin
+      if MainForm.cancelling then begin
+        AExceptionData := GetExceptionData(Exception.Create('Cancelled by user.'));
+        try
+          FMysqlConn.Reconnect;
+        finally
+          MainForm.cancelling := false;
+        end;
+      end else begin
+        AExceptionData := GetExceptionData(E);
+      end;
+    end;
   end;
 
   FreeAndNil (q);

source/queryprogress.dfm

@@ -31,9 +31,8 @@ object frmQueryProgress: TfrmQueryProgress
     Width = 73
     Height = 25
     Cancel = True
-    Caption = 'Please wait'
+    Caption = 'Cancel'
     Default = True
-    Enabled = False
     TabOrder = 0
     OnClick = btnAbortClick
   end

source/queryprogress.pas

@@ -32,8 +32,7 @@ uses
 
 procedure TfrmQueryProgress.btnAbortClick(Sender: TObject);
 begin
-  Close();
-  // todo: implement connection killing !!
+  MainForm.CancelQuery;
 end;