My favorites | Sign in
Project Home Source
Checkout   Browse   Changes  
Changes to /trunk/source/dbconnection.pas
r4131 vs. r4132 Compare: vs.  Format:
Revision r4132
Go to: 
/trunk/source/dbconnection.pas   r4131 /trunk/source/dbconnection.pas   r4132
1 unit dbconnection; 1 unit dbconnection;
2 2
3 interface 3 interface
4 4
5 uses 5 uses
6 Classes, SysUtils, windows, mysql_structures, SynRegExpr, Contnrs, Generics.Collections, Generics.Defaults, 6 Classes, SysUtils, windows, mysql_structures, SynRegExpr, Contnrs, Generics.Collections, Generics.Defaults,
7 DateUtils, Types, ShellApi, Math, Dialogs, ADODB, DB, DBCommon, ComObj, Graphics; 7 DateUtils, Types, ShellApi, Math, Dialogs, ADODB, DB, DBCommon, ComObj, Graphics;
8 8
9 9
10 type 10 type
11 { TDBObjectList and friends } 11 { TDBObjectList and friends }
12 12
13 TListNodeType = (lntNone, lntDb, lntTable, lntView, lntFunction, lntProcedure, lntTrigger, lntEvent, lntColumn); 13 TListNodeType = (lntNone, lntDb, lntTable, lntView, lntFunction, lntProcedure, lntTrigger, lntEvent, lntColumn);
14 TListNodeTypes = Set of TListNodeType; 14 TListNodeTypes = Set of TListNodeType;
15 TDBConnection = class; 15 TDBConnection = class;
16 TDBQuery = class; 16 TDBQuery = class;
17 TDBQueryList = TObjectList<TDBQuery>; 17 TDBQueryList = TObjectList<TDBQuery>;
18 TDBObject = class(TPersistent) 18 TDBObject = class(TPersistent)
19 private 19 private
20 FCreateCode: String; 20 FCreateCode: String;
21 FCreateCodeFetched: Boolean; 21 FCreateCodeFetched: Boolean;
22 FConnection: TDBConnection; 22 FConnection: TDBConnection;
23 function GetObjType: String; 23 function GetObjType: String;
24 function GetImageIndex: Integer; 24 function GetImageIndex: Integer;
25 function GetCreateCode: String; 25 function GetCreateCode: String;
26 procedure SetCreateCode(Value: String); 26 procedure SetCreateCode(Value: String);
27 public 27 public
28 Name, Database, Column, Engine, Comment, RowFormat, CreateOptions, Collation: String; 28 Name, Database, Column, Engine, Comment, RowFormat, CreateOptions, Collation: String;
29 Created, Updated, LastChecked: TDateTime; 29 Created, Updated, LastChecked: TDateTime;
30 Rows, Size, Version, AvgRowLen, MaxDataLen, IndexLen, DataLen, DataFree, AutoInc, CheckSum: Int64; 30 Rows, Size, Version, AvgRowLen, MaxDataLen, IndexLen, DataLen, DataFree, AutoInc, CheckSum: Int64;
31 NodeType: TListNodeType; 31 NodeType: TListNodeType;
32 constructor Create(OwnerConnection: TDBConnection); 32 constructor Create(OwnerConnection: TDBConnection);
33 procedure Assign(Source: TPersistent); override; 33 procedure Assign(Source: TPersistent); override;
34 function IsSameAs(CompareTo: TDBObject): Boolean; 34 function IsSameAs(CompareTo: TDBObject): Boolean;
35 function QuotedDatabase(AlwaysQuote: Boolean=True): String; 35 function QuotedDatabase(AlwaysQuote: Boolean=True): String;
36 function QuotedName(AlwaysQuote: Boolean=True): String; 36 function QuotedName(AlwaysQuote: Boolean=True): String;
37 function QuotedColumn(AlwaysQuote: Boolean=True): String; 37 function QuotedColumn(AlwaysQuote: Boolean=True): String;
38 property ObjType: String read GetObjType; 38 property ObjType: String read GetObjType;
39 property ImageIndex: Integer read GetImageIndex; 39 property ImageIndex: Integer read GetImageIndex;
40 property CreateCode: String read GetCreateCode write SetCreateCode; 40 property CreateCode: String read GetCreateCode write SetCreateCode;
41 property Connection: TDBConnection read FConnection; 41 property Connection: TDBConnection read FConnection;
42 end; 42 end;
43 PDBObject = ^TDBObject; 43 PDBObject = ^TDBObject;
44 TDBObjectList = class(TObjectList<TDBObject>) 44 TDBObjectList = class(TObjectList<TDBObject>)
45 private 45 private
46 FDatabase: String; 46 FDatabase: String;
47 FDataSize: Int64; 47 FDataSize: Int64;
48 FLargestObjectSize: Int64; 48 FLargestObjectSize: Int64;
49 FLastUpdate: TDateTime; 49 FLastUpdate: TDateTime;
50 FCollation: String; 50 FCollation: String;
51 public 51 public
52 property Database: String read FDatabase; 52 property Database: String read FDatabase;
53 property DataSize: Int64 read FDataSize; 53 property DataSize: Int64 read FDataSize;
54 property LargestObjectSize: Int64 read FLargestObjectSize; 54 property LargestObjectSize: Int64 read FLargestObjectSize;
55 property LastUpdate: TDateTime read FLastUpdate; 55 property LastUpdate: TDateTime read FLastUpdate;
56 property Collation: String read FCollation; 56 property Collation: String read FCollation;
57 end; 57 end;
58 TDatabaseList = TObjectList<TDBObjectList>; // A list of db object lists, used for caching 58 TDatabaseList = TObjectList<TDBObjectList>; // A list of db object lists, used for caching
59 TDBObjectComparer = class(TComparer<TDBObject>) 59 TDBObjectComparer = class(TComparer<TDBObject>)
60 function Compare(const Left, Right: TDBObject): Integer; override; 60 function Compare(const Left, Right: TDBObject): Integer; override;
61 end; 61 end;
62 TDBObjectDropComparer = class(TComparer<TDBObject>) 62 TDBObjectDropComparer = class(TComparer<TDBObject>)
63 function Compare(const Left, Right: TDBObject): Integer; override; 63 function Compare(const Left, Right: TDBObject): Integer; override;
64 end; 64 end;
65 65
66 // General purpose editing status flag 66 // General purpose editing status flag
67 TEditingStatus = (esUntouched, esModified, esDeleted, esAddedUntouched, esAddedModified, esAddedDeleted); 67 TEditingStatus = (esUntouched, esModified, esDeleted, esAddedUntouched, esAddedModified, esAddedDeleted);
68 68
69 TColumnDefaultType = (cdtNothing, cdtText, cdtTextUpdateTS, cdtNull, cdtNullUpdateTS, cdtCurTS, cdtCurTSUpdateTS, cdtAutoInc); 69 TColumnDefaultType = (cdtNothing, cdtText, cdtTextUpdateTS, cdtNull, cdtNullUpdateTS, cdtCurTS, cdtCurTSUpdateTS, cdtAutoInc);
70 70
71 // Column object, many of them in a TObjectList 71 // Column object, many of them in a TObjectList
72 TTableColumn = class(TObject) 72 TTableColumn = class(TObject)
73 private 73 private
74 FConnection: TDBConnection; 74 FConnection: TDBConnection;
75 procedure SetStatus(Value: TEditingStatus); 75 procedure SetStatus(Value: TEditingStatus);
76 public 76 public
77 Name, OldName: String; 77 Name, OldName: String;
78 DataType, OldDataType: TDBDatatype; 78 DataType, OldDataType: TDBDatatype;
79 LengthSet: String; 79 LengthSet: String;
80 Unsigned, AllowNull, ZeroFill, LengthCustomized: Boolean; 80 Unsigned, AllowNull, ZeroFill, LengthCustomized: Boolean;
81 DefaultType: TColumnDefaultType; 81 DefaultType: TColumnDefaultType;
82 DefaultText: String; 82 DefaultText: String;
83 Comment, Charset, Collation, Expression, Virtuality: String; 83 Comment, Charset, Collation, Expression, Virtuality: String;
84 FStatus: TEditingStatus; 84 FStatus: TEditingStatus;
85 constructor Create(AOwner: TDBConnection); 85 constructor Create(AOwner: TDBConnection);
86 destructor Destroy; override; 86 destructor Destroy; override;
87 function SQLCode: String; 87 function SQLCode: String;
88 property Status: TEditingStatus read FStatus write SetStatus; 88 property Status: TEditingStatus read FStatus write SetStatus;
89 end; 89 end;
90 PTableColumn = ^TTableColumn; 90 PTableColumn = ^TTableColumn;
91 TTableColumnList = TObjectList<TTableColumn>; 91 TTableColumnList = TObjectList<TTableColumn>;
92 92
93 TTableKey = class(TObject) 93 TTableKey = class(TObject)
94 private 94 private
95 FConnection: TDBConnection; 95 FConnection: TDBConnection;
96 public 96 public
97 Name, OldName: String; 97 Name, OldName: String;
98 IndexType, OldIndexType, Algorithm: String; 98 IndexType, OldIndexType, Algorithm: String;
99 Columns, SubParts: TStringList; 99 Columns, SubParts: TStringList;
100 Modified, Added: Boolean; 100 Modified, Added: Boolean;
101 constructor Create(AOwner: TDBConnection); 101 constructor Create(AOwner: TDBConnection);
102 destructor Destroy; override; 102 destructor Destroy; override;
103 procedure Modification(Sender: TObject); 103 procedure Modification(Sender: TObject);
104 function SQLCode: String; 104 function SQLCode: String;
105 end; 105 end;
106 TTableKeyList = TObjectList<TTableKey>; 106 TTableKeyList = TObjectList<TTableKey>;
107 107
108 // Helper object to manage foreign keys in a TObjectList 108 // Helper object to manage foreign keys in a TObjectList
109 TForeignKey = class(TObject) 109 TForeignKey = class(TObject)
110 private 110 private
111 FConnection: TDBConnection; 111 FConnection: TDBConnection;
112 public 112 public
113 KeyName, OldKeyName, ReferenceTable, OnUpdate, OnDelete: String; 113 KeyName, OldKeyName, ReferenceTable, OnUpdate, OnDelete: String;
114 Columns, ForeignColumns: TStringList; 114 Columns, ForeignColumns: TStringList;
115 Modified, Added, KeyNameWasCustomized: Boolean; 115 Modified, Added, KeyNameWasCustomized: Boolean;
116 constructor Create(AOwner: TDBConnection); 116 constructor Create(AOwner: TDBConnection);
117 destructor Destroy; override; 117 destructor Destroy; override;
118 function SQLCode(IncludeSymbolName: Boolean): String; 118 function SQLCode(IncludeSymbolName: Boolean): String;
119 end; 119 end;
120 TForeignKeyList = TObjectList<TForeignKey>; 120 TForeignKeyList = TObjectList<TForeignKey>;
121 121
122 TRoutineParam = class(TObject) 122 TRoutineParam = class(TObject)
123 public 123 public
124 Name, Context, Datatype: String; 124 Name, Context, Datatype: String;
125 end; 125 end;
126 TRoutineParamList = TObjectList<TRoutineParam>; 126 TRoutineParamList = TObjectList<TRoutineParam>;
127 127
128 // Structures for in-memory changes of a TMySQLQuery 128 // Structures for in-memory changes of a TMySQLQuery
129 TCellData = class(TObject) 129 TCellData = class(TObject)
130 NewText, OldText: String; 130 NewText, OldText: String;
131 NewIsNull, OldIsNull: Boolean; 131 NewIsNull, OldIsNull: Boolean;
132 Modified: Boolean; 132 Modified: Boolean;
133 destructor Destroy; override; 133 destructor Destroy; override;
134 end; 134 end;
135 TRowData = class(TObjectList<TCellData>) 135 TRowData = class(TObjectList<TCellData>)
136 RecNo: Int64; 136 RecNo: Int64;
137 Inserted: Boolean; 137 Inserted: Boolean;
138 end; 138 end;
139 TUpdateData = TObjectList<TRowData>; 139 TUpdateData = TObjectList<TRowData>;
140 140
141 // Custom exception class for any connection or database related error 141 // Custom exception class for any connection or database related error
142 EDatabaseError = class(Exception); 142 EDatabaseError = class(Exception);
143 143
144 {$M+} // Needed to add published properties 144 {$M+} // Needed to add published properties
145 145
146 { TConnectionParameters and friends } 146 { TConnectionParameters and friends }
147 147
148 TNetType = (ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel, 148 TNetType = (ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel,
149 ntMSSQL_NamedPipe, ntMSSQL_TCPIP, ntMSSQL_SPX, ntMSSQL_VINES, ntMSSQL_RPC); 149 ntMSSQL_NamedPipe, ntMSSQL_TCPIP, ntMSSQL_SPX, ntMSSQL_VINES, ntMSSQL_RPC);
150 TNetTypeGroup = (ngMySQL, ngMSSQL); 150 TNetTypeGroup = (ngMySQL, ngMSSQL);
151 151
152 TConnectionParameters = class(TObject) 152 TConnectionParameters = class(TObject)
153 strict private 153 strict private
154 FNetType: TNetType; 154 FNetType: TNetType;
155 FHostname, FUsername, FPassword, FAllDatabases, FStartupScriptFilename, 155 FHostname, FUsername, FPassword, FAllDatabases, FStartupScriptFilename,
156 FSessionName, FSSLPrivateKey, FSSLCertificate, FSSLCACertificate, FServerVersion, 156 FSessionName, FSSLPrivateKey, FSSLCertificate, FSSLCACertificate, FServerVersion,
157 FSSHHost, FSSHUser, FSSHPassword, FSSHPlinkExe, FSSHPrivateKey: String; 157 FSSHHost, FSSHUser, FSSHPassword, FSSHPlinkExe, FSSHPrivateKey: String;
158 FPort, FSSHPort, FSSHLocalPort, FSSHTimeout: Integer; 158 FPort, FSSHPort, FSSHLocalPort, FSSHTimeout: Integer;
159 FLoginPrompt, FCompressed, FWindowsAuth, FWantSSL: Boolean; 159 FLoginPrompt, FCompressed, FWindowsAuth, FWantSSL: Boolean;
160 FSessionColor: TColor; 160 FSessionColor: TColor;
161 function GetImageIndex: Integer; 161 function GetImageIndex: Integer;
162 public 162 public
163 constructor Create; 163 constructor Create;
164 function CreateConnection(AOwner: TComponent): TDBConnection; 164 function CreateConnection(AOwner: TComponent): TDBConnection;
165 function CreateQuery(AOwner: TComponent): TDBQuery; 165 function CreateQuery(AOwner: TComponent): TDBQuery;
166 function NetTypeName(NetType: TNetType; LongFormat: Boolean): String; 166 function NetTypeName(NetType: TNetType; LongFormat: Boolean): String;
167 function GetNetTypeGroup: TNetTypeGroup; 167 function GetNetTypeGroup: TNetTypeGroup;
168 function IsMariaDB: Boolean; 168 function IsMariaDB: Boolean;
169 function IsPercona: Boolean; 169 function IsPercona: Boolean;
170 function IsTokudb: Boolean; 170 function IsTokudb: Boolean;
171 function IsInfiniDB: Boolean; 171 function IsInfiniDB: Boolean;
172 function IsInfobright: Boolean; 172 function IsInfobright: Boolean;
173 class function ReadFromRegistry(Session: String): TConnectionParameters; 173 class function ReadFromRegistry(Session: String): TConnectionParameters;
174 property ImageIndex: Integer read GetImageIndex; 174 property ImageIndex: Integer read GetImageIndex;
175 published 175 published
176 property NetType: TNetType read FNetType write FNetType; 176 property NetType: TNetType read FNetType write FNetType;
177 property NetTypeGroup: TNetTypeGroup read GetNetTypeGroup; 177 property NetTypeGroup: TNetTypeGroup read GetNetTypeGroup;
178 property ServerVersion: String read FServerVersion write FServerVersion; 178 property ServerVersion: String read FServerVersion write FServerVersion;
179 property SessionName: String read FSessionName write FSessionName; 179 property SessionName: String read FSessionName write FSessionName;
180 property SessionColor: TColor read FSessionColor write FSessionColor; 180 property SessionColor: TColor read FSessionColor write FSessionColor;
181 property Hostname: String read FHostname write FHostname; 181 property Hostname: String read FHostname write FHostname;
182 property Port: Integer read FPort write FPort; 182 property Port: Integer read FPort write FPort;
183 property Username: String read FUsername write FUsername; 183 property Username: String read FUsername write FUsername;
184 property Password: String read FPassword write FPassword; 184 property Password: String read FPassword write FPassword;
185 property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt; 185 property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
186 property WindowsAuth: Boolean read FWindowsAuth write FWindowsAuth; 186 property WindowsAuth: Boolean read FWindowsAuth write FWindowsAuth;
187 property AllDatabasesStr: String read FAllDatabases write FAllDatabases; 187 property AllDatabasesStr: String read FAllDatabases write FAllDatabases;
188 property StartupScriptFilename: String read FStartupScriptFilename write FStartupScriptFilename; 188 property StartupScriptFilename: String read FStartupScriptFilename write FStartupScriptFilename;
189 property Compressed: Boolean read FCompressed write FCompressed; 189 property Compressed: Boolean read FCompressed write FCompressed;
190 property SSHHost: String read FSSHHost write FSSHHost; 190 property SSHHost: String read FSSHHost write FSSHHost;
191 property SSHPort: Integer read FSSHPort write FSSHPort; 191 property SSHPort: Integer read FSSHPort write FSSHPort;
192 property SSHUser: String read FSSHUser write FSSHUser; 192 property SSHUser: String read FSSHUser write FSSHUser;
193 property SSHPassword: String read FSSHPassword write FSSHPassword; 193 property SSHPassword: String read FSSHPassword write FSSHPassword;
194 property SSHTimeout: Integer read FSSHTimeout write FSSHTimeout; 194 property SSHTimeout: Integer read FSSHTimeout write FSSHTimeout;
195 property SSHPrivateKey: String read FSSHPrivateKey write FSSHPrivateKey; 195 property SSHPrivateKey: String read FSSHPrivateKey write FSSHPrivateKey;
196 property SSHLocalPort: Integer read FSSHLocalPort write FSSHLocalPort; 196 property SSHLocalPort: Integer read FSSHLocalPort write FSSHLocalPort;
197 property SSHPlinkExe: String read FSSHPlinkExe write FSSHPlinkExe; 197 property SSHPlinkExe: String read FSSHPlinkExe write FSSHPlinkExe;
198 property WantSSL: Boolean read FWantSSL write FWantSSL; 198 property WantSSL: Boolean read FWantSSL write FWantSSL;
199 property SSLPrivateKey: String read FSSLPrivateKey write FSSLPrivateKey; 199 property SSLPrivateKey: String read FSSLPrivateKey write FSSLPrivateKey;
200 property SSLCertificate: String read FSSLCertificate write FSSLCertificate; 200 property SSLCertificate: String read FSSLCertificate write FSSLCertificate;
201 property SSLCACertificate: String read FSSLCACertificate write FSSLCACertificate; 201 property SSLCACertificate: String read FSSLCACertificate write FSSLCACertificate;
202 end; 202 end;
203 PConnectionParameters = ^TConnectionParameters; 203 PConnectionParameters = ^TConnectionParameters;
204 204
205 205
206 { TDBConnection } 206 { TDBConnection }
207 207
208 TDBLogCategory = (lcInfo, lcSQL, lcUserFiredSQL, lcError, lcDebug); 208 TDBLogCategory = (lcInfo, lcSQL, lcUserFiredSQL, lcError, lcDebug);
209 TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object; 209 TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object;
210 TDBEvent = procedure(Connection: TDBConnection; Database: String) of object; 210 TDBEvent = procedure(Connection: TDBConnection; Database: String) of object;
211 TDBDataTypeArray = Array of TDBDataType; 211 TDBDataTypeArray = Array of TDBDataType;
212 TSQLSpecifityId = (spDatabaseTable, spDatabaseTableId, 212 TSQLSpecifityId = (spDatabaseTable, spDatabaseTableId,
213 spDbObjectsTable, spDbObjectsCreateCol, spDbObjectsUpdateCol, spDbObjectsTypeCol, 213 spDbObjectsTable, spDbObjectsCreateCol, spDbObjectsUpdateCol, spDbObjectsTypeCol,
214 spEmptyTable, spCurrentUserHost); 214 spEmptyTable, spCurrentUserHost);
215 215
216 TDBConnection = class(TComponent) 216 TDBConnection = class(TComponent)
217 private 217 private
218 FActive: Boolean; 218 FActive: Boolean;
219 FConnectionStarted: Integer; 219 FConnectionStarted: Integer;
220 FServerUptime: Integer; 220 FServerUptime: Integer;
221 FParameters: TConnectionParameters; 221 FParameters: TConnectionParameters;
222 FLoginPromptDone: Boolean; 222 FLoginPromptDone: Boolean;
223 FDatabase: String; 223 FDatabase: String;
224 FAllDatabases: TStringList; 224 FAllDatabases: TStringList;
225 FLogPrefix: String; 225 FLogPrefix: String;
226 FOnLog: TDBLogEvent; 226 FOnLog: TDBLogEvent;
227 FOnConnected: TDBEvent; 227 FOnConnected: TDBEvent;
228 FOnDatabaseChanged: TDBEvent; 228 FOnDatabaseChanged: TDBEvent;
229 FOnDBObjectsCleared: TDBEvent; 229 FOnDBObjectsCleared: TDBEvent;
230 FRowsFound: Int64; 230 FRowsFound: Int64;
231 FRowsAffected: Int64; 231 FRowsAffected: Int64;
232 FWarningCount: Cardinal; 232 FWarningCount: Cardinal;
233 FServerOS: String; 233 FServerOS: String;
234 FServerVersionUntouched: String; 234 FServerVersionUntouched: String;
235 FRealHostname: String; 235 FRealHostname: String;
236 FLastQueryDuration, FLastQueryNetworkDuration: Cardinal; 236 FLastQueryDuration, FLastQueryNetworkDuration: Cardinal;
237 FLastQuerySQL: String; 237 FLastQuerySQL: String;
238 FIsUnicode: Boolean; 238 FIsUnicode: Boolean;
239 FIsSSL: Boolean; 239 FIsSSL: Boolean;
240 FTableEngines: TStringList; 240 FTableEngines: TStringList;
241 FTableEngineDefault: String; 241 FTableEngineDefault: String;
242 FCollationTable: TDBQuery; 242 FCollationTable: TDBQuery;
243 FCharsetTable: TDBQuery; 243 FCharsetTable: TDBQuery;
244 FInformationSchemaObjects: TStringList; 244 FInformationSchemaObjects: TStringList;
245 FDatabases: TDatabaseList; 245 FDatabases: TDatabaseList;
246 FObjectNamesInSelectedDB: TStrings; 246 FObjectNamesInSelectedDB: TStrings;
247 FResultCount: Integer; 247 FResultCount: Integer;
248 FCurrentUserHostCombination: String; 248 FCurrentUserHostCombination: String;
249 FLockedByThread: TThread; 249 FLockedByThread: TThread;
250 FQuoteChar: Char; 250 FQuoteChar: Char;
251 FDatatypes: TDBDataTypeArray; 251 FDatatypes: TDBDataTypeArray;
252 FThreadID: Cardinal; 252 FThreadID: Cardinal;
253 FSQLSpecifities: Array[TSQLSpecifityId] of String; 253 FSQLSpecifities: Array[TSQLSpecifityId] of String;
254 procedure SetActive(Value: Boolean); virtual; abstract; 254 procedure SetActive(Value: Boolean); virtual; abstract;
255 procedure DoBeforeConnect; virtual; 255 procedure DoBeforeConnect; virtual;
256 procedure DoAfterConnect; virtual; 256 procedure DoAfterConnect; virtual;
257 procedure SetDatabase(Value: String); 257 procedure SetDatabase(Value: String);
258 function GetThreadId: Cardinal; virtual; abstract; 258 function GetThreadId: Cardinal; virtual; abstract;
259 function GetCharacterSet: String; virtual; abstract; 259 function GetCharacterSet: String; virtual; abstract;
260 procedure SetCharacterSet(CharsetName: String); virtual; abstract; 260 procedure SetCharacterSet(CharsetName: String); virtual; abstract;
261 function GetLastErrorCode: Cardinal; virtual; abstract; 261 function GetLastErrorCode: Cardinal; virtual; abstract;
262 function GetLastError: String; virtual; abstract; 262 function GetLastError: String; virtual; abstract;
263 function GetServerVersionStr: String; 263 function GetServerVersionStr: String;
264 function GetServerVersionInt: Integer; virtual; abstract; 264 function GetServerVersionInt: Integer; virtual; abstract;
265 function GetAllDatabases: TStringList; virtual; 265 function GetAllDatabases: TStringList; virtual;
266 function GetTableEngines: TStringList; virtual; 266 function GetTableEngines: TStringList; virtual;
267 function GetCollationTable: TDBQuery; virtual; 267 function GetCollationTable: TDBQuery; virtual;
268 function GetCollationList: TStringList; 268 function GetCollationList: TStringList;
269 function GetCharsetTable: TDBQuery; virtual; 269 function GetCharsetTable: TDBQuery; virtual;
270 function GetCharsetList: TStringList; 270 function GetCharsetList: TStringList;
271 function GetInformationSchemaObjects: TStringList; virtual; 271 function GetInformationSchemaObjects: TStringList; virtual;
272 function GetConnectionUptime: Integer; 272 function GetConnectionUptime: Integer;
273 function GetServerUptime: Integer; 273 function GetServerUptime: Integer;
274 function GetCurrentUserHostCombination: String; 274 function GetCurrentUserHostCombination: String;
275 function DecodeAPIString(a: AnsiString): String; 275 function DecodeAPIString(a: AnsiString): String;
276 procedure ClearCache(IncludeDBObjects: Boolean); 276 procedure ClearCache(IncludeDBObjects: Boolean);
277 procedure SetObjectNamesInSelectedDB; 277 procedure SetObjectNamesInSelectedDB;
278 procedure SetLockedByThread(Value: TThread); virtual; 278 procedure SetLockedByThread(Value: TThread); virtual;
279 public 279 public
280 constructor Create(AOwner: TComponent); override; 280 constructor Create(AOwner: TComponent); override;
281 destructor Destroy; override; 281 destructor Destroy; override;
282 procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); virtual; abstract; 282 procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); virtual; abstract;
283 procedure Log(Category: TDBLogCategory; Msg: String); 283 procedure Log(Category: TDBLogCategory; Msg: String);
284 function EscapeString(Text: String; ProcessJokerChars: Boolean=False; DoQuote: Boolean=True): String; 284 function EscapeString(Text: String; ProcessJokerChars: Boolean=False; DoQuote: Boolean=True): String;
285 function QuoteIdent(Identifier: String; AlwaysQuote: Boolean=True; Glue: Char=#0): String; 285 function QuoteIdent(Identifier: String; AlwaysQuote: Boolean=True; Glue: Char=#0): String;
286 function DeQuoteIdent(Identifier: String; Glue: Char=#0): String; 286 function DeQuoteIdent(Identifier: String; Glue: Char=#0): String;
287 function escChars(const Text: String; EscChar, Char1, Char2, Char3, Char4: Char): String; 287 function escChars(const Text: String; EscChar, Char1, Char2, Char3, Char4: Char): String;
288 function UnescapeString(Text: String): String; 288 function UnescapeString(Text: String): String;
289 function ConvertServerVersion(Version: Integer): String; virtual; abstract; 289 function ConvertServerVersion(Version: Integer): String; virtual; abstract;
290 function GetResults(SQL: String): TDBQuery; 290 function GetResults(SQL: String): TDBQuery;
291 function GetCol(SQL: String; Column: Integer=0): TStringList; 291 function GetCol(SQL: String; Column: Integer=0): TStringList;
292 function GetVar(SQL: String; Column: Integer=0): String; overload; 292 function GetVar(SQL: String; Column: Integer=0): String; overload;
293 function GetVar(SQL: String; Column: String): String; overload; 293 function GetVar(SQL: String; Column: String): String; overload;
294 function Ping(Reconnect: Boolean): Boolean; virtual; abstract; 294 function Ping(Reconnect: Boolean): Boolean; virtual; abstract;
295 function RefreshAllDatabases: TStringList; 295 function RefreshAllDatabases: TStringList;
296 function GetDBObjects(db: String; Refresh: Boolean=False): TDBObjectList; virtual; abstract; 296 function GetDBObjects(db: String; Refresh: Boolean=False): TDBObjectList; virtual; abstract;
297 function DbObjectsCached(db: String): Boolean; 297 function DbObjectsCached(db: String): Boolean;
298 function ParseDateTime(Str: String): TDateTime; 298 function ParseDateTime(Str: String): TDateTime;
299 function GetKeyColumns(Columns: TTableColumnList; Keys: TTableKeyList): TStringList; 299 function GetKeyColumns(Columns: TTableColumnList; Keys: TTableKeyList): TStringList;
300 function ConnectionInfo: TStringList; 300 function ConnectionInfo: TStringList;
301 function GetLastResults: TDBQueryList; virtual; abstract; 301 function GetLastResults: TDBQueryList; virtual; abstract;
302 function GetCreateCode(Database, Name: String; NodeType: TListNodeType): String; virtual; abstract; 302 function GetCreateCode(Database, Name: String; NodeType: TListNodeType): String; virtual; abstract;
303 function GetServerVariables: TDBQuery; virtual; abstract; 303 function GetServerVariables: TDBQuery; virtual; abstract;
304 function GetSQLSpecifity(Specifity: TSQLSpecifityId): String; 304 function GetSQLSpecifity(Specifity: TSQLSpecifityId): String;
305 procedure ClearDbObjects(db: String); 305 procedure ClearDbObjects(db: String);
306 procedure ClearAllDbObjects; 306 procedure ClearAllDbObjects;
307 procedure ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList); 307 procedure ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList);
308 procedure ParseViewStructure(CreateCode, ViewName: String; Columns: TTableColumnList; 308 procedure ParseViewStructure(CreateCode, ViewName: String; Columns: TTableColumnList;
309 var Algorithm, Definer, SQLSecurity, CheckOption, SelectCode: String); 309 var Algorithm, Definer, SQLSecurity, CheckOption, SelectCode: String);
310 procedure ParseRoutineStructure(CreateCode: String; Parameters: TRoutineParamList; 310 procedure ParseRoutineStructure(CreateCode: String; Parameters: TRoutineParamList;
311 var Deterministic: Boolean; var Definer, Returns, DataAccess, Security, Comment, Body: String); 311 var Deterministic: Boolean; var Definer, Returns, DataAccess, Security, Comment, Body: String);
312 function GetDatatypeByName(Datatype: String): TDBDatatype; 312 function GetDatatypeByName(Datatype: String): TDBDatatype;
313 function ApplyLimitClause(QueryType, QueryBody: String; Limit, Offset: Cardinal): String; 313 function ApplyLimitClause(QueryType, QueryBody: String; Limit, Offset: Cardinal): String;
314 property Parameters: TConnectionParameters read FParameters write FParameters; 314 property Parameters: TConnectionParameters read FParameters write FParameters;
315 property ThreadId: Cardinal read GetThreadId; 315 property ThreadId: Cardinal read GetThreadId;
316 property ConnectionUptime: Integer read GetConnectionUptime; 316 property ConnectionUptime: Integer read GetConnectionUptime;
317 property ServerUptime: Integer read GetServerUptime; 317 property ServerUptime: Integer read GetServerUptime;
318 property CharacterSet: String read GetCharacterSet write SetCharacterSet; 318 property CharacterSet: String read GetCharacterSet write SetCharacterSet;
319 property LastErrorCode: Cardinal read GetLastErrorCode; 319 property LastErrorCode: Cardinal read GetLastErrorCode;
320 property LastError: String read GetLastError; 320 property LastError: String read GetLastError;
321 property ServerOS: String read FServerOS; 321 property ServerOS: String read FServerOS;
322 property ServerVersionUntouched: String read FServerVersionUntouched; 322 property ServerVersionUntouched: String read FServerVersionUntouched;
323 property ServerVersionStr: String read GetServerVersionStr; 323 property ServerVersionStr: String read GetServerVersionStr;
324 property ServerVersionInt: Integer read GetServerVersionInt; 324 property ServerVersionInt: Integer read GetServerVersionInt;
325 property RowsFound: Int64 read FRowsFound; 325 property RowsFound: Int64 read FRowsFound;
326 property RowsAffected: Int64 read FRowsAffected; 326 property RowsAffected: Int64 read FRowsAffected;
327 property WarningCount: Cardinal read FWarningCount; 327 property WarningCount: Cardinal read FWarningCount;
328 property LastQueryDuration: Cardinal read FLastQueryDuration; 328 property LastQueryDuration: Cardinal read FLastQueryDuration;
329 property LastQueryNetworkDuration: Cardinal read FLastQueryNetworkDuration; 329 property LastQueryNetworkDuration: Cardinal read FLastQueryNetworkDuration;
330 property IsUnicode: Boolean read FIsUnicode; 330 property IsUnicode: Boolean read FIsUnicode;
331 property IsSSL: Boolean read FIsSSL; 331 property IsSSL: Boolean read FIsSSL;
332 property AllDatabases: TStringList read GetAllDatabases; 332 property AllDatabases: TStringList read GetAllDatabases;
333 property TableEngines: TStringList read GetTableEngines; 333 property TableEngines: TStringList read GetTableEngines;
334 property TableEngineDefault: String read FTableEngineDefault; 334 property TableEngineDefault: String read FTableEngineDefault;
335 property CollationTable: TDBQuery read GetCollationTable; 335 property CollationTable: TDBQuery read GetCollationTable;
336 property CollationList: TStringList read GetCollationList; 336 property CollationList: TStringList read GetCollationList;
337 property CharsetTable: TDBQuery read GetCharsetTable; 337 property CharsetTable: TDBQuery read GetCharsetTable;
338 property CharsetList: TStringList read GetCharsetList; 338 property CharsetList: TStringList read GetCharsetList;
339 property InformationSchemaObjects: TStringList read GetInformationSchemaObjects; 339 property InformationSchemaObjects: TStringList read GetInformationSchemaObjects;
340 property ObjectNamesInSelectedDB: TStrings read FObjectNamesInSelectedDB write FObjectNamesInSelectedDB; 340 property ObjectNamesInSelectedDB: TStrings read FObjectNamesInSelectedDB write FObjectNamesInSelectedDB;
341 property ResultCount: Integer read FResultCount; 341 property ResultCount: Integer read FResultCount;
342 property CurrentUserHostCombination: String read GetCurrentUserHostCombination; 342 property CurrentUserHostCombination: String read GetCurrentUserHostCombination;
343 property LockedByThread: TThread read FLockedByThread write SetLockedByThread; 343 property LockedByThread: TThread read FLockedByThread write SetLockedByThread;
344 property Datatypes: TDBDataTypeArray read FDatatypes; 344 property Datatypes: TDBDataTypeArray read FDatatypes;
345 published 345 published
346 property Active: Boolean read FActive write SetActive default False; 346 property Active: Boolean read FActive write SetActive default False;
347 property Database: String read FDatabase write SetDatabase; 347 property Database: String read FDatabase write SetDatabase;
348 property LogPrefix: String read FLogPrefix write FLogPrefix; 348 property LogPrefix: String read FLogPrefix write FLogPrefix;
349 property OnLog: TDBLogEvent read FOnLog write FOnLog; 349 property OnLog: TDBLogEvent read FOnLog write FOnLog;
350 property OnConnected: TDBEvent read FOnConnected write FOnConnected; 350 property OnConnected: TDBEvent read FOnConnected write FOnConnected;
351 property OnDatabaseChanged: TDBEvent read FOnDatabaseChanged write FOnDatabaseChanged; 351 property OnDatabaseChanged: TDBEvent read FOnDatabaseChanged write FOnDatabaseChanged;
352 property OnDBObjectsCleared: TDBEvent read FOnDBObjectsCleared write FOnDBObjectsCleared; 352 property OnDBObjectsCleared: TDBEvent read FOnDBObjectsCleared write FOnDBObjectsCleared;
353 end; 353 end;
354 TDBConnectionList = TObjectList<TDBConnection>; 354 TDBConnectionList = TObjectList<TDBConnection>;
355 355
356 356
357 { TMySQLConnection } 357 { TMySQLConnection }
358 358
359 TMySQLRawResults = Array of PMYSQL_RES; 359 TMySQLRawResults = Array of PMYSQL_RES;
360 TMySQLConnection = class(TDBConnection) 360 TMySQLConnection = class(TDBConnection)
361 private 361 private
362 FHandle: PMYSQL; 362 FHandle: PMYSQL;
363 FLastRawResults: TMySQLRawResults; 363 FLastRawResults: TMySQLRawResults;
364 FPlinkProcInfo: TProcessInformation; 364 FPlinkProcInfo: TProcessInformation;
365 procedure SetActive(Value: Boolean); override; 365 procedure SetActive(Value: Boolean); override;
366 procedure DoBeforeConnect; override; 366 procedure DoBeforeConnect; override;
367 procedure DoAfterConnect; override; 367 procedure DoAfterConnect; override;
368 procedure AssignProc(var Proc: FARPROC; Name: PAnsiChar); 368 procedure AssignProc(var Proc: FARPROC; Name: PAnsiChar);
369 procedure ClosePlink; 369 procedure ClosePlink;
370 function GetThreadId: Cardinal; override; 370 function GetThreadId: Cardinal; override;
371 function GetCharacterSet: String; override; 371 function GetCharacterSet: String; override;
372 procedure SetCharacterSet(CharsetName: String); override; 372 procedure SetCharacterSet(CharsetName: String); override;
373 function GetLastErrorCode: Cardinal; override; 373 function GetLastErrorCode: Cardinal; override;
374 function GetLastError: String; override; 374 function GetLastError: String; override;
375 function GetServerVersionInt: Integer; override; 375 function GetServerVersionInt: Integer; override;
376 function GetAllDatabases: TStringList; override; 376 function GetAllDatabases: TStringList; override;
377 function GetTableEngines: TStringList; override; 377 function GetTableEngines: TStringList; override;
378 function GetCollationTable: TDBQuery; override; 378 function GetCollationTable: TDBQuery; override;
379 function GetCharsetTable: TDBQuery; override; 379 function GetCharsetTable: TDBQuery; override;
380 function GetCreateViewCode(Database, Name: String): String; 380 function GetCreateViewCode(Database, Name: String): String;
381 procedure SetLockedByThread(Value: TThread); override; 381 procedure SetLockedByThread(Value: TThread); override;
382 public 382 public
383 constructor Create(AOwner: TComponent); override; 383 constructor Create(AOwner: TComponent); override;
384 procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); override; 384 procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); override;
385 function ConvertServerVersion(Version: Integer): String; override; 385 function ConvertServerVersion(Version: Integer): String; override;
386 function Ping(Reconnect: Boolean): Boolean; override; 386 function Ping(Reconnect: Boolean): Boolean; override;
387 function GetDBObjects(db: String; Refresh: Boolean=False): TDBObjectList; override; 387 function GetDBObjects(db: String; Refresh: Boolean=False): TDBObjectList; override;
388 function GetLastResults: TDBQueryList; override; 388 function GetLastResults: TDBQueryList; override;
389 function GetCreateCode(Database, Name: String; NodeType: TListNodeType): String; override; 389 function GetCreateCode(Database, Name: String; NodeType: TListNodeType): String; override;
390 property LastRawResults: TMySQLRawResults read FLastRawResults; 390 property LastRawResults: TMySQLRawResults read FLastRawResults;
391 function GetServerVariables: TDBQuery; override; 391 function GetServerVariables: TDBQuery; override;
392 end; 392 end;
393 393
394 TAdoRawResults = Array of _RecordSet; 394 TAdoRawResults = Array of _RecordSet;
395 TAdoDBConnection = class(TDBConnection) 395 TAdoDBConnection = class(TDBConnection)
396 private 396 private
397 FAdoHandle: TAdoConnection; 397 FAdoHandle: TAdoConnection;
398 FLastRawResults: TAdoRawResults; 398 FLastRawResults: TAdoRawResults;
399 FLastError: String; 399 FLastError: String;
400 procedure SetActive(Value: Boolean); override; 400 procedure SetActive(Value: Boolean); override;
401 procedure DoAfterConnect; override; 401 procedure DoAfterConnect; override;
402 function GetThreadId: Cardinal; override; 402 function GetThreadId: Cardinal; override;
403 function GetCharacterSet: String; override; 403 function GetCharacterSet: String; override;
404 procedure SetCharacterSet(CharsetName: String); override; 404 procedure SetCharacterSet(CharsetName: String); override;
405 function GetLastErrorCode: Cardinal; override; 405 function GetLastErrorCode: Cardinal; override;
406 function GetLastError: String; override; 406 function GetLastError: String; override;
407 function GetServerVersionInt: Integer; override; 407 function GetServerVersionInt: Integer; override;
408 function GetAllDatabases: TStringList; override; 408 function GetAllDatabases: TStringList; override;
409 function GetCollationTable: TDBQuery; override; 409 function GetCollationTable: TDBQuery; override;
410 function GetCharsetTable: TDBQuery; override; 410 function GetCharsetTable: TDBQuery; override;
411 function GetInformationSchemaObjects: TStringList; override; 411 function GetInformationSchemaObjects: TStringList; override;
412 public 412 public
413 constructor Create(AOwner: TComponent); override; 413 constructor Create(AOwner: TComponent); override;
414 destructor Destroy; override; 414 destructor Destroy; override;
415 procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); override; 415 procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); override;
416 function ConvertServerVersion(Version: Integer): String; override; 416 function ConvertServerVersion(Version: Integer): String; override;
417 function Ping(Reconnect: Boolean): Boolean; override; 417 function Ping(Reconnect: Boolean): Boolean; override;
418 function GetDBObjects(db: String; Refresh: Boolean=False): TDBObjectList; override; 418 function GetDBObjects(db: String; Refresh: Boolean=False): TDBObjectList; override;
419 function GetLastResults: TDBQueryList; override; 419 function GetLastResults: TDBQueryList; override;
420 function GetCreateCode(Database, Name: String; NodeType: TListNodeType): String; override; 420 function GetCreateCode(Database, Name: String; NodeType: TListNodeType): String; override;
421 function GetServerVariables: TDBQuery; override; 421 function GetServerVariables: TDBQuery; override;
422 property LastRawResults: TAdoRawResults read FLastRawResults; 422 property LastRawResults: TAdoRawResults read FLastRawResults;
423 end; 423 end;
424 424
425 425
426 { TDBQuery } 426 { TDBQuery }
427 427
428 TDBQuery = class(TComponent) 428 TDBQuery = class(TComponent)
429 private 429 private
430 FSQL: String; 430 FSQL: String;
431 FConnection: TDBConnection; 431 FConnection: TDBConnection;
432 FRecNo, 432 FRecNo,
433 FRecordCount: Int64; 433 FRecordCount: Int64;
434 FColumnNames: TStringList; 434 FColumnNames: TStringList;
435 FColumnOrgNames: TStringList; 435 FColumnOrgNames: TStringList;
436 FColumnTypes: Array of TDBDatatype; 436 FColumnTypes: Array of TDBDatatype;
437 FColumnLengths: TIntegerDynArray; 437 FColumnLengths: TIntegerDynArray;
438 FColumnFlags: TCardinalDynArray; 438 FColumnFlags: TCardinalDynArray;
439 FCurrentUpdateRow: TRowData; 439 FCurrentUpdateRow: TRowData;
440 FEof: Boolean; 440 FEof: Boolean;
441 FStoreResult: Boolean; 441 FStoreResult: Boolean;
442 FColumns: TTableColumnList; 442 FColumns: TTableColumnList;
443 FKeys: TTableKeyList; 443 FKeys: TTableKeyList;
444 FForeignKeys: TForeignKeyList; 444 FForeignKeys: TForeignKeyList;
445 FEditingPrepared: Boolean; 445 FEditingPrepared: Boolean;
446 FUpdateData: TUpdateData; 446 FUpdateData: TUpdateData;
447 procedure SetRecNo(Value: Int64); virtual; abstract; 447 procedure SetRecNo(Value: Int64); virtual; abstract;
448 procedure SetColumnOrgNames(Value: TStringList); 448 procedure SetColumnOrgNames(Value: TStringList);
449 procedure CreateUpdateRow; 449 procedure CreateUpdateRow;
450 function GetKeyColumns: TStringList; 450 function GetKeyColumns: TStringList;
451 function GetWhereClause: String; 451 function GetWhereClause: String;
452 function ColAttributes(Column: Integer): TTableColumn; 452 function ColAttributes(Column: Integer): TTableColumn;
453 public 453 public
454 constructor Create(AOwner: TComponent); override; 454 constructor Create(AOwner: TComponent); override;
455 destructor Destroy; override; 455 destructor Destroy; override;
456 procedure Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); virtual; abstract; 456 procedure Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); virtual; abstract;
457 procedure First; 457 procedure First;
458 procedure Next; 458 procedure Next;
459 function ColumnCount: Integer; 459 function ColumnCount: Integer;
460 function Col(Column: Integer; IgnoreErrors: Boolean=False): String; overload; virtual; abstract; 460 function Col(Column: Integer; IgnoreErrors: Boolean=False): String; overload; virtual; abstract;
461 function Col(ColumnName: String; IgnoreErrors: Boolean=False): String; overload; 461 function Col(ColumnName: String; IgnoreErrors: Boolean=False): String; overload;
462 function ColumnLengths(Column: Integer): Int64; virtual; 462 function ColumnLengths(Column: Integer): Int64; virtual;
463 function HexValue(Column: Integer; IgnoreErrors: Boolean=False): String; overload; 463 function HexValue(Column: Integer; IgnoreErrors: Boolean=False): String; overload;
464 function HexValue(BinValue: String): String; overload; 464 function HexValue(BinValue: String): String; overload;
465 function DataType(Column: Integer): TDBDataType; 465 function DataType(Column: Integer): TDBDataType;
466 function MaxLength(Column: Integer): Int64; 466 function MaxLength(Column: Integer): Int64;
467 function ValueList(Column: Integer): TStringList; 467 function ValueList(Column: Integer): TStringList;
468 function ColExists(Column: String): Boolean; 468 function ColExists(Column: String): Boolean;
469 function ColIsPrimaryKeyPart(Column: Integer): Boolean; virtual; abstract; 469 function ColIsPrimaryKeyPart(Column: Integer): Boolean; virtual; abstract;
470 function ColIsUniqueKeyPart(Column: Integer): Boolean; virtual; abstract; 470 function ColIsUniqueKeyPart(Column: Integer): Boolean; virtual; abstract;
471 function ColIsKeyPart(Column: Integer): Boolean; virtual; abstract; 471 function ColIsKeyPart(Column: Integer): Boolean; virtual; abstract;
472 function IsNull(Column: Integer): Boolean; overload; virtual; abstract; 472 function IsNull(Column: Integer): Boolean; overload; virtual; abstract;
473 function IsNull(Column: String): Boolean; overload; 473 function IsNull(Column: String): Boolean; overload;
474 function HasResult: Boolean; virtual; abstract; 474 function HasResult: Boolean; virtual; abstract;
475 procedure CheckEditable; 475 procedure CheckEditable;
476 procedure DeleteRow; 476 procedure DeleteRow;
477 function InsertRow: Cardinal; 477 function InsertRow: Cardinal;
478 procedure SetCol(Column: Integer; NewText: String; Null: Boolean); 478 procedure SetCol(Column: Integer; NewText: String; Null: Boolean);
479 function EnsureFullRow: Boolean; 479 function EnsureFullRow: Boolean;
480 function HasFullData: Boolean; 480 function HasFullData: Boolean;
481 function Modified(Column: Integer): Boolean; overload; 481 function Modified(Column: Integer): Boolean; overload;
482 function Modified: Boolean; overload; 482 function Modified: Boolean; overload;
483 function Inserted: Boolean; 483 function Inserted: Boolean;
484 function SaveModifications: Boolean; 484 function SaveModifications: Boolean;
485 function DatabaseName: String; virtual; abstract; 485 function DatabaseName: String; virtual; abstract;
486 function TableName: String; virtual; abstract; 486 function TableName: String; virtual; abstract;
487 function QuotedDbAndTableName: String; 487 function QuotedDbAndTableName: String;
488 procedure DiscardModifications; 488 procedure DiscardModifications;
489 procedure PrepareEditing; 489 procedure PrepareEditing;
490 property RecNo: Int64 read FRecNo write SetRecNo; 490 property RecNo: Int64 read FRecNo write SetRecNo;
491 property Eof: Boolean read FEof; 491 property Eof: Boolean read FEof;
492 property RecordCount: Int64 read FRecordCount; 492 property RecordCount: Int64 read FRecordCount;
493 property ColumnNames: TStringList read FColumnNames; 493 property ColumnNames: TStringList read FColumnNames;
494 property StoreResult: Boolean read FStoreResult write FStoreResult; 494 property StoreResult: Boolean read FStoreResult write FStoreResult;
495 property ColumnOrgNames: TStringList read FColumnOrgNames write SetColumnOrgNames; 495 property ColumnOrgNames: TStringList read FColumnOrgNames write SetColumnOrgNames;
496 published 496 published
497 property SQL: String read FSQL write FSQL; 497 property SQL: String read FSQL write FSQL;
498 property Connection: TDBConnection read FConnection write FConnection; 498 property Connection: TDBConnection read FConnection write FConnection;
499 end; 499 end;
500 PDBQuery = ^TDBQuery; 500 PDBQuery = ^TDBQuery;
501 501
502 { TMySQLQuery } 502 { TMySQLQuery }
503 503
504 TMySQLQuery = class(TDBQuery) 504 TMySQLQuery = class(TDBQuery)
505 private 505 private
506 FResultList: TMySQLRawResults; 506 FResultList: TMySQLRawResults;
507 FCurrentResults: PMYSQL_RES; 507 FCurrentResults: PMYSQL_RES;
508 FCurrentRow: PMYSQL_ROW; 508 FCurrentRow: PMYSQL_ROW;
509 procedure SetRecNo(Value: Int64); override; 509 procedure SetRecNo(Value: Int64); override;
510 public 510 public
511 destructor Destroy; override; 511 destructor Destroy; override;
512 procedure Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); override; 512 procedure Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); override;
513 function Col(Column: Integer; IgnoreErrors: Boolean=False): String; overload; override; 513 function Col(Column: Integer; IgnoreErrors: Boolean=False): String; overload; override;
514 function ColIsPrimaryKeyPart(Column: Integer): Boolean; override; 514 function ColIsPrimaryKeyPart(Column: Integer): Boolean; override;
515 function ColIsUniqueKeyPart(Column: Integer): Boolean; override; 515 function ColIsUniqueKeyPart(Column: Integer): Boolean; override;
516 function ColIsKeyPart(Column: Integer): Boolean; override; 516 function ColIsKeyPart(Column: Integer): Boolean; override;
517 function IsNull(Column: Integer): Boolean; overload; override; 517 function IsNull(Column: Integer): Boolean; overload; override;
518 function HasResult: Boolean; override; 518 function HasResult: Boolean; override;
519 function DatabaseName: String; override; 519 function DatabaseName: String; override;
520 function TableName: String; override; 520 function TableName: String; override;
521 end; 521 end;
522 522
523 TAdoDBQuery = class(TDBQuery) 523 TAdoDBQuery = class(TDBQuery)
524 private 524 private
525 FCurrentResults: TAdoQuery; 525 FCurrentResults: TAdoQuery;
526 FResultList: Array of TAdoQuery; 526 FResultList: Array of TAdoQuery;
527 procedure SetRecNo(Value: Int64); override; 527 procedure SetRecNo(Value: Int64); override;
528 public 528 public
529 destructor Destroy; override; 529 destructor Destroy; override;
530 procedure Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); override; 530 procedure Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); override;
531 function Col(Column: Integer; IgnoreErrors: Boolean=False): String; overload; override; 531 function Col(Column: Integer; IgnoreErrors: Boolean=False): String; overload; override;
532 function ColIsPrimaryKeyPart(Column: Integer): Boolean; override; 532 function ColIsPrimaryKeyPart(Column: Integer): Boolean; override;
533 function ColIsUniqueKeyPart(Column: Integer): Boolean; override; 533 function ColIsUniqueKeyPart(Column: Integer): Boolean; override;
534 function ColIsKeyPart(Column: Integer): Boolean; override; 534 function ColIsKeyPart(Column: Integer): Boolean; override;
535 function IsNull(Column: Integer): Boolean; overload; override; 535 function IsNull(Column: Integer): Boolean; overload; override;
536 function HasResult: Boolean; override; 536 function HasResult: Boolean; override;
537 function DatabaseName: String; override; 537 function DatabaseName: String; override;
538 function TableName: String; override; 538 function TableName: String; override;
539 end; 539 end;
540 540
541 function mysql_authentication_dialog_ask( 541 function mysql_authentication_dialog_ask(
542 Handle: PMYSQL; 542 Handle: PMYSQL;
543 _type: Integer; 543 _type: Integer;
544 prompt: PAnsiChar; 544 prompt: PAnsiChar;
545 buf: PAnsiChar; 545 buf: PAnsiChar;
546 buf_len: Integer 546 buf_len: Integer
547 ): PAnsiChar; cdecl; 547 ): PAnsiChar; cdecl;
548 548
549 exports 549 exports
550 mysql_authentication_dialog_ask; 550 mysql_authentication_dialog_ask;
551 551
552 {$I const.inc} 552 {$I const.inc}
553 553
554 var 554 var
555 LibMysqlPath: String = 'libmysql.dll'; 555 LibMysqlPath: String = 'libmysql.dll';
556 LibMysqlHandle: HMODULE; // Shared module handle 556 LibMysqlHandle: HMODULE; // Shared module handle
557 557
558 mysql_affected_rows: function(Handle: PMYSQL): Int64; stdcall; 558 mysql_affected_rows: function(Handle: PMYSQL): Int64; stdcall;
559 mysql_character_set_name: function(Handle: PMYSQL): PAnsiChar; stdcall; 559 mysql_character_set_name: function(Handle: PMYSQL): PAnsiChar; stdcall;
560 mysql_close: procedure(Handle: PMYSQL); stdcall; 560 mysql_close: procedure(Handle: PMYSQL); stdcall;
561 mysql_data_seek: procedure(Result: PMYSQL_RES; Offset: Int64); stdcall; 561 mysql_data_seek: procedure(Result: PMYSQL_RES; Offset: Int64); stdcall;
562 mysql_errno: function(Handle: PMYSQL): Cardinal; stdcall; 562 mysql_errno: function(Handle: PMYSQL): Cardinal; stdcall;
563 mysql_error: function(Handle: PMYSQL): PAnsiChar; stdcall; 563 mysql_error: function(Handle: PMYSQL): PAnsiChar; stdcall;
564 mysql_fetch_field_direct: function(Result: PMYSQL_RES; FieldNo: Cardinal): PMYSQL_FIELD; stdcall; 564 mysql_fetch_field_direct: function(Result: PMYSQL_RES; FieldNo: Cardinal): PMYSQL_FIELD; stdcall;
565 mysql_fetch_lengths: function(Result: PMYSQL_RES): PLongInt; stdcall; 565 mysql_fetch_lengths: function(Result: PMYSQL_RES): PLongInt; stdcall;
566 mysql_fetch_row: function(Result: PMYSQL_RES): PMYSQL_ROW; stdcall; 566 mysql_fetch_row: function(Result: PMYSQL_RES): PMYSQL_ROW; stdcall;
567 mysql_free_result: procedure(Result: PMYSQL_RES); stdcall; 567 mysql_free_result: procedure(Result: PMYSQL_RES); stdcall;
568 mysql_get_client_info: function: PAnsiChar; stdcall; 568 mysql_get_client_info: function: PAnsiChar; stdcall;
569 mysql_get_server_info: function(Handle: PMYSQL): PAnsiChar; stdcall; 569 mysql_get_server_info: function(Handle: PMYSQL): PAnsiChar; stdcall;
570 mysql_init: function(Handle: PMYSQL): PMYSQL; stdcall; 570 mysql_init: function(Handle: PMYSQL): PMYSQL; stdcall;
571 mysql_num_fields: function(Result: PMYSQL_RES): Integer; stdcall; 571 mysql_num_fields: function(Result: PMYSQL_RES): Integer; stdcall;
572 mysql_num_rows: function(Result: PMYSQL_RES): Int64; stdcall; 572 mysql_num_rows: function(Result: PMYSQL_RES): Int64; stdcall;
573 mysql_options: function(Handle: PMYSQL; Option: TMySQLOption; arg: PAnsiChar): Integer; stdcall; 573 mysql_options: function(Handle: PMYSQL; Option: TMySQLOption; arg: PAnsiChar): Integer; stdcall;
574 mysql_ping: function(Handle: PMYSQL): Integer; stdcall; 574 mysql_ping: function(Handle: PMYSQL): Integer; stdcall;
575 mysql_real_connect: function(Handle: PMYSQL; const Host, User, Passwd, Db: PAnsiChar; Port: Cardinal; const UnixSocket: PAnsiChar; ClientFlag: Cardinal): PMYSQL; stdcall; 575 mysql_real_connect: function(Handle: PMYSQL; const Host, User, Passwd, Db: PAnsiChar; Port: Cardinal; const UnixSocket: PAnsiChar; ClientFlag: Cardinal): PMYSQL; stdcall;
576 mysql_real_query: function(Handle: PMYSQL; const Query: PAnsiChar; Length: Cardinal): Integer; stdcall; 576 mysql_real_query: function(Handle: PMYSQL; const Query: PAnsiChar; Length: Cardinal): Integer; stdcall;
577 mysql_ssl_set: function(Handle: PMYSQL; const key, cert, CA, CApath, cipher: PAnsiChar): Byte; stdcall; 577 mysql_ssl_set: function(Handle: PMYSQL; const key, cert, CA, CApath, cipher: PAnsiChar): Byte; stdcall;
578 mysql_stat: function(Handle: PMYSQL): PAnsiChar; stdcall; 578 mysql_stat: function(Handle: PMYSQL): PAnsiChar; stdcall;
579 mysql_store_result: function(Handle: PMYSQL): PMYSQL_RES; stdcall; 579 mysql_store_result: function(Handle: PMYSQL): PMYSQL_RES; stdcall;
580 mysql_thread_id: function(Handle: PMYSQL): Cardinal; stdcall; 580 mysql_thread_id: function(Handle: PMYSQL): Cardinal; stdcall;
581 mysql_next_result: function(Handle: PMYSQL): Integer; stdcall; 581 mysql_next_result: function(Handle: PMYSQL): Integer; stdcall;
582 mysql_set_character_set: function(Handle: PMYSQL; csname: PAnsiChar): Integer; stdcall; 582 mysql_set_character_set: function(Handle: PMYSQL; csname: PAnsiChar): Integer; stdcall;
583 mysql_thread_init: function: Byte; stdcall; 583 mysql_thread_init: function: Byte; stdcall;
584 mysql_thread_end: procedure; stdcall; 584 mysql_thread_end: procedure; stdcall;
585 mysql_warning_count: function(Handle: PMYSQL): Cardinal; stdcall; 585 mysql_warning_count: function(Handle: PMYSQL): Cardinal; stdcall;
586 586
587 implementation 587 implementation
588 588
589 uses helpers, loginform; 589 uses helpers, loginform;
590 590
591 591
592 592
593 { TConnectionParameters } 593 { TConnectionParameters }
594 594
595 constructor TConnectionParameters.Create; 595 constructor TConnectionParameters.Create;
596 begin 596 begin
597 FNetType := ntMySQL_TCPIP; 597 FNetType := ntMySQL_TCPIP;
598 FHostname := DEFAULT_HOST; 598 FHostname := DEFAULT_HOST;
599 FUsername := DEFAULT_USER; 599 FUsername := DEFAULT_USER;
600 FPassword := ''; 600 FPassword := '';
601 FPort := DEFAULT_PORT; 601 FPort := DEFAULT_PORT;
602 FSSHPlinkExe := GetRegValue(REGNAME_PLINKEXE, ''); 602 FSSHPlinkExe := GetRegValue(REGNAME_PLINKEXE, '');
603 FSSHPort := DEFAULT_SSHPORT; 603 FSSHPort := DEFAULT_SSHPORT;
604 FSSHTimeout := DEFAULT_SSHTIMEOUT; 604 FSSHTimeout := DEFAULT_SSHTIMEOUT;
605 FSSHLocalPort := FPort + 1; 605 FSSHLocalPort := FPort + 1;
606 FSSLPrivateKey := ''; 606 FSSLPrivateKey := '';
607 FSSLCertificate := ''; 607 FSSLCertificate := '';
608 FSSLCACertificate := ''; 608 FSSLCACertificate := '';
609 FStartupScriptFilename := ''; 609 FStartupScriptFilename := '';
610 FSessionColor := DEFAULT_TREEBACKGROUND;
610 end; 611 end;
611 612
612 613
613 function TConnectionParameters.CreateConnection(AOwner: TComponent): TDBConnection; 614 function TConnectionParameters.CreateConnection(AOwner: TComponent): TDBConnection;
614 begin 615 begin
615 case NetTypeGroup of 616 case NetTypeGroup of
616 ngMySQL: 617 ngMySQL:
617 Result := TMySQLConnection.Create(AOwner); 618 Result := TMySQLConnection.Create(AOwner);
618 ngMSSQL: 619 ngMSSQL:
619 Result := TAdoDBConnection.Create(AOwner); 620 Result := TAdoDBConnection.Create(AOwner);
620 else 621 else
621 raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]); 622 raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]);
622 end; 623 end;
623 Result.Parameters := Self; 624 Result.Parameters := Self;
624 end; 625 end;
625 626
626 627
627 function TConnectionParameters.CreateQuery(AOwner: TComponent): TDBQuery; 628 function TConnectionParameters.CreateQuery(AOwner: TComponent): TDBQuery;
628 begin 629 begin
629 case NetTypeGroup of 630 case NetTypeGroup of
630 ngMySQL: 631 ngMySQL:
631 Result := TMySQLQuery.Create(AOwner); 632 Result := TMySQLQuery.Create(AOwner);
632 ngMSSQL: 633 ngMSSQL:
633 Result := TAdoDBQuery.Create(AOwner); 634 Result := TAdoDBQuery.Create(AOwner);
634 else 635 else
635 raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]); 636 raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]);
636 end; 637 end;
637 end; 638 end;
638 639
639 640
640 function TConnectionParameters.NetTypeName(NetType: TNetType; LongFormat: Boolean): String; 641 function TConnectionParameters.NetTypeName(NetType: TNetType; LongFormat: Boolean): String;
641 var 642 var
642 My: String; 643 My: String;
643 begin 644 begin
644 if IsMariaDB then 645 if IsMariaDB then
645 My := 'MariaDB' 646 My := 'MariaDB'
646 else if IsPercona then 647 else if IsPercona then
647 My := 'Percona' 648 My := 'Percona'
648 else if IsTokudb then 649 else if IsTokudb then
649 My := 'TokuDB' 650 My := 'TokuDB'
650 else if IsInfiniDB then 651 else if IsInfiniDB then
651 My := 'InfiniDB' 652 My := 'InfiniDB'
652 else if IsInfobright then 653 else if IsInfobright then
653 My := 'Infobright' 654 My := 'Infobright'
654 else 655 else
655 My := 'MySQL'; 656 My := 'MySQL';
656 if LongFormat then case NetType of 657 if LongFormat then case NetType of
657 ntMySQL_TCPIP: 658 ntMySQL_TCPIP:
658 Result := My+' (TCP/IP)'; 659 Result := My+' (TCP/IP)';
659 ntMySQL_NamedPipe: 660 ntMySQL_NamedPipe:
660 Result := My+' (named pipe)'; 661 Result := My+' (named pipe)';
661 ntMySQL_SSHtunnel: 662 ntMySQL_SSHtunnel:
662 Result := My+' (SSH tunnel)'; 663 Result := My+' (SSH tunnel)';
663 ntMSSQL_NamedPipe: 664 ntMSSQL_NamedPipe:
664 Result := 'Microsoft SQL Server (named pipe, experimental)'; 665 Result := 'Microsoft SQL Server (named pipe, experimental)';
665 ntMSSQL_TCPIP: 666 ntMSSQL_TCPIP:
666 Result := 'Microsoft SQL Server (TCP/IP, experimental)'; 667 Result := 'Microsoft SQL Server (TCP/IP, experimental)';
667 ntMSSQL_SPX: 668 ntMSSQL_SPX:
668 Result := 'Microsoft SQL Server (SPX/IPX, experimental)'; 669 Result := 'Microsoft SQL Server (SPX/IPX, experimental)';
669 ntMSSQL_VINES: 670 ntMSSQL_VINES:
670 Result := 'Microsoft SQL Server (Banyan VINES, experimental)'; 671 Result := 'Microsoft SQL Server (Banyan VINES, experimental)';
671 ntMSSQL_RPC: 672 ntMSSQL_RPC:
672 Result := 'Microsoft SQL Server (Windows RPC, experimental)'; 673 Result := 'Microsoft SQL Server (Windows RPC, experimental)';
673 end else case NetType of 674 end else case NetType of
674 ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel: 675 ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel:
675 Result := My; 676 Result := My;
676 ntMSSQL_NamedPipe, ntMSSQL_TCPIP: 677 ntMSSQL_NamedPipe, ntMSSQL_TCPIP:
677 Result := 'MS SQL'; 678 Result := 'MS SQL';
678 end; 679 end;
679 end; 680 end;
680 681
681 682
682 function TConnectionParameters.GetNetTypeGroup: TNetTypeGroup; 683 function TConnectionParameters.GetNetTypeGroup: TNetTypeGroup;
683 begin 684 begin
684 case FNetType of 685 case FNetType of
685 ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel: 686 ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel:
686 Result := ngMySQL; 687 Result := ngMySQL;
687 ntMSSQL_NamedPipe, ntMSSQL_TCPIP, ntMSSQL_SPX, ntMSSQL_VINES, ntMSSQL_RPC: 688 ntMSSQL_NamedPipe, ntMSSQL_TCPIP, ntMSSQL_SPX, ntMSSQL_VINES, ntMSSQL_RPC:
688 Result := ngMSSQL; 689 Result := ngMSSQL;
689 else 690 else
690 raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]); 691 raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]);
691 end; 692 end;
692 end; 693 end;
693 694
694 695
695 function TConnectionParameters.IsMariaDB: Boolean; 696 function TConnectionParameters.IsMariaDB: Boolean;
696 begin 697 begin
697 Result := Pos('-mariadb', LowerCase(ServerVersion)) > 0; 698 Result := Pos('-mariadb', LowerCase(ServerVersion)) > 0;
698 end; 699 end;
699 700
700 701
701 function TConnectionParameters.IsPercona: Boolean; 702 function TConnectionParameters.IsPercona: Boolean;
702 begin 703 begin
703 Result := Pos('percona server', LowerCase(ServerVersion)) > 0; 704 Result := Pos('percona server', LowerCase(ServerVersion)) > 0;
704 end; 705 end;
705 706
706 707
707 function TConnectionParameters.IsTokudb: Boolean; 708 function TConnectionParameters.IsTokudb: Boolean;
708 begin 709 begin
709 Result := Pos('tokudb', LowerCase(ServerVersion)) > 0; 710 Result := Pos('tokudb', LowerCase(ServerVersion)) > 0;
710 end; 711 end;
711 712
712 713
713 function TConnectionParameters.IsInfiniDB: Boolean; 714 function TConnectionParameters.IsInfiniDB: Boolean;
714 begin 715 begin
715 Result := Pos('infinidb', LowerCase(ServerVersion)) > 0; 716 Result := Pos('infinidb', LowerCase(ServerVersion)) > 0;
716 end; 717 end;
717 718
718 719
719 function TConnectionParameters.IsInfobright: Boolean; 720 function TConnectionParameters.IsInfobright: Boolean;
720 begin 721 begin
721 Result := Pos('infobright', LowerCase(ServerVersion)) > 0; 722 Result := Pos('infobright', LowerCase(ServerVersion)) > 0;
722 end; 723 end;
723 724
724 725
725 function TConnectionParameters.GetImageIndex: Integer; 726 function TConnectionParameters.GetImageIndex: Integer;
726 begin 727 begin
727 case NetTypeGroup of 728 case NetTypeGroup of
728 ngMySQL: begin 729 ngMySQL: begin
729 Result := 164; 730 Result := 164;
730 if IsMariaDB then Result := 166 731 if IsMariaDB then Result := 166
731 else if IsPercona then Result := 169 732 else if IsPercona then Result := 169
732 else if IsTokudb then Result := 171 733 else if IsTokudb then Result := 171
733 else if IsInfiniDB then Result := 172 734 else if IsInfiniDB then Result := 172
734 else if IsInfobright then Result := 173; 735 else if IsInfobright then Result := 173;
735 end; 736 end;
736 ngMSSQL: Result := 123; 737 ngMSSQL: Result := 123;
737 else Result := ICONINDEX_SERVER; 738 else Result := ICONINDEX_SERVER;
738 end; 739 end;
739 end; 740 end;
740 741
741 742
742 class function TConnectionParameters.ReadFromRegistry(Session: String): TConnectionParameters; 743 class function TConnectionParameters.ReadFromRegistry(Session: String): TConnectionParameters;
743 begin 744 begin
744 if not Mainreg.KeyExists(REGPATH + REGKEY_SESSIONS + Session) then 745 if not Mainreg.KeyExists(REGPATH + REGKEY_SESSIONS + Session) then
745 raise Exception.Create('Error: Session "'+Session+'" not found in registry.') 746 raise Exception.Create('Error: Session "'+Session+'" not found in registry.')
746 else begin 747 else begin
747 Result := TConnectionParameters.Create; 748 Result := TConnectionParameters.Create;
748 Result.SessionName := Session; 749 Result.SessionName := Session;
749 Result.SessionColor := GetRegValue(REGNAME_TREEBACKGROUND, clWindow, Session); 750 Result.SessionColor := GetRegValue(REGNAME_TREEBACKGROUND, DEFAULT_TREEBACKGROUND, Session);
750 Result.NetType := TNetType(GetRegValue(REGNAME_NETTYPE, Integer(ntMySQL_TCPIP), Session)); 751 Result.NetType := TNetType(GetRegValue(REGNAME_NETTYPE, Integer(ntMySQL_TCPIP), Session));
751 Result.Hostname := GetRegValue(REGNAME_HOST, '', Session); 752 Result.Hostname := GetRegValue(REGNAME_HOST, '', Session);
752 Result.Username := GetRegValue(REGNAME_USER, '', Session); 753 Result.Username := GetRegValue(REGNAME_USER, '', Session);
753 Result.Password := decrypt(GetRegValue(REGNAME_PASSWORD, '', Session)); 754 Result.Password := decrypt(GetRegValue(REGNAME_PASSWORD, '', Session));
754 Result.LoginPrompt := GetRegValue(REGNAME_LOGINPROMPT, False, Session); 755 Result.LoginPrompt := GetRegValue(REGNAME_LOGINPROMPT, False, Session);
755 Result.WindowsAuth := GetRegValue(REGNAME_WINDOWSAUTH, False, Session); 756 Result.WindowsAuth := GetRegValue(REGNAME_WINDOWSAUTH, False, Session);
756 Result.Port := StrToIntDef(GetRegValue(REGNAME_PORT, '', Session), DEFAULT_PORT); 757 Result.Port := StrToIntDef(GetRegValue(REGNAME_PORT, '', Session), DEFAULT_PORT);
757 Result.AllDatabasesStr := GetRegValue(REGNAME_DATABASES, '', Session); 758 Result.AllDatabasesStr := GetRegValue(REGNAME_DATABASES, '', Session);
758 Result.SSHHost := GetRegValue(REGNAME_SSHHOST, '', Session); 759 Result.SSHHost := GetRegValue(REGNAME_SSHHOST, '', Session);
759 Result.SSHPort := GetRegValue(REGNAME_SSHPORT, DEFAULT_SSHPORT, Session); 760 Result.SSHPort := GetRegValue(REGNAME_SSHPORT, DEFAULT_SSHPORT, Session);
760 Result.SSHUser := GetRegValue(REGNAME_SSHUSER, '', Session); 761 Result.SSHUser := GetRegValue(REGNAME_SSHUSER, '', Session);
761 Result.SSHPassword := decrypt(GetRegValue(REGNAME_SSHPASSWORD, '', Session)); 762 Result.SSHPassword := decrypt(GetRegValue(REGNAME_SSHPASSWORD, '', Session));
762 Result.SSHTimeout := GetRegValue(REGNAME_SSHTIMEOUT, DEFAULT_SSHTIMEOUT, Session); 763 Result.SSHTimeout := GetRegValue(REGNAME_SSHTIMEOUT, DEFAULT_SSHTIMEOUT, Session);
763 Result.SSHPrivateKey := GetRegValue(REGNAME_SSHKEY, '', Session); 764 Result.SSHPrivateKey := GetRegValue(REGNAME_SSHKEY, '', Session);
764 Result.SSHLocalPort := GetRegValue(REGNAME_SSHLOCALPORT, 0, Session); 765 Result.SSHLocalPort := GetRegValue(REGNAME_SSHLOCALPORT, 0, Session);
765 Result.SSHPlinkExe := GetRegValue(REGNAME_PLINKEXE, ''); 766 Result.SSHPlinkExe := GetRegValue(REGNAME_PLINKEXE, '');
766 Result.SSLPrivateKey := GetRegValue(REGNAME_SSL_KEY, '', Session); 767 Result.SSLPrivateKey := GetRegValue(REGNAME_SSL_KEY, '', Session);
767 // Auto-activate SSL for sessions created before UseSSL was introduced: 768 // Auto-activate SSL for sessions created before UseSSL was introduced:
768 Result.WantSSL := GetRegValue(REGNAME_SSL_ACTIVE, Result.SSLPrivateKey<>'', Session); 769 Result.WantSSL := GetRegValue(REGNAME_SSL_ACTIVE, Result.SSLPrivateKey<>'', Session);
769 Result.SSLCertificate := GetRegValue(REGNAME_SSL_CERT, '', Session); 770 Result.SSLCertificate := GetRegValue(REGNAME_SSL_CERT, '', Session);
770 Result.SSLCACertificate := GetRegValue(REGNAME_SSL_CA, '', Session); 771 Result.SSLCACertificate := GetRegValue(REGNAME_SSL_CA, '', Session);
771 Result.StartupScriptFilename := GetRegValue(REGNAME_STARTUPSCRIPT, '', Session); 772 Result.StartupScriptFilename := GetRegValue(REGNAME_STARTUPSCRIPT, '', Session);
772 Result.Compressed := GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, Session); 773 Result.Compressed := GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, Session);
773 Result.ServerVersion := GetRegValue(REGNAME_SERVERVERSION_FULL, '', Session); 774 Result.ServerVersion := GetRegValue(REGNAME_SERVERVERSION_FULL, '', Session);
774 end; 775 end;
775 end; 776 end;
776 777
777 778
778 779
779 { TMySQLConnection } 780 { TMySQLConnection }
780 781
781 constructor TDBConnection.Create(AOwner: TComponent); 782 constructor TDBConnection.Create(AOwner: TComponent);
782 begin 783 begin
783 inherited; 784 inherited;
784 FParameters := TConnectionParameters.Create; 785 FParameters := TConnectionParameters.Create;
785 FRowsFound := 0; 786 FRowsFound := 0;
786 FRowsAffected := 0; 787 FRowsAffected := 0;
787 FWarningCount := 0; 788 FWarningCount := 0;
788 FConnectionStarted := 0; 789 FConnectionStarted := 0;
789 FLastQueryDuration := 0; 790 FLastQueryDuration := 0;
790 FLastQueryNetworkDuration := 0; 791 FLastQueryNetworkDuration := 0;
791 FThreadID := 0; 792 FThreadID := 0;
792 FLogPrefix := ''; 793 FLogPrefix := '';
793 FIsUnicode := False; 794 FIsUnicode := False;
794 FIsSSL := False; 795 FIsSSL := False;
795 FDatabases := TDatabaseList.Create(True); 796 FDatabases := TDatabaseList.Create(True);
796 FLoginPromptDone := False; 797 FLoginPromptDone := False;
797 FCurrentUserHostCombination := ''; 798 FCurrentUserHostCombination := '';
798 end; 799 end;
799 800
800 801
801 constructor TMySQLConnection.Create(AOwner: TComponent); 802 constructor TMySQLConnection.Create(AOwner: TComponent);
802 var 803 var
803 i: Integer; 804 i: Integer;
804 begin 805 begin
805 inherited; 806 inherited;
806 FQuoteChar := '`'; 807 FQuoteChar := '`';
807 // The compiler complains that dynamic and static arrays are incompatible, so this does not work: 808 // The compiler complains that dynamic and static arrays are incompatible, so this does not work:
808 // FDatatypes := MySQLDatatypes 809 // FDatatypes := MySQLDatatypes
809 SetLength(FDatatypes, Length(MySQLDatatypes)); 810 SetLength(FDatatypes, Length(MySQLDatatypes));
810 for i:=0 to High(MySQLDatatypes) do 811 for i:=0 to High(MySQLDatatypes) do
811 FDatatypes[i] := MySQLDatatypes[i]; 812 FDatatypes[i] := MySQLDatatypes[i];
812 end; 813 end;
813 814
814 815
815 constructor TAdoDBConnection.Create(AOwner: TComponent); 816 constructor TAdoDBConnection.Create(AOwner: TComponent);
816 var 817 var
817 i: Integer; 818 i: Integer;
818 begin 819 begin
819 inherited; 820 inherited;
820 FQuoteChar := '"'; 821 FQuoteChar := '"';
821 SetLength(FDatatypes, Length(MSSQLDatatypes)); 822 SetLength(FDatatypes, Length(MSSQLDatatypes));
822 for i:=0 to High(MSSQLDatatypes) do 823 for i:=0 to High(MSSQLDatatypes) do
823 FDatatypes[i] := MSSQLDatatypes[i]; 824 FDatatypes[i] := MSSQLDatatypes[i];
824 end; 825 end;
825 826
826 827
827 destructor TDBConnection.Destroy; 828 destructor TDBConnection.Destroy;
828 begin 829 begin
829 if Active then Active := False; 830 if Active then Active := False;
830 FOnDBObjectsCleared := nil; 831 FOnDBObjectsCleared := nil;
831 ClearCache(True); 832 ClearCache(True);
832 inherited; 833 inherited;
833 end; 834 end;
834 835
835 836
836 destructor TAdoDBConnection.Destroy; 837 destructor TAdoDBConnection.Destroy;
837 begin 838 begin
838 if Active then Active := False; 839 if Active then Active := False;
839 FreeAndNil(FAdoHandle); 840 FreeAndNil(FAdoHandle);
840 inherited; 841 inherited;
841 end; 842 end;
842 843
843 844
844 function TDBConnection.GetDatatypeByName(Datatype: String): TDBDatatype; 845 function TDBConnection.GetDatatypeByName(Datatype: String): TDBDatatype;
845 var 846 var
846 i: Integer; 847 i: Integer;
847 begin 848 begin
848 for i:=0 to High(FDatatypes) do begin 849 for i:=0 to High(FDatatypes) do begin
849 if AnsiCompareText(FDatatypes[i].Name, Datatype) = 0 then begin 850 if AnsiCompareText(FDatatypes[i].Name, Datatype) = 0 then begin
850 Result := FDatatypes[i]; 851 Result := FDatatypes[i];
851 break; 852 break;
852 end; 853 end;
853 end; 854 end;
854 end; 855 end;
855 856
856 857
857 procedure TMySQLConnection.AssignProc(var Proc: FARPROC; Name: PAnsiChar); 858 procedure TMySQLConnection.AssignProc(var Proc: FARPROC; Name: PAnsiChar);
858 var 859 var
859 ClientVersion: String; 860 ClientVersion: String;
860 begin 861 begin
861 // Map library procedure to internal procedure 862 // Map library procedure to internal procedure
862 Log(lcDebug, 'Assign procedure "'+Name+'"'); 863 Log(lcDebug, 'Assign procedure "'+Name+'"');
863 Proc := GetProcAddress(LibMysqlHandle, Name); 864 Proc := GetProcAddress(LibMysqlHandle, Name);
864 if Proc = nil then begin 865 if Proc = nil then begin
865 if @mysql_get_client_info = nil then 866 if @mysql_get_client_info = nil then
866 mysql_get_client_info := GetProcAddress(LibMysqlHandle, 'mysql_get_client_info'); 867 mysql_get_client_info := GetProcAddress(LibMysqlHandle, 'mysql_get_client_info');
867 ClientVersion := ''; 868 ClientVersion := '';
868 if @mysql_get_client_info <> nil then 869 if @mysql_get_client_info <> nil then
869 ClientVersion := ' ('+DecodeApiString(mysql_get_client_info)+')'; 870 ClientVersion := ' ('+DecodeApiString(mysql_get_client_info)+')';
870 LibMysqlHandle := 0; 871 LibMysqlHandle := 0;
871 raise EDatabaseError.Create('Your '+LibMysqlPath+ClientVersion+' is out-dated or somehow incompatible to '+APPNAME+'. Please use the one from the installer, or just reinstall '+APPNAME+'.'); 872 raise EDatabaseError.Create('Your '+LibMysqlPath+ClientVersion+' is out-dated or somehow incompatible to '+APPNAME+'. Please use the one from the installer, or just reinstall '+APPNAME+'.');
872 end; 873 end;
873 end; 874 end;
874 875
875 876
876 procedure TDBConnection.SetLockedByThread(Value: TThread); 877 procedure TDBConnection.SetLockedByThread(Value: TThread);
877 begin 878 begin
878 FLockedByThread := Value; 879 FLockedByThread := Value;
879 end; 880 end;
880 881
881 882
882 procedure TMySQLConnection.SetLockedByThread(Value: TThread); 883 procedure TMySQLConnection.SetLockedByThread(Value: TThread);
883 begin 884 begin
884 if Value <> FLockedByThread then begin 885 if Value <> FLockedByThread then begin
885 if Value <> nil then begin 886 if Value <> nil then begin
886 // We're running in a thread already. Ensure that Log() is able to detect that. 887 // We're running in a thread already. Ensure that Log() is able to detect that.
887 FLockedByThread := Value; 888 FLockedByThread := Value;
888 Log(lcDebug, 'mysql_thread_init, thread id #'+IntToStr(Value.ThreadID)); 889 Log(lcDebug, 'mysql_thread_init, thread id #'+IntToStr(Value.ThreadID));
889 mysql_thread_init; 890 mysql_thread_init;
890 end else begin 891 end else begin
891 mysql_thread_end; 892 mysql_thread_end;
892 Log(lcDebug, 'mysql_thread_end, thread id #'+IntToStr(FLockedByThread.ThreadID)); 893 Log(lcDebug, 'mysql_thread_end, thread id #'+IntToStr(FLockedByThread.ThreadID));
893 FLockedByThread := Value; 894 FLockedByThread := Value;
894 end; 895 end;
895 end; 896 end;
896 end; 897 end;
897 898
898 899
899 {** 900 {**
900 (Dis-)Connect to/from server 901 (Dis-)Connect to/from server
901 } 902 }
902 procedure TMySQLConnection.SetActive( Value: Boolean ); 903 procedure TMySQLConnection.SetActive( Value: Boolean );
903 var 904 var
904 Connected: PMYSQL; 905 Connected: PMYSQL;
905 ClientFlags, FinalPort: Integer; 906 ClientFlags, FinalPort: Integer;
906 Error, tmpdb, FinalHost, FinalSocket, PlinkCmd, StatusName: String; 907 Error, tmpdb, FinalHost, FinalSocket, PlinkCmd, StatusName: String;
907 CurCharset: String; 908 CurCharset: String;
908 StartupInfo: TStartupInfo; 909 StartupInfo: TStartupInfo;
909 ExitCode: LongWord; 910 ExitCode: LongWord;
910 sslca, sslkey, sslcert: PAnsiChar; 911 sslca, sslkey, sslcert: PAnsiChar;
911 PluginDir: AnsiString; 912 PluginDir: AnsiString;
912 Vars, Status: TDBQuery; 913 Vars, Status: TDBQuery;
913 begin 914 begin
914 if Value and (FHandle = nil) then begin 915 if Value and (FHandle = nil) then begin
915 DoBeforeConnect; 916 DoBeforeConnect;
916 917
917 // Get handle 918 // Get handle
918 FHandle := mysql_init(nil); 919 FHandle := mysql_init(nil);
919 920
920 // Prepare special stuff for SSL and SSH tunnel 921 // Prepare special stuff for SSL and SSH tunnel
921 FinalHost := FParameters.Hostname; 922 FinalHost := FParameters.Hostname;
922 FinalSocket := ''; 923 FinalSocket := '';
923 FinalPort := FParameters.Port; 924 FinalPort := FParameters.Port;
924 case FParameters.NetType of 925 case FParameters.NetType of
925 ntMySQL_TCPIP: begin 926 ntMySQL_TCPIP: begin
926 if FParameters.WantSSL then begin 927 if FParameters.WantSSL then begin
927 // mysql_ssl_set() wants nil, while PAnsiChar(AnsiString()) is never nil 928 // mysql_ssl_set() wants nil, while PAnsiChar(AnsiString()) is never nil
928 sslkey := nil; 929 sslkey := nil;
929 sslcert := nil; 930 sslcert := nil;
930 sslca := nil; 931 sslca := nil;
931 if FParameters.SSLPrivateKey <> '' then 932 if FParameters.SSLPrivateKey <> '' then
932 sslkey := PAnsiChar(AnsiString(FParameters.SSLPrivateKey)); 933 sslkey := PAnsiChar(AnsiString(FParameters.SSLPrivateKey));
933 if FParameters.SSLCertificate <> '' then 934 if FParameters.SSLCertificate <> '' then
934 sslcert := PAnsiChar(AnsiString(FParameters.SSLCertificate)); 935 sslcert := PAnsiChar(AnsiString(FParameters.SSLCertificate));
935 if FParameters.SSLCACertificate <> '' then 936 if FParameters.SSLCACertificate <> '' then
936 sslca := PAnsiChar(AnsiString(FParameters.SSLCACertificate)); 937 sslca := PAnsiChar(AnsiString(FParameters.SSLCACertificate));
937 { TODO : Use Cipher and CAPath parameters } 938 { TODO : Use Cipher and CAPath parameters }
938 mysql_ssl_set(FHandle, 939 mysql_ssl_set(FHandle,
939 sslkey, 940 sslkey,
940 sslcert, 941 sslcert,
941 sslca, 942 sslca,
942 nil, 943 nil,
943 nil); 944 nil);
944 Log(lcInfo, 'SSL parameters successfully set.'); 945 Log(lcInfo, 'SSL parameters successfully set.');
945 end; 946 end;
946 end; 947 end;
947 948
948 ntMySQL_NamedPipe: begin 949 ntMySQL_NamedPipe: begin
949 FinalHost := '.'; 950 FinalHost := '.';
950 FinalSocket := FParameters.Hostname; 951 FinalSocket := FParameters.Hostname;
951 end; 952 end;
952 953
953 ntMySQL_SSHtunnel: begin 954 ntMySQL_SSHtunnel: begin
954 // Build plink.exe command line 955 // Build plink.exe command line
955 // plink bob@domain.com -pw myPassw0rd1 -P 22 -i "keyfile.pem" -L 55555:localhost:3306 956 // plink bob@domain.com -pw myPassw0rd1 -P 22 -i "keyfile.pem" -L 55555:localhost:3306
956 PlinkCmd := FParameters.SSHPlinkExe + ' -ssh '; 957 PlinkCmd := FParameters.SSHPlinkExe + ' -ssh ';
957 if FParameters.SSHUser <> '' then 958 if FParameters.SSHUser <> '' then
958 PlinkCmd := PlinkCmd + FParameters.SSHUser + '@'; 959 PlinkCmd := PlinkCmd + FParameters.SSHUser + '@';
959 if FParameters.SSHHost <> '' then 960 if FParameters.SSHHost <> '' then
960 PlinkCmd := PlinkCmd + FParameters.SSHHost 961 PlinkCmd := PlinkCmd + FParameters.SSHHost
961 else 962 else
962 PlinkCmd := PlinkCmd + FParameters.Hostname; 963 PlinkCmd := PlinkCmd + FParameters.Hostname;
963 if FParameters.SSHPassword <> '' then 964 if FParameters.SSHPassword <> '' then
964 PlinkCmd := PlinkCmd + ' -pw "' + FParameters.SSHPassword + '"'; 965 PlinkCmd := PlinkCmd + ' -pw "' + FParameters.SSHPassword + '"';
965 if FParameters.SSHPort > 0 then 966 if FParameters.SSHPort > 0 then
966 PlinkCmd := PlinkCmd + ' -P ' + IntToStr(FParameters.SSHPort); 967 PlinkCmd := PlinkCmd + ' -P ' + IntToStr(FParameters.SSHPort);
967 if FParameters.SSHPrivateKey <> '' then 968 if FParameters.SSHPrivateKey <> '' then
968 PlinkCmd := PlinkCmd + ' -i "' + FParameters.SSHPrivateKey + '"'; 969 PlinkCmd := PlinkCmd + ' -i "' + FParameters.SSHPrivateKey + '"';
969 PlinkCmd := PlinkCmd + ' -N -L ' + IntToStr(FParameters.SSHLocalPort) + ':' + FParameters.Hostname + ':' + IntToStr(FParameters.Port); 970 PlinkCmd := PlinkCmd + ' -N -L ' + IntToStr(FParameters.SSHLocalPort) + ':' + FParameters.Hostname + ':' + IntToStr(FParameters.Port);
970 Log(lcInfo, 'Attempt to create plink.exe process, waiting '+FormatNumber(FParameters.SSHTimeout)+'s for response ...'); 971 Log(lcInfo, 'Attempt to create plink.exe process, waiting '+FormatNumber(FParameters.SSHTimeout)+'s for response ...');
971 // Create plink.exe process 972 // Create plink.exe process
972 FillChar(FPlinkProcInfo, SizeOf(TProcessInformation), 0); 973 FillChar(FPlinkProcInfo, SizeOf(TProcessInformation), 0);
973 FillChar(StartupInfo, SizeOf(TStartupInfo), 0); 974 FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
974 StartupInfo.cb := SizeOf(TStartupInfo); 975 StartupInfo.cb := SizeOf(TStartupInfo);
975 if CreateProcess(nil, PChar(PlinkCmd), nil, nil, false, 976 if CreateProcess(nil, PChar(PlinkCmd), nil, nil, false,
976 CREATE_DEFAULT_ERROR_MODE + NORMAL_PRIORITY_CLASS + CREATE_NO_WINDOW, 977 CREATE_DEFAULT_ERROR_MODE + NORMAL_PRIORITY_CLASS + CREATE_NO_WINDOW,
977 nil, nil, StartupInfo, FPlinkProcInfo) then begin 978 nil, nil, StartupInfo, FPlinkProcInfo) then begin
978 WaitForSingleObject(FPlinkProcInfo.hProcess, FParameters.SSHTimeout*1000); 979 WaitForSingleObject(FPlinkProcInfo.hProcess, FParameters.SSHTimeout*1000);
979 GetExitCodeProcess(FPlinkProcInfo.hProcess, ExitCode); 980 GetExitCodeProcess(FPlinkProcInfo.hProcess, ExitCode);
980 if ExitCode <> STILL_ACTIVE then 981 if ExitCode <> STILL_ACTIVE then
981 raise EDatabaseError.Create('PLink exited unexpected. Command line was:'+CRLF+PlinkCmd); 982 raise EDatabaseError.Create('PLink exited unexpected. Command line was:'+CRLF+PlinkCmd);
982 end else begin 983 end else begin
983 ClosePlink; 984 ClosePlink;
984 raise EDatabaseError.Create('Couldn''t execute PLink: '+CRLF+PlinkCmd); 985 raise EDatabaseError.Create('Couldn''t execute PLink: '+CRLF+PlinkCmd);
985 end; 986 end;
986 FinalHost := 'localhost'; 987 FinalHost := 'localhost';
987 FinalPort := FParameters.SSHLocalPort; 988 FinalPort := FParameters.SSHLocalPort;
988 end; 989 end;
989 end; 990 end;
990 991
991 // Gather client options 992 // Gather client options
992 ClientFlags := CLIENT_LOCAL_FILES or CLIENT_INTERACTIVE or CLIENT_PROTOCOL_41 or CLIENT_MULTI_STATEMENTS; 993 ClientFlags := CLIENT_LOCAL_FILES or CLIENT_INTERACTIVE or CLIENT_PROTOCOL_41 or CLIENT_MULTI_STATEMENTS;
993 if Parameters.Compressed then 994 if Parameters.Compressed then
994 ClientFlags := ClientFlags or CLIENT_COMPRESS; 995 ClientFlags := ClientFlags or CLIENT_COMPRESS;
995 if Parameters.WantSSL then 996 if Parameters.WantSSL then
996 ClientFlags := ClientFlags or CLIENT_SSL; 997 ClientFlags := ClientFlags or CLIENT_SSL;
997 998
998 // Point libmysql to the folder with client plugins 999 // Point libmysql to the folder with client plugins
999 PluginDir := AnsiString(ExtractFilePath(ParamStr(0))+'plugins\'); 1000 PluginDir := AnsiString(ExtractFilePath(ParamStr(0))+'plugins\');
1000 mysql_options(FHandle, MYSQL_PLUGIN_DIR, PAnsiChar(PluginDir)); 1001 mysql_options(FHandle, MYSQL_PLUGIN_DIR, PAnsiChar(PluginDir));
1001 1002
1002 Connected := mysql_real_connect( 1003 Connected := mysql_real_connect(
1003 FHandle, 1004 FHandle,
1004 PAnsiChar(Utf8Encode(FinalHost)), 1005 PAnsiChar(Utf8Encode(FinalHost)),
1005 PAnsiChar(Utf8Encode(FParameters.Username)), 1006 PAnsiChar(Utf8Encode(FParameters.Username)),
1006 PAnsiChar(Utf8Encode(FParameters.Password)), 1007 PAnsiChar(Utf8Encode(FParameters.Password)),
1007 nil, 1008 nil,
1008 FinalPort, 1009 FinalPort,
1009 PAnsiChar(Utf8Encode(FinalSocket)), 1010 PAnsiChar(Utf8Encode(FinalSocket)),
1010 ClientFlags 1011 ClientFlags
1011 ); 1012 );
1012 if Connected = nil then begin 1013 if Connected = nil then begin
1013 Error := LastError; 1014 Error := LastError;
1014 Log(lcError, Error); 1015 Log(lcError, Error);
1015 FConnectionStarted := 0; 1016 FConnectionStarted := 0;
1016 FHandle := nil; 1017 FHandle := nil;
1017 ClosePlink; 1018 ClosePlink;
1018 raise EDatabaseError.Create(Error); 1019 raise EDatabaseError.Create(Error);
1019 end else begin 1020 end else begin
1020 FActive := True; 1021 FActive := True;
1021 Log(lcInfo, 'Connected. Thread-ID: '+IntToStr(ThreadId)); 1022 Log(lcInfo, 'Connected. Thread-ID: '+IntToStr(ThreadId));
1022 CharacterSet := 'utf8'; 1023 CharacterSet := 'utf8';
1023 CurCharset := CharacterSet; 1024 CurCharset := CharacterSet;
1024 Log(lcDebug, 'Characterset: '+CurCharset); 1025 Log(lcDebug, 'Characterset: '+CurCharset);
1025 FIsUnicode := CurCharset = 'utf8'; 1026 FIsUnicode := CurCharset = 'utf8';
1026 FConnectionStarted := GetTickCount div 1000; 1027 FConnectionStarted := GetTickCount div 1000;
1027 FServerUptime := -1; 1028 FServerUptime := -1;
1028 Status := GetResults('SHOW STATUS'); 1029 Status := GetResults('SHOW STATUS');
1029 while not Status.Eof do begin 1030 while not Status.Eof do begin
1030 StatusName := LowerCase(Status.Col(0)); 1031 StatusName := LowerCase(Status.Col(0));
1031 if StatusName = 'uptime' then 1032 if StatusName = 'uptime' then
1032 FServerUptime := StrToIntDef(Status.Col(1), FServerUptime) 1033 FServerUptime := StrToIntDef(Status.Col(1), FServerUptime)
1033 else if StatusName = 'ssl_cipher' then 1034 else if StatusName = 'ssl_cipher' then
1034 FIsSSL := Status.Col(1) <> ''; 1035 FIsSSL := Status.Col(1) <> '';
1035 Status.Next; 1036 Status.Next;
1036 end; 1037 end;
1037 FServerVersionUntouched := DecodeAPIString(mysql_get_server_info(FHandle)); 1038 FServerVersionUntouched := DecodeAPIString(mysql_get_server_info(FHandle));
1038 Vars := GetServerVariables; 1039 Vars := GetServerVariables;
1039 while not Vars.Eof do begin 1040 while not Vars.Eof do begin
1040 if Vars.Col(0) = 'version_compile_os' then 1041 if Vars.Col(0) = 'version_compile_os' then
1041 FServerOS := Vars.Col(1); 1042 FServerOS := Vars.Col(1);
1042 if Vars.Col(0) = 'hostname' then 1043 if Vars.Col(0) = 'hostname' then
1043 FRealHostname := Vars.Col(1); 1044 FRealHostname := Vars.Col(1);
1044 if (Vars.Col(0) = 'version_comment') and (Vars.Col(1) <> '') then 1045 if (Vars.Col(0) = 'version_comment') and (Vars.Col(1) <> '') then
1045 FServerVersionUntouched := FServerVersionUntouched + ' - ' + Vars.Col(1); 1046 FServerVersionUntouched := FServerVersionUntouched + ' - ' + Vars.Col(1);
1046 Vars.Next; 1047 Vars.Next;
1047 end; 1048 end;
1048 if FDatabase <> '' then begin 1049 if FDatabase <> '' then begin
1049 tmpdb := FDatabase; 1050 tmpdb := FDatabase;
1050 FDatabase := ''; 1051 FDatabase := '';
1051 try 1052 try
1052 Database := tmpdb; 1053 Database := tmpdb;
1053 except 1054 except
1054 // Trigger OnDatabaseChange event for <no db> if wanted db is not available 1055 // Trigger OnDatabaseChange event for <no db> if wanted db is not available
1055 FDatabase := tmpdb; 1056 FDatabase := tmpdb;
1056 Database := ''; 1057 Database := '';
1057 end; 1058 end;
1058 end; 1059 end;
1059 DoAfterConnect; 1060 DoAfterConnect;
1060 end; 1061 end;
1061 end 1062 end
1062 1063
1063 else if (not Value) and (FHandle <> nil) then begin 1064 else if (not Value) and (FHandle <> nil) then begin
1064 mysql_close(FHandle); 1065 mysql_close(FHandle);
1065 FActive := False; 1066 FActive := False;
1066 ClearCache(False); 1067 ClearCache(False);
1067 FConnectionStarted := 0; 1068 FConnectionStarted := 0;
1068 FHandle := nil; 1069 FHandle := nil;
1069 ClosePlink; 1070 ClosePlink;
1070 Log(lcInfo, Format(MsgDisconnect, [FParameters.Hostname, DateTimeToStr(Now)])); 1071 Log(lcInfo, Format(MsgDisconnect, [FParameters.Hostname, DateTimeToStr(Now)]));
1071 end; 1072 end;
1072 1073
1073 end; 1074 end;
1074 1075
1075 1076
1076 procedure TAdoDBConnection.SetActive(Value: Boolean); 1077 procedure TAdoDBConnection.SetActive(Value: Boolean);
1077 var 1078 var
1078 tmpdb, Error, NetLib, DataSource: String; 1079 tmpdb, Error, NetLib, DataSource: String;
1079 rx: TRegExpr; 1080 rx: TRegExpr;
1080 i: Integer; 1081 i: Integer;
1081 begin 1082 begin
1082 if Value then begin 1083 if Value then begin
1083 DoBeforeConnect; 1084 DoBeforeConnect;
1084 try 1085 try
1085 // Creating the ADO object throws exceptions if MDAC is missing, especially on Wine 1086 // Creating the ADO object throws exceptions if MDAC is missing, especially on Wine
1086 FAdoHandle := TAdoConnection.Create(Owner); 1087 FAdoHandle := TAdoConnection.Create(Owner);
1087 except 1088 except
1088 on E:Exception do 1089 on E:Exception do
1089 raise EDatabaseError.Create(E.Message+CRLF+CRLF+ 1090 raise EDatabaseError.Create(E.Message+CRLF+CRLF+
1090 'On Wine, you can try to install MDAC:'+CRLF+ 1091 'On Wine, you can try to install MDAC:'+CRLF+
1091 '> wget http://winetricks.org/winetricks'+CRLF+ 1092 '> wget http://winetricks.org/winetricks'+CRLF+
1092 '> chmod +x winetricks'+CRLF+ 1093 '> chmod +x winetricks'+CRLF+
1093 '> sh winetricks mdac28'); 1094 '> sh winetricks mdac28');
1094 end; 1095 end;
1095 NetLib := ''; 1096 NetLib := '';
1096 case Parameters.NetType of 1097 case Parameters.NetType of
1097 ntMSSQL_NamedPipe: NetLib := 'DBNMPNTW'; 1098 ntMSSQL_NamedPipe: NetLib := 'DBNMPNTW';
1098 ntMSSQL_TCPIP: NetLib := 'DBMSSOCN'; 1099 ntMSSQL_TCPIP: NetLib := 'DBMSSOCN';
1099 ntMSSQL_SPX: NetLib := 'DBMSSPXN'; 1100 ntMSSQL_SPX: NetLib := 'DBMSSPXN';
1100 ntMSSQL_VINES: NetLib := 'DBMSVINN'; 1101 ntMSSQL_VINES: NetLib := 'DBMSVINN';
1101 ntMSSQL_RPC: NetLib := 'DBMSRPCN'; 1102 ntMSSQL_RPC: NetLib := 'DBMSRPCN';
1102 end; 1103 end;
1103 DataSource := Parameters.Hostname; 1104 DataSource := Parameters.Hostname;
1104 if (Parameters.NetType = ntMSSQL_TCPIP) and (Parameters.Port <> 0) then 1105 if (Parameters.NetType = ntMSSQL_TCPIP) and (Parameters.Port <> 0) then
1105 DataSource := DataSource + ','+IntToStr(Parameters.Port); 1106 DataSource := DataSource + ','+IntToStr(Parameters.Port);
1106 FAdoHandle.ConnectionString := 'Provider=SQLOLEDB;'+ 1107 FAdoHandle.ConnectionString := 'Provider=SQLOLEDB;'+
1107 'Password='+Parameters.Password+';'+ 1108 'Password='+Parameters.Password+';'+
1108 'Persist Security Info=True;'+ 1109 'Persist Security Info=True;'+
1109 'User ID='+Parameters.Username+';'+ 1110 'User ID='+Parameters.Username+';'+
1110 'Network Library='+NetLib+';'+ 1111 'Network Library='+NetLib+';'+
1111 'Data Source='+DataSource+';'+ 1112 'Data Source='+DataSource+';'+
1112 'Application Name='+AppName+';' 1113 'Application Name='+AppName+';'
1113 ; 1114 ;
1114 if Parameters.WindowsAuth then 1115 if Parameters.WindowsAuth then
1115 FAdoHandle.ConnectionString := FAdoHandle.ConnectionString + 'Integrated Security=SSPI;'; 1116 FAdoHandle.ConnectionString := FAdoHandle.ConnectionString + 'Integrated Security=SSPI;';
1116 try 1117 try
1117 FAdoHandle.Connected := True; 1118 FAdoHandle.Connected := True;
1118 FConnectionStarted := GetTickCount div 1000; 1119 FConnectionStarted := GetTickCount div 1000;
1119 FActive := True; 1120 FActive := True;
1120 Log(lcInfo, 'Connected. Thread-ID: '+IntToStr(ThreadId)); 1121 Log(lcInfo, 'Connected. Thread-ID: '+IntToStr(ThreadId));
1121 // No need to set a charset for MS SQL 1122 // No need to set a charset for MS SQL
1122 // CharacterSet := 'utf8'; 1123 // CharacterSet := 'utf8';
1123 // CurCharset := CharacterSet; 1124 // CurCharset := CharacterSet;
1124 // Log(lcDebug, 'Characterset: '+CurCharset); 1125 // Log(lcDebug, 'Characterset: '+CurCharset);
1125 FIsUnicode := True; 1126 FIsUnicode := True;
1126 FServerUptime := StrToIntDef(GetVar('SELECT DATEDIFF(SECOND, '+QuoteIdent('login_time')+', CURRENT_TIMESTAMP) FROM '+QuoteIdent('master')+'.'+QuoteIdent('dbo')+'.'+QuoteIdent('sysprocesses')+' WHERE '+QuoteIdent('spid')+'=1'), -1); 1127 FServerUptime := StrToIntDef(GetVar('SELECT DATEDIFF(SECOND, '+QuoteIdent('login_time')+', CURRENT_TIMESTAMP) FROM '+QuoteIdent('master')+'.'+QuoteIdent('dbo')+'.'+QuoteIdent('sysprocesses')+' WHERE '+QuoteIdent('spid')+'=1'), -1);
1127 // Microsoft SQL Server 2008 R2 (RTM) - 10.50.1600.1 (Intel X86) 1128 // Microsoft SQL Server 2008 R2 (RTM) - 10.50.1600.1 (Intel X86)
1128 // Apr 2 2010 15:53:02 1129 // Apr 2 2010 15:53:02
1129 // Copyright (c) Microsoft Corporation 1130 // Copyright (c) Microsoft Corporation
1130 // Express Edition with Advanced Services on Windows NT 6.1 <X86> (Build 7600: ) 1131 // Express Edition with Advanced Services on Windows NT 6.1 <X86> (Build 7600: )
1131 FServerVersionUntouched := Trim(GetVar('SELECT @@VERSION')); 1132 FServerVersionUntouched := Trim(GetVar('SELECT @@VERSION'));
1132 rx := TRegExpr.Create; 1133 rx := TRegExpr.Create;
1133 rx.ModifierI := False; 1134 rx.ModifierI := False;
1134 // Extract server OS 1135 // Extract server OS
1135 rx.Expression := '\s+on\s+([^\r\n]+)'; 1136 rx.Expression := '\s+on\s+([^\r\n]+)';
1136 if rx.Exec(FServerVersionUntouched) then 1137 if rx.Exec(FServerVersionUntouched) then
1137 FServerOS := rx.Match[1]; 1138 FServerOS := rx.Match[1];
1138 // Cut at first line break 1139 // Cut at first line break
1139 rx.Expression := '^([^\r\n]+)'; 1140 rx.Expression := '^([^\r\n]+)';
1140 if rx.Exec(FServerVersionUntouched) then 1141 if rx.Exec(FServerVersionUntouched) then
1141 FServerVersionUntouched := rx.Match[1]; 1142 FServerVersionUntouched := rx.Match[1];
1142 rx.Free; 1143 rx.Free;
1143 FRealHostname := Parameters.Hostname; 1144 FRealHostname := Parameters.Hostname;
1144 1145
1145 // Show up dynamic connection properties, probably useful for debugging 1146 // Show up dynamic connection properties, probably useful for debugging
1146 for i:=0 to FAdoHandle.Properties.Count-1 do 1147 for i:=0 to FAdoHandle.Properties.Count-1 do
1147 Log(lcDebug, 'OLE DB property "'+FAdoHandle.Properties[i].Name+'": '+String(FAdoHandle.Properties[i].Value)); 1148 Log(lcDebug, 'OLE DB property "'+FAdoHandle.Properties[i].Name+'": '+String(FAdoHandle.Properties[i].Value));
1148 1149
1149 DoAfterConnect; 1150 DoAfterConnect;
1150 1151
1151 // Reopen closed datasets after reconnecting 1152 // Reopen closed datasets after reconnecting
1152 // ... does not work for some reason. Still getting "not allowed on a closed object" errors in grid. 1153 // ... does not work for some reason. Still getting "not allowed on a closed object" errors in grid.
1153 //for i:=0 to FAdoHandle.DataSetCount-1 do 1154 //for i:=0 to FAdoHandle.DataSetCount-1 do
1154 // FAdoHandle.DataSets[i].Open; 1155 // FAdoHandle.DataSets[i].Open;
1155 1156
1156 if FDatabase <> '' then begin 1157 if FDatabase <> '' then begin
1157 tmpdb := FDatabase; 1158 tmpdb := FDatabase;
1158 FDatabase := ''; 1159 FDatabase := '';
1159 try 1160 try
1160 Database := tmpdb; 1161 Database := tmpdb;
1161 except 1162 except
1162 FDatabase := tmpdb; 1163 FDatabase := tmpdb;
1163 Database := ''; 1164 Database := '';
1164 end; 1165 end;
1165 end; 1166 end;
1166 except 1167 except
1167 on E:EOleException do begin 1168 on E:EOleException do begin
1168 Error := LastError; 1169 Error := LastError;
1169 Log(lcError, Error); 1170 Log(lcError, Error);
1170 FConnectionStarted := 0; 1171 FConnectionStarted := 0;
1171 raise EDatabaseError.Create(Error); 1172 raise EDatabaseError.Create(Error);
1172 end; 1173 end;
1173 end; 1174 end;
1174 end else begin 1175 end else begin
1175 FAdoHandle.Connected := False; 1176 FAdoHandle.Connected := False;
1176 FActive := False; 1177 FActive := False;
1177 ClearCache(False); 1178 ClearCache(False);
1178 FConnectionStarted := 0; 1179 FConnectionStarted := 0;
1179 Log(lcInfo, Format(MsgDisconnect, [FParameters.Hostname, DateTimeToStr(Now)])); 1180 Log(lcInfo, Format(MsgDisconnect, [FParameters.Hostname, DateTimeToStr(Now)]));
1180 end; 1181 end;
1181 end; 1182 end;
1182 1183
1183 1184
1184 procedure TDBConnection.DoBeforeConnect; 1185 procedure TDBConnection.DoBeforeConnect;
1185 var 1186 var
1186 UsingPass: String; 1187 UsingPass: String;
1187 Dialog: TfrmLogin; 1188 Dialog: TfrmLogin;
1188 begin 1189 begin
1189 // Prompt for password on initial connect 1190 // Prompt for password on initial connect
1190 if FParameters.LoginPrompt and (not FLoginPromptDone) then begin 1191 if FParameters.LoginPrompt and (not FLoginPromptDone) then begin
1191 Dialog := TfrmLogin.Create(Self); 1192 Dialog := TfrmLogin.Create(Self);
1192 Dialog.lblPrompt.Caption := 'Login to '+FParameters.Hostname+':'; 1193 Dialog.lblPrompt.Caption := 'Login to '+FParameters.Hostname+':';
1193 Dialog.editUsername.Text := FParameters.Username; 1194 Dialog.editUsername.Text := FParameters.Username;
1194 Dialog.editPassword.Text := FParameters.Password; 1195 Dialog.editPassword.Text := FParameters.Password;
1195 Dialog.ShowModal; 1196 Dialog.ShowModal;
1196 FParameters.Username := Dialog.editUsername.Text; 1197 FParameters.Username := Dialog.editUsername.Text;
1197 FParameters.Password := Dialog.editPassword.Text; 1198 FParameters.Password := Dialog.editPassword.Text;
1198 Dialog.Free; 1199 Dialog.Free;
1199 FLoginPromptDone := True; 1200 FLoginPromptDone := True;
1200 end; 1201 end;
1201 1202
1202 // Prepare connection 1203 // Prepare connection
1203 if FParameters.Password <> '' then UsingPass := 'Yes' else UsingPass := 'No'; 1204 if FParameters.Password <> '' then UsingPass := 'Yes' else UsingPass := 'No';
1204 Log(lcInfo, 'Connecting to '+FParameters.Hostname+' via '+FParameters.NetTypeName(FParameters.NetType, True)+ 1205 Log(lcInfo, 'Connecting to '+FParameters.Hostname+' via '+FParameters.NetTypeName(FParameters.NetType, True)+
1205 ', username '+FParameters.Username+ 1206 ', username '+FParameters.Username+
1206 ', using password: '+UsingPass+' ...'); 1207 ', using password: '+UsingPass+' ...');
1207 end; 1208 end;
1208 1209
1209 1210
1210 procedure TMySQLConnection.DoBeforeConnect; 1211 procedure TMySQLConnection.DoBeforeConnect;
1211 begin 1212 begin
1212 // Init libmysql before actually connecting. 1213 // Init libmysql before actually connecting.
1213 // Each connection has its own library handle 1214 // Each connection has its own library handle
1214 if LibMysqlHandle = 0 then begin 1215 if LibMysqlHandle = 0 then begin
1215 Log(lcDebug, 'Loading library file '+LibMysqlPath+' ...'); 1216 Log(lcDebug, 'Loading library file '+LibMysqlPath+' ...');
1216 LibMysqlHandle := LoadLibrary(PWideChar(LibMysqlPath)); 1217 LibMysqlHandle := LoadLibrary(PWideChar(LibMysqlPath));
1217 if LibMysqlHandle = 0 then 1218 if LibMysqlHandle = 0 then
1218 raise EDatabaseError.Create('Can''t find a usable '+LibMysqlPath+'. Please launch '+ExtractFileName(ParamStr(0))+' from the directory where you have installed it.') 1219 raise EDatabaseError.Create('Can''t find a usable '+LibMysqlPath+'. Please launch '+ExtractFileName(ParamStr(0))+' from the directory where you have installed it.')
1219 else begin 1220 else begin
1220 AssignProc(@mysql_affected_rows, 'mysql_affected_rows'); 1221 AssignProc(@mysql_affected_rows, 'mysql_affected_rows');
1221 AssignProc(@mysql_character_set_name, 'mysql_character_set_name'); 1222 AssignProc(@mysql_character_set_name, 'mysql_character_set_name');
1222 AssignProc(@mysql_close, 'mysql_close'); 1223 AssignProc(@mysql_close, 'mysql_close');
1223 AssignProc(@mysql_data_seek, 'mysql_data_seek'); 1224 AssignProc(@mysql_data_seek, 'mysql_data_seek');
1224 AssignProc(@mysql_errno, 'mysql_errno'); 1225 AssignProc(@mysql_errno, 'mysql_errno');
1225 AssignProc(@mysql_error, 'mysql_error'); 1226 AssignProc(@mysql_error, 'mysql_error');
1226 AssignProc(@mysql_fetch_field_direct, 'mysql_fetch_field_direct'); 1227 AssignProc(@mysql_fetch_field_direct, 'mysql_fetch_field_direct');
1227 AssignProc(@mysql_fetch_lengths, 'mysql_fetch_lengths'); 1228 AssignProc(@mysql_fetch_lengths, 'mysql_fetch_lengths');
1228 AssignProc(@mysql_fetch_row, 'mysql_fetch_row'); 1229 AssignProc(@mysql_fetch_row, 'mysql_fetch_row');
1229 AssignProc(@mysql_free_result, 'mysql_free_result'); 1230 AssignProc(@mysql_free_result, 'mysql_free_result');
1230 AssignProc(@mysql_get_client_info, 'mysql_get_client_info'); 1231 AssignProc(@mysql_get_client_info, 'mysql_get_client_info');
1231 AssignProc(@mysql_get_server_info, 'mysql_get_server_info'); 1232 AssignProc(@mysql_get_server_info, 'mysql_get_server_info');
1232 AssignProc(@mysql_init, 'mysql_init'); 1233 AssignProc(@mysql_init, 'mysql_init');
1233 AssignProc(@mysql_num_fields, 'mysql_num_fields'); 1234 AssignProc(@mysql_num_fields, 'mysql_num_fields');
1234 AssignProc(@mysql_num_rows, 'mysql_num_rows'); 1235 AssignProc(@mysql_num_rows, 'mysql_num_rows');
1235 AssignProc(@mysql_ping, 'mysql_ping'); 1236 AssignProc(@mysql_ping, 'mysql_ping');
1236 AssignProc(@mysql_options, 'mysql_options'); 1237 AssignProc(@mysql_options, 'mysql_options');
1237 AssignProc(@mysql_real_connect, 'mysql_real_connect'); 1238 AssignProc(@mysql_real_connect, 'mysql_real_connect');
1238 AssignProc(@mysql_real_query, 'mysql_real_query'); 1239 AssignProc(@mysql_real_query, 'mysql_real_query');
1239 AssignProc(@mysql_ssl_set, 'mysql_ssl_set'); 1240 AssignProc(@mysql_ssl_set, 'mysql_ssl_set');
1240 AssignProc(@mysql_stat, 'mysql_stat'); 1241 AssignProc(@mysql_stat, 'mysql_stat');
1241 AssignProc(@mysql_store_result, 'mysql_store_result'); 1242 AssignProc(@mysql_store_result, 'mysql_store_result');
1242 AssignProc(@mysql_thread_id, 'mysql_thread_id'); 1243 AssignProc(@mysql_thread_id, 'mysql_thread_id');
1243 AssignProc(@mysql_next_result, 'mysql_next_result'); 1244 AssignProc(@mysql_next_result, 'mysql_next_result');
1244 AssignProc(@mysql_set_character_set, 'mysql_set_character_set'); 1245 AssignProc(@mysql_set_character_set, 'mysql_set_character_set');
1245 AssignProc(@mysql_thread_init, 'mysql_thread_init'); 1246 AssignProc(@mysql_thread_init, 'mysql_thread_init');
1246 AssignProc(@mysql_thread_end, 'mysql_thread_end'); 1247 AssignProc(@mysql_thread_end, 'mysql_thread_end');
1247 AssignProc(@mysql_warning_count, 'mysql_warning_count'); 1248 AssignProc(@mysql_warning_count, 'mysql_warning_count');
1248 Log(lcDebug, LibMysqlPath + ' v' + DecodeApiString(mysql_get_client_info) + ' loaded.'); 1249 Log(lcDebug, LibMysqlPath + ' v' + DecodeApiString(mysql_get_client_info) + ' loaded.');
1249 end; 1250 end;
1250 end; 1251 end;
1251 inherited; 1252 inherited;
1252 end; 1253 end;
1253 1254
1254 1255
1255 procedure TDBConnection.DoAfterConnect; 1256 procedure TDBConnection.DoAfterConnect;
1256 begin 1257 begin
1257 OpenRegistry(FParameters.SessionName); 1258 OpenRegistry(FParameters.SessionName);
1258 MainReg.WriteString(REGNAME_SERVERVERSION_FULL, FServerVersionUntouched); 1259 MainReg.WriteString(REGNAME_SERVERVERSION_FULL, FServerVersionUntouched);
1259 FParameters.ServerVersion := FServerVersionUntouched; 1260 FParameters.ServerVersion := FServerVersionUntouched;
1260 if Assigned(FOnConnected) then 1261 if Assigned(FOnConnected) then
1261 FOnConnected(Self, FDatabase); 1262 FOnConnected(Self, FDatabase);
1262 end; 1263 end;
1263 1264
1264 1265
1265 procedure TMySQLConnection.DoAfterConnect; 1266 procedure TMySQLConnection.DoAfterConnect;
1266 begin 1267 begin
1267 inherited; 1268 inherited;
1268 FSQLSpecifities[spEmptyTable] := 'TRUNCATE '; 1269 FSQLSpecifities[spEmptyTable] := 'TRUNCATE ';
1269 FSQLSpecifities[spCurrentUserHost] := 'SELECT CURRENT_USER()'; 1270 FSQLSpecifities[spCurrentUserHost] := 'SELECT CURRENT_USER()';
1270 end; 1271 end;
1271 1272
1272 1273
1273 procedure TAdoDBConnection.DoAfterConnect; 1274 procedure TAdoDBConnection.DoAfterConnect;
1274 begin 1275 begin
1275 inherited; 1276 inherited;
1276 FSQLSpecifities[spEmptyTable] := 'DELETE FROM '; 1277 FSQLSpecifities[spEmptyTable] := 'DELETE FROM ';
1277 FSQLSpecifities[spCurrentUserHost] := 'SELECT SYSTEM_USER'; 1278 FSQLSpecifities[spCurrentUserHost] := 'SELECT SYSTEM_USER';
1278 case ServerVersionInt of 1279 case ServerVersionInt of
1279 2000: begin 1280 2000: begin
1280 FSQLSpecifities[spDatabaseTable] := QuoteIdent('master')+'..'+QuoteIdent('sysdatabases'); 1281 FSQLSpecifities[spDatabaseTable] := QuoteIdent('master')+'..'+QuoteIdent('sysdatabases');
1281 FSQLSpecifities[spDatabaseTableId] := QuoteIdent('dbid'); 1282 FSQLSpecifities[spDatabaseTableId] := QuoteIdent('dbid');
1282 FSQLSpecifities[spDbObjectsTable] := '..'+QuoteIdent('sysobjects'); 1283 FSQLSpecifities[spDbObjectsTable] := '..'+QuoteIdent('sysobjects');
1283 FSQLSpecifities[spDbObjectsCreateCol] := 'crdate'; 1284 FSQLSpecifities[spDbObjectsCreateCol] := 'crdate';
1284 FSQLSpecifities[spDbObjectsUpdateCol] := ''; 1285 FSQLSpecifities[spDbObjectsUpdateCol] := '';
1285 FSQLSpecifities[spDbObjectsTypeCol] := 'xtype'; 1286 FSQLSpecifities[spDbObjectsTypeCol] := 'xtype';
1286 end; 1287 end;
1287 else begin 1288 else begin
1288 FSQLSpecifities[spDatabaseTable] := QuoteIdent('sys')+'.'+QuoteIdent('databases'); 1289 FSQLSpecifities[spDatabaseTable] := QuoteIdent('sys')+'.'+QuoteIdent('databases');
1289 FSQLSpecifities[spDatabaseTableId] := QuoteIdent('database_id'); 1290 FSQLSpecifities[spDatabaseTableId] := QuoteIdent('database_id');
1290 FSQLSpecifities[spDbObjectsTable] := '.'+QuoteIdent('sys')+'.'+QuoteIdent('objects'); 1291 FSQLSpecifities[spDbObjectsTable] := '.'+QuoteIdent('sys')+'.'+QuoteIdent('objects');
1291 FSQLSpecifities[spDbObjectsCreateCol] := 'create_date'; 1292 FSQLSpecifities[spDbObjectsCreateCol] := 'create_date';
1292 FSQLSpecifities[spDbObjectsUpdateCol] := 'modify_date'; 1293 FSQLSpecifities[spDbObjectsUpdateCol] := 'modify_date';
1293 FSQLSpecifities[spDbObjectsTypeCol] := 'type'; 1294 FSQLSpecifities[spDbObjectsTypeCol] := 'type';
1294 end; 1295 end;
1295 end; 1296 end;
1296 end; 1297 end;
1297 1298
1298 1299
1299 function TMySQLConnection.Ping(Reconnect: Boolean): Boolean; 1300 function TMySQLConnection.Ping(Reconnect: Boolean): Boolean;
1300 begin 1301 begin
1301 Log(lcDebug, 'Ping server ...'); 1302 Log(lcDebug, 'Ping server ...');
1302 if (FHandle=nil) or (mysql_ping(FHandle) <> 0) then begin 1303 if (FHandle=nil) or (mysql_ping(FHandle) <> 0) then begin
1303 // Be sure to release some stuff before reconnecting 1304 // Be sure to release some stuff before reconnecting
1304 Active := False; 1305 Active := False;
1305 if Reconnect then 1306 if Reconnect then
1306 Active := True; 1307 Active := True;
1307 end; 1308 end;
1308 Result := FActive; 1309 Result := FActive;
1309 end; 1310 end;
1310 1311
1311 1312
1312 function TAdoDBConnection.Ping(Reconnect: Boolean): Boolean; 1313 function TAdoDBConnection.Ping(Reconnect: Boolean): Boolean;
1313 begin 1314 begin
1314 Log(lcDebug, 'Ping server ...'); 1315 Log(lcDebug, 'Ping server ...');
1315 if FActive then try 1316 if FActive then try
1316 FAdoHandle.Execute('SELECT 1'); 1317 FAdoHandle.Execute('SELECT 1');
1317 except 1318 except
1318 on E:EOleException do begin 1319 on E:EOleException do begin
1319 Log(lcError, E.Message); 1320 Log(lcError, E.Message);
1320 Active := False; 1321 Active := False;
1321 if Reconnect then 1322 if Reconnect then
1322 Active := True; 1323 Active := True;
1323 end; 1324 end;
1324 end; 1325 end;
1325 1326
1326 Result := FActive; 1327 Result := FActive;
1327 end; 1328 end;
1328 1329
1329 1330
1330 procedure TMySQLConnection.ClosePlink; 1331 procedure TMySQLConnection.ClosePlink;
1331 begin 1332 begin
1332 if FPlinkProcInfo.hProcess <> 0 then begin 1333 if FPlinkProcInfo.hProcess <> 0 then begin
1333 Log(lcInfo, 'Closing plink.exe process #'+IntToStr(FPlinkProcInfo.dwProcessId)+' ...'); 1334 Log(lcInfo, 'Closing plink.exe process #'+IntToStr(FPlinkProcInfo.dwProcessId)+' ...');
1334 TerminateProcess(FPlinkProcInfo.hProcess, 0); 1335 TerminateProcess(FPlinkProcInfo.hProcess, 0);
1335 CloseHandle(FPlinkProcInfo.hProcess); 1336 CloseHandle(FPlinkProcInfo.hProcess);
1336 end; 1337 end;
1337 end; 1338 end;
1338 1339
1339 1340
1340 {** 1341 {**
1341 Executes a query 1342 Executes a query
1342 } 1343 }
1343 procedure TMySQLConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); 1344 procedure TMySQLConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL);
1344 var 1345 var
1345 QueryStatus: Integer; 1346 QueryStatus: Integer;
1346 NativeSQL: AnsiString; 1347 NativeSQL: AnsiString;
1347 TimerStart: Cardinal; 1348 TimerStart: Cardinal;
1348 QueryResult: PMYSQL_RES; 1349 QueryResult: PMYSQL_RES;
1349 begin 1350 begin
1350 if (FLockedByThread <> nil) and (FLockedByThread.ThreadID <> GetCurrentThreadID) then begin 1351 if (FLockedByThread <> nil) and (FLockedByThread.ThreadID <> GetCurrentThreadID) then begin
1351 Log(lcDebug, 'Waiting for running query to finish ...'); 1352 Log(lcDebug, 'Waiting for running query to finish ...');
1352 try 1353 try
1353 FLockedByThread.WaitFor; 1354 FLockedByThread.WaitFor;
1354 except 1355 except
1355 on E:EThread do; 1356 on E:EThread do;
1356 end; 1357 end;
1357 end; 1358 end;
1358 1359
1359 Ping(True); 1360 Ping(True);
1360 Log(LogCategory, SQL); 1361 Log(LogCategory, SQL);
1361 FLastQuerySQL := SQL; 1362 FLastQuerySQL := SQL;
1362 if IsUnicode then 1363 if IsUnicode then
1363 NativeSQL := UTF8Encode(SQL) 1364 NativeSQL := UTF8Encode(SQL)
1364 else 1365 else
1365 NativeSQL := AnsiString(SQL); 1366 NativeSQL := AnsiString(SQL);
1366 TimerStart := GetTickCount; 1367 TimerStart := GetTickCount;
1367 SetLength(FLastRawResults, 0); 1368 SetLength(FLastRawResults, 0);
1368 FResultCount := 0; 1369 FResultCount := 0;
1369 QueryStatus := mysql_real_query(FHandle, PAnsiChar(NativeSQL), Length(NativeSQL)); 1370 QueryStatus := mysql_real_query(FHandle, PAnsiChar(NativeSQL), Length(NativeSQL));
1370 FLastQueryDuration := GetTickCount - TimerStart; 1371 FLastQueryDuration := GetTickCount - TimerStart;
1371 FLastQueryNetworkDuration := 0; 1372 FLastQueryNetworkDuration := 0;
1372 if QueryStatus <> 0 then begin 1373 if QueryStatus <> 0 then begin
1373 // Most errors will show up here, some others slightly later, after mysql_store_result() 1374 // Most errors will show up here, some others slightly later, after mysql_store_result()
1374 Log(lcError, GetLastError); 1375 Log(lcError, GetLastError);
1375 raise EDatabaseError.Create(GetLastError); 1376 raise EDatabaseError.Create(GetLastError);
1376 end else begin 1377 end else begin
1377 // We must call mysql_store_result() + mysql_free_result() to unblock the connection 1378 // We must call mysql_store_result() + mysql_free_result() to unblock the connection
1378 // See: http://dev.mysql.com/doc/refman/5.0/en/mysql-store-result.html 1379 // See: http://dev.mysql.com/doc/refman/5.0/en/mysql-store-result.html
1379 FRowsAffected := mysql_affected_rows(FHandle); 1380 FRowsAffected := mysql_affected_rows(FHandle);
1380 FWarningCount := mysql_warning_count(FHandle); 1381 FWarningCount := mysql_warning_count(FHandle);
1381 TimerStart := GetTickCount; 1382 TimerStart := GetTickCount;
1382 QueryResult := mysql_store_result(FHandle); 1383 QueryResult := mysql_store_result(FHandle);
1383 FLastQueryNetworkDuration := GetTickCount - TimerStart; 1384 FLastQueryNetworkDuration := GetTickCount - TimerStart;
1384 if (QueryResult = nil) and (FRowsAffected = -1) then begin 1385 if (QueryResult = nil) and (FRowsAffected = -1) then begin
1385 // Indicates a late error, e.g. triggered by mysql_store_result(), after selecting a stored 1386 // Indicates a late error, e.g. triggered by mysql_store_result(), after selecting a stored
1386 // function with invalid SQL body. Also SHOW TABLE STATUS on older servers. 1387 // function with invalid SQL body. Also SHOW TABLE STATUS on older servers.
1387 Log(lcError, GetLastError); 1388 Log(lcError, GetLastError);
1388 raise EDatabaseError.Create(GetLastError); 1389 raise EDatabaseError.Create(GetLastError);
1389 end; 1390 end;
1390 if QueryResult <> nil then begin 1391 if QueryResult <> nil then begin
1391 FRowsFound := mysql_num_rows(QueryResult); 1392 FRowsFound := mysql_num_rows(QueryResult);
1392 FRowsAffected := 0; 1393 FRowsAffected := 0;
1393 Log(lcDebug, IntToStr(RowsFound)+' rows found, '+IntToStr(WarningCount)+' warnings.'); 1394 Log(lcDebug, IntToStr(RowsFound)+' rows found, '+IntToStr(WarningCount)+' warnings.');
1394 1395
1395 while true do begin 1396 while true do begin
1396 if QueryResult <> nil then begin 1397 if QueryResult <> nil then begin
1397 if DoStoreResult then begin 1398 if DoStoreResult then begin
1398 SetLength(FLastRawResults, Length(FLastRawResults)+1); 1399 SetLength(FLastRawResults, Length(FLastRawResults)+1);
1399 FLastRawResults[Length(FLastRawResults)-1] := QueryResult; 1400 FLastRawResults[Length(FLastRawResults)-1] := QueryResult;
1400 end else begin 1401 end else begin
1401 mysql_free_result(QueryResult); 1402 mysql_free_result(QueryResult);
1402 end; 1403 end;
1403 end; 1404 end;
1404 // more results? -1 = no, >0 = error, 0 = yes (keep looping) 1405 // more results? -1 = no, >0 = error, 0 = yes (keep looping)
1405 QueryStatus := mysql_next_result(FHandle); 1406 QueryStatus := mysql_next_result(FHandle);
1406 case QueryStatus of 1407 case QueryStatus of
1407 -1: break; 1408 -1: break;
1408 0: QueryResult := mysql_store_result(FHandle); 1409 0: QueryResult := mysql_store_result(FHandle);
1409 else begin 1410 else begin
1410 Log(lcError, GetLastError); 1411 Log(lcError, GetLastError);
1411 raise EDatabaseError.Create(GetLastError); 1412 raise EDatabaseError.Create(GetLastError);
1412 end; 1413 end;
1413 end; 1414 end;
1414 end; 1415 end;
1415 FResultCount := Length(FLastRawResults); 1416 FResultCount := Length(FLastRawResults);
1416 1417
1417 end else begin 1418 end else begin
1418 // Query did not return a result 1419 // Query did not return a result
1419 FRowsFound := 0; 1420 FRowsFound := 0;
1420 Log(lcDebug, IntToStr(RowsAffected)+' rows affected.'); 1421 Log(lcDebug, IntToStr(RowsAffected)+' rows affected.');
1421 if UpperCase(Copy(SQL, 1, 3)) = 'USE' then begin 1422 if UpperCase(Copy(SQL, 1, 3)) = 'USE' then begin
1422 FDatabase := Trim(Copy(SQL, 4, Length(SQL)-3)); 1423 FDatabase := Trim(Copy(SQL, 4, Length(SQL)-3));
1423 FDatabase := DeQuoteIdent(FDatabase); 1424 FDatabase := DeQuoteIdent(FDatabase);
1424 Log(lcDebug, 'Database "'+FDatabase+'" selected'); 1425 Log(lcDebug, 'Database "'+FDatabase+'" selected');
1425 if Assigned(FOnDatabaseChanged) then 1426 if Assigned(FOnDatabaseChanged) then
1426 FOnDatabaseChanged(Self, Database); 1427 FOnDatabaseChanged(Self, Database);
1427 end; 1428 end;
1428 end; 1429 end;
1429 end; 1430 end;
1430 end; 1431 end;
1431 1432
1432 1433
1433 procedure TAdoDBConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); 1434 procedure TAdoDBConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL);
1434 var 1435 var
1435 TimerStart: Cardinal; 1436 TimerStart: Cardinal;
1436 VarRowsAffected: OleVariant; 1437 VarRowsAffected: OleVariant;
1437 QueryResult, NextResult: _RecordSet; 1438 QueryResult, NextResult: _RecordSet;
1438 Affected: Int64; 1439 Affected: Int64;
1439 begin 1440 begin
1440 if (FLockedByThread <> nil) and (FLockedByThread.ThreadID <> GetCurrentThreadID) then begin 1441 if (FLockedByThread <> nil) and (FLockedByThread.ThreadID <> GetCurrentThreadID) then begin
1441 Log(lcDebug, 'Waiting for running query to finish ...'); 1442 Log(lcDebug, 'Waiting for running query to finish ...');
1442 try 1443 try
1443 FLockedByThread.WaitFor; 1444 FLockedByThread.WaitFor;
1444 except 1445 except
1445 on E:EThread do; 1446 on E:EThread do;
1446 end; 1447 end;
1447 end; 1448 end;
1448 1449
1449 Ping(True); 1450 Ping(True);
1450 Log(LogCategory, SQL); 1451 Log(LogCategory, SQL);
1451 FLastQuerySQL := SQL; 1452 FLastQuerySQL := SQL;
1452 TimerStart := GetTickCount; 1453 TimerStart := GetTickCount;
1453 SetLength(FLastRawResults, 0); 1454 SetLength(FLastRawResults, 0);
1454 FResultCount := 0; 1455 FResultCount := 0;
1455 FRowsFound := 0; 1456 FRowsFound := 0;
1456 FRowsAffected := 0; 1457 FRowsAffected := 0;
1457 try 1458 try
1458 QueryResult := FAdoHandle.ConnectionObject.Execute(SQL, VarRowsAffected, 1); 1459 QueryResult := FAdoHandle.ConnectionObject.Execute(SQL, VarRowsAffected, 1);
1459 FLastQueryDuration := GetTickCount - TimerStart; 1460 FLastQueryDuration := GetTickCount - TimerStart;
1460 FLastQueryNetworkDuration := 0; 1461 FLastQueryNetworkDuration := 0;
1461 1462
1462 // Handle multiple results 1463 // Handle multiple results
1463 while(QueryResult <> nil) do begin 1464 while(QueryResult <> nil) do begin
1464 Affected := VarRowsAffected; 1465 Affected := VarRowsAffected;
1465 Affected := Max(Affected, 0); 1466 Affected := Max(Affected, 0);
1466 Inc(FRowsAffected, Affected); 1467 Inc(FRowsAffected, Affected);
1467 NextResult := QueryResult.NextRecordset(VarRowsAffected); 1468 NextResult := QueryResult.NextRecordset(VarRowsAffected);
1468 if QueryResult.Fields.Count > 0 then begin 1469 if QueryResult.Fields.Count > 0 then begin
1469 Inc(FRowsFound, QueryResult.RecordCount); 1470 Inc(FRowsFound, QueryResult.RecordCount);
1470 if DoStoreResult then begin 1471 if DoStoreResult then begin
1471 SetLength(FLastRawResults, Length(FLastRawResults)+1); 1472 SetLength(FLastRawResults, Length(FLastRawResults)+1);
1472 FLastRawResults[Length(FLastRawResults)-1] := QueryResult; 1473 FLastRawResults[Length(FLastRawResults)-1] := QueryResult;
1473 end else 1474 end else
1474 QueryResult := nil; 1475 QueryResult := nil;
1475 end else 1476 end else
1476 QueryResult := nil; 1477 QueryResult := nil;
1477 QueryResult := NextResult; 1478 QueryResult := NextResult;
1478 end; 1479 end;
1479 FResultCount := Length(FLastRawResults); 1480 FResultCount := Length(FLastRawResults);
1480 1481
1481 if UpperCase(Copy(SQL, 1, 3)) = 'USE' then begin 1482 if UpperCase(Copy(SQL, 1, 3)) = 'USE' then begin
1482 FDatabase := Trim(Copy(SQL, 4, Length(SQL)-3)); 1483 FDatabase := Trim(Copy(SQL, 4, Length(SQL)-3));
1483 FDatabase := DeQuoteIdent(FDatabase); 1484 FDatabase := DeQuoteIdent(FDatabase);
1484 Log(lcDebug, 'Database "'+FDatabase+'" selected'); 1485 Log(lcDebug, 'Database "'+FDatabase+'" selected');
1485 if Assigned(FOnDatabaseChanged) then 1486 if Assigned(FOnDatabaseChanged) then
1486 FOnDatabaseChanged(Self, Database); 1487 FOnDatabaseChanged(Self, Database);
1487 end; 1488 end;
1488 except 1489 except
1489 on E:EOleException do begin 1490 on E:EOleException do begin
1490 FLastError := E.Message; 1491 FLastError := E.Message;
1491 Log(lcError, GetLastError); 1492 Log(lcError, GetLastError);
1492 raise EDatabaseError.Create(GetLastError); 1493 raise EDatabaseError.Create(GetLastError);
1493 end; 1494 end;
1494 end; 1495 end;
1495 end; 1496 end;
1496 1497
1497 1498
1498 function TMySQLConnection.GetLastResults: TDBQueryList; 1499 function TMySQLConnection.GetLastResults: TDBQueryList;
1499 var 1500 var
1500 r: TDBQuery; 1501 r: TDBQuery;
1501 i: Integer; 1502 i: Integer;
1502 begin 1503 begin
1503 Result := TDBQueryList.Create(False); 1504 Result := TDBQueryList.Create(False);
1504 for i:=Low(FLastRawResults) to High(FLastRawResults) do begin 1505 for i:=Low(FLastRawResults) to High(FLastRawResults) do begin
1505 r := Parameters.CreateQuery(nil); 1506 r := Parameters.CreateQuery(nil);
1506 r.Connection := Self; 1507 r.Connection := Self;
1507 r.SQL := FLastQuerySQL; 1508 r.SQL := FLastQuerySQL;
1508 r.Execute(False, i); 1509 r.Execute(False, i);
1509 Result.Add(r); 1510 Result.Add(r);
1510 end; 1511 end;
1511 end; 1512 end;
1512 1513
1513 1514
1514 function TAdoDBConnection.GetLastResults: TDBQueryList; 1515 function TAdoDBConnection.GetLastResults: TDBQueryList;
1515 var 1516 var
1516 r: TDBQuery; 1517 r: TDBQuery;
1517 i: Integer; 1518 i: Integer;
1518 begin 1519 begin
1519 Result := TDBQueryList.Create(False); 1520 Result := TDBQueryList.Create(False);
1520 for i:=Low(FLastRawResults) to High(FLastRawResults) do begin 1521 for i:=Low(FLastRawResults) to High(FLastRawResults) do begin
1521 r := Parameters.CreateQuery(nil); 1522 r := Parameters.CreateQuery(nil);
1522 r.Connection := Self; 1523 r.Connection := Self;
1523 r.SQL := FLastQuerySQL; 1524 r.SQL := FLastQuerySQL;
1524 r.Execute(False, i); 1525 r.Execute(False, i);
1525 Result.Add(r); 1526 Result.Add(r);
1526 end; 1527 end;
1527 end; 1528 end;
1528 1529
1529 1530
1530 function TMySQLConnection.GetCreateCode(Database, Name: String; NodeType: TListNodeType): String; 1531 function TMySQLConnection.GetCreateCode(Database, Name: String; NodeType: TListNodeType): String;
1531 var 1532 var
1532 Column: Integer; 1533 Column: Integer;
1533 ObjType: String; 1534 ObjType: String;
1534 TmpObj: TDBObject; 1535 TmpObj: TDBObject;
1535 begin 1536 begin
1536 Column := -1; 1537 Column := -1;
1537 TmpObj := TDBObject.Create(Self); 1538 TmpObj := TDBObject.Create(Self);
1538 TmpObj.NodeType := NodeType; 1539 TmpObj.NodeType := NodeType;
1539 ObjType := TmpObj.ObjType; 1540 ObjType := TmpObj.ObjType;
1540 case NodeType of 1541 case NodeType of
1541 lntTable, lntView: Column := 1; 1542 lntTable, lntView: Column := 1;
1542 lntFunction, lntProcedure, lntTrigger: Column := 2; 1543 lntFunction, lntProcedure, lntTrigger: Column := 2;
1543 lntEvent: Column := 3; 1544 lntEvent: Column := 3;
1544 else Exception.Create('Unhandled list node type in '+ClassName+'.GetCreateCode'); 1545 else Exception.Create('Unhandled list node type in '+ClassName+'.GetCreateCode');
1545 end; 1546 end;
1546 if NodeType = lntView then 1547 if NodeType = lntView then
1547 Result := GetCreateViewCode(Database, Name) 1548 Result := GetCreateViewCode(Database, Name)
1548 else 1549 else
1549 Result := GetVar('SHOW CREATE '+UpperCase(TmpObj.ObjType)+' '+QuoteIdent(Database)+'.'+QuoteIdent(Name), Column); 1550 Result := GetVar('SHOW CREATE '+UpperCase(TmpObj.ObjType)+' '+QuoteIdent(Database)+'.'+QuoteIdent(Name), Column);
1550 TmpObj.Free; 1551 TmpObj.Free;
1551 end; 1552 end;
1552 1553
1553 1554
1554 function TMySQLConnection.GetCreateViewCode(Database, Name: String): String; 1555 function TMySQLConnection.GetCreateViewCode(Database, Name: String): String;
1555 var 1556 var
1556 ViewIS: TDBQuery; 1557 ViewIS: TDBQuery;
1557 ViewName, Algorithm, CheckOption, SelectCode, Definer, SQLSecurity: String; 1558 ViewName, Algorithm, CheckOption, SelectCode, Definer, SQLSecurity: String;
1558 AlternativeSelectCode: String; 1559 AlternativeSelectCode: String;
1559 rx: TRegExpr; 1560 rx: TRegExpr;
1560 begin 1561 begin
1561 // Get CREATE VIEW code, which can throw privilege errors and errors due to 1562 // Get CREATE VIEW code, which can throw privilege errors and errors due to
1562 // references to renamed or deleted columns 1563 // references to renamed or deleted columns
1563 try 1564 try
1564 Result := GetVar('SHOW CREATE VIEW '+QuoteIdent(Database)+'.'+QuoteIdent(Name), 1); 1565 Result := GetVar('SHOW CREATE VIEW '+QuoteIdent(Database)+'.'+QuoteIdent(Name), 1);
1565 except 1566 except
1566 on E:EDatabaseError do begin 1567 on E:EDatabaseError do begin
1567 ViewIS := GetResults('SELECT * FROM INFORMATION_SCHEMA.VIEWS WHERE '+ 1568 ViewIS := GetResults('SELECT * FROM INFORMATION_SCHEMA.VIEWS WHERE '+
1568 'TABLE_SCHEMA='+EscapeString(Database)+' AND TABLE_NAME='+EscapeString(Name)); 1569 'TABLE_SCHEMA='+EscapeString(Database)+' AND TABLE_NAME='+EscapeString(Name));
1569 Result := 'CREATE '; 1570 Result := 'CREATE ';
1570 if ViewIS.Col('DEFINER') <> '' then 1571 if ViewIS.Col('DEFINER') <> '' then
1571 Result := Result + 'DEFINER='+QuoteIdent(ViewIS.Col('DEFINER'), True, '@')+' '; 1572 Result := Result + 'DEFINER='+QuoteIdent(ViewIS.Col('DEFINER'), True, '@')+' ';
1572 Result := Result + 'VIEW '+QuoteIdent(Name)+' AS '+ViewIS.Col('VIEW_DEFINITION')+' '; 1573 Result := Result + 'VIEW '+QuoteIdent(Name)+' AS '+ViewIS.Col('VIEW_DEFINITION')+' ';
1573 if ViewIS.Col('CHECK_OPTION') <> 'NONE' then 1574 if ViewIS.Col('CHECK_OPTION') <> 'NONE' then
1574 Result := Result + 'WITH '+Uppercase(ViewIS.Col('CHECK_OPTION'))+' CHECK OPTION'; 1575 Result := Result + 'WITH '+Uppercase(ViewIS.Col('CHECK_OPTION'))+' CHECK OPTION';
1575 end; 1576 end;
1576 end; 1577 end;
1577 try 1578 try
1578 // Try to fetch original VIEW code from .frm file 1579 // Try to fetch original VIEW code from .frm file
1579 AlternativeSelectCode := GetVar('SELECT LOAD_FILE(CONCAT(IFNULL(@@GLOBAL.datadir, CONCAT(@@GLOBAL.basedir, '+EscapeString('data/')+')), '+EscapeString(Database+'/'+Name+'.frm')+'))'); 1580 AlternativeSelectCode := GetVar('SELECT LOAD_FILE(CONCAT(IFNULL(@@GLOBAL.datadir, CONCAT(@@GLOBAL.basedir, '+EscapeString('data/')+')), '+EscapeString(Database+'/'+Name+'.frm')+'))');
1580 rx := TRegExpr.Create; 1581 rx := TRegExpr.Create;
1581 rx.ModifierI := True; 1582 rx.ModifierI := True;
1582 rx.ModifierG := False; 1583 rx.ModifierG := False;
1583 rx.Expression := '\nsource\=(.+)\n\w+\='; 1584 rx.Expression := '\nsource\=(.+)\n\w+\=';
1584 if rx.Exec(AlternativeSelectCode) then begin 1585 if rx.Exec(AlternativeSelectCode) then begin
1585 // Put pieces of CREATE VIEW together 1586 // Put pieces of CREATE VIEW together
1586 ParseViewStructure(Result, ViewName, nil, 1587 ParseViewStructure(Result, ViewName, nil,
1587 Algorithm, Definer, SQLSecurity, CheckOption, SelectCode); 1588 Algorithm, Definer, SQLSecurity, CheckOption, SelectCode);
1588 AlternativeSelectCode := UnescapeString(rx.Match[1]); 1589 AlternativeSelectCode := UnescapeString(rx.Match[1]);
1589 Result := 'CREATE '; 1590 Result := 'CREATE ';
1590 if Algorithm <> '' then 1591 if Algorithm <> '' then
1591 Result := Result + 'ALGORITHM='+Uppercase(Algorithm)+' '; 1592 Result := Result + 'ALGORITHM='+Uppercase(Algorithm)+' ';
1592 if Definer <> '' then 1593 if Definer <> '' then
1593 Result := Result + 'DEFINER='+QuoteIdent(Definer, True, '@')+' '; 1594 Result := Result + 'DEFINER='+QuoteIdent(Definer, True, '@')+' ';
1594 Result := Result + 'VIEW '+QuoteIdent(Name)+' AS '+AlternativeSelectCode+' '; 1595 Result := Result + 'VIEW '+QuoteIdent(Name)+' AS '+AlternativeSelectCode+' ';
1595 if CheckOption <> '' then 1596 if CheckOption <> '' then
1596 Result := Result + 'WITH '+Uppercase(CheckOption)+' CHECK OPTION'; 1597 Result := Result + 'WITH '+Uppercase(CheckOption)+' CHECK OPTION';
1597 end; 1598 end;
1598 rx.Free; 1599 rx.Free;
1599 except 1600 except
1600 // Do not raise if that didn't work 1601 // Do not raise if that didn't work
1601 on E:EDatabaseError do; 1602 on E:EDatabaseError do;
1602 end; 1603 end;
1603 end; 1604 end;
1604 1605
1605 1606
1606 function TAdoDBConnection.GetCreateCode(Database, Name: String; NodeType: TListNodeType): String; 1607 function TAdoDBConnection.GetCreateCode(Database, Name: String; NodeType: TListNodeType): String;
1607 var 1608 var
1608 Cols: TDBQuery; 1609 Cols: TDBQuery;
1609 begin 1610 begin
1610 Result := 'CREATE TABLE '+QuoteIdent(Name)+' ('; 1611 Result := 'CREATE TABLE '+QuoteIdent(Name)+' (';
1611 Cols := GetResults('SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE '+ 1612 Cols := GetResults('SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE '+
1612 'TABLE_CATALOG='+EscapeString(Database)+' AND TABLE_NAME='+EscapeString(Name)); 1613 'TABLE_CATALOG='+EscapeString(Database)+' AND TABLE_NAME='+EscapeString(Name));
1613 while not Cols.Eof do begin 1614 while not Cols.Eof do begin
1614 Result := Result + CRLF + #9 + QuoteIdent(Cols.Col('COLUMN_NAME')) + ' ' + UpperCase(Cols.Col('DATA_TYPE')); 1615 Result := Result + CRLF + #9 + QuoteIdent(Cols.Col('COLUMN_NAME')) + ' ' + UpperCase(Cols.Col('DATA_TYPE'));
1615 if not Cols.IsNull('CHARACTER_MAXIMUM_LENGTH') then 1616 if not Cols.IsNull('CHARACTER_MAXIMUM_LENGTH') then
1616 Result := Result + '(' + Cols.Col('CHARACTER_MAXIMUM_LENGTH') + ')'; 1617 Result := Result + '(' + Cols.Col('CHARACTER_MAXIMUM_LENGTH') + ')';
1617 if Cols.Col('IS_NULLABLE') = 'NO' then 1618 if Cols.Col('IS_NULLABLE') = 'NO' then
1618 Result := Result + ' NOT'; 1619 Result := Result + ' NOT';
1619 Result := Result + ' NULL'; 1620 Result := Result + ' NULL';
1620 Result := Result + ','; 1621 Result := Result + ',';
1621 Cols.Next; 1622 Cols.Next;
1622 end; 1623 end;
1623 Cols.Free; 1624 Cols.Free;
1624 Delete(Result, Length(Result), 1); 1625 Delete(Result, Length(Result), 1);
1625 Result := Result + ')'; 1626 Result := Result + ')';
1626 end; 1627 end;
1627 1628
1628 1629
1629 {** 1630 {**
1630 Set "Database" property and select that db if connected 1631 Set "Database" property and select that db if connected
1631 } 1632 }
1632 procedure TDBConnection.SetDatabase(Value: String); 1633 procedure TDBConnection.SetDatabase(Value: String);
1633 begin 1634 begin
1634 Log(lcDebug, 'SetDatabase('+Value+'), FDatabase: '+FDatabase); 1635 Log(lcDebug, 'SetDatabase('+Value+'), FDatabase: '+FDatabase);
1635 if Value <> FDatabase then begin 1636 if Value <> FDatabase then begin
1636 if Value = '' then begin 1637 if Value = '' then begin
1637 FDatabase := Value; 1638 FDatabase := Value;
1638 if Assigned(FOnDatabaseChanged) then 1639 if Assigned(FOnDatabaseChanged) then
1639 FOnDatabaseChanged(Self, Value); 1640 FOnDatabaseChanged(Self, Value);
1640 end else 1641 end else
1641 Query('USE '+QuoteIdent(Value), False); 1642 Query('USE '+QuoteIdent(Value), False);
1642 SetObjectNamesInSelectedDB; 1643 SetObjectNamesInSelectedDB;
1643 end; 1644 end;
1644 end; 1645 end;
1645 1646
1646 1647
1647 {** 1648 {**
1648 Return current thread id 1649 Return current thread id
1649 } 1650 }
1650 function TMySQLConnection.GetThreadId: Cardinal; 1651 function TMySQLConnection.GetThreadId: Cardinal;
1651 begin 1652 begin
1652 if FThreadId = 0 then begin 1653 if FThreadId = 0 then begin
1653 Ping(False); 1654 Ping(False);
1654 if FActive then 1655 if FActive then
1655 FThreadID := mysql_thread_id(FHandle); 1656 FThreadID := mysql_thread_id(FHandle);
1656 end; 1657 end;
1657 Result := FThreadID; 1658 Result := FThreadID;
1658 end; 1659 end;
1659 1660
1660 1661
1661 function TAdoDBConnection.GetThreadId: Cardinal; 1662 function TAdoDBConnection.GetThreadId: Cardinal;
1662 begin 1663 begin
1663 if FThreadId = 0 then begin 1664 if FThreadId = 0 then begin
1664 Ping(False); 1665 Ping(False);
1665 if FActive then 1666 if FActive then
1666 FThreadID := StrToIntDef(GetVar('SELECT @@SPID'), 0); 1667 FThreadID := StrToIntDef(GetVar('SELECT @@SPID'), 0);
1667 end; 1668 end;
1668 Result := FThreadID; 1669 Result := FThreadID;
1669 end; 1670 end;
1670 1671
1671 1672
1672 {** 1673 {**
1673 Return currently used character set 1674 Return currently used character set
1674 } 1675 }
1675 function TMySQLConnection.GetCharacterSet: String; 1676 function TMySQLConnection.GetCharacterSet: String;
1676 begin 1677 begin
1677 Result := DecodeAPIString(mysql_character_set_name(FHandle)); 1678 Result := DecodeAPIString(mysql_character_set_name(FHandle));
1678 end; 1679 end;
1679 1680
1680 1681
1681 function TAdoDBConnection.GetCharacterSet: String; 1682 function TAdoDBConnection.GetCharacterSet: String;
1682 begin 1683 begin
1683 Result := ''; 1684 Result := '';
1684 end; 1685 end;
1685 1686
1686 1687
1687 {** 1688 {**
1688 Switch character set 1689 Switch character set
1689 } 1690 }
1690 procedure TMySQLConnection.SetCharacterSet(CharsetName: String); 1691 procedure TMySQLConnection.SetCharacterSet(CharsetName: String);
1691 begin 1692 begin
1692 mysql_set_character_set(FHandle, PAnsiChar(Utf8Encode(CharsetName))); 1693 mysql_set_character_set(FHandle, PAnsiChar(Utf8Encode(CharsetName)));
1693 end; 1694 end;
1694 1695
1695 1696
1696 procedure TAdoDBConnection.SetCharacterSet(CharsetName: String); 1697 procedure TAdoDBConnection.SetCharacterSet(CharsetName: String);
1697 begin 1698 begin
1698 // Not in use. No charset stuff going on here? 1699 // Not in use. No charset stuff going on here?
1699 end; 1700 end;
1700 1701
1701 1702
1702 function TMySQLConnection.GetLastErrorCode: Cardinal; 1703 function TMySQLConnection.GetLastErrorCode: Cardinal;
1703 begin 1704 begin
1704 Result := mysql_errno(FHandle); 1705 Result := mysql_errno(FHandle);
1705 end; 1706 end;
1706 1707
1707 1708
1708 function TAdoDBConnection.GetLastErrorCode: Cardinal; 1709 function TAdoDBConnection.GetLastErrorCode: Cardinal;
1709 begin 1710 begin
1710 // SELECT @@SPID throws errors without filling the error pool. See issue #2684. 1711 // SELECT @@SPID throws errors without filling the error pool. See issue #2684.
1711 if FAdoHandle.Errors.Count > 0 then 1712 if FAdoHandle.Errors.Count > 0 then
1712 Result := FAdoHandle.Errors[FAdoHandle.Errors.Count-1].NativeError 1713 Result := FAdoHandle.Errors[FAdoHandle.Errors.Count-1].NativeError
1713 else 1714 else
1714 Result := 0; 1715 Result := 0;
1715 end; 1716 end;
1716 1717
1717 1718
1718 {** 1719 {**
1719 Return the last error nicely formatted 1720 Return the last error nicely formatted
1720 } 1721 }
1721 function TMySQLConnection.GetLastError: String; 1722 function TMySQLConnection.GetLastError: String;
1722 var 1723 var
1723 Msg, Additional: String; 1724 Msg, Additional: String;
1724 rx: TRegExpr; 1725 rx: TRegExpr;
1725 begin 1726 begin
1726 Msg := DecodeAPIString(mysql_error(FHandle)); 1727 Msg := DecodeAPIString(mysql_error(FHandle));
1727 // Find "(errno: 123)" in message and add more meaningful message from perror.exe 1728 // Find "(errno: 123)" in message and add more meaningful message from perror.exe
1728 rx := TRegExpr.Create; 1729 rx := TRegExpr.Create;
1729 rx.Expression := '.+\(errno\:\s+(\d+)\)'; 1730 rx.Expression := '.+\(errno\:\s+(\d+)\)';
1730 if rx.Exec(Msg) then begin 1731 if rx.Exec(Msg) then begin
1731 Additional := MySQLErrorCodes.Values[rx.Match[1]]; 1732 Additional := MySQLErrorCodes.Values[rx.Match[1]];
1732 if Additional <> '' then 1733 if Additional <> '' then
1733 Msg := Msg + CRLF + CRLF + Additional; 1734 Msg := Msg + CRLF + CRLF + Additional;
1734 end; 1735 end;
1735 rx.Free; 1736 rx.Free;
1736 Result := Format(MsgSQLError, [LastErrorCode, Msg]); 1737 Result := Format(MsgSQLError, [LastErrorCode, Msg]);
1737 end; 1738 end;
1738 1739
1739 1740
1740 function TAdoDBConnection.GetLastError: String; 1741 function TAdoDBConnection.GetLastError: String;
1741 var 1742 var
1742 Msg: String; 1743 Msg: String;
1743 rx: TRegExpr; 1744 rx: TRegExpr;
1744 E: Error; 1745 E: Error;
1745 begin 1746 begin
1746 if FAdoHandle.Errors.Count > 0 then begin 1747 if FAdoHandle.Errors.Count > 0 then begin
1747 E := FAdoHandle.Errors[FAdoHandle.Errors.Count-1]; 1748 E := FAdoHandle.Errors[FAdoHandle.Errors.Count-1];
1748 Msg := E.Description; 1749 Msg := E.Description;
1749 // Remove stuff from driver in message "[DBNETLIB][ConnectionOpen (Connect()).]" 1750 // Remove stuff from driver in message "[DBNETLIB][ConnectionOpen (Connect()).]"
1750 rx := TRegExpr.Create; 1751 rx := TRegExpr.Create;
1751 rx.Expression := '^\[DBNETLIB\]\[.*\](.+)$'; 1752 rx.Expression := '^\[DBNETLIB\]\[.*\](.+)$';
1752 if rx.Exec(Msg) then 1753 if rx.Exec(Msg) then
1753 Msg := rx.Match[1]; 1754 Msg := rx.Match[1];
1754 rx.Free; 1755 rx.Free;
1755 end else 1756 end else
1756 Msg := 'unknown'; 1757 Msg := 'unknown';
1757 Result := Format(MsgSQLError, [LastErrorCode, Msg]); 1758 Result := Format(MsgSQLError, [LastErrorCode, Msg]);
1758 end; 1759 end;
1759 1760
1760 1761
1761 {** 1762 {**
1762 Get version string as normalized integer 1763 Get version string as normalized integer
1763 "5.1.12-beta-community-123" => 50112 1764 "5.1.12-beta-community-123" => 50112
1764 } 1765 }
1765 function TMySQLConnection.GetServerVersionInt: Integer; 1766 function TMySQLConnection.GetServerVersionInt: Integer;
1766 var 1767 var
1767 i, dots: Byte; 1768 i, dots: Byte;
1768 v1, v2, v3: String; 1769 v1, v2, v3: String;
1769 begin 1770 begin
1770 Result := -1; 1771 Result := -1;
1771 1772
1772 dots := 0; 1773 dots := 0;
1773 v1 := ''; 1774 v1 := '';
1774 v2 := ''; 1775 v2 := '';
1775 v3 := ''; 1776 v3 := '';
1776 for i:=1 to Length(FServerVersionUntouched) do begin 1777 for i:=1 to Length(FServerVersionUntouched) do begin
1777 if FServerVersionUntouched[i] = '.' then begin 1778 if FServerVersionUntouched[i] = '.' then begin
1778 inc(dots); 1779 inc(dots);
1779 // We expect exactly 2 dots. 1780 // We expect exactly 2 dots.
1780 if dots > 2 then 1781 if dots > 2 then
1781 break; 1782 break;
1782 end else if CharInSet(FServerVersionUntouched[i], ['0'..'9']) then begin 1783 end else if CharInSet(FServerVersionUntouched[i], ['0'..'9']) then begin
1783 if dots = 0 then 1784 if dots = 0 then
1784 v1 := v1 + FServerVersionUntouched[i] 1785 v1 := v1 + FServerVersionUntouched[i]
1785 else if dots = 1 then 1786 else if dots = 1 then
1786 v2 := v2 + FServerVersionUntouched[i] 1787 v2 := v2 + FServerVersionUntouched[i]
1787 else if dots = 2 then 1788 else if dots = 2 then
1788 v3 := v3 + FServerVersionUntouched[i]; 1789 v3 := v3 + FServerVersionUntouched[i];
1789 end else // Don't include potential numbers of trailing string 1790 end else // Don't include potential numbers of trailing string
1790 break; 1791 break;
1791 end; 1792 end;
1792 1793
1793 // Concat tokens 1794 // Concat tokens
1794 if (Length(v1)>0) and (Length(v2)>0) and (Length(v3)>0) then begin 1795 if (Length(v1)>0) and (Length(v2)>0) and (Length(v3)>0) then begin
1795 Result := StrToIntDef(v1, 0) *10000 + 1796 Result := StrToIntDef(v1, 0) *10000 +
1796 StrToIntDef(v2, 0) *100 + 1797 StrToIntDef(v2, 0) *100 +
1797 StrToIntDef(v3, 0); 1798 StrToIntDef(v3, 0);
1798 end; 1799 end;
1799 1800
1800 end; 1801 end;
1801 1802
1802 function TAdoDBConnection.GetServerVersionInt: Integer; 1803 function TAdoDBConnection.GetServerVersionInt: Integer;
1803 var 1804 var
1804 rx: TRegExpr; 1805 rx: TRegExpr;
1805 begin 1806 begin
1806 rx := TRegExpr.Create; 1807 rx := TRegExpr.Create;
1807 rx.ModifierG := False; 1808 rx.ModifierG := False;
1808 rx.Expression := '(\d{4})\D'; 1809 rx.Expression := '(\d{4})\D';
1809 if rx.Exec(FServerVersionUntouched) then 1810 if rx.Exec(FServerVersionUntouched) then
1810 Result := MakeInt(rx.Match[1]) 1811 Result := MakeInt(rx.Match[1])
1811 else 1812 else
1812 Result := 0; 1813 Result := 0;
1813 rx.Free; 1814 rx.Free;
1814 end; 1815 end;
1815 1816
1816 1817
1817 function TDBConnection.GetServerVersionStr: String; 1818 function TDBConnection.GetServerVersionStr: String;
1818 begin 1819 begin
1819 Result := ConvertServerVersion(ServerVersionInt); 1820 Result := ConvertServerVersion(ServerVersionInt);
1820 end; 1821 end;
1821 1822
1822 1823
1823 function TDBConnection.GetAllDatabases: TStringList; 1824 function TDBConnection.GetAllDatabases: TStringList;
1824 var 1825 var
1825 rx: TRegExpr; 1826 rx: TRegExpr;
1826 begin 1827 begin
1827 // Get user passed delimited list 1828 // Get user passed delimited list
1828 if not Assigned(FAllDatabases) then begin 1829 if not Assigned(FAllDatabases) then begin
1829 if FParameters.AllDatabasesStr <> '' then begin 1830 if FParameters.AllDatabasesStr <> '' then begin
1830 FAllDatabases := TStringList.Create; 1831 FAllDatabases := TStringList.Create;
1831 rx := TRegExpr.Create; 1832 rx := TRegExpr.Create;
1832 rx.Expression := '[^;\s]+'; 1833 rx.Expression := '[^;\s]+';
1833 rx.ModifierG := True; 1834 rx.ModifierG := True;
1834 if rx.Exec(FParameters.AllDatabasesStr) then while true do begin 1835 if rx.Exec(FParameters.AllDatabasesStr) then while true do begin
1835 // Add if not a duplicate 1836 // Add if not a duplicate
1836 if FAllDatabases.IndexOf(rx.Match[0]) = -1 then 1837 if FAllDatabases.IndexOf(rx.Match[0]) = -1 then
1837 FAllDatabases.Add(rx.Match[0]); 1838 FAllDatabases.Add(rx.Match[0]);
1838 if not rx.ExecNext then 1839 if not rx.ExecNext then
1839 break; 1840 break;
1840 end; 1841 end;
1841 rx.Free; 1842 rx.Free;
1842 end; 1843 end;
1843 end; 1844 end;
1844 Result := FAllDatabases; 1845 Result := FAllDatabases;
1845 end; 1846 end;
1846 1847
1847 1848
1848 function TMySQLConnection.GetAllDatabases: TStringList; 1849 function TMySQLConnection.GetAllDatabases: TStringList;
1849 begin 1850 begin
1850 Result := inherited; 1851 Result := inherited;
1851 if not Assigned(Result) then begin 1852 if not Assigned(Result) then begin
1852 try 1853 try
1853 FAllDatabases := GetCol('SHOW DATABASES'); 1854 FAllDatabases := GetCol('SHOW DATABASES');
1854 except on E:EDatabaseError do 1855 except on E:EDatabaseError do
1855 try 1856 try
1856 FAllDatabases := GetCol('SELECT '+QuoteIdent('SCHEMA_NAME')+' FROM '+QuoteIdent('information_schema')+'.'+QuoteIdent('SCHEMATA')+' ORDER BY '+QuoteIdent('SCHEMA_NAME')); 1857 FAllDatabases := GetCol('SELECT '+QuoteIdent('SCHEMA_NAME')+' FROM '+QuoteIdent('information_schema')+'.'+QuoteIdent('SCHEMATA')+' ORDER BY '+QuoteIdent('SCHEMA_NAME'));
1857 except 1858 except
1858 on E:EDatabaseError do begin 1859 on E:EDatabaseError do begin
1859 FAllDatabases := TStringList.Create; 1860 FAllDatabases := TStringList.Create;
1860 Log(lcError, 'Database names not available due to missing privileges for user '+CurrentUserHostCombination+'.'); 1861 Log(lcError, 'Database names not available due to missing privileges for user '+CurrentUserHostCombination+'.');
1861 end; 1862 end;
1862 end; 1863 end;
1863 end; 1864 end;
1864 Result := FAllDatabases; 1865 Result := FAllDatabases;
1865 end; 1866 end;
1866 end; 1867 end;
1867 1868
1868 1869
1869 function TAdoDBConnection.GetAllDatabases: TStringList; 1870 function TAdoDBConnection.GetAllDatabases: TStringList;
1870 begin 1871 begin
1871 Result := inherited; 1872 Result := inherited;
1872 if not Assigned(Result) then begin 1873 if not Assigned(Result) then begin
1873 try 1874 try
1874 FAllDatabases := GetCol('SELECT '+QuoteIdent('name')+' FROM '+GetSQLSpecifity(spDatabaseTable)+' ORDER BY '+QuoteIdent('name')); 1875 FAllDatabases := GetCol('SELECT '+QuoteIdent('name')+' FROM '+GetSQLSpecifity(spDatabaseTable)+' ORDER BY '+QuoteIdent('name'));
1875 except on E:EDatabaseError do 1876 except on E:EDatabaseError do
1876 FAllDatabases := TStringList.Create; 1877 FAllDatabases := TStringList.Create;
1877 end; 1878 end;
1878 Result := FAllDatabases; 1879 Result := FAllDatabases;
1879 end; 1880 end;
1880 end; 1881 end;
1881 1882
1882 1883
1883 function TDBConnection.RefreshAllDatabases: TStringList; 1884 function TDBConnection.RefreshAllDatabases: TStringList;
1884 begin 1885 begin
1885 FreeAndNil(FAllDatabases); 1886 FreeAndNil(FAllDatabases);
1886 Result := AllDatabases; 1887 Result := AllDatabases;
1887 end; 1888 end;
1888 1889
1889 1890
1890 {** 1891 {**
1891 Convert integer version to real version string 1892 Convert integer version to real version string
1892 } 1893 }
1893 function TMySQLConnection.ConvertServerVersion(Version: Integer): String; 1894 function TMySQLConnection.ConvertServerVersion(Version: Integer): String;
1894 var 1895 var
1895 v : String; 1896 v : String;
1896 v1, v2 : Byte; 1897 v1, v2 : Byte;
1897 begin 1898 begin
1898 v := IntToStr( Version ); 1899 v := IntToStr( Version );
1899 v1 := StrToIntDef( v[2]+v[3], 0 ); 1900 v1 := StrToIntDef( v[2]+v[3], 0 );
1900 v2 := StrToIntDef( v[4]+v[5], 0 ); 1901 v2 := StrToIntDef( v[4]+v[5], 0 );
1901 Result := v[1] + '.' + IntToStr(v1) + '.' + IntToStr(v2); 1902 Result := v[1] + '.' + IntToStr(v1) + '.' + IntToStr(v2);
1902 end; 1903 end;
1903 1904
1904 1905
1905 function TAdoDBConnection.ConvertServerVersion(Version: Integer): String; 1906 function TAdoDBConnection.ConvertServerVersion(Version: Integer): String;
1906 begin 1907 begin
1907 Result := IntToStr(Version); 1908 Result := IntToStr(Version);
1908 end; 1909 end;
1909 1910
1910 1911
1911 function TDBConnection.GetResults(SQL: String): TDBQuery; 1912 function TDBConnection.GetResults(SQL: String): TDBQuery;
1912 begin 1913 begin
1913 Result := Parameters.CreateQuery(Self); 1914 Result := Parameters.CreateQuery(Self);
1914 Result.Connection := Self; 1915 Result.Connection := Self;
1915 Result.SQL := SQL; 1916 Result.SQL := SQL;
1916 try 1917 try
1917 Result.Execute; 1918 Result.Execute;
1918 except 1919 except
1919 FreeAndNil(Result); 1920 FreeAndNil(Result);
1920 Raise; 1921 Raise;
1921 end; 1922 end;
1922 end; 1923 end;
1923 1924
1924 1925
1925 {** 1926 {**
1926 Call log event if assigned to object 1927 Call log event if assigned to object
1927 If running a thread, log to queue and let the main thread later do logging 1928 If running a thread, log to queue and let the main thread later do logging
1928 } 1929 }
1929 procedure TDBConnection.Log(Category: TDBLogCategory; Msg: String); 1930 procedure TDBConnection.Log(Category: TDBLogCategory; Msg: String);
1930 begin 1931 begin
1931 if Assigned(FOnLog) then begin 1932 if Assigned(FOnLog) then begin
1932 if FLogPrefix <> '' then 1933 if FLogPrefix <> '' then
1933 Msg := '['+FLogPrefix+'] ' + Msg; 1934 Msg := '['+FLogPrefix+'] ' + Msg;
1934 // If in a thread, synchronize logging with the main thread. Logging within a thread 1935 // If in a thread, synchronize logging with the main thread. Logging within a thread
1935 // causes SynEdit to throw exceptions left and right. 1936 // causes SynEdit to throw exceptions left and right.
1936 if (FLockedByThread <> nil) and (FLockedByThread.ThreadID = GetCurrentThreadID) then 1937 if (FLockedByThread <> nil) and (FLockedByThread.ThreadID = GetCurrentThreadID) then
1937 (FLockedByThread as TQueryThread).LogFromOutside(Msg, Category) 1938 (FLockedByThread as TQueryThread).LogFromOutside(Msg, Category)
1938 else 1939 else
1939 FOnLog(Msg, Category, Self); 1940 FOnLog(Msg, Category, Self);
1940 end; 1941 end;
1941 end; 1942 end;
1942 1943
1943 1944
1944 {** 1945 {**
1945 Escapes a string for usage in SQL queries 1946 Escapes a string for usage in SQL queries
1946 - single-backslashes which represent normal parts of the text and not escape-sequences 1947 - single-backslashes which represent normal parts of the text and not escape-sequences
1947 - characters which MySQL doesn't strictly care about, but which might confuse editors etc. 1948 - characters which MySQL doesn't strictly care about, but which might confuse editors etc.
1948 - single and double quotes in a text string 1949 - single and double quotes in a text string
1949 - joker-chars for LIKE-comparisons 1950 - joker-chars for LIKE-comparisons
1950 Finally, surround the text by single quotes. 1951 Finally, surround the text by single quotes.
1951 1952
1952 @param string Text to escape 1953 @param string Text to escape
1953 @param boolean Escape text so it can be used in a LIKE-comparison 1954 @param boolean Escape text so it can be used in a LIKE-comparison
1954 @return string 1955 @return string
1955 } 1956 }
1956 function TDBConnection.EscapeString(Text: String; ProcessJokerChars: Boolean=false; DoQuote: Boolean=True): String; 1957 function TDBConnection.EscapeString(Text: String; ProcessJokerChars: Boolean=false; DoQuote: Boolean=True): String;
1957 var 1958 var
1958 c1, c2, c3, c4, EscChar: Char; 1959 c1, c2, c3, c4, EscChar: Char;
1959 begin 1960 begin
1960 c1 := ''''; 1961 c1 := '''';
1961 c2 := '\'; 1962 c2 := '\';
1962 c3 := '%'; 1963 c3 := '%';
1963 c4 := '_'; 1964 c4 := '_';
1964 EscChar := '\'; 1965 EscChar := '\';
1965 if not ProcessJokerChars then begin 1966 if not ProcessJokerChars then begin
1966 // Do not escape joker-chars which are used in a LIKE-clause 1967 // Do not escape joker-chars which are used in a LIKE-clause
1967 c4 := ''''; 1968 c4 := '''';
1968 c3 := ''''; 1969 c3 := '''';
1969 end; 1970 end;
1970 Result := escChars(Text, EscChar, c1, c2, c3, c4); 1971 Result := escChars(Text, EscChar, c1, c2, c3, c4);
1971 // Remove characters that SynEdit chokes on, so that 1972 // Remove characters that SynEdit chokes on, so that
1972 // the SQL file can be non-corruptedly loaded again. 1973 // the SQL file can be non-corruptedly loaded again.
1973 c1 := #13; 1974 c1 := #13;
1974 c2 := #10; 1975 c2 := #10;
1975 c3 := #0; 1976 c3 := #0;
1976 c4 := #0; 1977 c4 := #0;
1977 // TODO: SynEdit also chokes on Char($2028) and possibly Char($2029). 1978 // TODO: SynEdit also chokes on Char($2028) and possibly Char($2029).
1978 Result := escChars(Result, EscChar, c1, c2, c3, c4); 1979 Result := escChars(Result, EscChar, c1, c2, c3, c4);
1979 if DoQuote then begin 1980 if DoQuote then begin
1980 // Add surrounding single quotes 1981 // Add surrounding single quotes
1981 Result := Char(#39) + Result + Char(#39); 1982 Result := Char(#39) + Result + Char(#39);
1982 end; 1983 end;
1983 end; 1984 end;
1984 1985
1985 1986
1986 {*** 1987 {***
1987 Attempt to do string replacement faster than StringReplace 1988 Attempt to do string replacement faster than StringReplace
1988 } 1989 }
1989 function TDBConnection.escChars(const Text: String; EscChar, Char1, Char2, Char3, Char4: Char): String; 1990 function TDBConnection.escChars(const Text: String; EscChar, Char1, Char2, Char3, Char4: Char): String;
1990 const 1991 const
1991 // Attempt to match whatever the CPU cache will hold. 1992 // Attempt to match whatever the CPU cache will hold.
1992 block: Cardinal = 65536; 1993 block: Cardinal = 65536;
1993 var 1994 var
1994 bstart, bend, matches, i: Cardinal; 1995 bstart, bend, matches, i: Cardinal;
1995 // These could be bumped to uint64 if necessary. 1996 // These could be bumped to uint64 if necessary.
1996 len, respos: Cardinal; 1997 len, respos: Cardinal;
1997 next: Char; 1998 next: Char;
1998 begin 1999 begin
1999 len := Length(Text); 2000 len := Length(Text);
2000 Result := ''; 2001 Result := '';
2001 bend := 0; 2002 bend := 0;
2002 respos := 0; 2003 respos := 0;
2003 repeat 2004 repeat
2004 bstart := bend + 1; 2005 bstart := bend + 1;
2005 bend := bstart + block - 1; 2006 bend := bstart + block - 1;
2006 if bend > len then bend := len; 2007 if bend > len then bend := len;
2007 matches := 0; 2008 matches := 0;
2008 for i := bstart to bend do if 2009 for i := bstart to bend do if
2009 (Text[i] = Char1) or 2010 (Text[i] = Char1) or
2010 (Text[i] = Char2) or 2011 (Text[i] = Char2) or
2011 (Text[i] = Char3) or 2012 (Text[i] = Char3) or
2012 (Text[i] = Char4) 2013 (Text[i] = Char4)
2013 then Inc(matches); 2014 then Inc(matches);
2014 SetLength(Result, bend + 1 - bstart + matches + respos); 2015 SetLength(Result, bend + 1 - bstart + matches + respos);
2015 for i := bstart to bend do begin 2016 for i := bstart to bend do begin
2016 next := Text[i]; 2017 next := Text[i];
2017 if 2018 if
2018 (next = Char1) or 2019 (next = Char1) or
2019 (next = Char2) or 2020 (next = Char2) or
2020 (next = Char3) or 2021 (next = Char3) or
2021 (next = Char4) 2022 (next = Char4)
2022 then begin 2023 then begin
2023 Inc(respos); 2024 Inc(respos);
2024 Result[respos] := EscChar; 2025 Result[respos] := EscChar;
2025 // Special values for MySQL escape. 2026 // Special values for MySQL escape.
2026 if next = #13 then next := 'r'; 2027 if next = #13 then next := 'r';
2027 if next = #10 then next := 'n'; 2028 if next = #10 then next := 'n';
2028 if next = #0 then next := '0'; 2029 if next = #0 then next := '0';
2029 end; 2030 end;
2030 Inc(respos); 2031 Inc(respos);
2031 Result[respos] := next; 2032 Result[respos] := next;
2032 end; 2033 end;
2033 until bend = len; 2034 until bend = len;
2034 end; 2035 end;
2035 2036
2036 2037
2037 function TDBConnection.UnescapeString(Text: String): String; 2038 function TDBConnection.UnescapeString(Text: String): String;
2038 begin 2039 begin
2039 // Return text with MySQL special sequences turned back to normal characters 2040 // Return text with MySQL special sequences turned back to normal characters
2040 Result := StringReplace(Text, '\0', #0, [rfReplaceAll]); 2041 Result := StringReplace(Text, '\0', #0, [rfReplaceAll]);
2041 Result := StringReplace(Result, '\b', #8, [rfReplaceAll]); 2042 Result := StringReplace(Result, '\b', #8, [rfReplaceAll]);
2042 Result := StringReplace(Result, '\t', #9, [rfReplaceAll]); 2043 Result := StringReplace(Result, '\t', #9, [rfReplaceAll]);
2043 Result := StringReplace(Result, '\n', #10, [rfReplaceAll]); 2044 Result := StringReplace(Result, '\n', #10, [rfReplaceAll]);
2044 Result := StringReplace(Result, '\r', #13, [rfReplaceAll]); 2045 Result := StringReplace(Result, '\r', #13, [rfReplaceAll]);
2045 Result := StringReplace(Result, '\Z', #26, [rfReplaceAll]); 2046 Result := StringReplace(Result, '\Z', #26, [rfReplaceAll]);
2046 Result := StringReplace(Result, '''''', '''', [rfReplaceAll]); 2047 Result := StringReplace(Result, '''''', '''', [rfReplaceAll]);
2047 Result := StringReplace(Result, '\''', '''', [rfReplaceAll]); 2048 Result := StringReplace(Result, '\''', '''', [rfReplaceAll]);
2048 end; 2049 end;
2049 2050
2050 2051
2051 {** 2052 {**
2052 Add backticks to identifier 2053 Add backticks to identifier
2053 Todo: Support ANSI style 2054 Todo: Support ANSI style
2054 } 2055 }
2055 function TDBConnection.QuoteIdent(Identifier: String; AlwaysQuote: Boolean=True; Glue: Char=#0): String; 2056 function TDBConnection.QuoteIdent(Identifier: String; AlwaysQuote: Boolean=True; Glue: Char=#0): String;
2056 var 2057 var
2057 GluePos, i: Integer; 2058 GluePos, i: Integer;
2058 begin 2059 begin
2059 Result := Identifier; 2060 Result := Identifier;
2060 GluePos := 0; 2061 GluePos := 0;
2061 if Glue <> #0 then begin 2062 if Glue <> #0 then begin
2062 GluePos := Pos(Glue, Result); 2063 GluePos := Pos(Glue, Result);
2063 if GluePos > 0 then 2064 if GluePos > 0 then
2064 Result := QuoteIdent(Copy(Result, 1, GluePos-1)) + Glue + QuoteIdent(Copy(Result, GluePos+1, MaxInt)); 2065 Result := QuoteIdent(Copy(Result, 1, GluePos-1)) + Glue + QuoteIdent(Copy(Result, GluePos+1, MaxInt));
2065 end; 2066 end;
2066 if GluePos = 0 then begin 2067 if GluePos = 0 then begin
2067 if not AlwaysQuote then begin 2068 if not AlwaysQuote then begin
2068 if MySQLKeywords.IndexOf(Result) > -1 then 2069 if MySQLKeywords.IndexOf(Result) > -1 then
2069 AlwaysQuote := True 2070 AlwaysQuote := True
2070 else for i:=1 to Length(Result) do begin 2071 else for i:=1 to Length(Result) do begin
2071 if not CharInSet(Result[i], IDENTCHARS) then begin 2072 if not CharInSet(Result[i], IDENTCHARS) then begin
2072 AlwaysQuote := True; 2073 AlwaysQuote := True;
2073 break; 2074 break;
2074 end; 2075 end;
2075 end; 2076 end;
2076 end; 2077 end;
2077 if AlwaysQuote then begin 2078 if AlwaysQuote then begin
2078 Result := StringReplace(Result, FQuoteChar, FQuoteChar+FQuoteChar, [rfReplaceAll]); 2079 Result := StringReplace(Result, FQuoteChar, FQuoteChar+FQuoteChar, [rfReplaceAll]);
2079 Result := FQuoteChar + Result + FQuoteChar; 2080 Result := FQuoteChar + Result + FQuoteChar;
2080 end; 2081 end;
2081 end; 2082 end;
2082 end; 2083 end;
2083 2084
2084 2085
2085 function TDBConnection.DeQuoteIdent(Identifier: String; Glue: Char=#0): String; 2086 function TDBConnection.DeQuoteIdent(Identifier: String; Glue: Char=#0): String;
2086 begin 2087 begin
2087 Result := Identifier; 2088 Result := Identifier;
2088 if (Length(Identifier)>0) and (Result[1] = FQuoteChar) and (Result[Length(Identifier)] = FQuoteChar) then 2089 if (Length(Identifier)>0) and (Result[1] = FQuoteChar) and (Result[Length(Identifier)] = FQuoteChar) then
2089 Result := Copy(Result, 2, Length(Result)-2); 2090 Result := Copy(Result, 2, Length(Result)-2);
2090 if Glue <> #0 then 2091 if Glue <> #0 then
2091 Result := StringReplace(Result, FQuoteChar+Glue+FQuoteChar, Glue, [rfReplaceAll]); 2092 Result := StringReplace(Result, FQuoteChar+Glue+FQuoteChar, Glue, [rfReplaceAll]);
2092 Result := StringReplace(Result, FQuoteChar+FQuoteChar, FQuoteChar, [rfReplaceAll]); 2093 Result := StringReplace(Result, FQuoteChar+FQuoteChar, FQuoteChar, [rfReplaceAll]);
2093 end; 2094 end;
2094 2095
2095 2096
2096 function TDBConnection.GetCol(SQL: String; Column: Integer=0): TStringList; 2097 function TDBConnection.GetCol(SQL: String; Column: Integer=0): TStringList;
2097 var 2098 var
2098 Results: TDBQuery; 2099 Results: TDBQuery;
2099 begin 2100 begin
2100 Results := GetResults(SQL); 2101 Results := GetResults(SQL);
2101 Result := TStringList.Create; 2102 Result := TStringList.Create;
2102 if Results.RecordCount > 0 then while not Results.Eof do begin 2103 if Results.RecordCount > 0 then while not Results.Eof do begin
2103 Result.Add(Results.Col(Column)); 2104 Result.Add(Results.Col(Column));
2104 Results.Next; 2105 Results.Next;
2105 end; 2106 end;
2106 FreeAndNil(Results); 2107 FreeAndNil(Results);
2107 end; 2108 end;
2108 2109
2109 2110
2110 {** 2111 {**
2111 Get single cell value via SQL query, identified by column number 2112 Get single cell value via SQL query, identified by column number
2112 } 2113 }
2113 function TDBConnection.GetVar(SQL: String; Column: Integer=0): String; 2114 function TDBConnection.GetVar(SQL: String; Column: Integer=0): String;
2114 var 2115 var
2115 Results: TDBQuery; 2116 Results: TDBQuery;
2116 begin 2117 begin
2117 Results := GetResults(SQL); 2118 Results := GetResults(SQL);
2118 if Results.RecordCount > 0 then 2119 if Results.RecordCount > 0 then
2119 Result := Results.Col(Column) 2120 Result := Results.Col(Column)
2120 else 2121 else
2121 Result := ''; 2122 Result := '';
2122 FreeAndNil(Results); 2123 FreeAndNil(Results);
2123 end; 2124 end;
2124 2125
2125 2126
2126 {** 2127 {**
2127 Get single cell value via SQL query, identified by column name 2128 Get single cell value via SQL query, identified by column name
2128 } 2129 }
2129 function TDBConnection.GetVar(SQL: String; Column: String): String; 2130 function TDBConnection.GetVar(SQL: String; Column: String): String;
2130 var 2131 var
2131 Results: TDBQuery; 2132 Results: TDBQuery;
2132 begin 2133 begin
2133 Results := GetResults(SQL); 2134 Results := GetResults(SQL);
2134 if Results.RecordCount > 0 then 2135 if Results.RecordCount > 0 then
2135 Result := Results.Col(Column) 2136 Result := Results.Col(Column)
2136 else 2137 else
2137 Result := ''; 2138 Result := '';
2138 FreeAndNil(Results); 2139 FreeAndNil(Results);
2139 end; 2140 end;
2140 2141
2141 2142
2142 function TDBConnection.GetTableEngines: TStringList; 2143 function TDBConnection.GetTableEngines: TStringList;
2143 begin 2144 begin
2144 if not Assigned(FTableEngines) then 2145 if not Assigned(FTableEngines) then
2145 FTableEngines := TStringList.Create; 2146 FTableEngines := TStringList.Create;
2146 Result := FTableEngines; 2147 Result := FTableEngines;
2147 end; 2148 end;
2148 2149
2149 2150
2150 function TMySQLConnection.GetTableEngines: TStringList; 2151 function TMySQLConnection.GetTableEngines: TStringList;
2151 var 2152 var
2152 Results: TDBQuery; 2153 Results: TDBQuery;
2153 engineName, engineSupport: String; 2154 engineName, engineSupport: String;
2154 rx: TRegExpr; 2155 rx: TRegExpr;
2155 begin 2156 begin
2156 // After a disconnect Ping triggers the cached engines to be reset 2157 // After a disconnect Ping triggers the cached engines to be reset
2157 Log(lcDebug, 'Fetching list of table engines ...'); 2158 Log(lcDebug, 'Fetching list of table engines ...');
2158 Ping(True); 2159 Ping(True);
2159 if not Assigned(FTableEngines) then begin 2160 if not Assigned(FTableEngines) then begin
2160 FTableEngines := TStringList.Create; 2161 FTableEngines := TStringList.Create;
2161 try 2162 try
2162 Results := GetResults('SHOW ENGINES'); 2163 Results := GetResults('SHOW ENGINES');
2163 while not Results.Eof do begin 2164 while not Results.Eof do begin
2164 engineName := Results.Col('Engine'); 2165 engineName := Results.Col('Engine');
2165 engineSupport := LowerCase(Results.Col('Support')); 2166 engineSupport := LowerCase(Results.Col('Support'));
2166 // Add to dropdown if supported 2167 // Add to dropdown if supported
2167 if (engineSupport = 'yes') or (engineSupport = 'default') then 2168 if (engineSupport = 'yes') or (engineSupport = 'default') then
2168 FTableEngines.Add(engineName); 2169 FTableEngines.Add(engineName);
2169 // Check if this is the default engine 2170 // Check if this is the default engine
2170 if engineSupport = 'default' then 2171 if engineSupport = 'default' then
2171 FTableEngineDefault := engineName; 2172 FTableEngineDefault := engineName;
2172 Results.Next; 2173 Results.Next;
2173 end; 2174 end;
2174 Results.Free; 2175 Results.Free;
2175 except 2176 except
2176 // Ignore errors on old servers and try a fallback: 2177 // Ignore errors on old servers and try a fallback:
2177 // Manually fetch available engine types by analysing have_* options 2178 // Manually fetch available engine types by analysing have_* options
2178 // This is for servers below 4.1 or when the SHOW ENGINES statement has 2179 // This is for servers below 4.1 or when the SHOW ENGINES statement has
2179 // failed for some other reason 2180 // failed for some other reason
2180 Results := GetServerVariables; 2181 Results := GetServerVariables;
2181 // Add default engines which will not show in a have_* variable: 2182 // Add default engines which will not show in a have_* variable:
2182 FTableEngines.CommaText := 'MyISAM,MRG_MyISAM,HEAP'; 2183 FTableEngines.CommaText := 'MyISAM,MRG_MyISAM,HEAP';
2183 FTableEngineDefault := 'MyISAM'; 2184 FTableEngineDefault := 'MyISAM';
2184 rx := TRegExpr.Create; 2185 rx := TRegExpr.Create;
2185 rx.ModifierI := True; 2186 rx.ModifierI := True;
2186 rx.Expression := '^have_(ARCHIVE|BDB|BLACKHOLE|CSV|EXAMPLE|FEDERATED|INNODB|ISAM)(_engine)?$'; 2187 rx.Expression := '^have_(ARCHIVE|BDB|BLACKHOLE|CSV|EXAMPLE|FEDERATED|INNODB|ISAM)(_engine)?$';
2187 while not Results.Eof do begin 2188 while not Results.Eof do begin
2188 if rx.Exec(Results.Col(0)) and (LowerCase(Results.Col(1)) = 'yes') then 2189 if rx.Exec(Results.Col(0)) and (LowerCase(Results.Col(1)) = 'yes') then
2189 FTableEngines.Add(UpperCase(rx.Match[1])); 2190 FTableEngines.Add(UpperCase(rx.Match[1]));
2190 Results.Next; 2191 Results.Next;
2191 end; 2192 end;
2192 rx.Free; 2193 rx.Free;
2193 Results.Free; 2194 Results.Free;
2194 end; 2195 end;
2195 end; 2196 end;
2196 Result := FTableEngines; 2197 Result := FTableEngines;
2197 end; 2198 end;
2198 2199
2199 2200
2200 function TDBConnection.GetCollationTable: TDBQuery; 2201 function TDBConnection.GetCollationTable: TDBQuery;
2201 begin 2202 begin
2202 Log(lcDebug, 'Fetching list of collations ...'); 2203 Log(lcDebug, 'Fetching list of collations ...');
2203 Ping(True); 2204 Ping(True);
2204 Result := FCollationTable; 2205 Result := FCollationTable;
2205 end; 2206 end;
2206 2207
2207 2208
2208 function TMySQLConnection.GetCollationTable: TDBQuery; 2209 function TMySQLConnection.GetCollationTable: TDBQuery;
2209 begin 2210 begin
2210 inherited; 2211 inherited;
2211 if (not Assigned(FCollationTable)) and (ServerVersionInt >= 40100) then 2212 if (not Assigned(FCollationTable)) and (ServerVersionInt >= 40100) then
2212 FCollationTable := GetResults('SHOW COLLATION'); 2213 FCollationTable := GetResults('SHOW COLLATION');
2213 if Assigned(FCollationTable) then 2214 if Assigned(FCollationTable) then
2214 FCollationTable.First; 2215 FCollationTable.First;
2215 Result := FCollationTable; 2216 Result := FCollationTable;
2216 end; 2217 end;
2217 2218
2218 2219
2219 function TAdoDBConnection.GetCollationTable: TDBQuery; 2220 function TAdoDBConnection.GetCollationTable: TDBQuery;
2220 begin 2221 begin
2221 inherited; 2222 inherited;
2222 if (not Assigned(FCollationTable)) then 2223 if (not Assigned(FCollationTable)) then
2223 FCollationTable := GetResults('SELECT '+EscapeString('')+' AS '+QuoteIdent('Collation')+', '+ 2224 FCollationTable := GetResults('SELECT '+EscapeString('')+' AS '+QuoteIdent('Collation')+', '+
2224 EscapeString('')+' AS '+QuoteIdent('Charset')+', 0 AS '+QuoteIdent('Id')+', '+ 2225 EscapeString('')+' AS '+QuoteIdent('Charset')+', 0 AS '+QuoteIdent('Id')+', '+
2225 EscapeString('')+' AS '+QuoteIdent('Default')+', '+EscapeString('')+' AS '+QuoteIdent('Compiled')+', '+ 2226 EscapeString('')+' AS '+QuoteIdent('Default')+', '+EscapeString('')+' AS '+QuoteIdent('Compiled')+', '+
2226 '1 AS '+QuoteIdent('Sortlen')); 2227 '1 AS '+QuoteIdent('Sortlen'));
2227 if Assigned(FCollationTable) then 2228 if Assigned(FCollationTable) then
2228 FCollationTable.First; 2229 FCollationTable.First;
2229 Result := FCollationTable; 2230 Result := FCollationTable;
2230 end; 2231 end;
2231 2232
2232 2233
2233 function TDBConnection.GetCollationList: TStringList; 2234 function TDBConnection.GetCollationList: TStringList;
2234 var 2235 var
2235 c: TDBQuery; 2236 c: TDBQuery;
2236 begin 2237 begin
2237 c := CollationTable; 2238 c := CollationTable;
2238 Result := TStringList.Create; 2239 Result := TStringList.Create;
2239 if Assigned(c) then while not c.Eof do begin 2240 if Assigned(c) then while not c.Eof do begin
2240 Result.Add(c.Col('Collation')); 2241 Result.Add(c.Col('Collation'));
2241 c.Next; 2242 c.Next;
2242 end; 2243 end;
2243 end; 2244 end;
2244 2245
2245 2246
2246 function TDBConnection.GetCharsetTable: TDBQuery; 2247 function TDBConnection.GetCharsetTable: TDBQuery;
2247 begin 2248 begin
2248 Log(lcDebug, 'Fetching charset list ...'); 2249 Log(lcDebug, 'Fetching charset list ...');
2249 Ping(True); 2250 Ping(True);
2250 Result := nil; 2251 Result := nil;
2251 end; 2252 end;
2252 2253
2253 2254
2254 function TMySQLConnection.GetCharsetTable: TDBQuery; 2255 function TMySQLConnection.GetCharsetTable: TDBQuery;
2255 begin 2256 begin
2256 inherited; 2257 inherited;
2257 if (not Assigned(FCharsetTable)) and (ServerVersionInt >= 40100) then 2258 if (not Assigned(FCharsetTable)) and (ServerVersionInt >= 40100) then
2258 FCharsetTable := GetResults('SHOW CHARSET'); 2259 FCharsetTable := GetResults('SHOW CHARSET');
2259 Result := FCharsetTable; 2260 Result := FCharsetTable;
2260 end; 2261 end;
2261 2262
2262 2263
2263 function TAdoDBConnection.GetCharsetTable: TDBQuery; 2264 function TAdoDBConnection.GetCharsetTable: TDBQuery;
2264 begin 2265 begin
2265 inherited; 2266 inherited;
2266 if not Assigned(FCharsetTable) then 2267 if not Assigned(FCharsetTable) then
2267 FCharsetTable := GetResults('SELECT '+QuoteIdent('name')+' AS '+QuoteIdent('Charset')+', '+QuoteIdent('description')+' AS '+QuoteIdent('Description')+ 2268 FCharsetTable := GetResults('SELECT '+QuoteIdent('name')+' AS '+QuoteIdent('Charset')+', '+QuoteIdent('description')+' AS '+QuoteIdent('Description')+
2268 ' FROM '+QuoteIdent('sys')+'.'+QuoteIdent('syscharsets') 2269 ' FROM '+QuoteIdent('sys')+'.'+QuoteIdent('syscharsets')
2269 ); 2270 );
2270 Result := FCharsetTable; 2271 Result := FCharsetTable;
2271 end; 2272 end;
2272 2273
2273 2274
2274 function TDBConnection.GetCharsetList: TStringList; 2275 function TDBConnection.GetCharsetList: TStringList;
2275 var 2276 var
2276 c: TDBQuery; 2277 c: TDBQuery;
2277 begin 2278 begin
2278 c := CharsetTable; 2279 c := CharsetTable;
2279 Result := TStringList.Create; 2280 Result := TStringList.Create;
2280 if Assigned(c) then begin 2281 if Assigned(c) then begin
2281 c.First; 2282 c.First;
2282 while not c.Eof do begin 2283 while not c.Eof do begin
2283 Result.Add(c.Col('Description') + ' (' + c.Col('Charset') + ')'); 2284 Result.Add(c.Col('Description') + ' (' + c.Col('Charset') + ')');
2284 c.Next; 2285 c.Next;
2285 end; 2286 end;
2286 end; 2287 end;
2287 end; 2288 end;
2288 2289
2289 2290
2290 function TMySQLConnection.GetServerVariables: TDBQuery; 2291 function TMySQLConnection.GetServerVariables: TDBQuery;
2291 begin 2292 begin
2292 // Return server variables 2293 // Return server variables
2293 Result := GetResults('SHOW VARIABLES'); 2294 Result := GetResults('SHOW VARIABLES');
2294 end; 2295 end;
2295 2296
2296 2297
2297 function TAdoDBConnection.GetServerVariables: TDBQuery; 2298 function TAdoDBConnection.GetServerVariables: TDBQuery;
2298 begin 2299 begin
2299 // Enumerate some config values on MS SQL 2300 // Enumerate some config values on MS SQL
2300 Result := GetResults('SELECT '+QuoteIdent('comment')+', '+QuoteIdent('value')+' FROM '+QuoteIdent('master')+'.'+QuoteIdent('dbo')+'.'+QuoteIdent('syscurconfigs')+' ORDER BY '+QuoteIdent('comment')); 2301 Result := GetResults('SELECT '+QuoteIdent('comment')+', '+QuoteIdent('value')+' FROM '+QuoteIdent('master')+'.'+QuoteIdent('dbo')+'.'+QuoteIdent('syscurconfigs')+' ORDER BY '+QuoteIdent('comment'));
2301 end; 2302 end;
2302 2303
2303 2304
2304 function TDBConnection.GetSQLSpecifity(Specifity: TSQLSpecifityId): String; 2305 function TDBConnection.GetSQLSpecifity(Specifity: TSQLSpecifityId): String;
2305 begin 2306 begin
2306 // Return some version specific SQL clause or snippet 2307 // Return some version specific SQL clause or snippet
2307 Result := FSQLSpecifities[Specifity]; 2308 Result := FSQLSpecifities[Specifity];
2308 end; 2309 end;
2309 2310
2310 2311
2311 function TDBConnection.GetInformationSchemaObjects: TStringList; 2312 function TDBConnection.GetInformationSchemaObjects: TStringList;
2312 var 2313 var
2313 Objects: TDBObjectList; 2314 Objects: TDBObjectList;
2314 Obj: TDBObject; 2315 Obj: TDBObject;
2315 begin 2316 begin
2316 Log(lcDebug, 'Fetching objects in information_schema db ...'); 2317 Log(lcDebug, 'Fetching objects in information_schema db ...');
2317 Ping(True); 2318 Ping(True);
2318 if not Assigned(FInformationSchemaObjects) then begin 2319 if not Assigned(FInformationSchemaObjects) then begin
2319 FInformationSchemaObjects := TStringList.Create; 2320 FInformationSchemaObjects := TStringList.Create;
2320 // Gracefully return an empty list on old servers 2321 // Gracefully return an empty list on old servers
2321 if AllDatabases.IndexOf('information_schema') > -1 then begin 2322 if AllDatabases.IndexOf('information_schema') > -1 then begin
2322 Objects := GetDBObjects('information_schema'); 2323 Objects := GetDBObjects('information_schema');
2323 for Obj in Objects do 2324 for Obj in Objects do
2324 FInformationSchemaObjects.Add(Obj.Name); 2325 FInformationSchemaObjects.Add(Obj.Name);
2325 end; 2326 end;
2326 end; 2327 end;
2327 Result := FInformationSchemaObjects; 2328 Result := FInformationSchemaObjects;
2328 end; 2329 end;
2329 2330
2330 2331
2331 function TAdoDBConnection.GetInformationSchemaObjects: TStringList; 2332 function TAdoDBConnection.GetInformationSchemaObjects: TStringList;
2332 begin 2333 begin
2333 // MS SQL hides information_schema 2334 // MS SQL hides information_schema
2334 inherited; 2335 inherited;
2335 if FInformationSchemaObjects.Count = 0 then begin 2336 if FInformationSchemaObjects.Count = 0 then begin
2336 FInformationSchemaObjects.CommaText := 'CHECK_CONSTRAINTS,'+ 2337 FInformationSchemaObjects.CommaText := 'CHECK_CONSTRAINTS,'+
2337 'COLUMN_DOMAIN_USAGE,'+ 2338 'COLUMN_DOMAIN_USAGE,'+
2338 'COLUMN_PRIVILEGES,'+ 2339 'COLUMN_PRIVILEGES,'+
2339 'COLUMNS,'+ 2340 'COLUMNS,'+
2340 'CONSTRAINT_COLUMN_USAGE,'+ 2341 'CONSTRAINT_COLUMN_USAGE,'+
2341 'CONSTRAINT_TABLE_USAGE,'+ 2342 'CONSTRAINT_TABLE_USAGE,'+
2342 'DOMAIN_CONSTRAINTS,'+ 2343 'DOMAIN_CONSTRAINTS,'+
2343 'DOMAINS,'+ 2344 'DOMAINS,'+
2344 'KEY_COLUMN_USAGE,'+ 2345 'KEY_COLUMN_USAGE,'+
2345 'PARAMETERS,'+ 2346 'PARAMETERS,'+
2346 'REFERENTIAL_CONSTRAINTS,'+ 2347 'REFERENTIAL_CONSTRAINTS,'+
2347 'ROUTINES,'+ 2348 'ROUTINES,'+
2348 'ROUTINE_COLUMNS,'+ 2349 'ROUTINE_COLUMNS,'+
2349 'SCHEMATA,'+ 2350 'SCHEMATA,'+
2350 'TABLE_CONSTRAINTS,'+ 2351 'TABLE_CONSTRAINTS,'+
2351 'TABLE_PRIVILEGES,'+ 2352 'TABLE_PRIVILEGES,'+
2352 'TABLES,'+ 2353 'TABLES,'+
2353 'VIEW_COLUMN_USAGE,'+ 2354 'VIEW_COLUMN_USAGE,'+
2354 'VIEW_TABLE_USAGE,'+ 2355 'VIEW_TABLE_USAGE,'+
2355 'VIEWS'; 2356 'VIEWS';
2356 end; 2357 end;
2357 Result := FInformationSchemaObjects; 2358 Result := FInformationSchemaObjects;
2358 end; 2359 end;
2359 2360
2360 2361
2361 function TDBConnection.GetConnectionUptime: Integer; 2362 function TDBConnection.GetConnectionUptime: Integer;
2362 begin 2363 begin
2363 // Return seconds since last connect 2364 // Return seconds since last connect
2364 if not FActive then 2365 if not FActive then
2365 Result := 0 2366 Result := 0
2366 else 2367 else
2367 Result := Integer(GetTickCount div 1000) - FConnectionStarted; 2368 Result := Integer(GetTickCount div 1000) - FConnectionStarted;
2368 end; 2369 end;
2369 2370
2370 2371
2371 function TDBConnection.GetServerUptime: Integer; 2372 function TDBConnection.GetServerUptime: Integer;
2372 begin 2373 begin
2373 // Return server uptime in seconds. Return -1 if unknown. 2374 // Return server uptime in seconds. Return -1 if unknown.
2374 if FServerUptime > 0 then 2375 if FServerUptime > 0 then
2375 Result := FServerUptime + (Integer(GetTickCount div 1000) - FConnectionStarted) 2376 Result := FServerUptime + (Integer(GetTickCount div 1000) - FConnectionStarted)
2376 else 2377 else
2377 Result := -1; 2378 Result := -1;
2378 end; 2379 end;
2379 2380
2380 2381
2381 function TDBConnection.GetCurrentUserHostCombination: String; 2382 function TDBConnection.GetCurrentUserHostCombination: String;
2382 begin 2383 begin
2383 // Return current user@host combination, used by various object editors for DEFINER clauses 2384 // Return current user@host combination, used by various object editors for DEFINER clauses
2384 Log(lcDebug, 'Fetching user@host ...'); 2385 Log(lcDebug, 'Fetching user@host ...');
2385 Ping(True); 2386 Ping(True);
2386 if FCurrentUserHostCombination = '' then 2387 if FCurrentUserHostCombination = '' then
2387 FCurrentUserHostCombination := GetVar(GetSQLSpecifity(spCurrentUserHost)); 2388 FCurrentUserHostCombination := GetVar(GetSQLSpecifity(spCurrentUserHost));
2388 Result := FCurrentUserHostCombination; 2389 Result := FCurrentUserHostCombination;
2389 end; 2390 end;
2390 2391
2391 2392
2392 procedure TDBConnection.ClearCache(IncludeDBObjects: Boolean); 2393 procedure TDBConnection.ClearCache(IncludeDBObjects: Boolean);
2393 begin 2394 begin
2394 // Free cached lists and results. Called when the connection was closed and/or destroyed 2395 // Free cached lists and results. Called when the connection was closed and/or destroyed
2395 FreeAndNil(FCollationTable); 2396 FreeAndNil(FCollationTable);
2396 FreeAndNil(FCharsetTable); 2397 FreeAndNil(FCharsetTable);
2397 FreeAndNil(FTableEngines); 2398 FreeAndNil(FTableEngines);
2398 FreeAndNil(FInformationSchemaObjects); 2399 FreeAndNil(FInformationSchemaObjects);
2399 if IncludeDBObjects then 2400 if IncludeDBObjects then
2400 ClearAllDbObjects; 2401 ClearAllDbObjects;
2401 FTableEngineDefault := ''; 2402 FTableEngineDefault := '';
2402 FCurrentUserHostCombination := ''; 2403 FCurrentUserHostCombination := '';
2403 FThreadID := 0; 2404 FThreadID := 0;
2404 end; 2405 end;
2405 2406
2406 2407
2407 procedure TDBConnection.ClearDbObjects(db: String); 2408 procedure TDBConnection.ClearDbObjects(db: String);
2408 var 2409 var
2409 i: Integer; 2410 i: Integer;
2410 begin 2411 begin
2411 // Free cached database object list 2412 // Free cached database object list
2412 for i:=0 to FDatabases.Count-1 do begin 2413 for i:=0 to FDatabases.Count-1 do begin
2413 if FDatabases[i].Database = db then begin 2414 if FDatabases[i].Database = db then begin
2414 FDatabases.Delete(i); 2415 FDatabases.Delete(i);
2415 if Assigned(FOnDBObjectsCleared) then 2416 if Assigned(FOnDBObjectsCleared) then
2416 FOnDBObjectsCleared(Self, db); 2417 FOnDBObjectsCleared(Self, db);
2417 break; 2418 break;
2418 end; 2419 end;
2419 end; 2420 end;
2420 end; 2421 end;
2421 2422
2422 2423
2423 procedure TDBConnection.ClearAllDbObjects; 2424 procedure TDBConnection.ClearAllDbObjects;
2424 var 2425 var
2425 i: Integer; 2426 i: Integer;
2426 begin 2427 begin
2427 for i:=FDatabases.Count-1 downto 0 do 2428 for i:=FDatabases.Count-1 downto 0 do
2428 ClearDbObjects(FDatabases[i].Database); 2429 ClearDbObjects(FDatabases[i].Database);
2429 end; 2430 end;
2430 2431
2431 2432
2432 function TDBConnection.DbObjectsCached(db: String): Boolean; 2433 function TDBConnection.DbObjectsCached(db: String): Boolean;
2433 var 2434 var
2434 i: Integer; 2435 i: Integer;
2435 begin 2436 begin
2436 // Check if a table list is stored in cache 2437 // Check if a table list is stored in cache
2437 Result := False; 2438 Result := False;
2438 for i:=0 to FDatabases.Count-1 do begin 2439 for i:=0 to FDatabases.Count-1 do begin
2439 if FDatabases[i].Database = db then begin 2440 if FDatabases[i].Database = db then begin
2440 Result := True; 2441 Result := True;
2441 break; 2442 break;
2442 end; 2443 end;
2443 end; 2444 end;
2444 end; 2445 end;
2445 2446
2446 2447
2447 function TDBConnection.ParseDateTime(Str: String): TDateTime; 2448 function TDBConnection.ParseDateTime(Str: String): TDateTime;
2448 var 2449 var
2449 rx: TRegExpr; 2450 rx: TRegExpr;
2450 begin 2451 begin
2451 // Parse SQL date/time string value into a TDateTime 2452 // Parse SQL date/time string value into a TDateTime
2452 Result := 0; 2453 Result := 0;
2453 rx := TRegExpr.Create; 2454 rx := TRegExpr.Create;
2454 rx.Expression := '^(\d{4})\-(\d{2})\-(\d{2}) (\d{2})\:(\d{2})\:(\d{2})$'; 2455 rx.Expression := '^(\d{4})\-(\d{2})\-(\d{2}) (\d{2})\:(\d{2})\:(\d{2})$';
2455 if rx.Exec(Str) then try 2456 if rx.Exec(Str) then try
2456 Result := EncodeDateTime( 2457 Result := EncodeDateTime(
2457 StrToIntDef(rx.Match[1], 0), 2458 StrToIntDef(rx.Match[1], 0),
2458 StrToIntDef(rx.Match[2], 1), 2459 StrToIntDef(rx.Match[2], 1),
2459 StrToIntDef(rx.Match[3], 1), 2460 StrToIntDef(rx.Match[3], 1),
2460 StrToIntDef(rx.Match[4], 0), 2461 StrToIntDef(rx.Match[4], 0),
2461 StrToIntDef(rx.Match[5], 0), 2462 StrToIntDef(rx.Match[5], 0),
2462 StrToIntDef(rx.Match[6], 0), 2463 StrToIntDef(rx.Match[6], 0),
2463 0 // milliseconds, unused 2464 0 // milliseconds, unused
2464 ); 2465 );
2465 except 2466 except
2466 Result := 0; 2467 Result := 0;
2467 end; 2468 end;
2468 end; 2469 end;
2469 2470
2470 2471
2471 function TMySQLConnection.GetDbObjects(db: String; Refresh: Boolean=False): TDBObjectList; 2472 function TMySQLConnection.GetDbObjects(db: String; Refresh: Boolean=False): TDBObjectList;
2472 var 2473 var
2473 obj: TDBObject; 2474 obj: TDBObject;
2474 Results: TDBQuery; 2475 Results: TDBQuery;
2475 rx: TRegExpr; 2476 rx: TRegExpr;
2476 i: Integer; 2477 i: Integer;
2477 begin 2478 begin
2478 // Cache and return a db's table list 2479 // Cache and return a db's table list
2479 if Refresh then 2480 if Refresh then
2480 ClearDbObjects(db); 2481 ClearDbObjects(db);
2481 2482
2482 // Find list in cache 2483 // Find list in cache
2483 Result := nil; 2484 Result := nil;
2484 for i:=0 to FDatabases.Count-1 do begin 2485 for i:=0 to FDatabases.Count-1 do begin
2485 if FDatabases[i].Database = db then begin 2486 if FDatabases[i].Database = db then begin
2486 Result := FDatabases[i]; 2487 Result := FDatabases[i];
2487 break; 2488 break;
2488 end; 2489 end;
2489 end; 2490 end;
2490 2491
2491 if not Assigned(Result) then begin 2492 if not Assigned(Result) then begin
2492 Result := TDBObjectList.Create(TDBObjectComparer.Create); 2493 Result := TDBObjectList.Create(TDBObjectComparer.Create);
2493 Result.FLastUpdate := 0; 2494 Result.FLastUpdate := 0;
2494 Result.FDataSize := 0; 2495 Result.FDataSize := 0;
2495 Result.FDatabase := db; 2496 Result.FDatabase := db;
2496 try 2497 try
2497 Result.FCollation := GetVar('SELECT '+QuoteIdent('DEFAULT_COLLATION_NAME')+ 2498 Result.FCollation := GetVar('SELECT '+QuoteIdent('DEFAULT_COLLATION_NAME')+
2498 ' FROM '+QuoteIdent('information_schema')+'.'+QuoteIdent('SCHEMATA')+ 2499 ' FROM '+QuoteIdent('information_schema')+'.'+QuoteIdent('SCHEMATA')+
2499 ' WHERE '+QuoteIdent('SCHEMA_NAME')+'='+EscapeString(db)); 2500 ' WHERE '+QuoteIdent('SCHEMA_NAME')+'='+EscapeString(db));
2500 except 2501 except
2501 Result.FCollation := ''; 2502 Result.FCollation := '';
2502 end; 2503 end;
2503 Results := nil; 2504 Results := nil;
2504 rx := TRegExpr.Create; 2505 rx := TRegExpr.Create;
2505 rx.ModifierI := True; 2506 rx.ModifierI := True;
2506 2507
2507 // Tables and views 2508 // Tables and views
2508 try 2509 try
2509 Results := GetResults('SHOW TABLE STATUS FROM '+QuoteIdent(db)); 2510 Results := GetResults('SHOW TABLE STATUS FROM '+QuoteIdent(db));
2510 except 2511 except
2511 on E:EDatabaseError do; 2512 on E:EDatabaseError do;
2512 end; 2513 end;
2513 if Assigned(Results) then begin 2514 if Assigned(Results) then begin
2514 while not Results.Eof do begin 2515 while not Results.Eof do begin
2515 obj := TDBObject.Create(Self); 2516 obj := TDBObject.Create(Self);
2516 Result.Add(obj); 2517 Result.Add(obj);
2517 obj.Name := Results.Col('Name'); 2518 obj.Name := Results.Col('Name');
2518 obj.Database := db; 2519 obj.Database := db;
2519 obj.Rows := StrToInt64Def(Results.Col('Rows'), -1); 2520 obj.Rows := StrToInt64Def(Results.Col('Rows'), -1);
2520 if (not Results.IsNull('Data_length')) and (not Results.IsNull('Index_length')) then begin 2521 if (not Results.IsNull('Data_length')) and (not Results.IsNull('Index_length')) then begin
2521 Obj.Size := StrToInt64Def(Results.Col('Data_length'), 0) + StrToInt64Def(Results.Col('Index_length'), 0); 2522 Obj.Size := StrToInt64Def(Results.Col('Data_length'), 0) + StrToInt64Def(Results.Col('Index_length'), 0);
2522 Inc(Result.FDataSize, Obj.Size); 2523 Inc(Result.FDataSize, Obj.Size);
2523 Result.FLargestObjectSize := Max(Result.FLargestObjectSize, Obj.Size); 2524 Result.FLargestObjectSize := Max(Result.FLargestObjectSize, Obj.Size);
2524 end; 2525 end;
2525 Obj.NodeType := lntTable; 2526 Obj.NodeType := lntTable;
2526 if Results.IsNull(1) and Results.IsNull(2) then // Engine column is NULL for views 2527 if Results.IsNull(1) and Results.IsNull(2) then // Engine column is NULL for views
2527 Obj.NodeType := lntView; 2528 Obj.NodeType := lntView;
2528 Obj.Created := ParseDateTime(Results.Col('Create_time')); 2529 Obj.Created := ParseDateTime(Results.Col('Create_time'));
2529 Obj.Updated := ParseDateTime(Results.Col('Update_time')); 2530 Obj.Updated := ParseDateTime(Results.Col('Update_time'));
2530 if Results.ColExists('Type') then 2531 if Results.ColExists('Type') then
2531 Obj.Engine := Results.Col('Type') 2532 Obj.Engine := Results.Col('Type')
2532 else 2533 else
2533 Obj.Engine := Results.Col('Engine'); 2534 Obj.Engine := Results.Col('Engine');
2534 Obj.Comment := Results.Col('Comment'); 2535 Obj.Comment := Results.Col('Comment');
2535 // Sanitize comment from automatically appendage 2536 // Sanitize comment from automatically appendage
2536 rx.Expression := '(;\s*)?InnoDB\s*free\:.*$'; 2537 rx.Expression := '(;\s*)?InnoDB\s*free\:.*$';
2537 Obj.Comment := rx.Replace(Obj.Comment, '', False); 2538 Obj.Comment := rx.Replace(Obj.Comment, '', False);
2538 Obj.Version := StrToInt64Def(Results.Col('Version', True), Obj.Version); 2539 Obj.Version := StrToInt64Def(Results.Col('Version', True), Obj.Version);
2539 Obj.AutoInc := StrToInt64Def(Results.Col('Auto_increment'), Obj.AutoInc); 2540 Obj.AutoInc := StrToInt64Def(Results.Col('Auto_increment'), Obj.AutoInc);
2540 Obj.RowFormat := Results.Col('Row_format'); 2541 Obj.RowFormat := Results.Col('Row_format');
2541 Obj.AvgRowLen := StrToInt64Def(Results.Col('Avg_row_length'), Obj.AvgRowLen); 2542 Obj.AvgRowLen := StrToInt64Def(Results.Col('Avg_row_length'), Obj.AvgRowLen);
2542 Obj.MaxDataLen := StrToInt64Def(Results.Col('Max_data_length'), Obj.MaxDataLen); 2543 Obj.MaxDataLen := StrToInt64Def(Results.Col('Max_data_length'), Obj.MaxDataLen);
2543 Obj.IndexLen := StrToInt64Def(Results.Col('Index_length'), Obj.IndexLen); 2544 Obj.IndexLen := StrToInt64Def(Results.Col('Index_length'), Obj.IndexLen);
2544 Obj.DataLen := StrToInt64Def(Results.Col('Data_length'), Obj.DataLen); 2545 Obj.DataLen := StrToInt64Def(Results.Col('Data_length'), Obj.DataLen);
2545 Obj.DataFree := StrToInt64Def(Results.Col('Data_free'), Obj.DataFree); 2546 Obj.DataFree := StrToInt64Def(Results.Col('Data_free'), Obj.DataFree);
2546 Obj.LastChecked := ParseDateTime(Results.Col('Check_time')); 2547 Obj.LastChecked := ParseDateTime(Results.Col('Check_time'));
2547 Obj.Collation := Results.Col('Collation', True); 2548 Obj.Collation := Results.Col('Collation', True);
2548 Obj.CheckSum := StrToInt64Def(Results.Col('Checksum', True), Obj.CheckSum); 2549 Obj.CheckSum := StrToInt64Def(Results.Col('Checksum', True), Obj.CheckSum);
2549 Obj.CreateOptions := Results.Col('Create_options'); 2550 Obj.CreateOptions := Results.Col('Create_options');
2550 Results.Next; 2551 Results.Next;
2551 end; 2552 end;
2552 FreeAndNil(Results); 2553 FreeAndNil(Results);
2553 end; 2554 end;
2554 2555
2555 // Stored functions 2556 // Stored functions
2556 if ServerVersionInt >= 50000 then try 2557 if ServerVersionInt >= 50000 then try
2557 Results := GetResults('SHOW FUNCTION STATUS WHERE '+QuoteIdent('Db')+'='+EscapeString(db)); 2558 Results := GetResults('SHOW FUNCTION STATUS WHERE '+QuoteIdent('Db')+'='+EscapeString(db));
2558 except 2559 except
2559 on E:EDatabaseError do; 2560 on E:EDatabaseError do;
2560 end; 2561 end;
2561 if Assigned(Results) then begin 2562 if Assigned(Results) then begin
2562 while not Results.Eof do begin 2563 while not Results.Eof do begin
2563 obj := TDBObject.Create(Self); 2564 obj := TDBObject.Create(Self);
2564 Result.Add(obj); 2565 Result.Add(obj);
2565 obj.Name := Results.Col('Name'); 2566 obj.Name := Results.Col('Name');
2566 obj.Database := db; 2567 obj.Database := db;
2567 Obj.NodeType := lntFunction; 2568 Obj.NodeType := lntFunction;
2568 Obj.Created := ParseDateTime(Results.Col('Created')); 2569 Obj.Created := ParseDateTime(Results.Col('Created'));
2569 Obj.Updated := ParseDateTime(Results.Col('Modified')); 2570 Obj.Updated := ParseDateTime(Results.Col('Modified'));
2570 Obj.Comment := Results.Col('Comment'); 2571 Obj.Comment := Results.Col('Comment');
2571 Results.Next; 2572 Results.Next;
2572 end; 2573 end;
2573 FreeAndNil(Results); 2574 FreeAndNil(Results);
2574 end; 2575 end;
2575 2576
2576 // Stored procedures 2577 // Stored procedures
2577 if ServerVersionInt >= 50000 then try 2578 if ServerVersionInt >= 50000 then try
2578 Results := GetResults('SHOW PROCEDURE STATUS WHERE '+QuoteIdent('Db')+'='+EscapeString(db)); 2579 Results := GetResults('SHOW PROCEDURE STATUS WHERE '+QuoteIdent('Db')+'='+EscapeString(db));
2579 except 2580 except
2580 on E:EDatabaseError do; 2581 on E:EDatabaseError do;
2581 end; 2582 end;
2582 if Assigned(Results) then begin 2583 if Assigned(Results) then begin
2583 while not Results.Eof do begin 2584 while not Results.Eof do begin
2584 obj := TDBObject.Create(Self); 2585 obj := TDBObject.Create(Self);
2585 Result.Add(obj); 2586 Result.Add(obj);
2586 obj.Name := Results.Col('Name'); 2587 obj.Name := Results.Col('Name');
2587 obj.Database := db; 2588 obj.Database := db;
2588 Obj.NodeType := lntProcedure; 2589 Obj.NodeType := lntProcedure;
2589 Obj.Created := ParseDateTime(Results.Col('Created')); 2590 Obj.Created := ParseDateTime(Results.Col('Created'));
2590 Obj.Updated := ParseDateTime(Results.Col('Modified')); 2591 Obj.Updated := ParseDateTime(Results.Col('Modified'));
2591 Obj.Comment := Results.Col('Comment'); 2592 Obj.Comment := Results.Col('Comment');
2592 Results.Next; 2593 Results.Next;
2593 end; 2594 end;
2594 FreeAndNil(Results); 2595 FreeAndNil(Results);
2595 end; 2596 end;
2596 2597
2597 // Triggers 2598 // Triggers
2598 if ServerVersionInt >= 50010 then try 2599 if ServerVersionInt >= 50010 then try
2599 Results := GetResults('SHOW TRIGGERS FROM '+QuoteIdent(db)); 2600 Results := GetResults('SHOW TRIGGERS FROM '+QuoteIdent(db));
2600 except 2601 except
2601 on E:EDatabaseError do; 2602 on E:EDatabaseError do;
2602 end; 2603 end;
2603 if Assigned(Results) then begin 2604 if Assigned(Results) then begin
2604 while not Results.Eof do begin 2605 while not Results.Eof do begin
2605 obj := TDBObject.Create(Self); 2606 obj := TDBObject.Create(Self);
2606 Result.Add(obj); 2607 Result.Add(obj);
2607 obj.Name := Results.Col('Trigger'); 2608 obj.Name := Results.Col('Trigger');
2608 obj.Database := db; 2609 obj.Database := db;
2609 Obj.NodeType := lntTrigger; 2610 Obj.NodeType := lntTrigger;
2610 Obj.Created := ParseDateTime(Results.Col('Created')); 2611 Obj.Created := ParseDateTime(Results.Col('Created'));
2611 Obj.Comment := Results.Col('Timing')+' '+Results.Col('Event')+' in table '+QuoteIdent(Results.Col('Table')); 2612 Obj.Comment := Results.Col('Timing')+' '+Results.Col('Event')+' in table '+QuoteIdent(Results.Col('Table'));
2612 Results.Next; 2613 Results.Next;
2613 end; 2614 end;
2614 FreeAndNil(Results); 2615 FreeAndNil(Results);
2615 end; 2616 end;
2616 2617
2617 // Events 2618 // Events
2618 if ServerVersionInt >= 50100 then try 2619 if ServerVersionInt >= 50100 then try
2619 Results := GetResults('SHOW EVENTS FROM '+QuoteIdent(db)); 2620 Results := GetResults('SHOW EVENTS FROM '+QuoteIdent(db));
2620 except 2621 except
2621 on E:EDatabaseError do; 2622 on E:EDatabaseError do;
2622 end; 2623 end;
2623 if Assigned(Results) then begin 2624 if Assigned(Results) then begin
2624 while not Results.Eof do begin 2625 while not Results.Eof do begin
2625 if Results.Col('Db') = db then begin 2626 if Results.Col('Db') = db then begin
2626 Obj := TDBObject.Create(Self); 2627 Obj := TDBObject.Create(Self);
2627 Result.Add(obj); 2628 Result.Add(obj);
2628 Obj.Name := Results.Col('Name'); 2629 Obj.Name := Results.Col('Name');
2629 Obj.Database := db; 2630 Obj.Database := db;
2630 Obj.NodeType := lntEvent; 2631 Obj.NodeType := lntEvent;
2631 end; 2632 end;
2632 Results.Next; 2633 Results.Next;
2633 end; 2634 end;
2634 FreeAndNil(Results); 2635 FreeAndNil(Results);
2635 end; 2636 end;
2636 2637
2637 // Find youngest last update 2638 // Find youngest last update
2638 for i:=0 to Result.Count-1 do 2639 for i:=0 to Result.Count-1 do
2639 Result.FLastUpdate := Max(Result.FLastUpdate, Max(Result[i].Updated, Result[i].Created)); 2640 Result.FLastUpdate := Max(Result.FLastUpdate, Max(Result[i].Updated, Result[i].Created));
2640 // Sort list like it get sorted in AnyGridCompareNodes 2641 // Sort list like it get sorted in AnyGridCompareNodes
2641 Result.Sort; 2642 Result.Sort;
2642 // Add list of objects in this database to cached list of all databases 2643 // Add list of objects in this database to cached list of all databases
2643 FDatabases.Add(Result); 2644 FDatabases.Add(Result);
2644 SetObjectNamesInSelectedDB; 2645 SetObjectNamesInSelectedDB;
2645 end; 2646 end;
2646 2647
2647 end; 2648 end;
2648 2649
2649 2650
2650 function TAdoDBConnection.GetDbObjects(db: String; Refresh: Boolean=False): TDBObjectList; 2651 function TAdoDBConnection.GetDbObjects(db: String; Refresh: Boolean=False): TDBObjectList;
2651 var 2652 var
2652 obj: TDBObject; 2653 obj: TDBObject;
2653 Results: TDBQuery; 2654 Results: TDBQuery;
2654 i: Integer; 2655 i: Integer;
2655 tp: String; 2656 tp: String;
2656 begin 2657 begin
2657 // Cache and return a db's table list 2658 // Cache and return a db's table list
2658 if Refresh then 2659 if Refresh then
2659 ClearDbObjects(db); 2660 ClearDbObjects(db);
2660 2661
2661 // Find list in cache 2662 // Find list in cache
2662 Result := nil; 2663 Result := nil;
2663 for i:=0 to FDatabases.Count-1 do begin 2664 for i:=0 to FDatabases.Count-1 do begin
2664 if FDatabases[i].Database = db then begin 2665 if FDatabases[i].Database = db then begin
2665 Result := FDatabases[i]; 2666 Result := FDatabases[i];
2666 break; 2667 break;
2667 end; 2668 end;
2668 end; 2669 end;
2669 2670
2670 if not Assigned(Result) then begin 2671 if not Assigned(Result) then begin
2671 Result := TDBObjectList.Create(TDBObjectComparer.Create); 2672 Result := TDBObjectList.Create(TDBObjectComparer.Create);
2672 Result.FLastUpdate := 0; 2673 Result.FLastUpdate := 0;
2673 Result.FDataSize := 0; 2674 Result.FDataSize := 0;
2674 Result.FDatabase := db; 2675 Result.FDatabase := db;
2675 Results := nil; 2676 Results := nil;
2676 2677
2677 // Tables, views and procedures 2678 // Tables, views and procedures
2678 try 2679 try
2679 Results := GetResults('SELECT * FROM '+QuoteIdent(db)+GetSQLSpecifity(spDbObjectsTable)+ 2680 Results := GetResults('SELECT * FROM '+QuoteIdent(db)+GetSQLSpecifity(spDbObjectsTable)+
2680 ' WHERE '+QuoteIdent('type')+' IN ('+EscapeString('P')+', '+EscapeString('U')+', '+EscapeString('V')+', '+EscapeString('TR')+', '+EscapeString('FN')+')'); 2681 ' WHERE '+QuoteIdent('type')+' IN ('+EscapeString('P')+', '+EscapeString('U')+', '+EscapeString('V')+', '+EscapeString('TR')+', '+EscapeString('FN')+')');
2681 except 2682 except
2682 on E:EDatabaseError do; 2683 on E:EDatabaseError do;
2683 end; 2684 end;
2684 if Assigned(Results) then begin 2685 if Assigned(Results) then begin
2685 while not Results.Eof do begin 2686 while not Results.Eof do begin
2686 obj := TDBObject.Create(Self); 2687 obj := TDBObject.Create(Self);
2687 Result.Add(obj); 2688 Result.Add(obj);
2688 obj.Name := Results.Col('name'); 2689 obj.Name := Results.Col('name');
2689 obj.Created := ParseDateTime(Results.Col(GetSQLSpecifity(spDbObjectsCreateCol), True)); 2690 obj.Created := ParseDateTime(Results.Col(GetSQLSpecifity(spDbObjectsCreateCol), True));
2690 obj.Updated := ParseDateTime(Results.Col(GetSQLSpecifity(spDbObjectsUpdateCol), True)); 2691 obj.Updated := ParseDateTime(Results.Col(GetSQLSpecifity(spDbObjectsUpdateCol), True));
2691 obj.Database := db; 2692 obj.Database := db;
2692 tp := Trim(Results.Col(GetSQLSpecifity(spDbObjectsTypeCol), True)); 2693 tp := Trim(Results.Col(GetSQLSpecifity(spDbObjectsTypeCol), True));
2693 if tp = 'U' then 2694 if tp = 'U' then
2694 obj.NodeType := lntTable 2695 obj.NodeType := lntTable
2695 else if tp = 'P' then 2696 else if tp = 'P' then
2696 obj.NodeType := lntProcedure 2697 obj.NodeType := lntProcedure
2697 else if tp = 'V' then 2698 else if tp = 'V' then
2698 obj.NodeType := lntView 2699 obj.NodeType := lntView
2699 else if tp = 'TR' then 2700 else if tp = 'TR' then
2700 obj.NodeType := lntTrigger 2701 obj.NodeType := lntTrigger
2701 else if tp = 'FN' then 2702 else if tp = 'FN' then
2702 obj.NodeType := lntFunction; 2703 obj.NodeType := lntFunction;
2703 Results.Next; 2704 Results.Next;
2704 end; 2705 end;
2705 FreeAndNil(Results); 2706 FreeAndNil(Results);
2706 end; 2707 end;
2707 2708
2708 // Find youngest last update 2709 // Find youngest last update
2709 for i:=0 to Result.Count-1 do 2710 for i:=0 to Result.Count-1 do
2710 Result.FLastUpdate := Max(Result.FLastUpdate, Max(Result[i].Updated, Result[i].Created)); 2711 Result.FLastUpdate := Max(Result.FLastUpdate, Max(Result[i].Updated, Result[i].Created));
2711 // Sort list like it get sorted in AnyGridCompareNodes 2712 // Sort list like it get sorted in AnyGridCompareNodes
2712 Result.Sort; 2713 Result.Sort;
2713 // Add list of objects in this database to cached list of all databases 2714 // Add list of objects in this database to cached list of all databases
2714 FDatabases.Add(Result); 2715 FDatabases.Add(Result);
2715 SetObjectNamesInSelectedDB; 2716 SetObjectNamesInSelectedDB;
2716 end; 2717 end;
2717 2718
2718 end; 2719 end;
2719 2720
2720 2721
2721 procedure TDBConnection.SetObjectNamesInSelectedDB; 2722 procedure TDBConnection.SetObjectNamesInSelectedDB;
2722 var 2723 var
2723 i: Integer; 2724 i: Integer;
2724 Objects: TDBObjectList; 2725 Objects: TDBObjectList;
2725 ObjNames: String; 2726 ObjNames: String;
2726 begin 2727 begin
2727 // Add object names to additional stringlist 2728 // Add object names to additional stringlist
2728 if Assigned(FObjectNamesInSelectedDB) then begin 2729 if Assigned(FObjectNamesInSelectedDB) then begin
2729 if DbObjectsCached(FDatabase) then begin 2730 if DbObjectsCached(FDatabase) then begin
2730 Objects := GetDbObjects(FDatabase); 2731 Objects := GetDbObjects(FDatabase);
2731 for i:=0 to Objects.Count-1 do 2732 for i:=0 to Objects.Count-1 do
2732 ObjNames := ObjNames + Objects[i].Name + CRLF; 2733 ObjNames := ObjNames + Objects[i].Name + CRLF;
2733 end else 2734 end else
2734 ObjNames := ''; 2735 ObjNames := '';
2735 if FObjectNamesInSelectedDB.Text <> ObjNames then 2736 if FObjectNamesInSelectedDB.Text <> ObjNames then
2736 FObjectNamesInSelectedDB.Text := ObjNames; 2737 FObjectNamesInSelectedDB.Text := ObjNames;
2737 end; 2738 end;
2738 end; 2739 end;
2739 2740
2740 2741
2741 function TDBConnection.GetKeyColumns(Columns: TTableColumnList; Keys: TTableKeyList): TStringList; 2742 function TDBConnection.GetKeyColumns(Columns: TTableColumnList; Keys: TTableKeyList): TStringList;
2742 var 2743 var
2743 i: Integer; 2744 i: Integer;
2744 AllowsNull: Boolean; 2745 AllowsNull: Boolean;
2745 Key: TTableKey; 2746 Key: TTableKey;
2746 Col: TTableColumn; 2747 Col: TTableColumn;
2747 begin 2748 begin
2748 Result := TStringList.Create; 2749 Result := TStringList.Create;
2749 // Find best key for updates 2750 // Find best key for updates
2750 // 1. round: find a primary key 2751 // 1. round: find a primary key
2751 for Key in Keys do begin 2752 for Key in Keys do begin
2752 if Key.Name = 'PRIMARY' then 2753 if Key.Name = 'PRIMARY' then
2753 Result.Assign(Key.Columns); 2754 Result.Assign(Key.Columns);
2754 end; 2755 end;
2755 if Result.Count = 0 then begin 2756 if Result.Count = 0 then begin
2756 // no primary key available -> 2. round: find a unique key 2757 // no primary key available -> 2. round: find a unique key
2757 for Key in Keys do begin 2758 for Key in Keys do begin
2758 if Key.IndexType = UKEY then begin 2759 if Key.IndexType = UKEY then begin
2759 // We found a UNIQUE key - better than nothing. Check if one of the key 2760 // We found a UNIQUE key - better than nothing. Check if one of the key
2760 // columns allows NULLs which makes it dangerous to use in UPDATES + DELETES. 2761 // columns allows NULLs which makes it dangerous to use in UPDATES + DELETES.
2761 AllowsNull := False; 2762 AllowsNull := False;
2762 for i:=0 to Key.Columns.Count-1 do begin 2763 for i:=0 to Key.Columns.Count-1 do begin
2763 for Col in Columns do begin 2764 for Col in Columns do begin
2764 if Col.Name = Key.Columns[i] then 2765 if Col.Name = Key.Columns[i] then
2765 AllowsNull := Col.AllowNull; 2766 AllowsNull := Col.AllowNull;
2766 if AllowsNull then break; 2767 if AllowsNull then break;
2767 end; 2768 end;
2768 if AllowsNull then break; 2769 if AllowsNull then break;
2769 end; 2770 end;
2770 if not AllowsNull then begin 2771 if not AllowsNull then begin
2771 Result.Assign(Key.Columns); 2772 Result.Assign(Key.Columns);
2772 break; 2773 break;
2773 end; 2774 end;
2774 end; 2775 end;
2775 end; 2776 end;
2776 end; 2777 end;
2777 end; 2778 end;
2778 2779
2779 2780
2780 function TDBConnection.DecodeAPIString(a: AnsiString): String; 2781 function TDBConnection.DecodeAPIString(a: AnsiString): String;
2781 begin 2782 begin
2782 if IsUnicode then 2783 if IsUnicode then
2783 Result := Utf8ToString(a) 2784 Result := Utf8ToString(a)
2784 else 2785 else
2785 Result := String(a); 2786 Result := String(a);
2786 end; 2787 end;
2787 2788
2788 2789
2789 function TDBConnection.ConnectionInfo: TStringList; 2790 function TDBConnection.ConnectionInfo: TStringList;
2790 var 2791 var
2791 Infos, Val: String; 2792 Infos, Val: String;
2792 rx: TRegExpr; 2793 rx: TRegExpr;
2793 2794
2794 function EvalBool(B: Boolean): String; 2795 function EvalBool(B: Boolean): String;
2795 begin 2796 begin
2796 if B then Result := 'Yes' else Result := 'No'; 2797 if B then Result := 'Yes' else Result := 'No';
2797 end; 2798 end;
2798 begin 2799 begin
2799 Log(lcDebug, 'Get connection details ...'); 2800 Log(lcDebug, 'Get connection details ...');
2800 Result := TStringList.Create; 2801 Result := TStringList.Create;
2801 if Assigned(Parameters) then 2802 if Assigned(Parameters) then
2802 Result.Values['Hostname'] := Parameters.Hostname; 2803 Result.Values['Hostname'] := Parameters.Hostname;
2803 Ping(False); 2804 Ping(False);
2804 Result.Values['Connected'] := EvalBool(FActive); 2805 Result.Values['Connected'] := EvalBool(FActive);
2805 if FActive then begin 2806 if FActive then begin
2806 Result.Values['Real Hostname'] := FRealHostname; 2807 Result.Values['Real Hostname'] := FRealHostname;
2807 Result.Values['Server OS'] := ServerOS; 2808 Result.Values['Server OS'] := ServerOS;
2808 Result.Values['Server version'] := FServerVersionUntouched; 2809 Result.Values['Server version'] := FServerVersionUntouched;
2809 Result.Values['Connection port'] := IntToStr(Parameters.Port); 2810 Result.Values['Connection port'] := IntToStr(Parameters.Port);
2810 Result.Values['Compressed protocol'] := EvalBool(Parameters.Compressed); 2811 Result.Values['Compressed protocol'] := EvalBool(Parameters.Compressed);
2811 Result.Values['Unicode enabled'] := EvalBool(IsUnicode); 2812 Result.Values['Unicode enabled'] := EvalBool(IsUnicode);
2812 Result.Values['SSL enabled'] := EvalBool(IsSSL); 2813 Result.Values['SSL enabled'] := EvalBool(IsSSL);
2813 case Parameters.NetTypeGroup of 2814 case Parameters.NetTypeGroup of
2814 ngMySQL: begin 2815 ngMySQL: begin
2815 Result.Values['Client version (libmysql)'] := DecodeApiString(mysql_get_client_info); 2816 Result.Values['Client version (libmysql)'] := DecodeApiString(mysql_get_client_info);
2816 Infos := DecodeApiString(mysql_stat((Self as TMySQLConnection).FHandle)); 2817 Infos := DecodeApiString(mysql_stat((Self as TMySQLConnection).FHandle));
2817 rx := TRegExpr.Create; 2818 rx := TRegExpr.Create;
2818 rx.ModifierG := False; 2819 rx.ModifierG := False;
2819 rx.Expression := '(\S.*)\:\s+(\S*)(\s+|$)'; 2820 rx.Expression := '(\S.*)\:\s+(\S*)(\s+|$)';
2820 if rx.Exec(Infos) then while True do begin 2821 if rx.Exec(Infos) then while True do begin
2821 Val := rx.Match[2]; 2822 Val := rx.Match[2];
2822 if LowerCase(rx.Match[1]) = 'uptime' then 2823 if LowerCase(rx.Match[1]) = 'uptime' then
2823 Val := FormatTimeNumber(StrToIntDef(Val, 0), True) 2824 Val := FormatTimeNumber(StrToIntDef(Val, 0), True)
2824 else 2825 else
2825 Val := FormatNumber(Val); 2826 Val := FormatNumber(Val);
2826 Result.Values[rx.Match[1]] := Val; 2827 Result.Values[rx.Match[1]] := Val;
2827 if not rx.ExecNext then 2828 if not rx.ExecNext then
2828 break; 2829 break;
2829 end; 2830 end;
2830 rx.Free; 2831 rx.Free;
2831 end; 2832 end;
2832 2833
2833 ngMSSQL: ; // Nothing specific yet 2834 ngMSSQL: ; // Nothing specific yet
2834 end; 2835 end;
2835 end; 2836 end;
2836 end; 2837 end;
2837 2838
2838 2839
2839 procedure TDBConnection.ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList); 2840 procedure TDBConnection.ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList);
2840 var 2841 var
2841 ColSpec: String; 2842 ColSpec: String;
2842 rx, rxCol: TRegExpr; 2843 rx, rxCol: TRegExpr;
2843 i: Integer; 2844 i: Integer;
2844 InLiteral: Boolean; 2845 InLiteral: Boolean;
2845 Col: TTableColumn; 2846 Col: TTableColumn;
2846 Key: TTableKey; 2847 Key: TTableKey;
2847 ForeignKey: TForeignKey; 2848 ForeignKey: TForeignKey;
2848 Collations: TDBQuery; 2849 Collations: TDBQuery;
2849 begin 2850 begin
2850 Ping(True); 2851 Ping(True);
2851 if Assigned(Columns) then Columns.Clear; 2852 if Assigned(Columns) then Columns.Clear;
2852 if Assigned(Keys) then Keys.Clear; 2853 if Assigned(Keys) then Keys.Clear;
2853 if Assigned(ForeignKeys) then ForeignKeys.Clear; 2854 if Assigned(ForeignKeys) then ForeignKeys.Clear;
2854 if CreateTable = '' then 2855 if CreateTable = '' then
2855 Exit; 2856 Exit;
2856 Collations := CollationTable; 2857 Collations := CollationTable;
2857 rx := TRegExpr.Create; 2858 rx := TRegExpr.Create;
2858 rx.ModifierS := False; 2859 rx.ModifierS := False;
2859 rx.ModifierM := True; 2860 rx.ModifierM := True;
2860 rx.Expression := '^\s+[`"]([^`"]+)[`"]\s(\w+)'; 2861 rx.Expression := '^\s+[`"]([^`"]+)[`"]\s(\w+)';
2861 rxCol := TRegExpr.Create; 2862 rxCol := TRegExpr.Create;
2862 rxCol.ModifierI := True; 2863 rxCol.ModifierI := True;
2863 if rx.Exec(CreateTable) then while true do begin 2864 if rx.Exec(CreateTable) then while true do begin
2864 if not Assigned(Columns) then 2865 if not Assigned(Columns) then
2865 break; 2866 break;
2866 ColSpec := ''; 2867 ColSpec := '';
2867 for i:=rx.MatchPos[2]+rx.MatchLen[2] to Length(CreateTable) do begin 2868 for i:=rx.MatchPos[2]+rx.MatchLen[2] to Length(CreateTable) do begin
2868 if CharInSet(CreateTable[i], [#13, #10]) then 2869 if CharInSet(CreateTable[i], [#13, #10]) then
2869 break; 2870 break;
2870 ColSpec := ColSpec + CreateTable[i]; 2871 ColSpec := ColSpec + CreateTable[i];
2871 end; 2872 end;
2872 2873
2873 // Strip trailing comma 2874 // Strip trailing comma
2874 if (ColSpec <> '') and (ColSpec[Length(ColSpec)] = ',') then 2875 if (ColSpec <> '') and (ColSpec[Length(ColSpec)] = ',') then
2875 Delete(ColSpec, Length(ColSpec), 1); 2876 Delete(ColSpec, Length(ColSpec), 1);
2876 2877
2877 Col := TTableColumn.Create(Self); 2878 Col := TTableColumn.Create(Self);
2878 Columns.Add(Col); 2879 Columns.Add(Col);
2879 Col.Name := DeQuoteIdent(rx.Match[1]); 2880 Col.Name := DeQuoteIdent(rx.Match[1]);
2880 Col.OldName := Col.Name; 2881 Col.OldName := Col.Name;
2881 Col.Status := esUntouched; 2882 Col.Status := esUntouched;
2882 Col.LengthCustomized := True; 2883 Col.LengthCustomized := True;
2883 2884
2884 // Datatype 2885 // Datatype
2885 Col.DataType := GetDatatypeByName(UpperCase(rx.Match[2])); 2886 Col.DataType := GetDatatypeByName(UpperCase(rx.Match[2]));
2886 Col.OldDataType := GetDatatypeByName(UpperCase(rx.Match[2])); 2887 Col.OldDataType := GetDatatypeByName(UpperCase(rx.Match[2]));
2887 2888
2888 // Length / Set 2889 // Length / Set
2889 // Various datatypes, e.g. BLOBs, don't have any length property 2890 // Various datatypes, e.g. BLOBs, don't have any length property
2890 InLiteral := False; 2891 InLiteral := False;
2891 if (ColSpec <> '') and (ColSpec[1] = '(') then begin 2892 if (ColSpec <> '') and (ColSpec[1] = '(') then begin
2892 for i:=2 to Length(ColSpec) do begin 2893 for i:=2 to Length(ColSpec) do begin
2893 if (ColSpec[i] = ')') and (not InLiteral) then 2894 if (ColSpec[i] = ')') and (not InLiteral) then
2894 break; 2895 break;
2895 if ColSpec[i] = '''' then 2896 if ColSpec[i] = '''' then
2896 InLiteral := not InLiteral; 2897 InLiteral := not InLiteral;
2897 end; 2898 end;
2898 Col.LengthSet := Copy(ColSpec, 2, i-2); 2899 Col.LengthSet := Copy(ColSpec, 2, i-2);
2899 Delete(ColSpec, 1, i); 2900 Delete(ColSpec, 1, i);
2900 end; 2901 end;
2901 ColSpec := Trim(ColSpec); 2902 ColSpec := Trim(ColSpec);
2902 2903
2903 // Unsigned 2904 // Unsigned
2904 if UpperCase(Copy(ColSpec, 1, 8)) = 'UNSIGNED' then begin 2905 if UpperCase(Copy(ColSpec, 1, 8)) = 'UNSIGNED' then begin
2905 Col.Unsigned := True; 2906 Col.Unsigned := True;
2906 Delete(ColSpec, 1, 9); 2907 Delete(ColSpec, 1, 9);
2907 end else 2908 end else
2908 Col.Unsigned := False; 2909 Col.Unsigned := False;
2909 2910
2910 // Zero fill 2911 // Zero fill
2911 if UpperCase(Copy(ColSpec, 1, 8)) = 'ZEROFILL' then begin 2912 if UpperCase(Copy(ColSpec, 1, 8)) = 'ZEROFILL' then begin
2912 Col.ZeroFill := True; 2913 Col.ZeroFill := True;
2913 Delete(ColSpec, 1, 9); 2914 Delete(ColSpec, 1, 9);
2914 end else 2915 end else
2915 Col.ZeroFill := False; 2916 Col.ZeroFill := False;
2916 2917
2917 // Charset 2918 // Charset
2918 rxCol.Expression := '^CHARACTER SET (\w+)\b\s*'; 2919 rxCol.Expression := '^CHARACTER SET (\w+)\b\s*';
2919 if rxCol.Exec(ColSpec) then begin 2920 if rxCol.Exec(ColSpec) then begin
2920 Col.Charset := rxCol.Match[1]; 2921 Col.Charset := rxCol.Match[1];
2921 Delete(ColSpec, 1, rxCol.MatchLen[0]); 2922 Delete(ColSpec, 1, rxCol.MatchLen[0]);
2922 end; 2923 end;
2923 2924
2924 // Virtual columns 2925 // Virtual columns
2925 rxCol.Expression := '^AS \((.+)\)\s+(VIRTUAL|PERSISTENT)\s*'; 2926 rxCol.Expression := '^AS \((.+)\)\s+(VIRTUAL|PERSISTENT)\s*';
2926 if rxCol.Exec(ColSpec) then begin 2927 if rxCol.Exec(ColSpec) then begin
2927 Col.Expression := rxCol.Match[1]; 2928 Col.Expression := rxCol.Match[1];
2928 Col.Virtuality := rxCol.Match[2]; 2929 Col.Virtuality := rxCol.Match[2];
2929 Delete(ColSpec, 1, rxCol.MatchLen[0]); 2930 Delete(ColSpec, 1, rxCol.MatchLen[0]);
2930 end; 2931 end;
2931 2932
2932 // Collation - probably not present when charset present 2933 // Collation - probably not present when charset present
2933 rxCol.Expression := '^COLLATE (\w+)\b\s*'; 2934 rxCol.Expression := '^COLLATE (\w+)\b\s*';
2934 if rxCol.Exec(ColSpec) then begin 2935 if rxCol.Exec(ColSpec) then begin
2935 Col.Collation := rxCol.Match[1]; 2936 Col.Collation := rxCol.Match[1];
2936 Delete(ColSpec, 1, rxCol.MatchLen[0]); 2937 Delete(ColSpec, 1, rxCol.MatchLen[0]);
2937 end; 2938 end;
2938 if Col.Collation = '' then begin 2939 if Col.Collation = '' then begin
2939 if Assigned(Collations) then begin 2940 if Assigned(Collations) then begin
2940 Collations.First; 2941 Collations.First;
2941 while not Collations.Eof do begin 2942 while not Collations.Eof do begin
2942 if (Collations.Col('Charset') = Col.Charset) and (Collations.Col('Default') = 'Yes') then begin 2943 if (Collations.Col('Charset') = Col.Charset) and (Collations.Col('Default') = 'Yes') then begin
2943 Col.Collation := Collations.Col('Collation'); 2944 Col.Collation := Collations.Col('Collation');
2944 break; 2945 break;
2945 end; 2946 end;
2946 Collations.Next; 2947 Collations.Next;
2947 end; 2948 end;
2948 end; 2949 end;
2949 end; 2950 end;
2950 2951
2951 // Allow NULL 2952 // Allow NULL
2952 if UpperCase(Copy(ColSpec, 1, 8)) = 'NOT NULL' then begin 2953 if UpperCase(Copy(ColSpec, 1, 8)) = 'NOT NULL' then begin
2953 Col.AllowNull := False; 2954 Col.AllowNull := False;
2954 Delete(ColSpec, 1, 9); 2955 Delete(ColSpec, 1, 9);
2955 end else begin 2956 end else begin
2956 Col.AllowNull := True; 2957 Col.AllowNull := True;
2957 // Sporadically there is a "NULL" found at this position. 2958 // Sporadically there is a "NULL" found at this position.
2958 if UpperCase(Copy(ColSpec, 1, 4)) = 'NULL' then 2959 if UpperCase(Copy(ColSpec, 1, 4)) = 'NULL' then
2959 Delete(ColSpec, 1, 5); 2960 Delete(ColSpec, 1, 5);
2960 end; 2961 end;
2961 2962
2962 // Default value 2963 // Default value
2963 Col.DefaultType := cdtNothing; 2964 Col.DefaultType := cdtNothing;
2964 Col.DefaultText := ''; 2965 Col.DefaultText := '';
2965 if UpperCase(Copy(ColSpec, 1, 14)) = 'AUTO_INCREMENT' then begin 2966 if UpperCase(Copy(ColSpec, 1, 14)) = 'AUTO_INCREMENT' then begin
2966 Col.DefaultType := cdtAutoInc; 2967 Col.DefaultType := cdtAutoInc;
2967 Col.DefaultText := 'AUTO_INCREMENT'; 2968 Col.DefaultText := 'AUTO_INCREMENT';
2968 Delete(ColSpec, 1, 15); 2969 Delete(ColSpec, 1, 15);
2969 end else if UpperCase(Copy(ColSpec, 1, 8)) = 'DEFAULT ' then begin 2970 end else if UpperCase(Copy(ColSpec, 1, 8)) = 'DEFAULT ' then begin
2970 Delete(ColSpec, 1, 8); 2971 Delete(ColSpec, 1, 8);
2971 if UpperCase(Copy(ColSpec, 1, 4)) = 'NULL' then begin 2972 if UpperCase(Copy(ColSpec, 1, 4)) = 'NULL' then begin
2972 Col.DefaultType := cdtNull; 2973 Col.DefaultType := cdtNull;
2973 Col.DefaultText := 'NULL'; 2974 Col.DefaultText := 'NULL';
2974 Delete(ColSpec, 1, 5); 2975 Delete(ColSpec, 1, 5);
2975 end else if UpperCase(Copy(ColSpec, 1, 17)) = 'CURRENT_TIMESTAMP' then begin 2976 end else if UpperCase(Copy(ColSpec, 1, 17)) = 'CURRENT_TIMESTAMP' then begin
2976 Col.DefaultType := cdtCurTS; 2977 Col.DefaultType := cdtCurTS;
2977 Col.DefaultText := 'CURRENT_TIMESTAMP'; 2978 Col.DefaultText := 'CURRENT_TIMESTAMP';
2978 Delete(ColSpec, 1, 18); 2979 Delete(ColSpec, 1, 18);
2979 end else if ColSpec[1] = '''' then begin 2980 end else if ColSpec[1] = '''' then begin
2980 InLiteral := True; 2981 InLiteral := True;
2981 for i:=2 to Length(ColSpec) do begin 2982 for i:=2 to Length(ColSpec) do begin
2982 if ColSpec[i] = '''' then 2983 if ColSpec[i] = '''' then
2983 InLiteral := not InLiteral 2984 InLiteral := not InLiteral
2984 else if not InLiteral then 2985 else if not InLiteral then
2985 break; 2986 break;
2986 end; 2987 end;
2987 Col.DefaultType := cdtText; 2988 Col.DefaultType := cdtText;
2988 Col.DefaultText := Copy(ColSpec, 2, i-3); 2989 Col.DefaultText := Copy(ColSpec, 2, i-3);
2989 // A single quote gets escaped by single quote - remove the escape char - escaping is done in Save action afterwards 2990 // A single quote gets escaped by single quote - remove the escape char - escaping is done in Save action afterwards
2990 Col.DefaultText := StringReplace(Col.DefaultText, '''''', '''', [rfReplaceAll]); 2991 Col.DefaultText := StringReplace(Col.DefaultText, '''''', '''', [rfReplaceAll]);
2991 Delete(ColSpec, 1, i); 2992 Delete(ColSpec, 1, i);
2992 end; 2993 end;
2993 end; 2994 end;
2994 if UpperCase(Copy(ColSpec, 1, 27)) = 'ON UPDATE CURRENT_TIMESTAMP' then begin 2995 if UpperCase(Copy(ColSpec, 1, 27)) = 'ON UPDATE CURRENT_TIMESTAMP' then begin
2995 // Adjust default type 2996 // Adjust default type
2996 case Col.DefaultType of 2997 case Col.DefaultType of
2997 cdtText: Col.DefaultType := cdtTextUpdateTS; 2998 cdtText: Col.DefaultType := cdtTextUpdateTS;
2998 cdtNull: Col.DefaultType := cdtNullUpdateTS; 2999 cdtNull: Col.DefaultType := cdtNullUpdateTS;
2999 cdtCurTS: Col.DefaultType := cdtCurTSUpdateTS; 3000 cdtCurTS: Col.DefaultType := cdtCurTSUpdateTS;
3000 end; 3001 end;
3001 Delete(ColSpec, 1, 28); 3002 Delete(ColSpec, 1, 28);
3002 end; 3003 end;
3003 3004
3004 // Comment 3005 // Comment
3005 if UpperCase(Copy(ColSpec, 1, 9)) = 'COMMENT ''' then begin 3006 if UpperCase(Copy(ColSpec, 1, 9)) = 'COMMENT ''' then begin
3006 InLiteral := True; 3007 InLiteral := True;
3007 for i:=10 to Length(ColSpec) do begin 3008 for i:=10 to Length(ColSpec) do begin
3008 if ColSpec[i] = '''' then 3009 if ColSpec[i] = '''' then
3009 InLiteral := not InLiteral 3010 InLiteral := not InLiteral
3010 else if not InLiteral then 3011 else if not InLiteral then
3011 break; 3012 break;
3012 end; 3013 end;
3013 Col.Comment := Copy(ColSpec, 10, i-11); 3014 Col.Comment := Copy(ColSpec, 10, i-11);
3014 Col.Comment := StringReplace(Col.Comment, '''''', '''', [rfReplaceAll]); 3015 Col.Comment := StringReplace(Col.Comment, '''''', '''', [rfReplaceAll]);
3015 Delete(ColSpec, 1, i); 3016 Delete(ColSpec, 1, i);
3016 end; 3017 end;
3017 3018
3018 if not rx.ExecNext then 3019 if not rx.ExecNext then
3019 break; 3020 break;
3020 end; 3021 end;
3021 3022
3022 // Detect keys 3023 // Detect keys
3023 // PRIMARY KEY (`id`), UNIQUE KEY `id` (`id`), KEY `id_2` (`id`) USING BTREE, 3024 // PRIMARY KEY (`id`), UNIQUE KEY `id` (`id`), KEY `id_2` (`id`) USING BTREE,
3024 // KEY `Text` (`Text`(100)), FULLTEXT KEY `Email` (`Email`,`Text`) 3025 // KEY `Text` (`Text`(100)), FULLTEXT KEY `Email` (`Email`,`Text`)
3025 rx.Expression := '^\s+((\w+)\s+)?KEY\s+([`"]?([^`"]+)[`"]?\s+)?(USING\s+(\w+)\s+)?\((.+)\)(\s+USING\s+(\w+))?,?$'; 3026 rx.Expression := '^\s+((\w+)\s+)?KEY\s+([`"]?([^`"]+)[`"]?\s+)?(USING\s+(\w+)\s+)?\((.+)\)(\s+USING\s+(\w+))?,?$';
3026 if rx.Exec(CreateTable) then while true do begin 3027 if rx.Exec(CreateTable) then while true do begin
3027 if not Assigned(Keys) then 3028 if not Assigned(Keys) then
3028 break; 3029 break;
3029 Key := TTableKey.Create(Self); 3030 Key := TTableKey.Create(Self);
3030 Keys.Add(Key); 3031 Keys.Add(Key);
3031 Key.Name := rx.Match[4]; 3032 Key.Name := rx.Match[4];
3032 if Key.Name = '' then Key.Name := rx.Match[2]; // PRIMARY 3033 if Key.Name = '' then Key.Name := rx.Match[2]; // PRIMARY
3033 Key.OldName := Key.Name; 3034 Key.OldName := Key.Name;
3034 Key.IndexType := rx.Match[2]; 3035 Key.IndexType := rx.Match[2];
3035 Key.OldIndexType := Key.IndexType; 3036 Key.OldIndexType := Key.IndexType;
3036 if rx.Match[6] <> '' then // 5.0 and below show USING ... before column list 3037 if rx.Match[6] <> '' then // 5.0 and below show USING ... before column list
3037 Key.Algorithm := rx.Match[6] 3038 Key.Algorithm := rx.Match[6]
3038 else 3039 else
3039 Key.Algorithm := rx.Match[9]; 3040 Key.Algorithm := rx.Match[9];
3040 if Key.IndexType = '' then Key.IndexType := 'KEY'; // KEY 3041 if Key.IndexType = '' then Key.IndexType := 'KEY'; // KEY
3041 Key.Columns := Explode(',', rx.Match[7]); 3042 Key.Columns := Explode(',', rx.Match[7]);
3042 for i:=0 to Key.Columns.Count-1 do begin 3043 for i:=0 to Key.Columns.Count-1 do begin
3043 rxCol.Expression := '^[`"]?([^`"]+)[`"]?(\((\d+)\))?$'; 3044 rxCol.Expression := '^[`"]?([^`"]+)[`"]?(\((\d+)\))?$';
3044 if rxCol.Exec(Key.Columns[i]) then begin 3045 if rxCol.Exec(Key.Columns[i]) then begin
3045 Key.Columns[i] := rxCol.Match[1]; 3046 Key.Columns[i] := rxCol.Match[1];
3046 Key.SubParts.Add(rxCol.Match[3]); 3047 Key.SubParts.Add(rxCol.Match[3]);
3047 end; 3048 end;
3048 end; 3049 end;
3049 if not rx.ExecNext then 3050 if not rx.ExecNext then
3050 break; 3051 break;
3051 end; 3052 end;
3052 3053
3053 // Detect foreign keys 3054 // Detect foreign keys
3054 // CONSTRAINT `FK1` FOREIGN KEY (`which`) REFERENCES `fk1` (`id`) ON DELETE SET NULL ON UPDATE CASCADE 3055 // CONSTRAINT `FK1` FOREIGN KEY (`which`) REFERENCES `fk1` (`id`) ON DELETE SET NULL ON UPDATE CASCADE
3055 rx.Expression := '\s+CONSTRAINT\s+[`"]([^`"]+)[`"]\sFOREIGN KEY\s+\(([^\)]+)\)\s+REFERENCES\s+[`"]([^\(]+)[`"]\s\(([^\)]+)\)(\s+ON DELETE (RESTRICT|CASCADE|SET NULL|NO ACTION))?(\s+ON UPDATE (RESTRICT|CASCADE|SET NULL|NO ACTION))?'; 3056 rx.Expression := '\s+CONSTRAINT\s+[`"]([^`"]+)[`"]\sFOREIGN KEY\s+\(([^\)]+)\)\s+REFERENCES\s+[`"]([^\(]+)[`"]\s\(([^\)]+)\)(\s+ON DELETE (RESTRICT|CASCADE|SET NULL|NO ACTION))?(\s+ON UPDATE (RESTRICT|CASCADE|SET NULL|NO ACTION))?';
3056 if rx.Exec(CreateTable) then while true do begin 3057 if rx.Exec(CreateTable) then while true do begin
3057 if not Assigned(ForeignKeys) then 3058 if not Assigned(ForeignKeys) then
3058 break; 3059 break;
3059 ForeignKey := TForeignKey.Create(Self); 3060 ForeignKey := TForeignKey.Create(Self);
3060 ForeignKeys.Add(ForeignKey); 3061 ForeignKeys.Add(ForeignKey);
3061 ForeignKey.KeyName := rx.Match[1]; 3062 ForeignKey.KeyName := rx.Match[1];
3062 ForeignKey.OldKeyName := ForeignKey.KeyName; 3063 ForeignKey.OldKeyName := ForeignKey.KeyName;
3063 ForeignKey.KeyNameWasCustomized := True; 3064 ForeignKey.KeyNameWasCustomized := True;
3064 ForeignKey.ReferenceTable := StringReplace(rx.Match[3], '`', '', [rfReplaceAll]); 3065 ForeignKey.ReferenceTable := StringReplace(rx.Match[3], '`', '', [rfReplaceAll]);
3065 ForeignKey.ReferenceTable := StringReplace(ForeignKey.ReferenceTable, '"', '', [rfReplaceAll]); 3066 ForeignKey.ReferenceTable := StringReplace(ForeignKey.ReferenceTable, '"', '', [rfReplaceAll]);
3066 ExplodeQuotedList(rx.Match[2], ForeignKey.Columns); 3067 ExplodeQuotedList(rx.Match[2], ForeignKey.Columns);
3067 ExplodeQuotedList(rx.Match[4], ForeignKey.ForeignColumns); 3068 ExplodeQuotedList(rx.Match[4], ForeignKey.ForeignColumns);
3068 if rx.Match[6] <> '' then 3069 if rx.Match[6] <> '' then
3069 ForeignKey.OnDelete := rx.Match[6]; 3070 ForeignKey.OnDelete := rx.Match[6];
3070 if rx.Match[8] <> '' then 3071 if rx.Match[8] <> '' then
3071 ForeignKey.OnUpdate := rx.Match[8]; 3072 ForeignKey.OnUpdate := rx.Match[8];
3072 if not rx.ExecNext then 3073 if not rx.ExecNext then
3073 break; 3074 break;
3074 end; 3075 end;
3075 3076
3076 FreeAndNil(rxCol); 3077 FreeAndNil(rxCol);
3077 FreeAndNil(rx); 3078 FreeAndNil(rx);
3078 end; 3079 end;
3079 3080
3080 3081
3081 procedure TDBConnection.ParseViewStructure(CreateCode, ViewName: String; Columns: TTableColumnList; 3082 procedure TDBConnection.ParseViewStructure(CreateCode, ViewName: String; Columns: TTableColumnList;
3082 var Algorithm, Definer, SQLSecurity, CheckOption, SelectCode: String); 3083 var Algorithm, Definer, SQLSecurity, CheckOption, SelectCode: String);
3083 var 3084 var
3084 rx: TRegExpr; 3085 rx: TRegExpr;
3085 Col: TTableColumn; 3086 Col: TTableColumn;
3086 Results: TDBQuery; 3087 Results: TDBQuery;
3087 DbName, DbAndViewName: String; 3088 DbName, DbAndViewName: String;
3088 begin 3089 begin
3089 if CreateCode <> '' then begin 3090 if CreateCode <> '' then begin
3090 // CREATE 3091 // CREATE
3091 // [OR REPLACE] 3092 // [OR REPLACE]
3092 // [ALGORITHM = {UNDEFINED | MERGE | TEMPTABLE}] 3093 // [ALGORITHM = {UNDEFINED | MERGE | TEMPTABLE}]
3093 // [DEFINER = { user | CURRENT_USER }] 3094 // [DEFINER = { user | CURRENT_USER }]
3094 // [SQL SECURITY { DEFINER | INVOKER }] 3095 // [SQL SECURITY { DEFINER | INVOKER }]
3095 // VIEW view_name [(column_list)] 3096 // VIEW view_name [(column_list)]
3096 // AS select_statement 3097 // AS select_statement
3097 // [WITH [CASCADED | LOCAL] CHECK OPTION] 3098 // [WITH [CASCADED | LOCAL] CHECK OPTION]
3098 rx := TRegExpr.Create; 3099 rx := TRegExpr.Create;
3099 rx.ModifierG := False; 3100 rx.ModifierG := False;
3100 rx.ModifierI := True; 3101 rx.ModifierI := True;
3101 rx.Expression := '^CREATE\s+(OR\s+REPLACE\s+)?'+ 3102 rx.Expression := '^CREATE\s+(OR\s+REPLACE\s+)?'+
3102 '(ALGORITHM\s*=\s*(\w*)\s*)?'+ 3103 '(ALGORITHM\s*=\s*(\w*)\s*)?'+
3103 '(DEFINER\s*=\s*(\S+)\s+)?'+ 3104 '(DEFINER\s*=\s*(\S+)\s+)?'+
3104 '(SQL\s+SECURITY\s+\w+\s+)?'+ 3105 '(SQL\s+SECURITY\s+\w+\s+)?'+
3105 'VIEW\s+(([^\.]+)\.)?([^\.]+)\s+'+ 3106 'VIEW\s+(([^\.]+)\.)?([^\.]+)\s+'+
3106 '(\([^\)]\)\s+)?'+ 3107 '(\([^\)]\)\s+)?'+
3107 'AS\s+(.+)(\s+WITH\s+(\w+\s+)?CHECK\s+OPTION\s*)?$'; 3108 'AS\s+(.+)(\s+WITH\s+(\w+\s+)?CHECK\s+OPTION\s*)?$';
3108 if rx.Exec(CreateCode) then begin 3109 if rx.Exec(CreateCode) then begin
3109 Algorithm := rx.Match[3]; 3110 Algorithm := rx.Match[3];
3110 Definer := DeQuoteIdent(rx.Match[5], '@'); 3111 Definer := DeQuoteIdent(rx.Match[5], '@');
3111 // When exporting a view we need the db name for the below SHOW COLUMNS query, 3112 // When exporting a view we need the db name for the below SHOW COLUMNS query,
3112 // if the connection is on a different db currently 3113 // if the connection is on a different db currently
3113 DbName := DeQuoteIdent(rx.Match[8]); 3114 DbName := DeQuoteIdent(rx.Match[8]);
3114 ViewName := DeQuoteIdent(rx.Match[9]); 3115 ViewName := DeQuoteIdent(rx.Match[9]);
3115 CheckOption := Trim(rx.Match[13]); 3116 CheckOption := Trim(rx.Match[13]);
3116 SelectCode := rx.Match[11]; 3117 SelectCode := rx.Match[11];
3117 end else 3118 end else
3118 raise Exception.Create('Regular expression did not match the VIEW code in ParseViewStructure(): '+CRLF+CRLF+CreateCode); 3119 raise Exception.Create('Regular expression did not match the VIEW code in ParseViewStructure(): '+CRLF+CRLF+CreateCode);
3119 rx.Free; 3120 rx.Free;
3120 end; 3121 end;
3121 3122
3122 // Views reveal their columns only with a SHOW COLUMNS query. 3123 // Views reveal their columns only with a SHOW COLUMNS query.
3123 // No keys available in views - SHOW KEYS always returns an empty result 3124 // No keys available in views - SHOW KEYS always returns an empty result
3124 if Assigned(Columns) then begin 3125 if Assigned(Columns) then begin
3125 Columns.Clear; 3126 Columns.Clear;
3126 rx := TRegExpr.Create; 3127 rx := TRegExpr.Create;
3127 rx.Expression := '^(\w+)(\((.+)\))?'; 3128 rx.Expression := '^(\w+)(\((.+)\))?';
3128 if DbName <> '' then 3129 if DbName <> '' then
3129 DbAndViewName := QuoteIdent(DbName)+'.'; 3130 DbAndViewName := QuoteIdent(DbName)+'.';
3130 DbAndViewName := DbAndViewName + QuoteIdent(ViewName); 3131 DbAndViewName := DbAndViewName + QuoteIdent(ViewName);
3131 Results := GetResults('SHOW /*!32332 FULL */ COLUMNS FROM '+DbAndViewName); 3132 Results := GetResults('SHOW /*!32332 FULL */ COLUMNS FROM '+DbAndViewName);
3132 while not Results.Eof do begin 3133 while not Results.Eof do begin
3133 Col := TTableColumn.Create(Self); 3134 Col := TTableColumn.Create(Self);
3134 Columns.Add(Col); 3135 Columns.Add(Col);
3135 Col.Name := Results.Col('Field'); 3136 Col.Name := Results.Col('Field');
3136 Col.AllowNull := Results.Col('Null') = 'YES'; 3137 Col.AllowNull := Results.Col('Null') = 'YES';
3137 if rx.Exec(Results.Col('Type')) then begin 3138 if rx.Exec(Results.Col('Type')) then begin
3138 Col.DataType := GetDatatypeByName(rx.Match[1]); 3139 Col.DataType := GetDatatypeByName(rx.Match[1]);
3139 Col.LengthSet := rx.Match[3]; 3140 Col.LengthSet := rx.Match[3];
3140 end; 3141 end;
3141 Col.Unsigned := (Col.DataType.Category = dtcInteger) and (Pos('unsigned', Results.Col('Type')) > 0); 3142 Col.Unsigned := (Col.DataType.Category = dtcInteger) and (Pos('unsigned', Results.Col('Type')) > 0);
3142 Col.AllowNull := UpperCase(Results.Col('Null')) = 'YES'; 3143 Col.AllowNull := UpperCase(Results.Col('Null')) = 'YES';
3143 Col.Collation := Results.Col('Collation', True); 3144 Col.Collation := Results.Col('Collation', True);
3144 Col.Comment := Results.Col('Comment', True); 3145 Col.Comment := Results.Col('Comment', True);
3145 Col.DefaultText := Results.Col('Default'); 3146 Col.DefaultText := Results.Col('Default');
3146 if Results.IsNull('Default') then begin 3147 if Results.IsNull('Default') then begin
3147 if Col.AllowNull then 3148 if Col.AllowNull then
3148 Col.DefaultType := cdtNull 3149 Col.DefaultType := cdtNull
3149 else 3150 else
3150 Col.DefaultType := cdtNothing; 3151 Col.DefaultType := cdtNothing;
3151 end else if Col.DataType.Index = dtTimestamp then 3152 end else if Col.DataType.Index = dtTimestamp then
3152 Col.DefaultType := cdtCurTSUpdateTS 3153 Col.DefaultType := cdtCurTSUpdateTS
3153 else 3154 else
3154 Col.DefaultType := cdtText; 3155 Col.DefaultType := cdtText;
3155 Results.Next; 3156 Results.Next;
3156 end; 3157 end;
3157 rx.Free; 3158 rx.Free;
3158 end; 3159 end;
3159 end; 3160 end;
3160 3161
3161 3162
3162 procedure TDBConnection.ParseRoutineStructure(CreateCode: String; Parameters: TRoutineParamList; 3163 procedure TDBConnection.ParseRoutineStructure(CreateCode: String; Parameters: TRoutineParamList;
3163 var Deterministic: Boolean; var Definer, Returns, DataAccess, Security, Comment, Body: String); 3164 var Deterministic: Boolean; var Definer, Returns, DataAccess, Security, Comment, Body: String);
3164 var 3165 var
3165 Params: String; 3166 Params: String;
3166 ParenthesesCount: Integer; 3167 ParenthesesCount: Integer;
3167 rx: TRegExpr; 3168 rx: TRegExpr;
3168 i: Integer; 3169 i: Integer;
3169 Param: TRoutineParam; 3170 Param: TRoutineParam;
3170 begin 3171 begin
3171 // Parse CREATE code of stored function or procedure to detect parameters 3172 // Parse CREATE code of stored function or procedure to detect parameters
3172 rx := TRegExpr.Create; 3173 rx := TRegExpr.Create;
3173 rx.ModifierI := True; 3174 rx.ModifierI := True;
3174 rx.ModifierG := True; 3175 rx.ModifierG := True;
3175 // CREATE DEFINER=`root`@`localhost` PROCEDURE `bla2`(IN p1 INT, p2 VARCHAR(20)) 3176 // CREATE DEFINER=`root`@`localhost` PROCEDURE `bla2`(IN p1 INT, p2 VARCHAR(20))
3176 // CREATE DEFINER=`root`@`localhost` FUNCTION `test3`(`?b` varchar(20)) RETURNS tinyint(4) 3177 // CREATE DEFINER=`root`@`localhost` FUNCTION `test3`(`?b` varchar(20)) RETURNS tinyint(4)
3177 // CREATE DEFINER=`root`@`localhost` PROCEDURE `test3`(IN `Param1` int(1) unsigned) 3178 // CREATE DEFINER=`root`@`localhost` PROCEDURE `test3`(IN `Param1` int(1) unsigned)
3178 3179
3179 rx.Expression := '\bDEFINER\s*=\s*(\S+)\s'; 3180 rx.Expression := '\bDEFINER\s*=\s*(\S+)\s';
3180 if rx.Exec(CreateCode) then 3181 if rx.Exec(CreateCode) then
3181 Definer := DequoteIdent(rx.Match[1], '@') 3182 Definer := DequoteIdent(rx.Match[1], '@')
3182 else 3183 else
3183 Definer := ''; 3184 Definer := '';
3184 3185
3185 // Parse parameter list 3186 // Parse parameter list
3186 ParenthesesCount := 0; 3187 ParenthesesCount := 0;
3187 Params := ''; 3188 Params := '';
3188 for i:=1 to Length(CreateCode) do begin 3189 for i:=1 to Length(CreateCode) do begin
3189 if CreateCode[i] = ')' then begin 3190 if CreateCode[i] = ')' then begin
3190 Dec(ParenthesesCount); 3191 Dec(ParenthesesCount);
3191 if ParenthesesCount = 0 then 3192 if ParenthesesCount = 0 then
3192 break; 3193 break;
3193 end; 3194 end;
3194 if ParenthesesCount >= 1 then 3195 if ParenthesesCount >= 1 then
3195 Params := Params + CreateCode[i]; 3196 Params := Params + CreateCode[i];
3196 if CreateCode[i] = '(' then 3197 if CreateCode[i] = '(' then
3197 Inc(ParenthesesCount); 3198 Inc(ParenthesesCount);
3198 end; 3199 end;
3199 rx.Expression := '(^|,)\s*((IN|OUT|INOUT)\s+)?(\S+)\s+([^\s,\(]+(\([^\)]*\))?[^,]*)'; 3200 rx.Expression := '(^|,)\s*((IN|OUT|INOUT)\s+)?(\S+)\s+([^\s,\(]+(\([^\)]*\))?[^,]*)';
3200 if rx.Exec(Params) then while true do begin 3201 if rx.Exec(Params) then while true do begin
3201 Param := TRoutineParam.Create; 3202 Param := TRoutineParam.Create;
3202 Param.Context := UpperCase(rx.Match[3]); 3203 Param.Context := UpperCase(rx.Match[3]);
3203 if Param.Context = '' then 3204 if Param.Context = '' then
3204 Param.Context := 'IN'; 3205 Param.Context := 'IN';
3205 Param.Name := DeQuoteIdent(rx.Match[4]); 3206 Param.Name := DeQuoteIdent(rx.Match[4]);
3206 Param.Datatype := rx.Match[5]; 3207 Param.Datatype := rx.Match[5];
3207 Parameters.Add(Param); 3208 Parameters.Add(Param);
3208 if not rx.ExecNext then 3209 if not rx.ExecNext then
3209 break; 3210 break;
3210 end; 3211 end;
3211 3212
3212 // Cut left part including parameters, so it's easier to parse the rest 3213 // Cut left part including parameters, so it's easier to parse the rest
3213 CreateCode := Copy(CreateCode, i+1, MaxInt); 3214 CreateCode := Copy(CreateCode, i+1, MaxInt);
3214 // CREATE PROCEDURE sp_name ([proc_parameter[,...]]) [characteristic ...] routine_body 3215 // CREATE PROCEDURE sp_name ([proc_parameter[,...]]) [characteristic ...] routine_body
3215 // CREATE FUNCTION sp_name ([func_parameter[,...]]) RETURNS type [characteristic ...] routine_body 3216 // CREATE FUNCTION sp_name ([func_parameter[,...]]) RETURNS type [characteristic ...] routine_body
3216 // LANGUAGE SQL 3217 // LANGUAGE SQL
3217 // | [NOT] DETERMINISTIC // IS_DETERMINISTIC 3218 // | [NOT] DETERMINISTIC // IS_DETERMINISTIC
3218 // | { CONTAINS SQL | NO SQL | READS SQL DATA | MODIFIES SQL DATA } // DATA_ACCESS 3219 // | { CONTAINS SQL | NO SQL | READS SQL DATA | MODIFIES SQL DATA } // DATA_ACCESS
3219 // | SQL SECURITY { DEFINER | INVOKER } // SECURITY_TYPE 3220 // | SQL SECURITY { DEFINER | INVOKER } // SECURITY_TYPE
3220 // | COMMENT 'string' // COMMENT 3221 // | COMMENT 'string' // COMMENT
3221 3222
3222 rx.Expression := '\bLANGUAGE SQL\b'; 3223 rx.Expression := '\bLANGUAGE SQL\b';
3223 if rx.Exec(CreateCode) then 3224 if rx.Exec(CreateCode) then
3224 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]); 3225 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]);
3225 rx.Expression := '\bRETURNS\s+(\w+(\([^\)]*\))?(\s+UNSIGNED)?(\s+CHARSET\s+\S+)?(\s+COLLATE\s+\S+)?)'; 3226 rx.Expression := '\bRETURNS\s+(\w+(\([^\)]*\))?(\s+UNSIGNED)?(\s+CHARSET\s+\S+)?(\s+COLLATE\s+\S+)?)';
3226 if rx.Exec(CreateCode) then begin 3227 if rx.Exec(CreateCode) then begin
3227 Returns := rx.Match[1]; 3228 Returns := rx.Match[1];
3228 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]); 3229 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]);
3229 end; 3230 end;
3230 rx.Expression := '\b(NOT\s+)?DETERMINISTIC\b'; 3231 rx.Expression := '\b(NOT\s+)?DETERMINISTIC\b';
3231 if rx.Exec(CreateCode) then begin 3232 if rx.Exec(CreateCode) then begin
3232 Deterministic := rx.MatchLen[1] = -1; 3233 Deterministic := rx.MatchLen[1] = -1;
3233 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]); 3234 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]);
3234 end; 3235 end;
3235 rx.Expression := '\b(CONTAINS SQL|NO SQL|READS SQL DATA|MODIFIES SQL DATA)\b'; 3236 rx.Expression := '\b(CONTAINS SQL|NO SQL|READS SQL DATA|MODIFIES SQL DATA)\b';
3236 if rx.Exec(CreateCode) then begin 3237 if rx.Exec(CreateCode) then begin
3237 DataAccess := rx.Match[1]; 3238 DataAccess := rx.Match[1];
3238 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]); 3239 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]);
3239 end; 3240 end;
3240 rx.Expression := '\bSQL\s+SECURITY\s+(DEFINER|INVOKER)\b'; 3241 rx.Expression := '\bSQL\s+SECURITY\s+(DEFINER|INVOKER)\b';
3241 if rx.Exec(CreateCode) then begin 3242 if rx.Exec(CreateCode) then begin
3242 Security := rx.Match[1]; 3243 Security := rx.Match[1];
3243 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]); 3244 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]);
3244 end; 3245 end;
3245 rx.ModifierG := False; 3246 rx.ModifierG := False;
3246 rx.Expression := '\bCOMMENT\s+''((.+)[^''])''[^'']'; 3247 rx.Expression := '\bCOMMENT\s+''((.+)[^''])''[^'']';
3247 if rx.Exec(CreateCode) then begin 3248 if rx.Exec(CreateCode) then begin
3248 Comment := StringReplace(rx.Match[1], '''''', '''', [rfReplaceAll]); 3249 Comment := StringReplace(rx.Match[1], '''''', '''', [rfReplaceAll]);
3249 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]-1); 3250 Delete(CreateCode, rx.MatchPos[0], rx.MatchLen[0]-1);
3250 end; 3251 end;
3251 // Tata, remaining code is the routine body 3252 // Tata, remaining code is the routine body
3252 Body := TrimLeft(CreateCode); 3253 Body := TrimLeft(CreateCode);
3253 3254
3254 rx.Free; 3255 rx.Free;
3255 end; 3256 end;
3256 3257
3257 3258
3258 function TDBConnection.ApplyLimitClause(QueryType, QueryBody: String; Limit, Offset: Cardinal): String; 3259 function TDBConnection.ApplyLimitClause(QueryType, QueryBody: String; Limit, Offset: Cardinal): String;
3259 begin 3260 begin
3260 QueryType := UpperCase(QueryType); 3261 QueryType := UpperCase(QueryType);
3261 Result := QueryType + ' '; 3262 Result := QueryType + ' ';
3262 case FParameters.NetTypeGroup of 3263 case FParameters.NetTypeGroup of
3263 ngMSSQL: begin 3264 ngMSSQL: begin
3264 if QueryType = 'UPDATE' then 3265 if QueryType = 'UPDATE' then
3265 Result := Result + 'TOP('+IntToStr(Limit)+') ' 3266 Result := Result + 'TOP('+IntToStr(Limit)+') '
3266 else if QueryType = 'SELECT' then 3267 else if QueryType = 'SELECT' then
3267 Result := Result + 'TOP '+IntToStr(Limit)+' '; 3268 Result := Result + 'TOP '+IntToStr(Limit)+' ';
3268 Result := Result + QueryBody; 3269 Result := Result + QueryBody;
3269 end; 3270 end;
3270 ngMySQL: begin 3271 ngMySQL: begin
3271 Result := Result + QueryBody + ' LIMIT '; 3272 Result := Result + QueryBody + ' LIMIT ';
3272 if Offset > 0 then 3273 if Offset > 0 then
3273 Result := Result + IntToStr(Offset) + ', '; 3274 Result := Result + IntToStr(Offset) + ', ';
3274 Result := Result + IntToStr(Limit); 3275 Result := Result + IntToStr(Limit);
3275 end; 3276 end;
3276 end; 3277 end;
3277 end; 3278 end;
3278 3279
3279 3280
3280 3281
3281 { TMySQLQuery } 3282 { TMySQLQuery }
3282 3283
3283 constructor TDBQuery.Create(AOwner: TComponent); 3284 constructor TDBQuery.Create(AOwner: TComponent);
3284 begin 3285 begin
3285 inherited Create(AOwner); 3286 inherited Create(AOwner);
3286 FRecNo := -1; 3287 FRecNo := -1;
3287 FRecordCount := 0; 3288 FRecordCount := 0;
3288 FColumnNames := TStringList.Create; 3289 FColumnNames := TStringList.Create;
3289 FColumnNames.CaseSensitive := True; 3290 FColumnNames.CaseSensitive := True;
3290 FColumnOrgNames := TStringList.Create; 3291 FColumnOrgNames := TStringList.Create;
3291 FColumnOrgNames.CaseSensitive := True; 3292 FColumnOrgNames.CaseSensitive := True;
3292 FStoreResult := True; 3293 FStoreResult := True;
3293 end; 3294 end;
3294 3295
3295 3296
3296 destructor TDBQuery.Destroy; 3297 destructor TDBQuery.Destroy;
3297 begin 3298 begin
3298 FreeAndNil(FColumnNames); 3299 FreeAndNil(FColumnNames);
3299 FreeAndNil(FColumnOrgNames); 3300 FreeAndNil(FColumnOrgNames);
3300 FreeAndNil(FColumns); 3301 FreeAndNil(FColumns);
3301 FreeAndNil(FKeys); 3302 FreeAndNil(FKeys);
3302 FreeAndNil(FUpdateData); 3303 FreeAndNil(FUpdateData);
3303 SetLength(FColumnFlags, 0); 3304 SetLength(FColumnFlags, 0);
3304 SetLength(FColumnLengths, 0); 3305 SetLength(FColumnLengths, 0);
3305 SetLength(FColumnTypes, 0); 3306 SetLength(FColumnTypes, 0);
3306 FSQL := ''; 3307 FSQL := '';
3307 FRecordCount := 0; 3308 FRecordCount := 0;
3308 inherited; 3309 inherited;
3309 end; 3310 end;
3310 3311
3311 3312
3312 destructor TMySQLQuery.Destroy; 3313 destructor TMySQLQuery.Destroy;
3313 var 3314 var
3314 i: Integer; 3315 i: Integer;
3315 begin 3316 begin
3316 if HasResult then for i:=Low(FResultList) to High(FResultList) do 3317 if HasResult then for i:=Low(FResultList) to High(FResultList) do
3317 mysql_free_result(FResultList[i]); 3318 mysql_free_result(FResultList[i]);
3318 SetLength(FResultList, 0); 3319 SetLength(FResultList, 0);
3319 inherited; 3320 inherited;
3320 end; 3321 end;
3321 3322
3322 3323
3323 destructor TAdoDBQuery.Destroy; 3324 destructor TAdoDBQuery.Destroy;
3324 var 3325 var
3325 i: Integer; 3326 i: Integer;
3326 begin 3327 begin
3327 if HasResult then for i:=Low(FResultList) to High(FResultList) do begin 3328 if HasResult then for i:=Low(FResultList) to High(FResultList) do begin
3328 FResultList[i].Close; 3329 FResultList[i].Close;
3329 FResultList[i].Free; 3330 FResultList[i].Free;
3330 end; 3331 end;
3331 SetLength(FResultList, 0); 3332 SetLength(FResultList, 0);
3332 inherited; 3333 inherited;
3333 end; 3334 end;
3334 3335
3335 3336
3336 procedure TMySQLQuery.Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); 3337 procedure TMySQLQuery.Execute(AddResult: Boolean=False; UseRawResult: Integer=-1);
3337 var 3338 var
3338 i, j, NumFields: Integer; 3339 i, j, NumFields: Integer;
3339 NumResults: Int64; 3340 NumResults: Int64;
3340 Field: PMYSQL_FIELD; 3341 Field: PMYSQL_FIELD;
3341 IsBinary: Boolean; 3342 IsBinary: Boolean;
3342 LastResult: PMYSQL_RES; 3343 LastResult: PMYSQL_RES;
3343 begin 3344 begin
3344 // Execute a query, or just take over one of the last result pointers 3345 // Execute a query, or just take over one of the last result pointers
3345 if UseRawResult = -1 then begin 3346 if UseRawResult = -1 then begin
3346 Connection.Query(FSQL, FStoreResult); 3347 Connection.Query(FSQL, FStoreResult);
3347 UseRawResult := 0; 3348 UseRawResult := 0;
3348 end; 3349 end;
3349 if Connection.ResultCount > UseRawResult then 3350 if Connection.ResultCount > UseRawResult then
3350 LastResult := TMySQLConnection(Connection).LastRawResults[UseRawResult] 3351 LastResult := TMySQLConnection(Connection).LastRawResults[UseRawResult]
3351 else 3352 else
3352 LastResult := nil; 3353 LastResult := nil;
3353 if AddResult and (Length(FResultList) = 0) then 3354 if AddResult and (Length(FResultList) = 0) then
3354 AddResult := False; 3355 AddResult := False;
3355 if AddResult then 3356 if AddResult then
3356 NumResults := Length(FResultList)+1 3357 NumResults := Length(FResultList)+1
3357 else begin 3358 else begin
3358 for i:=Low(FResultList) to High(FResultList) do 3359 for i:=Low(FResultList) to High(FResultList) do
3359 mysql_free_result(FResultList[i]); 3360 mysql_free_result(FResultList[i]);
3360 NumResults := 1; 3361 NumResults := 1;
3361 FRecordCount := 0; 3362 FRecordCount := 0;
3362 FEditingPrepared := False; 3363 FEditingPrepared := False;
3363 end; 3364 end;
3364 if LastResult <> nil then begin 3365 if LastResult <> nil then begin
3365 Connection.Log(lcDebug, 'Result #'+IntToStr(NumResults)+' fetched.'); 3366 Connection.Log(lcDebug, 'Result #'+IntToStr(NumResults)+' fetched.');
3366 SetLength(FResultList, NumResults); 3367 SetLength(FResultList, NumResults);
3367 FResultList[NumResults-1] := LastResult; 3368 FResultList[NumResults-1] := LastResult;
3368 FRecordCount := FRecordCount + LastResult.row_count; 3369 FRecordCount := FRecordCount + LastResult.row_count;
3369 end; 3370 end;
3370 if not AddResult then begin 3371 if not AddResult then begin
3371 if HasResult then begin 3372 if HasResult then begin
3372 // FCurrentResults is normally done in SetRecNo, but never if result has no rows 3373 // FCurrentResults is normally done in SetRecNo, but never if result has no rows
3373 FCurrentResults := LastResult; 3374 FCurrentResults := LastResult;
3374 NumFields := mysql_num_fields(LastResult); 3375 NumFields := mysql_num_fields(LastResult);
3375 SetLength(FColumnTypes, NumFields); 3376 SetLength(FColumnTypes, NumFields);
3376 SetLength(FColumnLengths, NumFields); 3377 SetLength(FColumnLengths, NumFields);
3377 SetLength(FColumnFlags, NumFields); 3378 SetLength(FColumnFlags, NumFields);
3378 FColumnNames.Clear; 3379 FColumnNames.Clear;
3379 FColumnOrgNames.Clear; 3380 FColumnOrgNames.Clear;
3380 for i:=0 to NumFields-1 do begin 3381 for i:=0 to NumFields-1 do begin
3381 Field := mysql_fetch_field_direct(LastResult, i); 3382 Field := mysql_fetch_field_direct(LastResult, i);
3382 FColumnNames.Add(Connection.DecodeAPIString(Field.name)); 3383 FColumnNames.Add(Connection.DecodeAPIString(Field.name));
3383 if Connection.ServerVersionInt >= 40100 then 3384 if Connection.ServerVersionInt >= 40100 then
3384 FColumnOrgNames.Add(Connection.DecodeAPIString(Field.org_name)) 3385 FColumnOrgNames.Add(Connection.DecodeAPIString(Field.org_name))
3385 else 3386 else
3386 FColumnOrgNames.Add(Connection.DecodeAPIString(Field.name)); 3387 FColumnOrgNames.Add(Connection.DecodeAPIString(Field.name));
3387 FColumnFlags[i] := Field.flags; 3388 FColumnFlags[i] := Field.flags;
3388 FColumnTypes[i] := FConnection.Datatypes[0]; 3389 FColumnTypes[i] := FConnection.Datatypes[0];
3389 for j:=0 to High(FConnection.Datatypes) do begin 3390 for j:=0 to High(FConnection.Datatypes) do begin
3390 if (Field.flags and ENUM_FLAG) = ENUM_FLAG then begin 3391 if (Field.flags and ENUM_FLAG) = ENUM_FLAG then begin
3391 if FConnection.Datatypes[j].Index = dtEnum then 3392 if FConnection.Datatypes[j].Index = dtEnum then
3392 FColumnTypes[i] := FConnection.Datatypes[j]; 3393 FColumnTypes[i] := FConnection.Datatypes[j];
3393 end else if (Field.flags and SET_FLAG) = SET_FLAG then begin 3394 end else if (Field.flags and SET_FLAG) = SET_FLAG then begin
3394 if FConnection.Datatypes[j].Index = dtSet then 3395 if FConnection.Datatypes[j].Index = dtSet then
3395 FColumnTypes[i] := FConnection.Datatypes[j]; 3396 FColumnTypes[i] := FConnection.Datatypes[j];
3396 end else if Field._type = FConnection.Datatypes[j].NativeType then begin 3397 end else if Field._type = FConnection.Datatypes[j].NativeType then begin
3397 // Text and Blob types share the same constants (see FIELD_TYPEs) 3398 // Text and Blob types share the same constants (see FIELD_TYPEs)
3398 // Some function results return binary collation up to the latest versions. Work around 3399 // Some function results return binary collation up to the latest versions. Work around
3399 // that by checking if this field is a real table field 3400 // that by checking if this field is a real table field
3400 // See http://bugs.mysql.com/bug.php?id=10201 3401 // See http://bugs.mysql.com/bug.php?id=10201
3401 if Connection.IsUnicode then 3402 if Connection.IsUnicode then
3402 IsBinary := (Field.charsetnr = COLLATION_BINARY) and (Field.org_table <> '') 3403 IsBinary := (Field.charsetnr = COLLATION_BINARY) and (Field.org_table <> '')
3403 else 3404 else
3404 IsBinary := (Field.flags and BINARY_FLAG) = BINARY_FLAG; 3405 IsBinary := (Field.flags and BINARY_FLAG) = BINARY_FLAG;
3405 if IsBinary and (FConnection.Datatypes[j].Category = dtcText) then 3406 if IsBinary and (FConnection.Datatypes[j].Category = dtcText) then
3406 continue; 3407 continue;
3407 FColumnTypes[i] := FConnection.Datatypes[j]; 3408 FColumnTypes[i] := FConnection.Datatypes[j];
3408 break; 3409 break;
3409 end; 3410 end;
3410 end; 3411 end;
3411 end; 3412 end;
3412 FRecNo := -1; 3413 FRecNo := -1;
3413 First; 3414 First;
3414 end else begin 3415 end else begin
3415 SetLength(FColumnTypes, 0); 3416 SetLength(FColumnTypes, 0);
3416 SetLength(FColumnLengths, 0); 3417 SetLength(FColumnLengths, 0);
3417 SetLength(FColumnFlags, 0); 3418 SetLength(FColumnFlags, 0);
3418 end; 3419 end;
3419 end; 3420 end;
3420 end; 3421 end;
3421 3422
3422 3423
3423 procedure TAdoDBQuery.Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); 3424 procedure TAdoDBQuery.Execute(AddResult: Boolean=False; UseRawResult: Integer=-1);
3424 var 3425 var
3425 NumFields, i, j: Integer; 3426 NumFields, i, j: Integer;
3426 TypeIndex: TDBDatatypeIndex; 3427 TypeIndex: TDBDatatypeIndex;
3427 LastResult: TAdoQuery; 3428 LastResult: TAdoQuery;
3428 NumResults: Int64; 3429 NumResults: Int64;
3429 begin 3430 begin
3430 // TODO: Handle multiple results 3431 // TODO: Handle multiple results
3431 if UseRawResult = -1 then begin 3432 if UseRawResult = -1 then begin
3432 Connection.Query(FSQL, FStoreResult); 3433 Connection.Query(FSQL, FStoreResult);
3433 UseRawResult := 0; 3434 UseRawResult := 0;
3434 end; 3435 end;
3435 if Connection.ResultCount > UseRawResult then begin 3436 if Connection.ResultCount > UseRawResult then begin
3436 LastResult := TAdoQuery.Create(Self); 3437 LastResult := TAdoQuery.Create(Self);
3437 LastResult.Recordset := TAdoDBConnection(Connection).LastRawResults[UseRawResult]; 3438 LastResult.Recordset := TAdoDBConnection(Connection).LastRawResults[UseRawResult];
3438 LastResult.Open; 3439 LastResult.Open;
3439 end else 3440 end else
3440 LastResult := nil; 3441 LastResult := nil;
3441 if AddResult and (Length(FResultList) = 0) then 3442 if AddResult and (Length(FResultList) = 0) then
3442 AddResult := False; 3443 AddResult := False;
3443 if AddResult then 3444 if AddResult then
3444 NumResults := Length(FResultList)+1 3445 NumResults := Length(FResultList)+1
3445 else begin 3446 else begin
3446 for i:=Low(FResultList) to High(FResultList) do begin 3447 for i:=Low(FResultList) to High(FResultList) do begin
3447 FResultList[i].Close; 3448 FResultList[i].Close;
3448 FResultList[i].Free; 3449 FResultList[i].Free;
3449 end; 3450 end;
3450 NumResults := 1; 3451 NumResults := 1;
3451 FRecordCount := 0; 3452 FRecordCount := 0;
3452 FEditingPrepared := False; 3453 FEditingPrepared := False;
3453 end; 3454 end;
3454 if LastResult <> nil then begin 3455 if LastResult <> nil then begin
3455 Connection.Log(lcDebug, 'Result #'+IntToStr(NumResults)+' fetched.'); 3456 Connection.Log(lcDebug, 'Result #'+IntToStr(NumResults)+' fetched.');
3456 SetLength(FResultList, NumResults); 3457 SetLength(FResultList, NumResults);
3457 FResultList[NumResults-1] := LastResult; 3458 FResultList[NumResults-1] := LastResult;
3458 FRecordCount := FRecordCount + LastResult.RecordCount; 3459 FRecordCount := FRecordCount + LastResult.RecordCount;
3459 end; 3460 end;
3460 3461
3461 // Set up columns and data types 3462 // Set up columns and data types
3462 if not AddResult then begin 3463 if not AddResult then begin
3463 if HasResult then begin 3464 if HasResult then begin
3464 FCurrentResults := LastResult; 3465 FCurrentResults := LastResult;
3465 NumFields := LastResult.FieldCount; 3466 NumFields := LastResult.FieldCount;
3466 SetLength(FColumnTypes, NumFields); 3467 SetLength(FColumnTypes, NumFields);
3467 SetLength(FColumnLengths, NumFields); 3468 SetLength(FColumnLengths, NumFields);
3468 SetLength(FColumnFlags, NumFields); 3469 SetLength(FColumnFlags, NumFields);
3469 FColumnNames.Clear; 3470 FColumnNames.Clear;
3470 FColumnOrgNames.Clear; 3471 FColumnOrgNames.Clear;
3471 for i:=0 to NumFields-1 do begin 3472 for i:=0 to NumFields-1 do begin
3472 FColumnNames.Add(LastResult.Fields[i].FieldName); 3473 FColumnNames.Add(LastResult.Fields[i].FieldName);
3473 FColumnOrgNames.Add(FColumnNames[i]); 3474 FColumnOrgNames.Add(FColumnNames[i]);
3474 { ftUnknown, ftString, ftSmallint, ftInteger, ftWord, // 0..4 3475 { ftUnknown, ftString, ftSmallint, ftInteger, ftWord, // 0..4
3475 ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, // 5..11 3476 ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, // 5..11
3476 ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo, // 12..18 3477 ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo, // 12..18
3477 ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString, // 19..24 3478 ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString, // 19..24
3478 ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, // 25..31 3479 ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, // 25..31
3479 ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, // 32..37 3480 ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, // 32..37
3480 ftFixedWideChar, ftWideMemo, ftOraTimeStamp, ftOraInterval, // 38..41 3481 ftFixedWideChar, ftWideMemo, ftOraTimeStamp, ftOraInterval, // 38..41
3481 ftLongWord, ftShortint, ftByte, ftExtended, ftConnection, ftParams, ftStream, //42..48 3482 ftLongWord, ftShortint, ftByte, ftExtended, ftConnection, ftParams, ftStream, //42..48
3482 ftTimeStampOffset, ftObject, ftSingle //49..51 } 3483 ftTimeStampOffset, ftObject, ftSingle //49..51 }
3483 case LastResult.Fields[i].DataType of 3484 case LastResult.Fields[i].DataType of
3484 ftSmallint, ftWord: 3485 ftSmallint, ftWord:
3485 TypeIndex := dtMediumInt; 3486 TypeIndex := dtMediumInt;
3486 ftInteger, ftAutoInc: 3487 ftInteger, ftAutoInc:
3487 TypeIndex := dtInt; 3488 TypeIndex := dtInt;
3488 ftLargeint: 3489 ftLargeint:
3489 TypeIndex := dtBigInt; 3490 TypeIndex := dtBigInt;
3490 ftBCD, ftFMTBcd: 3491 ftBCD, ftFMTBcd:
3491 TypeIndex := dtDecimal; 3492 TypeIndex := dtDecimal;
3492 ftFixedChar: 3493 ftFixedChar:
3493 TypeIndex := dtChar; 3494 TypeIndex := dtChar;
3494 ftString, ftWideString, ftBoolean, ftGuid: 3495 ftString, ftWideString, ftBoolean, ftGuid:
3495 TypeIndex := dtVarchar; 3496 TypeIndex := dtVarchar;
3496 ftMemo, ftWideMemo: 3497 ftMemo, ftWideMemo:
3497 TypeIndex := dtMediumText; 3498 TypeIndex := dtMediumText;
3498 ftBlob, ftVariant: 3499 ftBlob, ftVariant:
3499 TypeIndex := dtMediumBlob; 3500 TypeIndex := dtMediumBlob;
3500 ftBytes: 3501 ftBytes:
3501 TypeIndex := dtBinary; 3502 TypeIndex := dtBinary;
3502 ftVarBytes: 3503 ftVarBytes:
3503 TypeIndex := dtVarbinary; 3504 TypeIndex := dtVarbinary;
3504 ftFloat: 3505 ftFloat:
3505 TypeIndex := dtEnum; 3506 TypeIndex := dtEnum;
3506 ftDate: 3507 ftDate:
3507 TypeIndex := dtDate; 3508 TypeIndex := dtDate;
3508 ftTime: 3509 ftTime:
3509 TypeIndex := dtTime; 3510 TypeIndex := dtTime;
3510 ftDateTime: 3511 ftDateTime:
3511 TypeIndex := dtDateTime; 3512 TypeIndex := dtDateTime;
3512 else 3513 else
3513 raise EDatabaseError.Create('Unknown data type for column #'+IntToStr(i)+' - '+FColumnNames[i]+': '+IntToStr(Integer(LastResult.Fields[i].DataType))); 3514 raise EDatabaseError.Create('Unknown data type for column #'+IntToStr(i)+' - '+FColumnNames[i]+': '+IntToStr(Integer(LastResult.Fields[i].DataType)));
3514 end; 3515 end;
3515 for j:=0 to High(FConnection.DataTypes) do begin 3516 for j:=0 to High(FConnection.DataTypes) do begin
3516 if TypeIndex = FConnection.DataTypes[j].Index then 3517 if TypeIndex = FConnection.DataTypes[j].Index then
3517 FColumnTypes[i] := FConnection.DataTypes[j]; 3518 FColumnTypes[i] := FConnection.DataTypes[j];
3518 end; 3519 end;
3519 3520
3520 end; 3521 end;
3521 FRecNo := -1; 3522 FRecNo := -1;
3522 First; 3523 First;
3523 end else begin 3524 end else begin
3524 SetLength(FColumnTypes, 0); 3525 SetLength(FColumnTypes, 0);
3525 SetLength(FColumnLengths, 0); 3526 SetLength(FColumnLengths, 0);
3526 SetLength(FColumnFlags, 0); 3527 SetLength(FColumnFlags, 0);
3527 end; 3528 end;
3528 end; 3529 end;
3529 end; 3530 end;
3530 3531
3531 3532
3532 procedure TDBQuery.SetColumnOrgNames(Value: TStringList); 3533 procedure TDBQuery.SetColumnOrgNames(Value: TStringList);
3533 begin 3534 begin
3534 // Retrieve original column names from caller 3535 // Retrieve original column names from caller
3535 FColumnOrgNames.Text := Value.Text; 3536 FColumnOrgNames.Text := Value.Text;
3536 end; 3537 end;
3537 3538
3538 3539
3539 procedure TDBQuery.First; 3540 procedure TDBQuery.First;
3540 begin 3541 begin
3541 RecNo := 0; 3542 RecNo := 0;
3542 end; 3543 end;
3543 3544
3544 3545
3545 procedure TDBQuery.Next; 3546 procedure TDBQuery.Next;
3546 begin 3547 begin
3547 RecNo := RecNo + 1; 3548 RecNo := RecNo + 1;
3548 end; 3549 end;
3549 3550
3550 3551
3551 procedure TMySQLQuery.SetRecNo(Value: Int64); 3552 procedure TMySQLQuery.SetRecNo(Value: Int64);
3552 var 3553 var
3553 LengthPointer: PLongInt; 3554 LengthPointer: PLongInt;
3554 i, j: Integer; 3555 i, j: Integer;
3555 NumRows, WantedLocalRecNo: Int64; 3556 NumRows, WantedLocalRecNo: Int64;
3556 Row: TRowData; 3557 Row: TRowData;
3557 RowFound: Boolean; 3558 RowFound: Boolean;
3558 begin 3559 begin
3559 if Value = FRecNo then 3560 if Value = FRecNo then
3560 Exit; 3561 Exit;
3561 if (not FEditingPrepared) and (Value >= RecordCount) then begin 3562 if (not FEditingPrepared) and (Value >= RecordCount) then begin
3562 FRecNo := RecordCount; 3563 FRecNo := RecordCount;
3563 FEof := True; 3564 FEof := True;
3564 end else begin 3565 end else begin
3565 3566
3566 // Find row in edited data 3567 // Find row in edited data
3567 RowFound := False; 3568 RowFound := False;
3568 if FEditingPrepared then begin 3569 if FEditingPrepared then begin
3569 for Row in FUpdateData do begin 3570 for Row in FUpdateData do begin
3570 if Row.RecNo = Value then begin 3571 if Row.RecNo = Value then begin
3571 FCurrentRow := nil; 3572 FCurrentRow := nil;
3572 FCurrentUpdateRow := Row; 3573 FCurrentUpdateRow := Row;
3573 for i:=Low(FColumnLengths) to High(FColumnLengths) do 3574 for i:=Low(FColumnLengths) to High(FColumnLengths) do
3574 FColumnLengths[i] := Length(FCurrentUpdateRow[i].NewText); 3575 FColumnLengths[i] := Length(FCurrentUpdateRow[i].NewText);
3575 RowFound := True; 3576 RowFound := True;
3576 break; 3577 break;
3577 end; 3578 end;
3578 end; 3579 end;
3579 end; 3580 end;
3580 3581
3581 // Row not edited data - find it in normal result 3582 // Row not edited data - find it in normal result
3582 if not RowFound then begin 3583 if not RowFound then begin
3583 NumRows := 0; 3584 NumRows := 0;
3584 for i:=Low(FResultList) to High(FResultList) do begin 3585 for i:=Low(FResultList) to High(FResultList) do begin
3585 Inc(NumRows, FResultList[i].row_count); 3586 Inc(NumRows, FResultList[i].row_count);
3586 if NumRows > Value then begin 3587 if NumRows > Value then begin
3587 FCurrentResults := FResultList[i]; 3588 FCurrentResults := FResultList[i];
3588 // Do not seek if FCurrentRow points to the previous row of the wanted row 3589 // Do not seek if FCurrentRow points to the previous row of the wanted row
3589 WantedLocalRecNo := FCurrentResults.row_count-(NumRows-Value); 3590 WantedLocalRecNo := FCurrentResults.row_count-(NumRows-Value);
3590 if (WantedLocalRecNo = 0) or (FRecNo+1 <> Value) or (FCurrentRow = nil) then 3591 if (WantedLocalRecNo = 0) or (FRecNo+1 <> Value) or (FCurrentRow = nil) then
3591 mysql_data_seek(FCurrentResults, WantedLocalRecNo); 3592 mysql_data_seek(FCurrentResults, WantedLocalRecNo);
3592 FCurrentRow := mysql_fetch_row(FCurrentResults); 3593 FCurrentRow := mysql_fetch_row(FCurrentResults);
3593 FCurrentUpdateRow := nil; 3594 FCurrentUpdateRow := nil;
3594 // Remember length of column contents. Important for Col() so contents of cells with #0 chars are not cut off 3595 // Remember length of column contents. Important for Col() so contents of cells with #0 chars are not cut off
3595 LengthPointer := mysql_fetch_lengths(FCurrentResults); 3596 LengthPointer := mysql_fetch_lengths(FCurrentResults);
3596 for j:=Low(FColumnLengths) to High(FColumnLengths) do 3597 for j:=Low(FColumnLengths) to High(FColumnLengths) do
3597 FColumnLengths[j] := PInteger(Integer(LengthPointer) + j * SizeOf(Integer))^; 3598 FColumnLengths[j] := PInteger(Integer(LengthPointer) + j * SizeOf(Integer))^;
3598 break; 3599 break;
3599 end; 3600 end;
3600 end; 3601 end;
3601 end; 3602 end;
3602 3603
3603 FRecNo := Value; 3604 FRecNo := Value;
3604 FEof := False; 3605 FEof := False;
3605 end; 3606 end;
3606 end; 3607 end;
3607 3608
3608 3609
3609 procedure TAdoDBQuery.SetRecNo(Value: Int64); 3610 procedure TAdoDBQuery.SetRecNo(Value: Int64);
3610 var 3611 var
3611 i, j: Integer; 3612 i, j: Integer;
3612 RowFound: Boolean; 3613 RowFound: Boolean;
3613 Row: TRowData; 3614 Row: TRowData;
3614 NumRows, WantedLocalRecNo: Int64; 3615 NumRows, WantedLocalRecNo: Int64;
3615 begin 3616 begin
3616 if Value = FRecNo then 3617 if Value = FRecNo then
3617 Exit; 3618 Exit;
3618 if (not FEditingPrepared) and (Value >= RecordCount) then begin 3619 if (not FEditingPrepared) and (Value >= RecordCount) then begin
3619 FRecNo := RecordCount; 3620 FRecNo := RecordCount;
3620 FEof := True; 3621 FEof := True;
3621 FCurrentResults.Last; 3622 FCurrentResults.Last;
3622 end else begin 3623 end else begin
3623 3624
3624 // Find row in edited data 3625 // Find row in edited data
3625 RowFound := False; 3626 RowFound := False;
3626 if FEditingPrepared then begin 3627 if FEditingPrepared then begin
3627 for Row in FUpdateData do begin 3628 for Row in FUpdateData do begin
3628 if Row.RecNo = Value then begin 3629 if Row.RecNo = Value then begin
3629 FCurrentUpdateRow := Row; 3630 FCurrentUpdateRow := Row;
3630 for i:=Low(FColumnLengths) to High(FColumnLengths) do 3631 for i:=Low(FColumnLengths) to High(FColumnLengths) do
3631 FColumnLengths[i] := Length(FCurrentUpdateRow[i].NewText); 3632 FColumnLengths[i] := Length(FCurrentUpdateRow[i].NewText);
3632 RowFound := True; 3633 RowFound := True;
3633 break; 3634 break;
3634 end; 3635 end;
3635 end; 3636 end;
3636 end; 3637 end;
3637 3638
3638 // Row not edited data - find it in normal result 3639 // Row not edited data - find it in normal result
3639 if not RowFound then begin 3640 if not RowFound then begin
3640 NumRows := 0; 3641 NumRows := 0;
3641 for i:=Low(FResultList) to High(FResultList) do begin 3642 for i:=Low(FResultList) to High(FResultList) do begin
3642 Inc(NumRows, FResultList[i].RecordCount); 3643 Inc(NumRows, FResultList[i].RecordCount);
3643 if NumRows > Value then begin 3644 if NumRows > Value then begin
3644 FCurrentResults := FResultList[i]; 3645 FCurrentResults := FResultList[i];
3645 WantedLocalRecNo := FCurrentResults.RecordCount-(NumRows-Value); 3646 WantedLocalRecNo := FCurrentResults.RecordCount-(NumRows-Value);
3646 FCurrentResults.RecNo := WantedLocalRecNo+1; 3647 FCurrentResults.RecNo := WantedLocalRecNo+1;
3647 FCurrentUpdateRow := nil; 3648 FCurrentUpdateRow := nil;
3648 for j:=Low(FColumnLengths) to High(FColumnLengths) do 3649 for j:=Low(FColumnLengths) to High(FColumnLengths) do
3649 FColumnLengths[j] := FCurrentResults.Fields[j].DataSize; 3650 FColumnLengths[j] := FCurrentResults.Fields[j].DataSize;
3650 break; 3651 break;
3651 end; 3652 end;
3652 end; 3653 end;
3653 end; 3654 end;
3654 3655
3655 FRecNo := Value; 3656 FRecNo := Value;
3656 FEof := False; 3657 FEof := False;
3657 end; 3658 end;
3658 end; 3659 end;
3659 3660
3660 3661
3661 function TDBQuery.ColumnCount: Integer; 3662 function TDBQuery.ColumnCount: Integer;
3662 begin 3663 begin
3663 Result := ColumnNames.Count; 3664 Result := ColumnNames.Count;
3664 end; 3665 end;
3665 3666
3666 3667
3667 function TMySQLQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; 3668 function TMySQLQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String;
3668 var 3669 var
3669 AnsiStr: AnsiString; 3670 AnsiStr: AnsiString;
3670 BitString: String; 3671 BitString: String;
3671 NumBit: Integer; 3672 NumBit: Integer;
3672 ByteVal: Byte; 3673 ByteVal: Byte;
3673 c: Char; 3674 c: Char;
3674 begin 3675 begin
3675 if (Column > -1) and (Column < ColumnCount) then begin 3676 if (Column > -1) and (Column < ColumnCount) then begin
3676 if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin 3677 if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin
3677 // Row was edited and only valid in a TRowData 3678 // Row was edited and only valid in a TRowData
3678 Result := FCurrentUpdateRow[Column].NewText; 3679 Result := FCurrentUpdateRow[Column].NewText;
3679 end else begin 3680 end else begin
3680 // The normal case: Fetch cell from mysql result 3681 // The normal case: Fetch cell from mysql result
3681 SetString(AnsiStr, FCurrentRow[Column], FColumnLengths[Column]); 3682 SetString(AnsiStr, FCurrentRow[Column], FColumnLengths[Column]);
3682 if Datatype(Column).Category in [dtcBinary, dtcSpatial] then 3683 if Datatype(Column).Category in [dtcBinary, dtcSpatial] then
3683 Result := String(AnsiStr) 3684 Result := String(AnsiStr)
3684 else 3685 else
3685 Result := Connection.DecodeAPIString(AnsiStr); 3686 Result := Connection.DecodeAPIString(AnsiStr);
3686 // Create string bitmask for BIT fields 3687 // Create string bitmask for BIT fields
3687 if Datatype(Column).Index = dtBit then begin 3688 if Datatype(Column).Index = dtBit then begin
3688 for c in Result do begin 3689 for c in Result do begin
3689 ByteVal := Byte(c); 3690 ByteVal := Byte(c);
3690 BitString := ''; 3691 BitString := '';
3691 for NumBit:=0 to 7 do begin 3692 for NumBit:=0 to 7 do begin
3692 if (ByteVal shr NumBit and $1) = $1 then 3693 if (ByteVal shr NumBit and $1) = $1 then
3693 BitString := BitString + '1' 3694 BitString := BitString + '1'
3694 else 3695 else
3695 BitString := BitString + '0'; 3696 BitString := BitString + '0';
3696 if Length(BitString) >= MaxLength(Column) then 3697 if Length(BitString) >= MaxLength(Column) then
3697 break; 3698 break;
3698 end; 3699 end;
3699 if Length(BitString) >= MaxLength(Column) then 3700 if Length(BitString) >= MaxLength(Column) then
3700 break; 3701 break;
3701 end; 3702 end;
3702 Result := BitString; 3703 Result := BitString;
3703 end; 3704 end;
3704 3705
3705 end; 3706 end;
3706 end else if not IgnoreErrors then 3707 end else if not IgnoreErrors then
3707 Raise EDatabaseError.CreateFmt(MsgInvalidColumn, [Column, ColumnCount, RecordCount]); 3708 Raise EDatabaseError.CreateFmt(MsgInvalidColumn, [Column, ColumnCount, RecordCount]);
3708 end; 3709 end;
3709 3710
3710 3711
3711 function TAdoDBQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; 3712 function TAdoDBQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String;
3712 begin 3713 begin
3713 if (Column > -1) and (Column < ColumnCount) then begin 3714 if (Column > -1) and (Column < ColumnCount) then begin
3714 if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin 3715 if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin
3715 Result := FCurrentUpdateRow[Column].NewText; 3716 Result := FCurrentUpdateRow[Column].NewText;
3716 end else begin 3717 end else begin
3717 try 3718 try
3718 Result := FCurrentResults.Fields[Column].AsString; 3719 Result := FCurrentResults.Fields[Column].AsString;
3719 except 3720 except
3720 Result := String(FCurrentResults.Fields[Column].AsAnsiString); 3721 Result := String(FCurrentResults.Fields[Column].AsAnsiString);
3721 end; 3722 end;
3722 end; 3723 end;
3723 end else if not IgnoreErrors then 3724 end else if not IgnoreErrors then
3724 Raise EDatabaseError.CreateFmt(MsgInvalidColumn, [Column, ColumnCount, RecordCount]); 3725 Raise EDatabaseError.CreateFmt(MsgInvalidColumn, [Column, ColumnCount, RecordCount]);
3725 end; 3726 end;
3726 3727
3727 3728
3728 function TDBQuery.Col(ColumnName: String; IgnoreErrors: Boolean=False): String; 3729 function TDBQuery.Col(ColumnName: String; IgnoreErrors: Boolean=False): String;
3729 var 3730 var
3730 idx: Integer; 3731 idx: Integer;
3731 begin 3732 begin
3732 idx := ColumnNames.IndexOf(ColumnName); 3733 idx := ColumnNames.IndexOf(ColumnName);
3733 if idx > -1 then 3734 if idx > -1 then
3734 Result := Col(idx) 3735 Result := Col(idx)
3735 else if not IgnoreErrors then 3736 else if not IgnoreErrors then
3736 Raise EDatabaseError.CreateFmt('Column "%s" not available.', [ColumnName]); 3737 Raise EDatabaseError.CreateFmt('Column "%s" not available.', [ColumnName]);
3737 end; 3738 end;
3738 3739
3739 3740
3740 function TDBQuery.ColumnLengths(Column: Integer): Int64; 3741 function TDBQuery.ColumnLengths(Column: Integer): Int64;
3741 begin 3742 begin
3742 Result := FColumnLengths[Column]; 3743 Result := FColumnLengths[Column];
3743 end; 3744 end;
3744 3745
3745 3746
3746 function TDBQuery.HexValue(Column: Integer; IgnoreErrors: Boolean=False): String; 3747 function TDBQuery.HexValue(Column: Integer; IgnoreErrors: Boolean=False): String;
3747 begin 3748 begin
3748 // Return a binary column value as hex AnsiString 3749 // Return a binary column value as hex AnsiString
3749 Result := HexValue(Col(Column, IgnoreErrors)); 3750 Result := HexValue(Col(Column, IgnoreErrors));
3750 end; 3751 end;
3751 3752
3752 3753
3753 function TDBQuery.HexValue(BinValue: String): String; 3754 function TDBQuery.HexValue(BinValue: String): String;
3754 var 3755 var
3755 BinLen: Integer; 3756 BinLen: Integer;
3756 Ansi: AnsiString; 3757 Ansi: AnsiString;
3757 begin 3758 begin
3758 // Return a binary value as hex AnsiString 3759 // Return a binary value as hex AnsiString
3759 Ansi := AnsiString(BinValue); 3760 Ansi := AnsiString(BinValue);
3760 BinLen := Length(Ansi); 3761 BinLen := Length(Ansi);
3761 if BinLen = 0 then begin 3762 if BinLen = 0 then begin
3762 Result := ''; 3763 Result := '';
3763 end else begin 3764 end else begin
3764 SetLength(Result, BinLen*2); 3765 SetLength(Result, BinLen*2);
3765 BinToHex(PAnsiChar(Ansi), PChar(Result), BinLen); 3766 BinToHex(PAnsiChar(Ansi), PChar(Result), BinLen);
3766 Result := '0x' + Result; 3767 Result := '0x' + Result;
3767 end; 3768 end;
3768 end; 3769 end;
3769 3770
3770 3771
3771 function TDBQuery.DataType(Column: Integer): TDBDataType; 3772 function TDBQuery.DataType(Column: Integer): TDBDataType;
3772 var 3773 var
3773 Col: TTableColumn; 3774 Col: TTableColumn;
3774 begin 3775 begin
3775 Col := ColAttributes(Column); 3776 Col := ColAttributes(Column);
3776 if Assigned(Col) then 3777 if Assigned(Col) then
3777 Result := Col.DataType 3778 Result := Col.DataType
3778 else 3779 else
3779 Result := FColumnTypes[Column]; 3780 Result := FColumnTypes[Column];
3780 end; 3781 end;
3781 3782
3782 3783
3783 function TDBQuery.MaxLength(Column: Integer): Int64; 3784 function TDBQuery.MaxLength(Column: Integer): Int64;
3784 var 3785 var
3785 ColAttr: TTableColumn; 3786 ColAttr: TTableColumn;
3786 begin 3787 begin
3787 // Return maximum posible length of values in given columns 3788 // Return maximum posible length of values in given columns
3788 // Note: PMYSQL_FIELD.max_length holds the maximum existing value in that column, which is useless here 3789 // Note: PMYSQL_FIELD.max_length holds the maximum existing value in that column, which is useless here
3789 Result := MaxInt; 3790 Result := MaxInt;
3790 ColAttr := ColAttributes(Column); 3791 ColAttr := ColAttributes(Column);
3791 if Assigned(ColAttr) then begin 3792 if Assigned(ColAttr) then begin
3792 case ColAttr.DataType.Index of 3793 case ColAttr.DataType.Index of
3793 dtChar, dtVarchar, dtBinary, dtVarBinary, dtBit: Result := MakeInt(ColAttr.LengthSet); 3794 dtChar, dtVarchar, dtBinary, dtVarBinary, dtBit: Result := MakeInt(ColAttr.LengthSet);
3794 dtTinyText, dtTinyBlob: Result := 255; 3795 dtTinyText, dtTinyBlob: Result := 255;
3795 dtText, dtBlob: Result := 65535; 3796 dtText, dtBlob: Result := 65535;
3796 dtMediumText, dtMediumBlob: Result := 16777215; 3797 dtMediumText, dtMediumBlob: Result := 16777215;
3797 dtLongText, dtLongBlob: Result := 4294967295; 3798 dtLongText, dtLongBlob: Result := 4294967295;
3798 end; 3799 end;
3799 end; 3800 end;
3800 end; 3801 end;
3801 3802
3802 3803
3803 function TDBQuery.ValueList(Column: Integer): TStringList; 3804 function TDBQuery.ValueList(Column: Integer): TStringList;
3804 var 3805 var
3805 ColAttr: TTableColumn; 3806 ColAttr: TTableColumn;
3806 begin 3807 begin
3807 Result := TStringList.Create; 3808 Result := TStringList.Create;
3808 Result.QuoteChar := ''''; 3809 Result.QuoteChar := '''';
3809 Result.Delimiter := ','; 3810 Result.Delimiter := ',';
3810 ColAttr := ColAttributes(Column); 3811 ColAttr := ColAttributes(Column);
3811 if Assigned(ColAttr) and (ColAttr.DataType.Index in [dtEnum, dtSet]) then 3812 if Assigned(ColAttr) and (ColAttr.DataType.Index in [dtEnum, dtSet]) then
3812 Result.DelimitedText := ColAttr.LengthSet; 3813 Result.DelimitedText := ColAttr.LengthSet;
3813 end; 3814 end;
3814 3815
3815 3816
3816 function TDBQuery.ColAttributes(Column: Integer): TTableColumn; 3817 function TDBQuery.ColAttributes(Column: Integer): TTableColumn;
3817 var 3818 var
3818 i: Integer; 3819 i: Integer;
3819 begin 3820 begin
3820 Result := nil; 3821 Result := nil;
3821 if (Column = -1) or (Column >= FColumnOrgNames.Count) then 3822 if (Column = -1) or (Column >= FColumnOrgNames.Count) then
3822 raise EDatabaseError.Create('Column #'+IntToStr(Column)+' not available.'); 3823 raise EDatabaseError.Create('Column #'+IntToStr(Column)+' not available.');
3823 if FEditingPrepared then begin 3824 if FEditingPrepared then begin
3824 for i:=0 to FColumns.Count-1 do begin 3825 for i:=0 to FColumns.Count-1 do begin
3825 if FColumns[i].Name = FColumnOrgNames[Column] then begin 3826 if FColumns[i].Name = FColumnOrgNames[Column] then begin
3826 Result := FColumns[i]; 3827 Result := FColumns[i];
3827 break; 3828 break;
3828 end; 3829 end;
3829 end; 3830 end;
3830 end; 3831 end;
3831 end; 3832 end;
3832 3833
3833 3834
3834 function TDBQuery.ColExists(Column: String): Boolean; 3835 function TDBQuery.ColExists(Column: String): Boolean;
3835 begin 3836 begin
3836 Result := (ColumnNames <> nil) and (ColumnNames.IndexOf(Column) > -1); 3837 Result := (ColumnNames <> nil) and (ColumnNames.IndexOf(Column) > -1);
3837 end; 3838 end;
3838 3839
3839 3840
3840 function TMySQLQuery.ColIsPrimaryKeyPart(Column: Integer): Boolean; 3841 function TMySQLQuery.ColIsPrimaryKeyPart(Column: Integer): Boolean;
3841 begin 3842 begin
3842 Result := (FColumnFlags[Column] and PRI_KEY_FLAG) = PRI_KEY_FLAG; 3843 Result := (FColumnFlags[Column] and PRI_KEY_FLAG) = PRI_KEY_FLAG;
3843 end; 3844 end;
3844 3845
3845 3846
3846 function TAdoDBQuery.ColIsPrimaryKeyPart(Column: Integer): Boolean; 3847 function TAdoDBQuery.ColIsPrimaryKeyPart(Column: Integer): Boolean;
3847 begin 3848 begin
3848 // Result := FCurrentResults.Fields[0].KeyFields 3849 // Result := FCurrentResults.Fields[0].KeyFields
3849 Result := False; 3850 Result := False;
3850 end; 3851 end;
3851 3852
3852 3853
3853 function TMySQLQuery.ColIsUniqueKeyPart(Column: Integer): Boolean; 3854 function TMySQLQuery.ColIsUniqueKeyPart(Column: Integer): Boolean;
3854 begin 3855 begin
3855 Result := (FColumnFlags[Column] and UNIQUE_KEY_FLAG) = UNIQUE_KEY_FLAG; 3856 Result := (FColumnFlags[Column] and UNIQUE_KEY_FLAG) = UNIQUE_KEY_FLAG;
3856 end; 3857 end;
3857 3858
3858 3859
3859 function TAdoDBQuery.ColIsUniqueKeyPart(Column: Integer): Boolean; 3860 function TAdoDBQuery.ColIsUniqueKeyPart(Column: Integer): Boolean;
3860 begin 3861 begin
3861 Result := False; 3862 Result := False;
3862 end; 3863 end;
3863 3864
3864 3865
3865 function TMySQLQuery.ColIsKeyPart(Column: Integer): Boolean; 3866 function TMySQLQuery.ColIsKeyPart(Column: Integer): Boolean;
3866 begin 3867 begin
3867 Result := (FColumnFlags[Column] and MULTIPLE_KEY_FLAG) = MULTIPLE_KEY_FLAG; 3868 Result := (FColumnFlags[Column] and MULTIPLE_KEY_FLAG) = MULTIPLE_KEY_FLAG;
3868 end; 3869 end;
3869 3870
3870 3871
3871 function TAdoDbQuery.ColIsKeyPart(Column: Integer): Boolean; 3872 function TAdoDbQuery.ColIsKeyPart(Column: Integer): Boolean;
3872 begin 3873 begin
3873 Result := FCurrentResults.Fields[Column].IsIndexField; 3874 Result := FCurrentResults.Fields[Column].IsIndexField;
3874 end; 3875 end;
3875 3876
3876 3877
3877 function TMySQLQuery.IsNull(Column: Integer): Boolean; 3878 function TMySQLQuery.IsNull(Column: Integer): Boolean;
3878 begin 3879 begin
3879 if FEditingPrepared and Assigned(FCurrentUpdateRow) then 3880 if FEditingPrepared and Assigned(FCurrentUpdateRow) then
3880 Result := FCurrentUpdateRow[Column].NewIsNull 3881 Result := FCurrentUpdateRow[Column].NewIsNull
3881 else 3882 else
3882 Result := FCurrentRow[Column] = nil; 3883 Result := FCurrentRow[Column] = nil;
3883 end; 3884 end;
3884 3885
3885 3886
3886 function TDBQuery.IsNull(Column: String): Boolean; 3887 function TDBQuery.IsNull(Column: String): Boolean;
3887 begin 3888 begin
3888 Result := IsNull(FColumnNames.IndexOf(Column)); 3889 Result := IsNull(FColumnNames.IndexOf(Column));
3889 end; 3890 end;
3890 3891
3891 3892
3892 function TAdoDBQuery.IsNull(Column: Integer): Boolean; 3893 function TAdoDBQuery.IsNull(Column: Integer): Boolean;
3893 begin 3894 begin
3894 Result := FCurrentResults.Fields[Column].IsNull; 3895 Result := FCurrentResults.Fields[Column].IsNull;
3895 end; 3896 end;
3896 3897
3897 3898
3898 function TMySQLQuery.HasResult: Boolean; 3899 function TMySQLQuery.HasResult: Boolean;
3899 begin 3900 begin
3900 Result := Length(FResultList) > 0; 3901 Result := Length(FResultList) > 0;
3901 end; 3902 end;
3902 3903
3903 3904
3904 function TAdoDBQuery.HasResult: Boolean; 3905 function TAdoDBQuery.HasResult: Boolean;
3905 begin 3906 begin
3906 Result := Length(FResultList) > 0; 3907 Result := Length(FResultList) > 0;
3907 end; 3908 end;
3908 3909
3909 3910
3910 procedure TDBQuery.PrepareEditing; 3911 procedure TDBQuery.PrepareEditing;
3911 var 3912 var
3912 CreateCode, Dummy, DB, Table: String; 3913 CreateCode, Dummy, DB, Table: String;
3913 DBObjects: TDBObjectList; 3914 DBObjects: TDBObjectList;
3914 Obj: TDBObject; 3915 Obj: TDBObject;
3915 ObjType: TListNodeType; 3916 ObjType: TListNodeType;
3916 begin 3917 begin
3917 // Try to fetch column names and keys 3918 // Try to fetch column names and keys
3918 if FEditingPrepared then 3919 if FEditingPrepared then
3919 Exit; 3920 Exit;
3920 // This is probably a VIEW, so column names need to be fetched differently 3921 // This is probably a VIEW, so column names need to be fetched differently
3921 DB := DatabaseName; 3922 DB := DatabaseName;
3922 if DB = '' then 3923 if DB = '' then
3923 DB := Connection.Database; 3924 DB := Connection.Database;
3924 DBObjects := Connection.GetDBObjects(DB); 3925 DBObjects := Connection.GetDBObjects(DB);
3925 Table := TableName; 3926 Table := TableName;
3926 ObjType := lntTable; 3927 ObjType := lntTable;
3927 for Obj in DBObjects do begin 3928 for Obj in DBObjects do begin
3928 if (Obj.NodeType in [lntTable, lntView]) and (Obj.Name = Table) then begin 3929 if (Obj.NodeType in [lntTable, lntView]) and (Obj.Name = Table) then begin
3929 ObjType := Obj.NodeType; 3930 ObjType := Obj.NodeType;
3930 break; 3931 break;
3931 end; 3932 end;
3932 end; 3933 end;
3933 CreateCode := Connection.GetCreateCode(DatabaseName, TableName, ObjType); 3934 CreateCode := Connection.GetCreateCode(DatabaseName, TableName, ObjType);
3934 FColumns := TTableColumnList.Create; 3935 FColumns := TTableColumnList.Create;
3935 FKeys := TTableKeyList.Create; 3936 FKeys := TTableKeyList.Create;
3936 FForeignKeys := TForeignKeyList.Create; 3937 FForeignKeys := TForeignKeyList.Create;
3937 case ObjType of 3938 case ObjType of
3938 lntTable: 3939 lntTable:
3939 Connection.ParseTableStructure(CreateCode, FColumns, FKeys, FForeignKeys); 3940 Connection.ParseTableStructure(CreateCode, FColumns, FKeys, FForeignKeys);
3940 lntView: 3941 lntView:
3941 Connection.ParseViewStructure(CreateCode, TableName, FColumns, Dummy, Dummy, Dummy, Dummy, Dummy); 3942 Connection.ParseViewStructure(CreateCode, TableName, FColumns, Dummy, Dummy, Dummy, Dummy, Dummy);
3942 end; 3943 end;
3943 FreeAndNil(FUpdateData); 3944 FreeAndNil(FUpdateData);
3944 FUpdateData := TUpdateData.Create(True); 3945 FUpdateData := TUpdateData.Create(True);
3945 FEditingPrepared := True; 3946 FEditingPrepared := True;
3946 end; 3947 end;
3947 3948
3948 3949
3949 procedure TDBQuery.DeleteRow; 3950 procedure TDBQuery.DeleteRow;
3950 var 3951 var
3951 sql: String; 3952 sql: String;
3952 IsVirtual: Boolean; 3953 IsVirtual: Boolean;
3953 begin 3954 begin
3954 // Delete current row from result 3955 // Delete current row from result
3955 PrepareEditing; 3956 PrepareEditing;
3956 IsVirtual := Assigned(FCurrentUpdateRow) and FCurrentUpdateRow.Inserted; 3957 IsVirtual := Assigned(FCurrentUpdateRow) and FCurrentUpdateRow.Inserted;
3957 if not IsVirtual then begin 3958 if not IsVirtual then begin
3958 sql := Connection.ApplyLimitClause('DELETE', 'FROM ' + QuotedDbAndTableName + ' WHERE ' + GetWhereClause, 1, 0); 3959 sql := Connection.ApplyLimitClause('DELETE', 'FROM ' + QuotedDbAndTableName + ' WHERE ' + GetWhereClause, 1, 0);
3959 Connection.Query(sql); 3960 Connection.Query(sql);
3960 if Connection.RowsAffected = 0 then 3961 if Connection.RowsAffected = 0 then
3961 raise EDatabaseError.Create(FormatNumber(Connection.RowsAffected)+' rows deleted when that should have been 1.'); 3962 raise EDatabaseError.Create(FormatNumber(Connection.RowsAffected)+' rows deleted when that should have been 1.');
3962 end; 3963 end;
3963 if Assigned(FCurrentUpdateRow) then begin 3964 if Assigned(FCurrentUpdateRow) then begin
3964 FUpdateData.Remove(FCurrentUpdateRow); 3965 FUpdateData.Remove(FCurrentUpdateRow);
3965 FCurrentUpdateRow := nil; 3966 FCurrentUpdateRow := nil;
3966 FRecNo := -1; 3967 FRecNo := -1;
3967 end; 3968 end;
3968 end; 3969 end;
3969 3970
3970 3971
3971 function TDBQuery.InsertRow: Cardinal; 3972 function TDBQuery.InsertRow: Cardinal;
3972 var 3973 var
3973 Row, OtherRow: TRowData; 3974 Row, OtherRow: TRowData;
3974 c: TCellData; 3975 c: TCellData;
3975 i: Integer; 3976 i: Integer;
3976 ColAttr: TTableColumn; 3977 ColAttr: TTableColumn;
3977 InUse: Boolean; 3978 InUse: Boolean;
3978 begin 3979 begin
3979 // Add new row and return row number 3980 // Add new row and return row number
3980 PrepareEditing; 3981 PrepareEditing;
3981 Row := TRowData.Create(True); 3982 Row := TRowData.Create(True);
3982 for i:=0 to ColumnCount-1 do begin 3983 for i:=0 to ColumnCount-1 do begin
3983 c := TCellData.Create; 3984 c := TCellData.Create;
3984 Row.Add(c); 3985 Row.Add(c);
3985 c.OldText := ''; 3986 c.OldText := '';
3986 c.OldIsNull := False; 3987 c.OldIsNull := False;
3987 ColAttr := ColAttributes(i); 3988 ColAttr := ColAttributes(i);
3988 if Assigned(ColAttr) then begin 3989 if Assigned(ColAttr) then begin
3989 c.OldIsNull := ColAttr.DefaultType in [cdtNull, cdtNullUpdateTS, cdtAutoInc]; 3990 c.OldIsNull := ColAttr.DefaultType in [cdtNull, cdtNullUpdateTS, cdtAutoInc];
3990 if ColAttr.DefaultType in [cdtText, cdtTextUpdateTS] then 3991 if ColAttr.DefaultType in [cdtText, cdtTextUpdateTS] then
3991 c.OldText := ColAttr.DefaultText; 3992 c.OldText := ColAttr.DefaultText;
3992 end; 3993 end;
3993 c.NewText := c.OldText; 3994 c.NewText := c.OldText;
3994 c.NewIsNull := c.OldIsNull; 3995 c.NewIsNull := c.OldIsNull;
3995 c.Modified := False; 3996 c.Modified := False;
3996 end; 3997 end;
3997 Row.Inserted := True; 3998 Row.Inserted := True;
3998 // Find highest unused recno of inserted rows and use that for this row 3999 // Find highest unused recno of inserted rows and use that for this row
3999 Result := High(Cardinal); 4000 Result := High(Cardinal);
4000 while True do begin 4001 while True do begin
4001 InUse := False; 4002 InUse := False;
4002 for OtherRow in FUpdateData do begin 4003 for OtherRow in FUpdateData do begin
4003 InUse := OtherRow.RecNo = Result; 4004 InUse := OtherRow.RecNo = Result;
4004 if InUse then break; 4005 if InUse then break;
4005 end; 4006 end;
4006 if not InUse then break; 4007 if not InUse then break;
4007 Dec(Result); 4008 Dec(Result);
4008 end; 4009 end;
4009 Row.RecNo := Result; 4010 Row.RecNo := Result;
4010 FUpdateData.Add(Row); 4011 FUpdateData.Add(Row);
4011 end; 4012 end;
4012 4013
4013 4014
4014 procedure TDBQuery.SetCol(Column: Integer; NewText: String; Null: Boolean); 4015 procedure TDBQuery.SetCol(Column: Integer; NewText: String; Null: Boolean);
4015 begin 4016 begin
4016 PrepareEditing; 4017 PrepareEditing;
4017 if not Assigned(FCurrentUpdateRow) then begin 4018 if not Assigned(FCurrentUpdateRow) then begin
4018 CreateUpdateRow; 4019 CreateUpdateRow;
4019 EnsureFullRow; 4020 EnsureFullRow;
4020 end; 4021 end;
4021 FCurrentUpdateRow[Column].NewIsNull := Null; 4022 FCurrentUpdateRow[Column].NewIsNull := Null;
4022 if Null then 4023 if Null then
4023 FCurrentUpdateRow[Column].NewText := '' 4024 FCurrentUpdateRow[Column].NewText := ''
4024 else 4025 else
4025 FCurrentUpdateRow[Column].NewText := NewText; 4026 FCurrentUpdateRow[Column].NewText := NewText;
4026 FCurrentUpdateRow[Column].Modified := (FCurrentUpdateRow[Column].NewText <> FCurrentUpdateRow[Column].OldText) or 4027 FCurrentUpdateRow[Column].Modified := (FCurrentUpdateRow[Column].NewText <> FCurrentUpdateRow[Column].OldText) or
4027 (FCurrentUpdateRow[Column].NewIsNull <> FCurrentUpdateRow[Column].OldIsNull); 4028 (FCurrentUpdateRow[Column].NewIsNull <> FCurrentUpdateRow[Column].OldIsNull);
4028 end; 4029 end;
4029 4030
4030 4031
4031 procedure TDBQuery.CreateUpdateRow; 4032 procedure TDBQuery.CreateUpdateRow;
4032 var 4033 var
4033 i: Integer; 4034 i: Integer;
4034 c: TCellData; 4035 c: TCellData;
4035 Row: TRowData; 4036 Row: TRowData;
4036 begin 4037 begin
4037 Row := TRowData.Create(True); 4038 Row := TRowData.Create(True);
4038 for i:=0 to ColumnCount-1 do begin 4039 for i:=0 to ColumnCount-1 do begin
4039 c := TCellData.Create; 4040 c := TCellData.Create;
4040 Row.Add(c); 4041 Row.Add(c);
4041 c.OldText := Col(i); 4042 c.OldText := Col(i);
4042 c.NewText := c.OldText; 4043 c.NewText := c.OldText;
4043 c.OldIsNull := IsNull(i); 4044 c.OldIsNull := IsNull(i);
4044 c.NewIsNull := c.OldIsNull; 4045 c.NewIsNull := c.OldIsNull;
4045 c.Modified := False; 4046 c.Modified := False;
4046 end; 4047 end;
4047 Row.Inserted := False; 4048 Row.Inserted := False;
4048 Row.RecNo := RecNo; 4049 Row.RecNo := RecNo;
4049 FCurrentUpdateRow := Row; 4050 FCurrentUpdateRow := Row;
4050 FUpdateData.Add(FCurrentUpdateRow); 4051 FUpdateData.Add(FCurrentUpdateRow);
4051 end; 4052 end;
4052 4053
4053 4054
4054 function TDBQuery.EnsureFullRow: Boolean; 4055 function TDBQuery.EnsureFullRow: Boolean;
4055 var 4056 var
4056 i: Integer; 4057 i: Integer;
4057 sql: String; 4058 sql: String;
4058 Data: TDBQuery; 4059 Data: TDBQuery;
4059 begin 4060 begin
4060 // Load full column values 4061 // Load full column values
4061 Result := True; 4062 Result := True;
4062 if not HasFullData then try 4063 if not HasFullData then try
4063 PrepareEditing; 4064 PrepareEditing;
4064 for i:=0 to FColumnOrgNames.Count-1 do begin 4065 for i:=0 to FColumnOrgNames.Count-1 do begin
4065 if sql <> '' then 4066 if sql <> '' then
4066 sql := sql + ', '; 4067 sql := sql + ', ';
4067 sql := sql + Connection.QuoteIdent(FColumnOrgNames[i]); 4068 sql := sql + Connection.QuoteIdent(FColumnOrgNames[i]);
4068 end; 4069 end;
4069 sql := sql + ' FROM '+QuotedDbAndTableName+' WHERE '+GetWhereClause; 4070 sql := sql + ' FROM '+QuotedDbAndTableName+' WHERE '+GetWhereClause;
4070 sql := Connection.ApplyLimitClause('SELECT', sql, 1, 0); 4071 sql := Connection.ApplyLimitClause('SELECT', sql, 1, 0);
4071 Data := Connection.GetResults(sql); 4072 Data := Connection.GetResults(sql);
4072 Result := Data.RecordCount = 1; 4073 Result := Data.RecordCount = 1;
4073 if Result then begin 4074 if Result then begin
4074 if not Assigned(FCurrentUpdateRow) then 4075 if not Assigned(FCurrentUpdateRow) then
4075 CreateUpdateRow; 4076 CreateUpdateRow;
4076 for i:=0 to Data.ColumnCount-1 do begin 4077 for i:=0 to Data.ColumnCount-1 do begin
4077 FCurrentUpdateRow[i].OldText := Data.Col(i); 4078 FCurrentUpdateRow[i].OldText := Data.Col(i);
4078 FCurrentUpdateRow[i].NewText := FCurrentUpdateRow[i].OldText; 4079 FCurrentUpdateRow[i].NewText := FCurrentUpdateRow[i].OldText;
4079 FCurrentUpdateRow[i].OldIsNull := Data.IsNull(i); 4080 FCurrentUpdateRow[i].OldIsNull := Data.IsNull(i);
4080 FCurrentUpdateRow[i].NewIsNull := FCurrentUpdateRow[i].OldIsNull; 4081 FCurrentUpdateRow[i].NewIsNull := FCurrentUpdateRow[i].OldIsNull;
4081 end; 4082 end;
4082 Data.Free; 4083 Data.Free;
4083 end; 4084 end;
4084 except on E:EDatabaseError do 4085 except on E:EDatabaseError do
4085 Result := False; 4086 Result := False;
4086 end; 4087 end;
4087 end; 4088 end;
4088 4089
4089 4090
4090 function TDBQuery.HasFullData: Boolean; 4091 function TDBQuery.HasFullData: Boolean;
4091 var 4092 var
4092 Val: String; 4093 Val: String;
4093 i: Integer; 4094 i: Integer;
4094 begin 4095 begin
4095 Result := True; 4096 Result := True;
4096 for i:=0 to ColumnCount-1 do begin 4097 for i:=0 to ColumnCount-1 do begin
4097 if not (Datatype(i).Category in [dtcText, dtcBinary]) then 4098 if not (Datatype(i).Category in [dtcText, dtcBinary]) then
4098 continue; 4099 continue;
4099 Val := Col(i); 4100 Val := Col(i);
4100 if Length(Val) = GRIDMAXDATA then begin 4101 if Length(Val) = GRIDMAXDATA then begin
4101 Result := False; 4102 Result := False;
4102 break; 4103 break;
4103 end; 4104 end;
4104 end; 4105 end;
4105 end; 4106 end;
4106 4107
4107 4108
4108 function TDBQuery.SaveModifications: Boolean; 4109 function TDBQuery.SaveModifications: Boolean;
4109 var 4110 var
4110 i: Integer; 4111 i: Integer;
4111 Row: TRowData; 4112 Row: TRowData;
4112 Cell: TCellData; 4113 Cell: TCellData;
4113 sqlUpdate, sqlInsertColumns, sqlInsertValues, Val: String; 4114 sqlUpdate, sqlInsertColumns, sqlInsertValues, Val: String;
4114 RowModified: Boolean; 4115 RowModified: Boolean;
4115 ColAttr: TTableColumn; 4116 ColAttr: TTableColumn;
4116 begin 4117 begin
4117 Result := True; 4118 Result := True;
4118 if not FEditingPrepared then 4119 if not FEditingPrepared then
4119 raise EDatabaseError.Create('Internal error: Cannot post modifications before editing was prepared.'); 4120 raise EDatabaseError.Create('Internal error: Cannot post modifications before editing was prepared.');
4120 4121
4121 for Row in FUpdateData do begin 4122 for Row in FUpdateData do begin
4122 // Prepare update and insert queries 4123 // Prepare update and insert queries
4123 RecNo := Row.RecNo; 4124 RecNo := Row.RecNo;
4124 sqlUpdate := ''; 4125 sqlUpdate := '';
4125 sqlInsertColumns := ''; 4126 sqlInsertColumns := '';
4126 sqlInsertValues := ''; 4127 sqlInsertValues := '';
4127 RowModified := False; 4128 RowModified := False;
4128 for i:=0 to ColumnCount-1 do begin 4129 for i:=0 to ColumnCount-1 do begin
4129 Cell := Row[i]; 4130 Cell := Row[i];
4130 if not Cell.Modified then 4131 if not Cell.Modified then
4131 continue; 4132 continue;
4132 RowModified := True; 4133 RowModified := True;
4133 if sqlUpdate <> '' then begin 4134 if sqlUpdate <> '' then begin
4134 sqlUpdate := sqlUpdate + ', '; 4135 sqlUpdate := sqlUpdate + ', ';
4135 sqlInsertColumns := sqlInsertColumns + ', '; 4136 sqlInsertColumns := sqlInsertColumns + ', ';
4136 sqlInsertValues := sqlInsertValues + ', '; 4137 sqlInsertValues := sqlInsertValues + ', ';
4137 end; 4138 end;
4138 if Cell.NewIsNull then 4139 if Cell.NewIsNull then
4139 Val := 'NULL' 4140 Val := 'NULL'
4140 else case Datatype(i).Category of 4141 else case Datatype(i).Category of
4141 dtcInteger, dtcReal: begin 4142 dtcInteger, dtcReal: begin
4142 Val := Cell.NewText; 4143 Val := Cell.NewText;
4143 if Datatype(i).Index = dtBit then 4144 if Datatype(i).Index = dtBit then
4144 Val := 'b' + Connection.EscapeString(Val); 4145 Val := 'b' + Connection.EscapeString(Val);
4145 end; 4146 end;
4146 dtcBinary, dtcSpatial: 4147 dtcBinary, dtcSpatial:
4147 Val := HexValue(Cell.NewText); 4148 Val := HexValue(Cell.NewText);
4148 else 4149 else
4149 Val := Connection.EscapeString(Cell.NewText); 4150 Val := Connection.EscapeString(Cell.NewText);
4150 end; 4151 end;
4151 sqlUpdate := sqlUpdate + Connection.QuoteIdent(FColumnOrgNames[i]) + '=' + Val; 4152 sqlUpdate := sqlUpdate + Connection.QuoteIdent(FColumnOrgNames[i]) + '=' + Val;
4152 sqlInsertColumns := sqlInsertColumns + Connection.QuoteIdent(FColumnOrgNames[i]); 4153 sqlInsertColumns := sqlInsertColumns + Connection.QuoteIdent(FColumnOrgNames[i]);
4153 sqlInsertValues := sqlInsertValues + Val; 4154 sqlInsertValues := sqlInsertValues + Val;
4154 end; 4155 end;
4155 4156
4156 // Post query and fetch just inserted auto-increment id if applicable 4157 // Post query and fetch just inserted auto-increment id if applicable
4157 if RowModified then try 4158 if RowModified then try
4158 if Row.Inserted then begin 4159 if Row.Inserted then begin
4159 Connection.Query('INSERT INTO '+QuotedDbAndTableName+' ('+sqlInsertColumns+') VALUES ('+sqlInsertValues+')'); 4160 Connection.Query('INSERT INTO '+QuotedDbAndTableName+' ('+sqlInsertColumns+') VALUES ('+sqlInsertValues+')');
4160 for i:=0 to ColumnCount-1 do begin 4161 for i:=0 to ColumnCount-1 do begin
4161 ColAttr := ColAttributes(i); 4162 ColAttr := ColAttributes(i);
4162 if Assigned(ColAttr) and (ColAttr.DefaultType = cdtAutoInc) then begin 4163 if Assigned(ColAttr) and (ColAttr.DefaultType = cdtAutoInc) then begin
4163 Row[i].NewText := UnformatNumber(Row[i].NewText); 4164 Row[i].NewText := UnformatNumber(Row[i].NewText);
4164 if Row[i].NewText = '0' then 4165 if Row[i].NewText = '0' then
4165 Row[i].NewText := Connection.GetVar('SELECT LAST_INSERT_ID()'); 4166 Row[i].NewText := Connection.GetVar('SELECT LAST_INSERT_ID()');
4166 Row[i].NewIsNull := False; 4167 Row[i].NewIsNull := False;
4167 break; 4168 break;
4168 end; 4169 end;
4169 end; 4170 end;
4170 end else begin 4171 end else begin
4171 sqlUpdate := QuotedDbAndTableName+' SET '+sqlUpdate+' WHERE '+GetWhereClause; 4172 sqlUpdate := QuotedDbAndTableName+' SET '+sqlUpdate+' WHERE '+GetWhereClause;
4172 sqlUpdate := Connection.ApplyLimitClause('UPDATE', sqlUpdate, 1, 0); 4173 sqlUpdate := Connection.ApplyLimitClause('UPDATE', sqlUpdate, 1, 0);
4173 Connection.Query(sqlUpdate); 4174 Connection.Query(sqlUpdate);
4174 if Connection.RowsAffected = 0 then begin 4175 if Connection.RowsAffected = 0 then begin
4175 raise EDatabaseError.Create(FormatNumber(Connection.RowsAffected)+' rows updated when that should have been 1.'); 4176 raise EDatabaseError.Create(FormatNumber(Connection.RowsAffected)+' rows updated when that should have been 1.');
4176 Result := False; 4177 Result := False;
4177 end; 4178 end;
4178 end; 4179 end;
4179 // Reset modification flags 4180 // Reset modification flags
4180 for i:=0 to ColumnCount-1 do begin 4181 for i:=0 to ColumnCount-1 do begin
4181 Cell := Row[i]; 4182 Cell := Row[i];
4182 Cell.OldText := Cell.NewText; 4183 Cell.OldText := Cell.NewText;
4183 Cell.OldIsNull := Cell.NewIsNull; 4184 Cell.OldIsNull := Cell.NewIsNull;
4184 Cell.Modified := False; 4185 Cell.Modified := False;
4185 end; 4186 end;
4186 Row.Inserted := False; 4187 Row.Inserted := False;
4187 // TODO: Reload real row data from server if keys allow that??? 4188 // TODO: Reload real row data from server if keys allow that???
4188 except 4189 except
4189 on E:EDatabaseError do begin 4190 on E:EDatabaseError do begin
4190 Result := False; 4191 Result := False;
4191 ErrorDialog(E.Message); 4192 ErrorDialog(E.Message);
4192 end; 4193 end;
4193 end; 4194 end;
4194 4195
4195 end; 4196 end;
4196 end; 4197 end;
4197 4198
4198 4199
4199 procedure TDBQuery.DiscardModifications; 4200 procedure TDBQuery.DiscardModifications;
4200 var 4201 var
4201 x: Integer; 4202 x: Integer;
4202 c: TCellData; 4203 c: TCellData;
4203 begin 4204 begin
4204 if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin 4205 if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin
4205 if FCurrentUpdateRow.Inserted then begin 4206 if FCurrentUpdateRow.Inserted then begin
4206 FUpdateData.Remove(FCurrentUpdateRow); 4207 FUpdateData.Remove(FCurrentUpdateRow);
4207 FRecNo := -1; 4208 FRecNo := -1;
4208 end else for x:=0 to FCurrentUpdateRow.Count-1 do begin 4209 end else for x:=0 to FCurrentUpdateRow.Count-1 do begin
4209 c := FCurrentUpdateRow[x]; 4210 c := FCurrentUpdateRow[x];
4210 c.NewText := c.OldText; 4211 c.NewText := c.OldText;
4211 c.NewIsNull := c.OldIsNull; 4212 c.NewIsNull := c.OldIsNull;
4212 c.Modified := False; 4213 c.Modified := False;
4213 end; 4214 end;
4214 end; 4215 end;
4215 end; 4216 end;
4216 4217
4217 4218
4218 function TDBQuery.Modified(Column: Integer): Boolean; 4219 function TDBQuery.Modified(Column: Integer): Boolean;
4219 begin 4220 begin
4220 Result := False; 4221 Result := False;
4221 if FEditingPrepared and Assigned(FCurrentUpdateRow) then try 4222 if FEditingPrepared and Assigned(FCurrentUpdateRow) then try
4222 Result := FCurrentUpdateRow[Column].Modified; 4223 Result := FCurrentUpdateRow[Column].Modified;
4223 except 4224 except
4224 connection.Log(lcdebug, inttostr(column)); 4225 connection.Log(lcdebug, inttostr(column));
4225 raise; 4226 raise;
4226 end; 4227 end;
4227 end; 4228 end;
4228 4229
4229 4230
4230 function TDBQuery.Modified: Boolean; 4231 function TDBQuery.Modified: Boolean;
4231 var 4232 var
4232 x, y: Integer; 4233 x, y: Integer;
4233 begin 4234 begin
4234 Result := False; 4235 Result := False;
4235 if FEditingPrepared then for y:=0 to FUpdateData.Count-1 do begin 4236 if FEditingPrepared then for y:=0 to FUpdateData.Count-1 do begin
4236 for x:=0 to FUpdateData[y].Count-1 do begin 4237 for x:=0 to FUpdateData[y].Count-1 do begin
4237 Result := FUpdateData[y][x].Modified; 4238 Result := FUpdateData[y][x].Modified;
4238 if Result then 4239 if Result then
4239 break; 4240 break;
4240 end; 4241 end;
4241 if Result then 4242 if Result then
4242 break; 4243 break;
4243 end; 4244 end;
4244 end; 4245 end;
4245 4246
4246 4247
4247 function TDBQuery.Inserted: Boolean; 4248 function TDBQuery.Inserted: Boolean;
4248 begin 4249 begin
4249 // Check if current row was inserted and not yet posted to the server 4250 // Check if current row was inserted and not yet posted to the server
4250 Result := False; 4251 Result := False;
4251 if FEditingPrepared and Assigned(FCurrentUpdateRow) then 4252 if FEditingPrepared and Assigned(FCurrentUpdateRow) then
4252 Result := FCurrentUpdateRow.Inserted; 4253 Result := FCurrentUpdateRow.Inserted;
4253 end; 4254 end;
4254 4255
4255 4256
4256 function TMySQLQuery.DatabaseName: String; 4257 function TMySQLQuery.DatabaseName: String;
4257 var 4258 var
4258 Field: PMYSQL_FIELD; 4259 Field: PMYSQL_FIELD;
4259 i: Integer; 4260 i: Integer;
4260 begin 4261 begin
4261 // Return first available Field.db property, or just the current database as fallback 4262 // Return first available Field.db property, or just the current database as fallback
4262 for i:=0 to ColumnCount-1 do begin 4263 for i:=0 to ColumnCount-1 do begin
4263 Field := mysql_fetch_field_direct(FCurrentResults, i); 4264 Field := mysql_fetch_field_direct(FCurrentResults, i);
4264 if Field.db <> '' then begin 4265 if Field.db <> '' then begin
4265 Result := Connection.DecodeAPIString(Field.db); 4266 Result := Connection.DecodeAPIString(Field.db);
4266 break; 4267 break;
4267 end; 4268 end;
4268 end; 4269 end;
4269 if Result = '' then 4270 if Result = '' then
4270 Result := Connection.Database; 4271 Result := Connection.Database;
4271 end; 4272 end;
4272 4273
4273 4274
4274 function TAdoDBQuery.DatabaseName: String; 4275 function TAdoDBQuery.DatabaseName: String;
4275 begin 4276 begin
4276 Result := Connection.Database; 4277 Result := Connection.Database;
4277 end; 4278 end;
4278 4279
4279 4280
4280 function TMySQLQuery.TableName: String; 4281 function TMySQLQuery.TableName: String;
4281 var 4282 var
4282 Field: PMYSQL_FIELD; 4283 Field: PMYSQL_FIELD;
4283 i: Integer; 4284 i: Integer;
4284 tbl, db: AnsiString; 4285 tbl, db: AnsiString;
4285 Objects: TDBObjectList; 4286 Objects: TDBObjectList;
4286 Obj: TDBObject; 4287 Obj: TDBObject;
4287 IsView: Boolean; 4288 IsView: Boolean;
4288 begin 4289 begin
4289 IsView := False; 4290 IsView := False;
4290 for i:=0 to ColumnCount-1 do begin 4291 for i:=0 to ColumnCount-1 do begin
4291 Field := mysql_fetch_field_direct(FCurrentResults, i); 4292 Field := mysql_fetch_field_direct(FCurrentResults, i);
4292 4293
4293 if Connection.DecodeAPIString(Field.table) <> Connection.DecodeAPIString(Field.org_table) then begin 4294 if Connection.DecodeAPIString(Field.table) <> Connection.DecodeAPIString(Field.org_table) then begin
4294 // Probably a VIEW, in which case we rely on the first column's table name. 4295 // Probably a VIEW, in which case we rely on the first column's table name.
4295 // TODO: This is unsafe when joining a view with a table/view. 4296 // TODO: This is unsafe when joining a view with a table/view.
4296 if Field.db <> '' then begin 4297 if Field.db <> '' then begin
4297 Objects := Connection.GetDBObjects(Connection.DecodeAPIString(Field.db)); 4298 Objects := Connection.GetDBObjects(Connection.DecodeAPIString(Field.db));
4298 for Obj in Objects do begin 4299 for Obj in Objects do begin
4299 if (Obj.Name = Connection.DecodeAPIString(Field.table)) and (Obj.NodeType = lntView) then begin 4300 if (Obj.Name = Connection.DecodeAPIString(Field.table)) and (Obj.NodeType = lntView) then begin
4300 tbl := Field.table; 4301 tbl := Field.table;
4301 IsView := True; 4302 IsView := True;
4302 break; 4303 break;
4303 end; 4304 end;
4304 end; 4305 end;
4305 end; 4306 end;
4306 if IsView and (tbl <> '') then 4307 if IsView and (tbl <> '') then
4307 break; 4308 break;
4308 end; 4309 end;
4309 4310
4310 if (Field.org_table <> '') and (tbl <> '') and ((tbl <> Field.org_table) or (db <> Field.db)) then 4311 if (Field.org_table <> '') and (tbl <> '') and ((tbl <> Field.org_table) or (db <> Field.db)) then
4311 raise EDatabaseError.Create('More than one table involved.'); 4312 raise EDatabaseError.Create('More than one table involved.');
4312 if Field.org_table <> '' then begin 4313 if Field.org_table <> '' then begin
4313 tbl := Field.org_table; 4314 tbl := Field.org_table;
4314 db := Field.db; 4315 db := Field.db;
4315 end; 4316 end;
4316 end; 4317 end;
4317 if tbl = '' then 4318 if tbl = '' then
4318 raise EDatabaseError.Create('Could not determine name of table.') 4319 raise EDatabaseError.Create('Could not determine name of table.')
4319 else 4320 else
4320 Result := Connection.DecodeAPIString(tbl) 4321 Result := Connection.DecodeAPIString(tbl)
4321 end; 4322 end;
4322 4323
4323 4324
4324 function TAdoDBQuery.TableName: String; 4325 function TAdoDBQuery.TableName: String;
4325 var 4326 var
4326 rx: TRegExpr; 4327 rx: TRegExpr;
4327 begin 4328 begin
4328 // Untested with joins, compute columns and views 4329 // Untested with joins, compute columns and views
4329 Result := GetTableNameFromSQLEx(SQL, idMixCase); 4330 Result := GetTableNameFromSQLEx(SQL, idMixCase);
4330 rx := TRegExpr.Create; 4331 rx := TRegExpr.Create;
4331 rx.Expression := '\.([^\.]+)$'; 4332 rx.Expression := '\.([^\.]+)$';
4332 if rx.Exec(Result) then 4333 if rx.Exec(Result) then
4333 Result := rx.Match[1]; 4334 Result := rx.Match[1];
4334 rx.Free; 4335 rx.Free;
4335 if Result = '' then 4336 if Result = '' then
4336 raise EDatabaseError.Create('Could not determine name of table.'); 4337 raise EDatabaseError.Create('Could not determine name of table.');
4337 end; 4338 end;
4338 4339
4339 4340
4340 function TDBQuery.QuotedDbAndTableName: String; 4341 function TDBQuery.QuotedDbAndTableName: String;
4341 var 4342 var
4342 db: String; 4343 db: String;
4343 begin 4344 begin
4344 // Return `db`.`table` if necessairy, otherwise `table` 4345 // Return `db`.`table` if necessairy, otherwise `table`
4345 db := DatabaseName; 4346 db := DatabaseName;
4346 if Connection.Database <> db then 4347 if Connection.Database <> db then
4347 Result := Connection.QuoteIdent(db)+'.'; 4348 Result := Connection.QuoteIdent(db)+'.';
4348 Result := Result + Connection.QuoteIdent(TableName); 4349 Result := Result + Connection.QuoteIdent(TableName);
4349 end; 4350 end;
4350 4351
4351 4352
4352 function TDBQuery.GetKeyColumns: TStringList; 4353 function TDBQuery.GetKeyColumns: TStringList;
4353 var 4354 var
4354 NeededCols: TStringList; 4355 NeededCols: TStringList;
4355 i: Integer; 4356 i: Integer;
4356 begin 4357 begin
4357 // Return key column names, or all column names if no good key present 4358 // Return key column names, or all column names if no good key present
4358 PrepareEditing; 4359 PrepareEditing;
4359 NeededCols := Connection.GetKeyColumns(FColumns, FKeys); 4360 NeededCols := Connection.GetKeyColumns(FColumns, FKeys);
4360 if NeededCols.Count = 0 then begin 4361 if NeededCols.Count = 0 then begin
4361 // No good key found. Just expect all columns to be present. 4362 // No good key found. Just expect all columns to be present.
4362 for i:=0 to FColumns.Count-1 do 4363 for i:=0 to FColumns.Count-1 do
4363 NeededCols.Add(FColumns[i].Name); 4364 NeededCols.Add(FColumns[i].Name);
4364 end; 4365 end;
4365 4366
4366 Result := TStringList.Create; 4367 Result := TStringList.Create;
4367 for i:=0 to NeededCols.Count-1 do begin 4368 for i:=0 to NeededCols.Count-1 do begin
4368 if FColumnOrgNames.IndexOf(NeededCols[i]) > -1 then 4369 if FColumnOrgNames.IndexOf(NeededCols[i]) > -1 then
4369 Result.Add(NeededCols[i]); 4370 Result.Add(NeededCols[i]);
4370 end; 4371 end;
4371 end; 4372 end;
4372 4373
4373 4374
4374 procedure TDBQuery.CheckEditable; 4375 procedure TDBQuery.CheckEditable;
4375 var 4376 var
4376 i: Integer; 4377 i: Integer;
4377 begin 4378 begin
4378 if GetKeyColumns.Count = 0 then 4379 if GetKeyColumns.Count = 0 then
4379 raise EDatabaseError.Create(MSG_NOGRIDEDITING); 4380 raise EDatabaseError.Create(MSG_NOGRIDEDITING);
4380 // All column names must be present in order to send valid INSERT/UPDATE/DELETE queries 4381 // All column names must be present in order to send valid INSERT/UPDATE/DELETE queries
4381 for i:=0 to FColumnOrgNames.Count-1 do begin 4382 for i:=0 to FColumnOrgNames.Count-1 do begin
4382 if FColumnOrgNames[i] = '' then 4383 if FColumnOrgNames[i] = '' then
4383 raise EDatabaseError.Create('Column #'+IntToStr(i)+' has an undefined origin: '+ColumnNames[i]); 4384 raise EDatabaseError.Create('Column #'+IntToStr(i)+' has an undefined origin: '+ColumnNames[i]);
4384 end; 4385 end;
4385 end; 4386 end;
4386 4387
4387 4388
4388 function TDBQuery.GetWhereClause: String; 4389 function TDBQuery.GetWhereClause: String;
4389 var 4390 var
4390 i, j: Integer; 4391 i, j: Integer;
4391 NeededCols: TStringList; 4392 NeededCols: TStringList;
4392 ColVal: String; 4393 ColVal: String;
4393 ColIsNull: Boolean; 4394 ColIsNull: Boolean;
4394 begin 4395 begin
4395 // Compose WHERE clause including values from best key for editing 4396 // Compose WHERE clause including values from best key for editing
4396 NeededCols := GetKeyColumns; 4397 NeededCols := GetKeyColumns;
4397 4398
4398 for i:=0 to NeededCols.Count-1 do begin 4399 for i:=0 to NeededCols.Count-1 do begin
4399 j := FColumnOrgNames.IndexOf(NeededCols[i]); 4400 j := FColumnOrgNames.IndexOf(NeededCols[i]);
4400 if j = -1 then 4401 if j = -1 then
4401 raise EDatabaseError.Create('Cannot compose WHERE clause - column missing: '+NeededCols[i]); 4402 raise EDatabaseError.Create('Cannot compose WHERE clause - column missing: '+NeededCols[i]);
4402 if Result <> '' then 4403 if Result <> '' then
4403 Result := Result + ' AND'; 4404 Result := Result + ' AND';
4404 Result := Result + ' ' + Connection.QuoteIdent(FColumnOrgNames[j]); 4405 Result := Result + ' ' + Connection.QuoteIdent(FColumnOrgNames[j]);
4405 if Modified(j) then begin 4406 if Modified(j) then begin
4406 ColVal := FCurrentUpdateRow[j].OldText; 4407 ColVal := FCurrentUpdateRow[j].OldText;
4407 ColIsNull := FCurrentUpdateRow[j].OldIsNull; 4408 ColIsNull := FCurrentUpdateRow[j].OldIsNull;
4408 end else begin 4409 end else begin
4409 ColVal := Col(j); 4410 ColVal := Col(j);
4410 ColIsNull := IsNull(j); 4411 ColIsNull := IsNull(j);
4411 end; 4412 end;
4412 4413
4413 if ColIsNull then 4414 if ColIsNull then
4414 Result := Result + ' IS NULL' 4415 Result := Result + ' IS NULL'
4415 else begin 4416 else begin
4416 case DataType(j).Category of 4417 case DataType(j).Category of
4417 dtcInteger, dtcReal: begin 4418 dtcInteger, dtcReal: begin
4418 if DataType(j).Index = dtBit then 4419 if DataType(j).Index = dtBit then
4419 Result := Result + '=b' + Connection.EscapeString(ColVal) 4420 Result := Result + '=b' + Connection.EscapeString(ColVal)
4420 else 4421 else
4421 Result := Result + '=' + ColVal; 4422 Result := Result + '=' + ColVal;
4422 end; 4423 end;
4423 dtcBinary: 4424 dtcBinary:
4424 Result := Result + '=' + HexValue(ColVal); 4425 Result := Result + '=' + HexValue(ColVal);
4425 else 4426 else
4426 Result := Result + '=' + Connection.EscapeString(ColVal); 4427 Result := Result + '=' + Connection.EscapeString(ColVal);
4427 end; 4428 end;
4428 end; 4429 end;
4429 end; 4430 end;
4430 end; 4431 end;
4431 4432
4432 4433
4433 4434
4434 { TCellData } 4435 { TCellData }
4435 4436
4436 destructor TCellData.Destroy; 4437 destructor TCellData.Destroy;
4437 begin 4438 begin
4438 NewText := ''; 4439 NewText := '';
4439 OldText := ''; 4440 OldText := '';
4440 end; 4441 end;
4441 4442
4442 4443
4443 4444
4444 { TDBObjectComparer } 4445 { TDBObjectComparer }
4445 4446
4446 function TDBObjectComparer.Compare(const Left, Right: TDBObject): Integer; 4447 function TDBObjectComparer.Compare(const Left, Right: TDBObject): Integer;
4447 begin 4448 begin
4448 // Simple sort method for a TDBObjectList 4449 // Simple sort method for a TDBObjectList
4449 Result := CompareAnyNode(Left.Name, Right.Name); 4450 Result := CompareAnyNode(Left.Name, Right.Name);
4450 end; 4451 end;
4451 4452
4452 4453
4453 function TDBObjectDropComparer.Compare(const Left, Right: TDBObject): Integer; 4454 function TDBObjectDropComparer.Compare(const Left, Right: TDBObject): Integer;
4454 begin 4455 begin
4455 // Sorting a TDBObject items so that dropping them does not trap in SQL errors 4456 // Sorting a TDBObject items so that dropping them does not trap in SQL errors
4456 if (Left.NodeType = lntTrigger) and (Right.NodeType <> lntTrigger) then 4457 if (Left.NodeType = lntTrigger) and (Right.NodeType <> lntTrigger) then
4457 Result := -1 4458 Result := -1
4458 else if (Left.NodeType <> lntTrigger) and (Right.NodeType = lntTrigger) then 4459 else if (Left.NodeType <> lntTrigger) and (Right.NodeType = lntTrigger) then
4459 Result := 1 4460 Result := 1
4460 else if (Left.NodeType = lntView) and (Right.NodeType <> lntView) then 4461 else if (Left.NodeType = lntView) and (Right.NodeType <> lntView) then
4461 Result := -1 4462 Result := -1
4462 else if (Left.NodeType <> lntView) and (Right.NodeType = lntView) then 4463 else if (Left.NodeType <> lntView) and (Right.NodeType = lntView) then
4463 Result := 1 4464 Result := 1
4464 else 4465 else
4465 Result := 0; 4466 Result := 0;
4466 end; 4467 end;
4467 4468
4468 4469
4469 4470
4470 { TDBObject } 4471 { TDBObject }
4471 4472
4472 constructor TDBObject.Create(OwnerConnection: TDBConnection); 4473 constructor TDBObject.Create(OwnerConnection: TDBConnection);
4473 begin 4474 begin
4474 NodeType := lntNone; 4475 NodeType := lntNone;
4475 Name := ''; 4476 Name := '';
4476 Database := ''; 4477 Database := '';
4477 Rows := -1; 4478 Rows := -1;
4478 Size := -1; 4479 Size := -1;
4479 Created := 0; 4480 Created := 0;
4480 Updated := 0; 4481 Updated := 0;
4481 Engine := ''; 4482 Engine := '';
4482 Comment := ''; 4483 Comment := '';
4483 Version := -1; 4484 Version := -1;
4484 AutoInc := -1; 4485 AutoInc := -1;
4485 RowFormat := ''; 4486 RowFormat := '';
4486 AvgRowLen := -1; 4487 AvgRowLen := -1;
4487 MaxDataLen := -1; 4488 MaxDataLen := -1;
4488 IndexLen := -1; 4489 IndexLen := -1;
4489 DataLen := -1; 4490 DataLen := -1;
4490 DataFree := -1; 4491 DataFree := -1;
4491 LastChecked := 0; 4492 LastChecked := 0;
4492 Collation := ''; 4493 Collation := '';
4493 CheckSum := -1; 4494 CheckSum := -1;
4494 CreateOptions := ''; 4495 CreateOptions := '';
4495 FCreateCode := ''; 4496 FCreateCode := '';
4496 FCreateCodeFetched := False; 4497 FCreateCodeFetched := False;
4497 FConnection := OwnerConnection; 4498 FConnection := OwnerConnection;
4498 end; 4499 end;
4499 4500
4500 4501
4501 procedure TDBObject.Assign(Source: TPersistent); 4502 procedure TDBObject.Assign(Source: TPersistent);
4502 var 4503 var
4503 s: TDBObject; 4504 s: TDBObject;
4504 begin 4505 begin
4505 if Source is TDBObject then begin 4506 if Source is TDBObject then begin
4506 s := Source as TDBObject; 4507 s := Source as TDBObject;
4507 Name := s.Name; 4508 Name := s.Name;
4508 Column := s.Column; 4509 Column := s.Column;
4509 Collation := s.Collation; 4510 Collation := s.Collation;
4510 Engine := s.Engine; 4511 Engine := s.Engine;
4511 Database := s.Database; 4512 Database := s.Database;
4512 NodeType := s.NodeType; 4513 NodeType := s.NodeType;
4513 Created := s.Created; 4514 Created := s.Created;
4514 Updated := s.Updated; 4515 Updated := s.Updated;
4515 Comment := s.Comment; 4516 Comment := s.Comment;
4516 Rows := s.Rows; 4517 Rows := s.Rows;
4517 Size := s.Size; 4518 Size := s.Size;
4518 FCreateCode := s.FCreateCode; 4519 FCreateCode := s.FCreateCode;
4519 FCreateCodeFetched := s.FCreateCodeFetched; 4520 FCreateCodeFetched := s.FCreateCodeFetched;
4520 end else 4521 end else
4521 inherited; 4522 inherited;
4522 end; 4523 end;
4523 4524
4524 4525
4525 function TDBObject.IsSameAs(CompareTo: TDBObject): Boolean; 4526 function TDBObject.IsSameAs(CompareTo: TDBObject): Boolean;
4526 begin 4527 begin
4527 if not Assigned(CompareTo) then 4528 if not Assigned(CompareTo) then
4528 Result := False 4529 Result := False
4529 else 4530 else
4530 Result := (Name = CompareTo.Name) 4531 Result := (Name = CompareTo.Name)
4531 and (NodeType = CompareTo.NodeType) 4532 and (NodeType = CompareTo.NodeType)
4532 and (Database = CompareTo.Database) 4533 and (Database = CompareTo.Database)
4533 and (Column = CompareTo.Column) 4534 and (Column = CompareTo.Column)
4534 and (Connection = CompareTo.Connection); 4535 and (Connection = CompareTo.Connection);
4535 end; 4536 end;
4536 4537
4537 4538
4538 function TDBObject.GetObjType: String; 4539 function TDBObject.GetObjType: String;
4539 begin 4540 begin
4540 case NodeType of 4541 case NodeType of
4541 lntTable: Result := 'Table'; 4542 lntTable: Result := 'Table';
4542 lntView: Result := 'View'; 4543 lntView: Result := 'View';
4543 lntFunction: Result := 'Function'; 4544 lntFunction: Result := 'Function';
4544 lntProcedure: Result := 'Procedure'; 4545 lntProcedure: Result := 'Procedure';
4545 lntTrigger: Result := 'Trigger'; 4546 lntTrigger: Result := 'Trigger';
4546 lntEvent: Result := 'Event'; 4547 lntEvent: Result := 'Event';
4547 lntColumn: Result := 'Column'; 4548 lntColumn: Result := 'Column';
4548 else Result := 'Unknown, should never appear'; 4549 else Result := 'Unknown, should never appear';
4549 end; 4550 end;
4550 end; 4551 end;
4551 4552
4552 function TDBObject.GetImageIndex: Integer; 4553 function TDBObject.GetImageIndex: Integer;
4553 begin 4554 begin
4554 // Detect key icon index for specified db object (table, trigger, ...) 4555 // Detect key icon index for specified db object (table, trigger, ...)
4555 case NodeType of 4556 case NodeType of
4556 lntNone: Result := FConnection.Parameters.ImageIndex; 4557 lntNone: Result := FConnection.Parameters.ImageIndex;
4557 4558
4558 lntDb: Result := ICONINDEX_DB; 4559 lntDb: Result := ICONINDEX_DB;
4559 4560
4560 lntTable: Result := ICONINDEX_TABLE; 4561 lntTable: Result := ICONINDEX_TABLE;
4561 lntFunction: Result := ICONINDEX_STOREDFUNCTION; 4562 lntFunction: Result := ICONINDEX_STOREDFUNCTION;
4562 lntProcedure: Result := ICONINDEX_STOREDPROCEDURE; 4563 lntProcedure: Result := ICONINDEX_STOREDPROCEDURE;
4563 lntView: Result := ICONINDEX_VIEW; 4564 lntView: Result := ICONINDEX_VIEW;
4564 lntTrigger: Result := ICONINDEX_TRIGGER; 4565 lntTrigger: Result := ICONINDEX_TRIGGER;
4565 lntEvent: Result := ICONINDEX_EVENT; 4566 lntEvent: Result := ICONINDEX_EVENT;
4566 4567
4567 lntColumn: Result := ICONINDEX_FIELD; 4568 lntColumn: Result := ICONINDEX_FIELD;
4568 4569
4569 else Result := -1; 4570 else Result := -1;
4570 end; 4571 end;
4571 end; 4572 end;
4572 4573
4573 4574
4574 function TDBObject.GetCreateCode: String; 4575 function TDBObject.GetCreateCode: String;
4575 begin 4576 begin
4576 if not FCreateCodeFetched then try 4577 if not FCreateCodeFetched then try
4577 FCreateCode := Connection.GetCreateCode(Database, Name, NodeType); 4578 FCreateCode := Connection.GetCreateCode(Database, Name, NodeType);
4578 except 4579 except
4579 end; 4580 end;
4580 FCreateCodeFetched := True; 4581 FCreateCodeFetched := True;
4581 Result := FCreateCode; 4582 Result := FCreateCode;
4582 end; 4583 end;
4583 4584
4584 procedure TDBObject.SetCreateCode(Value: String); 4585 procedure TDBObject.SetCreateCode(Value: String);
4585 begin 4586 begin
4586 // When manually clearing CreateCode from outside, also reset indicator for fetch attempt 4587 // When manually clearing CreateCode from outside, also reset indicator for fetch attempt
4587 FCreateCode := Value; 4588 FCreateCode := Value;
4588 FCreateCodeFetched := Value <> ''; 4589 FCreateCodeFetched := Value <> '';
4589 end; 4590 end;
4590 4591
4591 function TDBObject.QuotedDatabase(AlwaysQuote: Boolean=True): String; 4592 function TDBObject.QuotedDatabase(AlwaysQuote: Boolean=True): String;
4592 begin 4593 begin
4593 Result := Connection.QuoteIdent(Database, AlwaysQuote); 4594 Result := Connection.QuoteIdent(Database, AlwaysQuote);
4594 end; 4595 end;
4595 4596
4596 function TDBObject.QuotedName(AlwaysQuote: Boolean=True): String; 4597 function TDBObject.QuotedName(AlwaysQuote: Boolean=True): String;
4597 begin 4598 begin
4598 Result := Connection.QuoteIdent(Name, AlwaysQuote); 4599 Result := Connection.QuoteIdent(Name, AlwaysQuote);
4599 end; 4600 end;
4600 4601
4601 function TDBObject.QuotedColumn(AlwaysQuote: Boolean=True): String; 4602 function TDBObject.QuotedColumn(AlwaysQuote: Boolean=True): String;
4602 begin 4603 begin
4603 Result := Connection.QuoteIdent(Column, AlwaysQuote); 4604 Result := Connection.QuoteIdent(Column, AlwaysQuote);
4604 end; 4605 end;
4605 4606
4606 4607
4607 { *** TTableColumn } 4608 { *** TTableColumn }
4608 4609
4609 constructor TTableColumn.Create(AOwner: TDBConnection); 4610 constructor TTableColumn.Create(AOwner: TDBConnection);
4610 begin 4611 begin
4611 inherited Create; 4612 inherited Create;
4612 FConnection := AOwner; 4613 FConnection := AOwner;
4613 end; 4614 end;
4614 4615
4615 destructor TTableColumn.Destroy; 4616 destructor TTableColumn.Destroy;
4616 begin 4617 begin
4617 inherited Destroy; 4618 inherited Destroy;
4618 end; 4619 end;
4619 4620
4620 procedure TTableColumn.SetStatus(Value: TEditingStatus); 4621 procedure TTableColumn.SetStatus(Value: TEditingStatus);
4621 begin 4622 begin
4622 // Set editing flag and enable "Save" button 4623 // Set editing flag and enable "Save" button
4623 if (FStatus in [esAddedUntouched, esAddedModified]) and (Value = esModified) then 4624 if (FStatus in [esAddedUntouched, esAddedModified]) and (Value = esModified) then
4624 Value := esAddedModified 4625 Value := esAddedModified
4625 else if (FStatus in [esAddedUntouched, esAddedModified]) and (Value = esDeleted) then 4626 else if (FStatus in [esAddedUntouched, esAddedModified]) and (Value = esDeleted) then
4626 Value := esAddedDeleted; 4627 Value := esAddedDeleted;
4627 FStatus := Value; 4628 FStatus := Value;
4628 end; 4629 end;
4629 4630
4630 function TTableColumn.SQLCode: String; 4631 function TTableColumn.SQLCode: String;
4631 var 4632 var
4632 IsVirtual: Boolean; 4633 IsVirtual: Boolean;
4633 begin 4634 begin
4634 Result := FConnection.QuoteIdent(Name) + ' ' +DataType.Name; 4635 Result := FConnection.QuoteIdent(Name) + ' ' +DataType.Name;
4635 IsVirtual := (Expression <> '') and (Virtuality <> ''); 4636 IsVirtual := (Expression <> '') and (Virtuality <> '');
4636 if LengthSet <> '' then 4637 if LengthSet <> '' then
4637 Result := Result + '(' + LengthSet + ')'; 4638 Result := Result + '(' + LengthSet + ')';
4638 if (DataType.Category in [dtcInteger, dtcReal]) and Unsigned then 4639 if (DataType.Category in [dtcInteger, dtcReal]) and Unsigned then
4639 Result := Result + ' UNSIGNED'; 4640 Result := Result + ' UNSIGNED';
4640 if (DataType.Category in [dtcInteger, dtcReal]) and ZeroFill then 4641 if (DataType.Category in [dtcInteger, dtcReal]) and ZeroFill then
4641 Result := Result + ' ZEROFILL'; 4642 Result := Result + ' ZEROFILL';
4642 if not IsVirtual then begin 4643 if not IsVirtual then begin
4643 if not AllowNull then 4644 if not AllowNull then
4644 Result := Result + ' NOT'; 4645 Result := Result + ' NOT';
4645 Result := Result + ' NULL'; 4646 Result := Result + ' NULL';
4646 end; 4647 end;
4647 if DefaultType <> cdtNothing then begin 4648 if DefaultType <> cdtNothing then begin
4648 Result := Result + ' ' + GetColumnDefaultClause(DefaultType, DefaultText); 4649 Result := Result + ' ' + GetColumnDefaultClause(DefaultType, DefaultText);
4649 Result := TrimRight(Result); // Remove whitespace for columns without default value 4650 Result := TrimRight(Result); // Remove whitespace for columns without default value
4650 end; 4651 end;
4651 if IsVirtual then 4652 if IsVirtual then
4652 Result := Result + ' AS ('+Expression+') '+Virtuality; 4653 Result := Result + ' AS ('+Expression+') '+Virtuality;
4653 if Comment <> '' then 4654 if Comment <> '' then
4654 Result := Result + ' COMMENT '+esc(Comment); 4655 Result := Result + ' COMMENT '+esc(Comment);
4655 if Collation <> '' then 4656 if Collation <> '' then
4656 Result := Result + ' COLLATE '+esc(Collation); 4657 Result := Result + ' COLLATE '+esc(Collation);
4657 end; 4658 end;
4658 4659
4659 4660
4660 4661
4661 { *** TTableKey } 4662 { *** TTableKey }
4662 4663
4663 constructor TTableKey.Create(AOwner: TDBConnection); 4664 constructor TTableKey.Create(AOwner: TDBConnection);
4664 begin 4665 begin
4665 inherited Create; 4666 inherited Create;
4666 FConnection := AOwner; 4667 FConnection := AOwner;
4667 Columns := TStringList.Create; 4668 Columns := TStringList.Create;
4668 SubParts := TStringList.Create; 4669 SubParts := TStringList.Create;
4669 Columns.OnChange := Modification; 4670 Columns.OnChange := Modification;
4670 Subparts.OnChange := Modification; 4671 Subparts.OnChange := Modification;
4671 end; 4672 end;
4672 4673
4673 destructor TTableKey.Destroy; 4674 destructor TTableKey.Destroy;
4674 begin 4675 begin
4675 FreeAndNil(Columns); 4676 FreeAndNil(Columns);
4676 FreeAndNil(SubParts); 4677 FreeAndNil(SubParts);
4677 inherited Destroy; 4678 inherited Destroy;
4678 end; 4679 end;
4679 4680
4680 procedure TTableKey.Modification(Sender: TObject); 4681 procedure TTableKey.Modification(Sender: TObject);
4681 begin 4682 begin
4682 if not Added then 4683 if not Added then
4683 Modified := True; 4684 Modified := True;
4684 end; 4685 end;
4685 4686
4686 function TTableKey.SQLCode: String; 4687 function TTableKey.SQLCode: String;
4687 var 4688 var
4688 i: Integer; 4689 i: Integer;
4689 begin 4690 begin
4690 Result := ''; 4691 Result := '';
4691 // Supress SQL error trying index creation with 0 column 4692 // Supress SQL error trying index creation with 0 column
4692 if Columns.Count = 0 then 4693 if Columns.Count = 0 then
4693 Exit; 4694 Exit;
4694 if IndexType = PKEY then 4695 if IndexType = PKEY then
4695 Result := Result + 'PRIMARY KEY ' 4696 Result := Result + 'PRIMARY KEY '
4696 else begin 4697 else begin
4697 if IndexType <> KEY then 4698 if IndexType <> KEY then
4698 Result := Result + IndexType + ' '; 4699 Result := Result + IndexType + ' ';
4699 Result := Result + 'INDEX ' + FConnection.QuoteIdent(Name) + ' '; 4700 Result := Result + 'INDEX ' + FConnection.QuoteIdent(Name) + ' ';
4700 end; 4701 end;
4701 Result := Result + '('; 4702 Result := Result + '(';
4702 for i:=0 to Columns.Count-1 do begin 4703 for i:=0 to Columns.Count-1 do begin
4703 Result := Result + FConnection.QuoteIdent(Columns[i]); 4704 Result := Result + FConnection.QuoteIdent(Columns[i]);
4704 if SubParts[i] <> '' then 4705 if SubParts[i] <> '' then
4705 Result := Result + '(' + SubParts[i] + ')'; 4706 Result := Result + '(' + SubParts[i] + ')';
4706 Result := Result + ', '; 4707 Result := Result + ', ';
4707 end; 4708 end;
4708 if Columns.Count > 0 then 4709 if Columns.Count > 0 then
4709 Delete(Result, Length(Result)-1, 2); 4710 Delete(Result, Length(Result)-1, 2);
4710 4711
4711 Result := Result + ')'; 4712 Result := Result + ')';
4712 4713
4713 if Algorithm <> '' then 4714 if Algorithm <> '' then
4714 Result := Result + ' USING ' + Algorithm; 4715 Result := Result + ' USING ' + Algorithm;
4715 end; 4716 end;
4716 4717
4717 4718
4718 4719
4719 4720
4720 { *** TForeignKey } 4721 { *** TForeignKey }
4721 4722
4722 constructor TForeignKey.Create(AOwner: TDBConnection); 4723 constructor TForeignKey.Create(AOwner: TDBConnection);
4723 begin 4724 begin
4724 inherited Create; 4725 inherited Create;
4725 FConnection := AOwner; 4726 FConnection := AOwner;
4726 Columns := TStringList.Create; 4727 Columns := TStringList.Create;
4727 ForeignColumns := TStringList.Create; 4728 ForeignColumns := TStringList.Create;
4728 end; 4729 end;
4729 4730
4730 destructor TForeignKey.Destroy; 4731 destructor TForeignKey.Destroy;
4731 begin 4732 begin
4732 FreeAndNil(Columns); 4733 FreeAndNil(Columns);
4733 FreeAndNil(ForeignColumns); 4734 FreeAndNil(ForeignColumns);
4734 inherited Destroy; 4735 inherited Destroy;
4735 end; 4736 end;
4736 4737
4737 function TForeignKey.SQLCode(IncludeSymbolName: Boolean): String; 4738 function TForeignKey.SQLCode(IncludeSymbolName: Boolean): String;
4738 var 4739 var
4739 i: Integer; 4740 i: Integer;
4740 begin 4741 begin
4741 Result := ''; 4742 Result := '';
4742 // Symbol names are unique in a db. In order to autocreate a valid name we leave the constraint clause away. 4743 // Symbol names are unique in a db. In order to autocreate a valid name we leave the constraint clause away.
4743 if IncludeSymbolName then 4744 if IncludeSymbolName then
4744 Result := 'CONSTRAINT '+FConnection.QuoteIdent(KeyName)+' '; 4745 Result := 'CONSTRAINT '+FConnection.QuoteIdent(KeyName)+' ';
4745 Result := Result + 'FOREIGN KEY ('; 4746 Result := Result + 'FOREIGN KEY (';
4746 for i:=0 to Columns.Count-1 do 4747 for i:=0 to Columns.Count-1 do
4747 Result := Result + FConnection.QuoteIdent(Columns[i]) + ', '; 4748 Result := Result + FConnection.QuoteIdent(Columns[i]) + ', ';
4748 if Columns.Count > 0 then Delete(Result, Length(Result)-1, 2); 4749 if Columns.Count > 0 then Delete(Result, Length(Result)-1, 2);
4749 Result := Result + ') REFERENCES ' + FConnection.QuoteIdent(ReferenceTable, True, '.') + ' ('; 4750 Result := Result + ') REFERENCES ' + FConnection.QuoteIdent(ReferenceTable, True, '.') + ' (';
4750 for i:=0 to ForeignColumns.Count-1 do 4751 for i:=0 to ForeignColumns.Count-1 do
4751 Result := Result + FConnection.QuoteIdent(ForeignColumns[i]) + ', '; 4752 Result := Result + FConnection.QuoteIdent(ForeignColumns[i]) + ', ';
4752 if ForeignColumns.Count > 0 then Delete(Result, Length(Result)-1, 2); 4753 if ForeignColumns.Count > 0 then Delete(Result, Length(Result)-1, 2);
4753 Result := Result + ')'; 4754 Result := Result + ')';
4754 if OnUpdate <> '' then 4755 if OnUpdate <> '' then
4755 Result := Result + ' ON UPDATE ' + OnUpdate; 4756 Result := Result + ' ON UPDATE ' + OnUpdate;
4756 if OnDelete <> '' then 4757 if OnDelete <> '' then
4757 Result := Result + ' ON DELETE ' + OnDelete; 4758 Result := Result + ' ON DELETE ' + OnDelete;
4758 end; 4759 end;
4759 4760
4760 4761
4761 4762
4762 4763
4763 function mysql_authentication_dialog_ask; 4764 function mysql_authentication_dialog_ask;
4764 var 4765 var
4765 Username, Password: String; 4766 Username, Password: String;
4766 Dialog: TfrmLogin; 4767 Dialog: TfrmLogin;
4767 begin 4768 begin
4768 { 4769 {
4769 From client_plugin.h: 4770 From client_plugin.h:
4770 The C function with the name "mysql_authentication_dialog_ask", if exists, 4771 The C function with the name "mysql_authentication_dialog_ask", if exists,
4771 will be used by the "dialog" client authentication plugin when user 4772 will be used by the "dialog" client authentication plugin when user
4772 input is needed. This function should be of mysql_authentication_dialog_ask_t 4773 input is needed. This function should be of mysql_authentication_dialog_ask_t
4773 type. If the function does not exists, a built-in implementation will be 4774 type. If the function does not exists, a built-in implementation will be
4774 used. 4775 used.
4775 @param mysql mysql 4776 @param mysql mysql
4776 @param type type of the input 4777 @param type type of the input
4777 1 - normal string input 4778 1 - normal string input
4778 2 - password string 4779 2 - password string
4779 @param prompt prompt 4780 @param prompt prompt
4780 @param buf a buffer to store the use input 4781 @param buf a buffer to store the use input
4781 @param buf_len the length of the buffer 4782 @param buf_len