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