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