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