mORMot and Open Source friends
Check-in [c0cd24feea]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
SHA1:c0cd24feea5d399aef64989f8de85397953da84a
Date: 2012-11-28 13:35:59
User: abouchez
Comment:deleted whole ZEOS sub-folder from the repository, since it is not to be used any more, but our more efficient SynDB*.pas units
Tags And Properties
Context
2012-11-30
18:03
[f4e532be25] .NET/CLR external uncaught exceptions will now be logged with their C# type name (user: abouchez, tags: trunk)
2012-11-28
13:35
[c0cd24feea] deleted whole ZEOS sub-folder from the repository, since it is not to be used any more, but our more efficient SynDB*.pas units (user: abouchez, tags: trunk)
13:34
[1c6fe7a1fd] all former SQLite3\SQLite3*.pas units have been renamed to SQLite3\mORMot*.pas to match the database-agnostic scheme of the mORMot framework - this is a major break change, so all your "uses" clauses in your code is to be change to follow the new naming (user: abouchez, tags: trunk)
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Deleted zeos/Zeos.inc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

// Compilation directives for Lazarus
{$IFDEF FPC}
  {$MODE DELPHI}
  {$INTERFACES COM}
  {$DEFINE VER140BELOW}
  // We assume 2 levels is sufficient.
  // The higher the third number in a version, the better... (we hope)
  {$IFDEF VER2_5}
    {$DEFINE FPC2_5UP}
    {$DEFINE FPC2_4UP}
    {$DEFINE FPC2_3UP}
    {$DEFINE FPC2_2UP}
    {$DEFINE FPC2_1UP}
  {$ENDIF}
  {$IFDEF VER2_4}
    {$DEFINE FPC2_4UP}
    {$DEFINE FPC2_3UP}
    {$DEFINE FPC2_2UP}
    {$DEFINE FPC2_1UP}
  {$ENDIF}
  {$IFDEF VER2_3}
    {$DEFINE FPC2_3UP}
    {$DEFINE FPC2_2UP}
    {$DEFINE FPC2_1UP}
  {$ENDIF}

  {$IFDEF VER2_2}
    {$DEFINE FPC2_2UP}
    {$DEFINE FPC2_1UP}
  {$ENDIF}

  {$IFDEF VER2_1}
    {$DEFINE FPC2_1UP}
  {$ENDIF}

  {$IFDEF VER2}
    {$DEFINE FPC2_UP}
  {$ENDIF}
{$ENDIF}


// Compilation directives for Delphi4
// Not supported since Zeoslib 7.X
{$IFDEF VER120}
{$DEFINE VER140BELOW}
{$ENDIF}

// Compilation directives for Delphi 5
// Not supported since Zeoslib 7.X
{$IFDEF VER130}
{$DEFINE VER140BELOW}
{$ENDIF}

// Compilation directives for Delphi 6
// Not supported since Zeoslib 7.X
{$IFDEF VER140}
  {$DEFINE VER140BELOW}
  {$DEFINE VER150BELOW}
  {$DEFINE VER160BELOW}
  {$DEFINE VER170BELOW}
  {$DEFINE VER180BELOW}
{$ENDIF}

// Compilation directives for Delphi 7
{$IFDEF VER150}
  {$DEFINE VER150BELOW}
  {$DEFINE VER160BELOW}
  {$DEFINE VER170BELOW}
  {$DEFINE VER180BELOW}
{$ENDIF}

// Compilation directives for Delphi 8
{$IFDEF VER160}
  {$DEFINE VER160BELOW}
  {$DEFINE VER170BELOW}
  {$DEFINE VER180BELOW}
{$ENDIF}

// Compilation directives for Delphi 9 (DELPHI 2005)
{$IFDEF VER170}
  {$DEFINE VER170BELOW}
  {$DEFINE VER180BELOW}
  {$DEFINE BDS}
  {$DEFINE BDS3}
  {$DEFINE BDS3_UP}
  {$DEFINE COMPILER9}
  {$DEFINE COMPILER9_UP}
  {$DEFINE DELPHI9}
  {$DEFINE DELPHI9_UP}
{$ENDIF}

// Compilation directives for BDS 2006 (Delphi 2006, BCB 2006)
{$IFDEF VER180}
  {$DEFINE VER180BELOW}
  {$DEFINE BDS}
  {$DEFINE BDS4}
  {$DEFINE BDS4_UP}
  {$DEFINE COMPILER10}
  {$DEFINE COMPILER10_UP}
  {$IFDEF BCB}
    {$DEFINE BCB10}
    {$DEFINE BCB9_UP}
    {$DEFINE BCB10_UP}
  {$ELSE}
    {$DEFINE DELPHI10}
    {$DEFINE DELPHI9_UP}
    {$DEFINE DELPHI10_UP}
  {$ENDIF}
{$ENDIF}

// Compilation directives for Delphi 2009
{$IFDEF VER200}
  {$DEFINE VER200BELOW}
  {$DEFINE DELPHI12}
  {$DEFINE DELPHI9_UP}
  {$DEFINE DELPHI10_UP}
  {$DEFINE DELPHI12_UP}
  {$DEFINE BDS}
  {$DEFINE BDS5}
  {$DEFINE BDS4_UP}
  {$DEFINE BDS5_UP}
{$ENDIF}

// Compilation directives for Delphi 2010
{$IFDEF VER210}
  {$DEFINE VER200BELOW}
  {$DEFINE DELPHI14}
  {$DEFINE DELPHI9_UP}
  {$DEFINE DELPHI10_UP}
  {$DEFINE DELPHI12_UP}
  {$DEFINE DELPHI14_UP}
  {$DEFINE BDS}
  {$DEFINE BDS7}
  {$DEFINE BDS4_UP}
  {$DEFINE BDS5_UP}
  {$DEFINE BDS7_UP}
{$ENDIF}

// Compilation directives for Delphi XE
{$IFDEF VER220}
  {$DEFINE VER200BELOW}
  {$DEFINE DELPHI14}
  {$DEFINE DELPHI9_UP}
  {$DEFINE DELPHI10_UP}
  {$DEFINE DELPHI12_UP}
  {$DEFINE DELPHI14_UP}
  {$DEFINE DELPHI15_UP}
  {$DEFINE BDS}
  {$DEFINE BDS7}
  {$DEFINE BDS8}  // EDS8 ?
  {$DEFINE BDS4_UP}
  {$DEFINE BDS5_UP}
  {$DEFINE BDS7_UP}
  {$DEFINE BDS8_UP}
{$ENDIF}
{$IFDEF LINUX}
  {$DEFINE UNIX}
{$ENDIF}

{$IFDEF VER140BELOW}
  {$IFNDEF FPC}
    {$IFNDEF WIN32}
      {$if Declared(RTLVersion) and (RTLVersion = 14.5)}  //Kylix 3
      {$ELSE}
          "Kylix versions below Kylix3 aren't supported anymore"
      {$ifend}
    {$ELSE}
      {$ifdef BCB}  //Cbuilder
        {$IFNDEF VER140}
          "CBuilder versions below CBuilder6 aren't supported anymore"
        {$ENDIF}
      {$ELSE}
        {$IFNDEF VER140}
          "Delphi versions below Delphi 6 aren't supported anymore"
        {$ENDIF}
      {$ENDIF}
    {$ENDIF}
  {$ELSE}
    {$IFNDEF FPC2_UP}
    "FPC versions below FPC 2.0 aren't supported anymore"
    {$ENDIF}
  {$ENDIF}
{$ENDIF}

// Debug/release compiler options
{$D+}

{$IFOPT D-}
{$DEFINE BINARY_RELEASE}
{$ENDIF}

{$IFDEF BINARY_RELEASE}
// Settings for Release mode
{$C-}
{$I-}
{$R-}
{$L-}
{$Q-}
{$IFNDEF FPC}
{$O+}
{$W-}
{$ENDIF}

{$ELSE}

// Settings for Debug mode
{.$C+}
{.$I+}
{.$R+}
{.$L+}
{.$Q+}
{.$IFNDEF FPC}
{.$O-}
{.$W+}
{.$ENDIF}

{$ENDIF}

// Disables checking code.
// Use Range checking option to turn on/off optimization
{$IFOPT R-}
{$DEFINE DISABLE_CHECKING}
{$ENDIF}


// Enables MySQL support in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_MYSQL}
{$DEFINE ENABLE_MYSQL}
{$ENDIF}

// Enables PostgreSQL support in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_POSTGRESQL}
{$DEFINE ENABLE_POSTGRESQL}
{$ENDIF}

// Enables Sybase/MSSQL support in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_DBLIB}
{$DEFINE ENABLE_DBLIB}
{$ENDIF}

// Enables ADO support in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_ADO}
{$IFNDEF FPC}
 {$IFNDEF UNIX}
  {$DEFINE ENABLE_ADO}
 {$ENDIF}
{$ENDIF}
{$ENDIF}

// Enables Interbase/Firebird support in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_INTERBASE}
{$DEFINE ENABLE_INTERBASE}
{$ENDIF}

// Enables SQLite support in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_SQLITE}
{$DEFINE ENABLE_SQLITE}
{$ENDIF}

// Enables Oracle support in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_ORACLE}
{$DEFINE ENABLE_ORACLE}
{$ENDIF}

// Enables ASA support in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_ASA}
{$DEFINE ENABLE_ASA}
{$ENDIF}

// Enables Pooled connection support for all enabled db drivers in TZConnection/TZDataset
{$IFNDEF ZEOS_DISABLE_POOLED}
{$DEFINE ENABLE_POOLED}
{$ENDIF}

// Supported language. Now available languages:
// ENGLISH, GERMAN, PORTUGUESE, DUTCH, SPANISH, ROMANA, INDONESIAN, RUSSIAN, CZECH, POLISH
{$DEFINE ENGLISH}

// Prevents loading default libmysql.dll
{.$DEFINE MYSQL_STRICT_DLL_LOADING}

// Prevents loading default firebird.dll
{.$DEFINE FIREBIRD_STRICT_DLL_LOADING}

// Prevents loading default libpq.dll
{.$DEFINE POSTGRESQL_STRICT_DLL_LOADING}

//Allows to see SQL exceptions as strings
{$DEFINE INTERBASE_EXTENDED_MESSAGES}

// Loads libcrypt.so before Firebird client library.
// It fixes error "Undefined symbol: crypt".
{$DEFINE INTERBASE_CRYPT}

// Excludes old ZeosDBO from the performance tests
{$DEFINE EXCLUDE_OLD_ZEOS_TEST}

// Excludes DBExpress from the performance tests
{$DEFINE EXCLUDE_DBX_TEST}

// Excludes IBX from the performance tests
{$DEFINE EXCLUDE_IBX_TEST}

// Excludes BDE from the performance tests
{$DEFINE EXCLUDE_BDE_TEST}

// Registers property editors for the components.
{$DEFINE WITH_PROPERTY_EDITOR}

// Turn on IProviderSupport interface
{$IFNDEF FPC}
{$DEFINE WITH_IPROVIDER}
{$ENDIF}

// Turn on multithreading
{$DEFINE MULTI_THREADED}

// In Version 6.1.5 there are several bugs with the TZSQLMetadata-Component
// For Version 6.5.0 you should uncomment the following line
{$DEFINE USE_METADATA}

// A large database may have many tables, colums and/or procedures!!!
// Therefore there is the ability to show a warning
// before retrieving a list of these database objects
// {$DEFINE SHOW_WARNING}

// Use libfbclient.so under linux
// and not libfbembed.so when Firebird 1.5.2 is used under linux
{$DEFINE USELIBFBCLIENTSO}

// Use SynEdit for the SQL Editors.
// Uncomment it when you will use SynEdit instead of a MemoEdit.
// The SynEdit component must be installed on your system.
// You can get SynEdit at http://synedit.sourceforge.net/
//{$DEFINE USE_SYNEDIT}

// Compile test applications with a graphical user interface (GUI)
// Comment this definition if you want to compile console test applications
{.$DEFINE TESTGUI}

//PATCH TO DO NO METADATALOADING / UNTESTED HIGH RISK
{.$DEFINE FOSNOMETA}


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZClasses.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Core classes and interfaces                 }
{                                                         }
{          Originally written by Sergey Seroukhov         }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZClasses;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses                    
  SysUtils, Classes, SynCommons;

const
  ZEOS_VERSION = '7.0.0-dev';

{$IFDEF ENABLE_POOLED}
  {Pooled Protocol Prefix, including final dot}
  PooledPrefix = 'pooled.';
{$ENDIF}


type

  { Lazarus/FreePascal Support }
  {$IFDEF FPC}
  PDateTime = ^TDateTime;

  TAggregatedObject = class(TObject)
  private
    FController: Pointer;
    function GetController: IInterface;
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    constructor Create(const Controller: IInterface);
    property Controller: IInterface read GetController;
  end;

  TContainedObject = class(TAggregatedObject, IInterface)
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  end;
  {$ENDIF}

  {** Replacement for generic interface type. }
  IZInterface = IUnknown;

  {** Represents an interface for all abstract object. }
  IZObject = interface(IZInterface)
    ['{EF46E5F7-00CF-4DDA-BED0-057D6686AEE0}']
    function Equals(const Value: IZInterface): Boolean;
    function GetHashCode: LongInt;
    function Clone: IZInterface;
    function ToUTF8: RawUTF8;
    function InstanceOf(const IId: TGUID): Boolean;
  end;

  {** Represents a fake interface for coparable objects. }
  IZComparable = interface(IZObject)
    ['{04112081-F07B-4BBF-A757-817816EB67C1}']
  end;

  {** Represents an interface to clone objects. }
  IZClonnable = interface(IZObject)
    ['{ECB7F3A4-7B2E-4130-BA66-54A2D43C0149}']
  end;

  {** Represents a generic collection iterator interface. }
  IZIterator = interface(IZObject)
    ['{D964DDD0-2308-4D9B-BD36-5810632512F7}']
    function HasNext: Boolean;
    function Next: IZInterface;
  end;

  {** Represents a collection of object interfaces. }
  IZCollection = interface(IZClonnable)
    ['{51417C87-F992-4CAD-BC53-CF3925DD6E4C}']

    function Get(Index: Integer): IZInterface;
    procedure Put(Index: Integer; const Item: IZInterface);
    function IndexOf(const Item: IZInterface): Integer;
    function GetCount: Integer;
    function GetIterator: IZIterator;

    function First: IZInterface;
    function Last: IZInterface;

    function Add(const Item: IZInterface): Integer;
    procedure Insert(Index: Integer; const Item: IZInterface);
    function Remove(const Item: IZInterface): Integer;

    procedure Exchange(Index1, Index2: Integer);
    procedure Delete(Index: Integer);
    procedure Clear;

    function Contains(const Item: IZInterface): Boolean;
    function ContainsAll(const Col: IZCollection): Boolean;
    function AddAll(const Col: IZCollection): Boolean;
    function RemoveAll(const Col: IZCollection): Boolean;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: IZInterface read Get write Put; default;
  end;

  {** Represents a hash map interface. }
  IZHashMap = interface(IZClonnable)
    ['{782C64F4-AD09-4F56-AF2B-E4193A05BBCE}']

    function Get(const Key: IZInterface): IZInterface;
    procedure Put(const Key: IZInterface; const Value: IZInterface);
    function GetKeys: IZCollection;
    function GetValues: IZCollection;
    function GetCount: Integer;

    function Remove(Key: IZInterface): Boolean;
    procedure Clear;

    property Count: Integer read GetCount;
    property Keys: IZCollection read GetKeys;
    property Values: IZCollection read GetValues;
  end;

  {** Represents a stack interface. }
  IZStack = interface(IZClonnable)
    ['{8FEA0B3F-0C02-4E70-BD8D-FB0F42D4497B}']

    function Peek: IZInterface;
    function Pop: IZInterface;
    procedure Push(Value: IZInterface);
    function GetCount: Integer;

    property Count: Integer read GetCount;
  end;

  {** Implements an abstract interfaced object. }
  TZAbstractObject = class(TInterfacedObject, IZObject)
  public
    function Equals(const Value: IZInterface): Boolean; {$IFDEF DELPHI12_UP}reintroduce;{$ENDIF} virtual;
    {$IFNDEF DELPHI12_UP}
    function GetHashCode: LongInt; {$ENDIF}
    function Clone: IZInterface; virtual;
    function ToUTF8: RawUTF8; virtual;
    function InstanceOf(const IId: TGUID): Boolean;
  end;


implementation

uses ZMessages, ZCompatibility;

{$IFDEF FPC}

{ TAggregatedObject }

constructor TAggregatedObject.Create(const Controller: IInterface);
begin
  FController := Pointer(Controller);
end;

function TAggregatedObject.GetController: IInterface;
begin
  Result := IInterface(FController);
end;

function TAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  Result := IInterface(FController).QueryInterface(IID, Obj);
end;

function TAggregatedObject._AddRef: Integer;
begin
  Result := IInterface(FController)._AddRef;
end;

function TAggregatedObject._Release: Integer; stdcall;
begin
  Result := IInterface(FController)._Release;
end;

{ TContainedObject }

function TContainedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

{$ENDIF}

{ TZAbstractObject }

{**
  Checks is the specified value equals to this object.
  @param Value an interface to some object.
  @return <code>True</code> if the objects are identical.
}
function TZAbstractObject.Equals(const Value: IZInterface): Boolean;
begin
  if Value <> nil then
  begin
    Result := (IZInterface(Self) = Value)
      or ((Self as IZInterface) = (Value as IZInterface));
  end else
   Result := False;
end;

{**
  Gets a unique hash for this object.
  @return a unique hash for this object.
}
{$IFNDEF DELPHI12_UP}
function TZAbstractObject.GetHashCode: LongInt;
begin
  Result := LongInt(Self);
end;
{$ENDIF}

{**
  Clones an object instance.
  @return a clonned object instance.
}
function TZAbstractObject.Clone: IZInterface;
begin
  raise Exception.CreateRes(@SClonningIsNotSupported);
  result := nil;
end;

{**
  Checks is this object implements a specified interface.
  @param IId an interface id.
  @return <code>True</code> if this object support the interface.
}
function TZAbstractObject.InstanceOf(const IId: TGUID): Boolean;
begin
  Result := GetInterfaceEntry(IId) <> nil;
end;

{**
  Converts this object into the RawUTF8 representation.
  @return a RawUTF8 representation for this object.
}
function TZAbstractObject.ToUTF8: RawUTF8;
begin
  Result := FormatUTF8('% <%>', [ClassName, Pointer(Self)])
end;

end.

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






























































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZCollections.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{           Core collection and map classes               }
{                                                         }
{          Originally written by Sergey Seroukhov         }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZCollections;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses Classes, ZClasses, SynCommons;

type

  {** Implements an iterator for regular TZCollection collection. }
  TZIterator = class (TZAbstractObject, IZIterator)
  private
    FCollection: IZCollection;
    FCurrentIndex: Integer;
  public
    constructor Create(const Col: IZCollection);
    function HasNext: Boolean;
    function Next: IZInterface;
  end;

  {** Interface list types. }
  TZInterfaceList = array[0..MaxListSize - 1] of IZInterface;
  PZInterfaceList = ^TZInterfaceList;

  {** Implenments a collection of interfaces. }
  TZCollection = class(TZAbstractObject, IZCollection, IZClonnable)
  private
    FList: PZInterfaceList;
    FCount: Integer;
    FCapacity: Integer;
  protected
{$IFOPT R+}
    class procedure Error(ResStringRec: PResStringRec; Data: Integer);
{$ENDIF}
    procedure Grow;
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetCount(NewCount: Integer);
  public
    constructor Create;
    destructor Destroy; override;

    function Clone: IZInterface; override;
    function ToUTF8: RawUTF8; override;

    function Get(Index: Integer): IZInterface;
    procedure Put(Index: Integer; const Item: IZInterface);
    function IndexOf(const Item: IZInterface): Integer;
    function GetCount: Integer;
    function GetIterator: IZIterator;

    function First: IZInterface;
    function Last: IZInterface;

    function Add(const Item: IZInterface): Integer;
    procedure Insert(Index: Integer; const Item: IZInterface);
    function Remove(const Item: IZInterface): Integer;

    procedure Exchange(Index1, Index2: Integer);
    procedure Delete(Index: Integer);
    procedure Clear;

    function Contains(const Item: IZInterface): Boolean;
    function ContainsAll(const Col: IZCollection): Boolean;
    function AddAll(const Col: IZCollection): Boolean;
    function RemoveAll(const Col: IZCollection): Boolean;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: IZInterface read Get write Put; default;
  end;

  {** Implements an unmodifiable collection of interfaces. }
  TZUnmodifiableCollection = class(TZAbstractObject, IZCollection, IZClonnable)
  private
    FCollection: IZCollection;
  private
    procedure RaiseException;
  public
    constructor Create(Collection: IZCollection);
    destructor Destroy; override;

    function Clone: IZInterface; override;
    function ToUTF8: RawUTF8; override;

    function Get(Index: Integer): IZInterface;
    procedure Put(Index: Integer; const Item: IZInterface);
    function IndexOf(const Item: IZInterface): Integer;
    function GetCount: Integer;
    function GetIterator: IZIterator;

    function First: IZInterface;
    function Last: IZInterface;

    function Add(const Item: IZInterface): Integer;
    procedure Insert(Index: Integer; const Item: IZInterface);
    function Remove(const Item: IZInterface): Integer;

    procedure Exchange(Index1, Index2: Integer);
    procedure Delete(Index: Integer);
    procedure Clear;

    function Contains(const Item: IZInterface): Boolean;
    function ContainsAll(const Col: IZCollection): Boolean;
    function AddAll(const Col: IZCollection): Boolean;
    function RemoveAll(const Col: IZCollection): Boolean;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: IZInterface read Get write Put; default;
  end;

  {** Implements a hash map of interfaces. }
  TZHashMap = class(TZAbstractObject, IZHashMap, IZClonnable)
  private
    FKeys: IZCollection;
    FReadOnlyKeys: IZCollection;
    FValues: IZCollection;
    FReadOnlyValues: IZCollection;
  public
    constructor Create;
    destructor Destroy; override;

    function Clone: IZInterface; override;

    function Get(const Key: IZInterface): IZInterface;
    procedure Put(const Key: IZInterface; const Value: IZInterface);
    function GetKeys: IZCollection;
    function GetValues: IZCollection;
    function GetCount: Integer;

    function Remove(Key: IZInterface): Boolean;
    procedure Clear;

    property Count: Integer read GetCount;
    property Keys: IZCollection read GetKeys;
    property Values: IZCollection read GetValues;
  end;

  {** Implements a stack of interfaces. }
  TZStack = class(TZAbstractObject, IZStack, IZClonnable)
  private
    FValues: IZCollection;
  public
    constructor Create;
    destructor Destroy; override;

    function Clone: IZInterface; override;
    function ToUTF8: RawUTF8; override;

    function Peek: IZInterface;
    function Pop: IZInterface;
    procedure Push(Value: IZInterface);
    function GetCount: Integer;

    property Count: Integer read GetCount;
  end;

  
implementation

uses SysUtils, ZMessages;

{ TZIterator }

{**
  Creates this iterator for the specified interface list.
  @param List a list of interfaces.
}
constructor TZIterator.Create(const Col: IZCollection);
begin
  FCollection := Col;
end;

{**
  Checks has the iterated collection more elements.
  @return <code>True</code> if iterated collection has more elements.
}
function TZIterator.HasNext: Boolean;
begin
  Result := FCurrentIndex < FCollection.Count;
end;

{**
  Gets a next iterated element from the collection.
  @return a next iterated element from the collection or <code>null</code>
    if no more elements.
}
function TZIterator.Next: IZInterface;
begin
  if FCurrentIndex < FCollection.Count then
  begin
    Result := FCollection[FCurrentIndex];
    Inc(FCurrentIndex);
  end else
    Result := nil;
end;

{ TZCollection }

{**
  Creates this collection and assignes main properties.
}
constructor TZCollection.Create;
begin
end;

{**
  Destroys this object and frees the memory.
}
destructor TZCollection.Destroy;
begin
  Clear;
end;

{$IFOPT R+}
{**
  Raises a collection error.
  @param ResStringRec an error message.
  @param Data a integer value to describe an error.
}
class procedure TZCollection.Error(ResStringRec: PResStringRec; Data: Integer);
{$IFNDEF FPC}
  function ReturnAddr: Pointer;
  asm
    mov eax,[ebp+4]
  end;
{$ENDIF}
begin
  {$IFDEF FPC}
  raise EListError.CreateResFmt(ResStringRec, [Data]) at get_caller_addr(get_frame);
  {$ELSE}
  raise EListError.CreateResFmt(ResStringRec, [Data]) at ReturnAddr;
  {$ENDIF}
end;
{$ENDIF}

{**
  Increases an element count.
}
procedure TZCollection.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 64 then
    Delta := FCapacity div 4
  else
  begin
    if FCapacity > 8 then
      Delta := 16
    else
      Delta := 4;
  end;
  SetCapacity(FCapacity + Delta);
end;

{**
  Sets a new list capacity.
  @param NewCapacity a new list capacity.
}
procedure TZCollection.SetCapacity(NewCapacity: Integer);
begin
{$IFOPT R+}
  if (NewCapacity < FCount) or (NewCapacity > MaxListSize) then
    Error(@SListCapacityError, NewCapacity);
{$ENDIF}
  if NewCapacity <> FCapacity then
  begin
    ReallocMem(FList, NewCapacity * SizeOf(IZInterface));
    if NewCapacity > FCapacity then
         FillChar(FList^[FCount], (NewCapacity - FCapacity) *
            SizeOf(IZInterface), 0);
    FCapacity := NewCapacity;
  end;
end;

{**
  Sets a new element count.
  @param NewCount a new element count.
}
procedure TZCollection.SetCount(NewCount: Integer);
var
  I: Integer;
begin
{$IFOPT R+}
  if (NewCount < 0) or (NewCount > MaxListSize) then
    Error(@SListCountError, NewCount);
{$ENDIF}
  if NewCount > FCapacity then
    SetCapacity(NewCount);
  if NewCount < FCount then
  begin
    for I := FCount - 1 downto NewCount do
      FList^[I] := nil;
  end;
  FCount := NewCount;
end;

{**
  Clones the instance of this object.
  @return a reference to the clonned object.
}
function TZCollection.Clone: IZInterface;
var
  I: Integer;
  Collection: IZCollection;
  Clonnable: IZClonnable;
begin
  Collection := TZCollection.Create;
  for I := 0 to FCount - 1 do
    if FList^[I].QueryInterface(IZClonnable, Clonnable) = 0 then
      Collection.Add(Clonnable.Clone) else
      Collection.Add(FList^[I]);
  Result := Collection;
end;

{**
  Adds a new object at the and of this collection.
  @param Item an object to be added.
  @return a position of the added object.
}
function TZCollection.Add(const Item: IZInterface): Integer;
begin
  Result := FCount;
  if Result = FCapacity then
    Grow;
//  FList^[Result] := Item as IZInterface; // enourmous Memory Hole in FPC > 2.0.2 Release
  FList^[Result] := Item;
  Inc(FCount);
end;

{**
  Adds all elements from the specified collection into this collection.
  @param Col a collection of objects to be added.
  @return <code>True</code> is the collection was changed.
}
function TZCollection.AddAll(const Col: IZCollection): Boolean;
var
  I: Integer;
begin
  Result := Col.Count > 0;
  for I := 0 to Col.Count - 1 do
    Add(Col[I]);
end;

{**
  Clears the content of this collection.
}
procedure TZCollection.Clear;
begin
  SetCount(0);
  SetCapacity(0);
end;

{**
  Checks is the specified object is stored in this collection.
  @return <code>True</code> if the object was found in the collection.
}
function TZCollection.Contains(const Item: IZInterface): Boolean;
begin
  Result := IndexOf(Item) >= 0;
end;

{**
  Checks are all the object in this collection.
  @param Col a collection of objects to be checked.
  @return <code>True</code> if all objects are in this collection.
}
function TZCollection.ContainsAll(const Col: IZCollection): Boolean;
var
  I: Integer;
begin
  Result := Col.Count > 0;
  for I := 0 to Col.Count - 1 do
  begin
    if IndexOf(Col[I]) < 0 then
    begin
      Result := False;
      Break;
    end;
  end;
end;

{**
  Deletes an object from the specified position.
}
procedure TZCollection.Delete(Index: Integer);
begin
{$IFOPT R+}
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
{$ENDIF}
  FList^[Index] := nil; // release item interface instance
  Dec(FCount);
  if Index < FCount then
  begin
    System.Move(FList^[Index + 1], FList^[Index],
      (FCount - Index) * SizeOf(IZInterface));
  end;
end;

{**
  Exchanges two element in the collection.
  @param Index1 an index of the first element.
  @param Index2 an index of the second element.
}
procedure TZCollection.Exchange(Index1, Index2: Integer);
var
  Item: IZInterface;
begin
{$IFOPT R+}
  if (Index1 < 0) or (Index1 >= FCount) then
    Error(@SListIndexError, Index1);
  if (Index2 < 0) or (Index2 >= FCount) then
    Error(@SListIndexError, Index2);
{$ENDIF}
  Item := FList^[Index1];
  FList^[Index1] := FList^[Index2];
  FList^[Index2] := Item;
end;

{**
  Gets the first element from this collection.
  @return the first element.
}
function TZCollection.First: IZInterface;
begin
  Result := Get(0);
end;

{**
  Gets a collection element from the specified position.
  @param Index a position index of the element.
  @return a requested element.
}
function TZCollection.Get(Index: Integer): IZInterface;
begin
{$IFOPT R+}
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
{$ENDIF}
  Result := FList^[Index];
end;

{**
  Gets a number of the stored element in this collection.
  @return a number of stored elements.
}
function TZCollection.GetCount: Integer;
begin
  Result := FCount;
end;

{**
  Gets a created iterator for this collection.
  @return a created iterator for this collection.
}
function TZCollection.GetIterator: IZIterator;
begin
  Result := TZIterator.Create(Self);
end;

{**
  Defines an index of the specified object inside this colleciton.
  @param Item an object to be found.
  @return an object position index or -1 if it was not found.
}
function TZCollection.IndexOf(const Item: IZInterface): Integer;
var
  Comparable: IZComparable;
  Unknown: IZInterface;
begin
  if (FCount = 0) or (Item = nil) then begin
    Result := -1;
    Exit;
  end;
  { Find IComparable objects }
  if Item.QueryInterface(IZComparable, Comparable) = 0 then begin
    for result := 0 to FCount - 1 do
      if Comparable.Equals(FList^[result]) then
        exit;
  end
  { Find ordinary objects }
  else
  begin
    Unknown := Item;
    for result := 0 to FCount - 1 do
      if Unknown = FList^[result] then
        exit;
  end;
  Result := -1;
end;

{**
  Inserts an object into specified position.
  @param Index a position index.
  @param Item an object to be inserted.
}
procedure TZCollection.Insert(Index: Integer; const Item: IZInterface);
begin
{$IFOPT R+}
  if (Index < 0) or (Index > FCount) then
    Error(@SListIndexError, Index);
{$ENDIF}
  if FCount = FCapacity then
    Grow;
  if Index < FCount then
  begin
    System.Move(FList^[Index], FList^[Index + 1],
      (FCount - Index) * SizeOf(IZInterface));
  end;
//  FList^[Index] := Item as IZInterface; //MEMORY HOG
  FList^[Index] := Item;
  Inc(FCount);
end;

{**
  Gets the last object from this collection.
  @return the last object.
}
function TZCollection.Last: IZInterface;
begin
  Result := Get(FCount - 1);
end;

{**
  Puts a specified object into defined position.
  @param Index a position index.
  @param Items ab object to be put.
}
procedure TZCollection.Put(Index: Integer; const Item: IZInterface);
begin
{$IFOPT R+}
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
{$ENDIF}
//  FList^[Index] := Item as IZInterface; //MEMORY HOG
  FList^[Index] := Item;
end;

{**
  Removes an existed object which equals to the specified one.
  @param Item an object to be removed.
  @return an index of the removed object.
}
function TZCollection.Remove(const Item: IZInterface): Integer;
begin
  Result := IndexOf(Item);
  if Result >= 0 then
    Delete(Result);
end;

{**
  Removes all the elements from the specified collection.
  @param Col a collection of object to be removed.
  @return <code>True</code> if this collection was changed.
}
function TZCollection.RemoveAll(const Col: IZCollection): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to Col.Count - 1 do
    Result := (Remove(Col[I]) >= 0) or Result;
end;

{**
  Gets a RawUTF8 representation for this object.
}
function TZCollection.ToUTF8: RawUTF8;
var
  I: Integer;
  TempObject: IZObject;
begin
  Result := '';
  for I := 0 to FCount - 1 do
  begin
    if I > 0 then
      Result := Result + ',';
    if FList^[I].QueryInterface(IZObject, TempObject) = 0 then
      Result := Result + TempObject.ToUTF8 else
      Result := Result + FormatUTF8('<%>', [Pointer(FList^[I])]);
  end;
  Result := '[' + Result + ']';
end;

{ TZUnmodifiableCollection }

{**
  Constructs this object and assignes main properties.
  @param Collection an initial modifiable list of interfaces.
}
constructor TZUnmodifiableCollection.Create(Collection: IZCollection);
begin
  inherited Create;
  FCollection := Collection;
end;

{**
  Destroys this object and frees the memory.
}
destructor TZUnmodifiableCollection.Destroy;
begin
  FCollection := nil;
  inherited Destroy;
end;

{**
  Clones the instance of this object.
  @return a reference to the clonned object.
}
function TZUnmodifiableCollection.Clone: IZInterface;
begin
  Result := TZUnmodifiableCollection.Create(FCollection);
end;

{**
  Raises invalid operation exception.
}
procedure TZUnmodifiableCollection.RaiseException;
begin
  raise EInvalidOperation.CreateRes(@SImmutableOpIsNotAllowed);
end;

{**
  Adds a new object at the and of this collection.
  @param Item an object to be added.
  @return a position of the added object.
}
function TZUnmodifiableCollection.Add(const Item: IZInterface): Integer;
begin
  Result := -1;
  RaiseException;
end;

{**
  Adds all elements from the specified collection into this collection.
  @param Col a collection of objects to be added.
  @return <code>True</code> is the collection was changed.
}
function TZUnmodifiableCollection.AddAll(const Col: IZCollection): Boolean;
begin
  Result := False;
  RaiseException;
end;

{**
  Clears the content of this collection.
}
procedure TZUnmodifiableCollection.Clear;
begin
  RaiseException;
end;

{**
  Checks is the specified object is stored in this collection.
  @return <code>True</code> if the object was found in the collection.
}
function TZUnmodifiableCollection.Contains(const Item: IZInterface): Boolean;
begin
  Result := FCollection.Contains(Item);
end;

{**
  Checks are all the object in this collection.
  @param Col a collection of objects to be checked.
  @return <code>True</code> if all objects are in this collection.
}
function TZUnmodifiableCollection.ContainsAll(const Col: IZCollection): Boolean;
begin
  Result := FCollection.ContainsAll(Col);
end;

{**
  Deletes an object from the specified position.
}
procedure TZUnmodifiableCollection.Delete(Index: Integer);
begin
  RaiseException;
end;

{**
  Exchanges two element in the collection.
  @param Index1 an index of the first element.
  @param Index2 an index of the second element.
}
procedure TZUnmodifiableCollection.Exchange(Index1, Index2: Integer);
begin
  RaiseException;
end;

{**
  Gets the first element from this collection.
  @return the first element.
}
function TZUnmodifiableCollection.First: IZInterface;
begin
  Result := FCollection.First;
end;

{**
  Gets a collection element from the specified position.
  @param Index a position index of the element.
  @return a requested element.
}
function TZUnmodifiableCollection.Get(Index: Integer): IZInterface;
begin
  Result := FCollection[Index];
end;

{**
  Gets a number of the stored element in this collection.
  @return a number of stored elements.
}
function TZUnmodifiableCollection.GetCount: Integer;
begin
  Result := FCollection.Count;
end;

{**
  Gets a created iterator for this collection.
  @return a created iterator for this collection.
}
function TZUnmodifiableCollection.GetIterator: IZIterator;
begin
  Result := TZIterator.Create(Self);
end;

{**
  Defines an index of the specified object inside this colleciton.
  @param Item an object to be found.
  @return an object position index or -1 if it was not found.
}
function TZUnmodifiableCollection.IndexOf(const Item: IZInterface): Integer;
begin
  Result := FCollection.IndexOf(Item);
end;

{**
  Inserts an object into specified position.
  @param Index a position index.
  @param Item an object to be inserted.
}
procedure TZUnmodifiableCollection.Insert(Index: Integer; const Item: IZInterface);
begin
  RaiseException;
end;

{**
  Gets the last object from this collection.
  @return the last object.
}
function TZUnmodifiableCollection.Last: IZInterface;
begin
  Result := FCollection.Last;
end;

{**
  Puts a specified object into defined position.
  @param Index a position index.
  @param Items ab object to be put.
}
procedure TZUnmodifiableCollection.Put(Index: Integer; const Item: IZInterface);
begin
  RaiseException;
end;

{**
  Removes an existed object which equals to the specified one.
  @param Item an object to be removed.
  @return an index of the removed object.
}
function TZUnmodifiableCollection.Remove(const Item: IZInterface): Integer;
begin
  Result := -1;
  RaiseException;
end;

{**
  Removes all the elements from the specified collection.
  @param Col a collection of object to be removed.
  @return <code>True</code> if this collection was changed.
}
function TZUnmodifiableCollection.RemoveAll(const Col: IZCollection): Boolean;
begin
  Result := False;
  RaiseException;
end;

{**
  Gets a RawUTF8 representation for this object.
}
function TZUnmodifiableCollection.ToUTF8: RawUTF8;
begin
  Result := FCollection.ToUTF8;
end;

{ TZHashMap }

{**
  Creates this hash map and assignes main properties.
}
constructor TZHashMap.Create;
begin
  inherited Create;
  FKeys := TZCollection.Create;
  FValues := TZCollection.Create;
  FReadOnlyKeys := TZUnmodifiableCollection.Create(FKeys);
  FReadOnlyValues := TZUnmodifiableCollection.Create(FValues);
end;

{**
  Destroys this object and frees the memory.
}
destructor TZHashMap.Destroy;
begin
  FReadOnlyKeys := nil;
  FReadOnlyValues := nil;
  FKeys := nil;
  FValues := nil;
  inherited Destroy;
end;

{**
  Clones the instance of this object.
  @return a reference to the clonned object.
}
function TZHashMap.Clone: IZInterface;
var
  HashMap: TZHashMap;
begin
  HashMap := TZHashMap.Create;
  HashMap.FKeys := IZCollection(FKeys.Clone);
  HashMap.FReadOnlyKeys := IZCollection(FReadOnlyKeys.Clone);
  HashMap.FValues := IZCollection(FValues.Clone);
  HashMap.FReadOnlyValues := IZCollection(FReadOnlyValues.Clone);
  Result := HashMap;
end;

{**
  Gets a interface by it's key.
  @param Key a key interface.
  @return a found value interface or <code>nil</code> otherwise.
}
function TZHashMap.Get(const Key: IZInterface): IZInterface;
var
  Index: Integer;
begin
  Index := FKeys.IndexOf(Key);
  if Index >= 0 then
    Result := FValues[Index]
   else
      Result := nil;
end;

{**
  Put a new key/value pair interfaces.
  @param Key a key interface.
  @param Value a value interface.
}
procedure TZHashMap.Put(const Key: IZInterface; const Value: IZInterface);
var
 Index: Integer;
begin
  Index := FKeys.IndexOf(Key);
  if Index >= 0 then
    FValues[Index] := Value
  else
  begin
    FKeys.Add(Key);
    FValues.Add(Value);
  end;
end;

{**
  Gets a readonly collection of keys.
  @return a readonly collection of keys.
}
function TZHashMap.GetKeys: IZCollection;
begin
  Result := FReadOnlyKeys;
end;

{**
  Gets a readonly collection of values.
  @return a readonly collection of values.
}
function TZHashMap.GetValues: IZCollection;
begin
  Result := FReadOnlyValues;
end;

{**
  Gets a number of elements in this hash map.
  @return a number of elements in this hash map.
}
function TZHashMap.GetCount: Integer;
begin
  Result := FKeys.Count;
end;

{**
  Removes the element from the map by it's key.
  @param Key a key of the element.
  @return <code>true</code> of the hash map was changed.
}
function TZHashMap.Remove(Key: IZInterface): Boolean;
var
  Index: Integer;
begin
  Index := FKeys.IndexOf(Key);
  if Index >= 0 then
  begin
    FKeys.Delete(Index);
    FValues.Delete(Index);
    Result := True;
   end
   else
    Result := False;
end;

{**
  Clears this hash map and removes all elements.
}
procedure TZHashMap.Clear;
begin
  FKeys.Clear;
  FValues.Clear;
end;

{ TZStack }

{**
  Constructs this object and assignes the main properties.
}
constructor TZStack.Create;
begin
  FValues := TZCollection.Create;
end;

{**
  Destroys this object and cleanups the memory.
}
destructor TZStack.Destroy;
begin
  FValues := nil;
  inherited Destroy;
end;

{**
  Clones the instance of this object.
  @return a reference to the clonned object.
}
function TZStack.Clone: IZInterface;
var
  Stack: TZStack;
begin
  Stack := TZStack.Create;
  Stack.FValues := IZCollection(FValues.Clone);
  Result := Stack;
end;

{**
  Gets a count of the stored elements.
  @return an elements count.
}
function TZStack.GetCount: Integer;
begin
  Result := FValues.Count;
end;

{**
  Gets an element from the top this stack without removing it.
  @return an element from the top of the stack.
}
function TZStack.Peek: IZInterface;
begin
  if FValues.Count > 0 then
    Result := FValues[FValues.Count - 1]
   else
      Result := nil;
end;

{**
  Gets an element from the top this stack and remove it.
  @return an element from the top of the stack.
}
function TZStack.Pop: IZInterface;
begin
  if FValues.Count > 0 then
  begin
    Result := FValues[FValues.Count - 1];
    FValues.Delete(FValues.Count - 1);
   end
   else
    Result := nil;
end;

{**
  Puts a new element to the top of this stack.
  @param Value a new element to be put.
}
procedure TZStack.Push(Value: IZInterface);
begin
  FValues.Add(Value);
end;

{**
  Gets a RawUTF8 representation for this object.
}
function TZStack.ToUTF8: RawUTF8;
begin
  Result := FValues.ToUTF8;
end;

end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZCompatibility.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{            Compatibility Classes and Functions          }
{                                                         }
{          Originally written by Sergey Seroukhov         }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZCompatibility;

interface

{$I ZCore.inc}

uses
  Variants,
{$IFDEF UNIX}
  {$IFDEF FPC}
    dl,
  {$ELSE}
    libc,
  {$ENDIF}
{$ENDIF}
  Classes, SysUtils, SynCommons;

type

{$IFDEF FPC}
  TVariantDynArray      = array of Variant;
  {$IFDEF CPU64}
  ULong                 = QWord;
  {$ELSE}
  ULong                 = LongWord;
  {$ENDIF}
  ULongLong             = QWord;
{$ELSE}
  ULong                 = LongWord;
  ULongLong             = Int64; //delphi dont have Unsigned Int64 type
{$ENDIF}
  PULong                = ^ULong;
  PULongLong            = ^ULongLong;

  UInt                  = LongWord;
  PUInt                 = ^UInt;

  TObjectDynArray       = array of TObject;

{$IFDEF FPC}
type
  TDBScreenCursor = (dcrDefault, dcrHourGlass, dcrSQLWait, dcrOther);

  IDBScreen = interface
    ['{29A1C508-6ADC-44CD-88DE-4F51B25D5995}']
    function GetCursor: TDBScreenCursor;
    procedure SetCursor(Cursor: TDBScreenCursor);

    property Cursor: TDBScreenCursor read GetCursor write SetCursor;
  end;

var
  LoginDialogProc: function (const ADatabaseName: string; var AUserName,
    APassword: string): Boolean;
  DBScreen: IDBScreen;
{$ENDIF}

{$IFNDEF FPC} // Delphi and Windows
const
  LineEnding = #13#10;
  Brackets: TSetOfAnsiChar =
    ['(',')','[',']','{','}'];
  StdWordDelims: TSetOfAnsiChar =
    [#0..' ',',','.',';','/','\',':','''','"','`','(',')','[',']','{','}'];

function AnsiProperCase(const S: RawUTF8; const WordDelims: TSetOfAnsiChar): RawUTF8;

{$ENDIF}

{$IFDEF UNIX}
  {$IFDEF FPC}
  const
    RTLD_GLOBAL = $101;
    INVALID_HANDLE_VALUE = 0;

  type
    HMODULE = PtrInt;

  function LoadLibrary(ModuleName: PChar): HMODULE;
  function FreeLibrary(Module: HMODULE): LongBool;
  function GetProcAddress(Module: HMODULE; Proc: PChar): Pointer;
  {$ENDIF}
{$ENDIF}

implementation

{$IFDEF UNIX}
  {$IFDEF FPC}
function LoadLibrary(ModuleName: PChar): HMODULE;
begin
  Result := HMODULE(dlopen(Modulename, RTLD_GLOBAL));
end;

function FreeLibrary(Module: HMODULE): LongBool;
begin
  Result := longbool(dlclose(pointer(Module)));
end;

function GetProcAddress(Module: HMODULE; Proc: PChar): Pointer;
begin
  Result := dlsym(pointer(Module), Proc);
end;
  {$ENDIF}
{$ENDIF}

{$IFNDEF FPC}
function AnsiProperCase(const S: RawUTF8; const WordDelims: TSetOfAnsiChar): RawUTF8;
var
  P, PE: PUTF8Char;
begin
  Result := LowerCase(S);
  if Result='' then
    exit;
  P := @Result[1]; // call UnicodeString(Result)
  PE := P+Length(Result);
  while (P<PE) do begin
    while (P<PE) and (P^ in WordDelims) do
      inc(P);
    if (P<PE) then
      P^ := UpCase(P^);
    while (P<PE) and not (P^ in WordDelims) do
      inc(P);
  end;
end;
{$ENDIF}

end.

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































































































































































































































































































Deleted zeos/core/ZCore.inc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

{$IFDEF LINUX}
  {$DEFINE UNIX}
{$ENDIF}

{$IFNDEF UNIX}
{$I ..\Zeos.inc}
{$ELSE}
{$I ../Zeos.inc}
{$ENDIF}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































Deleted zeos/core/ZExprParser.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{         Expression Parser classes and interfaces        }
{                                                         }
{         Originally written by Sergey Seroukhov          }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZExprParser;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses SysUtils, Classes, Contnrs, ZCompatibility, ZVariant,
  ZTokenizer, SynCommons;

type
  {** Define types of expression tokens. }
  TZExpressionTokenType = (
    ttUnknown, ttLeftBrace, ttRightBrace, ttLeftSquareBrace,
    ttRightSquareBrace, ttPlus, ttMinus, ttStar, ttSlash, ttProcent, ttPower,
    ttEqual, ttNotEqual, ttMore, ttLess, ttEqualMore, ttEqualLess,
    ttAnd, ttOr, ttXor, ttIs, ttNull, ttNot, ttLike, ttNotLike, ttIsNull,
    ttIsNotNull, ttComma, ttUnary, ttFunction, ttVariable, ttConstant
  );

  {** Defines a parser exception. }
  TZParseError = class (Exception);

  {** Defines an expression token holder. }
  TZExpressionToken = class (TObject)
  private
    FTokenType: TZExpressionTokenType;
    FValue: TZVariant;
  public
    constructor Create(TokenType: TZExpressionTokenType; const Value: TZVariant);

    property TokenType: TZExpressionTokenType read FTokenType write FTokenType;
    property Value: TZVariant read FValue write FValue;
  end;

  {** Implements an expression parser class. }
  TZExpressionParser = class (TObject)
  private
    FTokenizer: IZTokenizer;
    FExpression: RawUTF8;
    FInitialTokens: TObjectList;
    FTokenIndex: Integer;
    FResultTokens: TObjectList;
    FVariables: TRawUTF8List;

    function HasMoreTokens: Boolean;
    function GetToken: TZExpressionToken;
    function GetNextToken: TZExpressionToken;
    procedure ShiftToken;
    function CheckTokenTypes(
      TokenTypes: array of TZExpressionTokenType): Boolean;

    procedure TokenizeExpression;

    procedure SyntaxAnalyse;
    procedure SyntaxAnalyse1;
    procedure SyntaxAnalyse2;
    procedure SyntaxAnalyse3;
    procedure SyntaxAnalyse4;
    procedure SyntaxAnalyse5;
    procedure SyntaxAnalyse6;
  public
    constructor Create(Tokenizer: IZTokenizer);
    destructor Destroy; override;

    procedure Parse(const Expression: RawUTF8);
    procedure Clear;

    property Tokenizer: IZTokenizer read FTokenizer write FTokenizer;
    property Expression: RawUTF8 read FExpression write Parse;
    property ResultTokens: TObjectList read FResultTokens;
    property Variables: TRawUTF8List read FVariables;
  end;

implementation

uses ZSysUtils, ZMessages;

{ TZExpressionToken }

{**
  Creates an expression token object.
  @param TokenType a type of the token.
  @param Value a token value.
}
constructor TZExpressionToken.Create(TokenType: TZExpressionTokenType;
  const Value: TZVariant);
begin
  FTokenType := TokenType;
  FValue := Value;
end;

const
  {** Defines a list of operators. }
  OperatorTokens: array[0..24] of RawUTF8 = (
    '(', ')', '[', ']', '+', '-', '*', '/', '%', '^',
    '=', '<>', '!=', '>', '<', '>=', '<=',
    'AND', 'OR', 'XOR', 'NOT', 'IS', 'NULL', 'LIKE', ','
  );

  {** Defines a list of operator codes. }
  OperatorCodes: array[0..24] of TZExpressionTokenType = (
    ttLeftBrace, ttRightBrace, ttLeftSquareBrace, ttRightSquareBrace,
    ttPlus, ttMinus, ttStar, ttSlash, ttProcent, ttPower, ttEqual, ttNotEqual,
    ttNotEqual, ttMore, ttLess, ttEqualMore, ttEqualLess, ttAnd, ttOr, ttXor,
    ttNot, ttIs, ttNull, ttLike, ttComma
  );

{ TZExpressionParser }

{**
  Creates this expression parser object.
  @param Tokenizer an expression tokenizer.
}
constructor TZExpressionParser.Create(Tokenizer: IZTokenizer);
begin
  FTokenizer := Tokenizer;
  FExpression := '';
  FInitialTokens := TObjectList.Create;
  FTokenIndex := 0;
  FResultTokens := TObjectList.Create;
  FVariables := TRawUTF8List.Create;
end;

{**
  Destroyes this object and cleanups the memory.
}
destructor TZExpressionParser.Destroy;
begin
  inherited Destroy;
  FInitialTokens.Free;
  FResultTokens.Free;
  FVariables.Free;
end;

{**
  Clears parsing result.
}
procedure TZExpressionParser.Clear;
begin
  FExpression := '';
  FInitialTokens.Clear;
  FResultTokens.Clear;
  FTokenIndex := 0;
  FVariables.Clear;
end;

{**
  Sets a new expression string and parses it into internal byte code.
  @param expression a new expression string.
}
procedure TZExpressionParser.Parse(const Expression: RawUTF8);
begin
  Clear;
  FExpression := Trim(Expression);
  if FExpression <> '' then
  begin
    TokenizeExpression;
    SyntaxAnalyse;
    if HasMoreTokens then
    begin
      raise TZParseError.CreateResFmt(
        @SSyntaxErrorNear, [SoftVarManager.GetAsUTF8(GetToken.Value)]);
    end;
  end;
end;

{**
  Checks are there more tokens for processing.
  @return <code>TRUE</code> if some tokens are present.
}
function TZExpressionParser.HasMoreTokens: Boolean;
begin
  Result := FTokenIndex < FInitialTokens.Count;
end;

{**
  Gets the current token object.
  @param tokens a collection of tokens.
  @returns the current token object.
}
function TZExpressionParser.GetToken: TZExpressionToken;
begin
  if FTokenIndex < FInitialTokens.Count then
    Result := TZExpressionToken(FInitialTokens[FTokenIndex])
   else
      Result := nil;
end;

{**
  Gets the next token object.
  @param tokens a collection of tokens.
  @returns the next token object.
}
function TZExpressionParser.GetNextToken: TZExpressionToken;
begin
  if (FTokenIndex + 1) < FInitialTokens.Count then
    Result := TZExpressionToken(FInitialTokens[FTokenIndex + 1])
   else
      Result := nil;
end;

{**
  Shifts the current token object.
}
procedure TZExpressionParser.ShiftToken;
begin
  Inc(FTokenIndex);
end;

{**
  Checks available token types with token types from the list.
  If they match it shifts the tokens.
  @param TokenTypes a list of token types to compare.
  @return <code>True</code> if token types match.
}
function TZExpressionParser.CheckTokenTypes(
  TokenTypes: array of TZExpressionTokenType): Boolean;
var
  I: Integer;
  Temp: TZExpressionToken;
begin
  Result := False;
  for I := Low(TokenTypes) to High(TokenTypes) do
  begin
    if (FTokenIndex + I) < FInitialTokens.Count then
    begin
      Temp := TZExpressionToken(FInitialTokens[FTokenIndex + I]);
      Result := Temp.TokenType = TokenTypes[I];
      end
      else
      Result := False;

    if not Result then
      Break;
  end;
  if Result then
    Inc(FTokenIndex, Length(TokenTypes));
end;

{**
  Tokenizes the given expression and prepares an initial tokens list.
}
procedure TZExpressionParser.TokenizeExpression;
var
  I: Integer;
  TokenIndex: Integer;
  Temp: RawUTF8;
  Tokens: TRawUTF8List;
  TokenType: TZExpressionTokenType;
  TokenValue: TZVariant;
begin
  Tokens := FTokenizer.TokenizeBufferToList(FExpression,
    [toSkipWhitespaces, toSkipComments, toSkipEOF, toDecodeStrings]);
  try
    TokenIndex := 0;

    while TokenIndex < Tokens.Count do
    begin
      TokenType := ttUnknown;
      TokenValue := NullVariant;
      case TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
        Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF}) of
        ttKeyword:
          begin
            Temp := UpperCase(Tokens[TokenIndex]);
            if Temp = 'TRUE' then
            begin
              TokenType := ttConstant;
              TokenValue:= EncodeBoolean(True);
            end
            else if Temp = 'FALSE' then
            begin
              TokenType := ttConstant;
              TokenValue:= EncodeBoolean(False);
            end
            else
            begin
              for I := Low(OperatorTokens) to High(OperatorTokens) do
              begin
                if OperatorTokens[I] = Temp then
                begin
                  TokenType := OperatorCodes[I];
                  Break;
                end;
              end;
            end;
          end;
        ttWord:
          begin
            TokenType := ttVariable;
            Temp := Tokens[TokenIndex];
            if FVariables.IndexOf(Temp) < 0 then
              FVariables.Add(Temp);
            TokenValue:= EncodeUTF8(Temp);
          end;
        ttInteger:
          begin
            TokenType := ttConstant;
            TokenValue:= EncodeInteger(GetInteger(Pointer(Tokens[TokenIndex])));
          end;
        ttFloat:
          begin
            TokenType := ttConstant;
            TokenValue:= EncodeFloat(SqlStrToFloat(pointer(Tokens[TokenIndex])));
          end;
        ttQuoted:
          begin
            TokenType := ttConstant;
            TokenValue:= EncodeUTF8(Tokens[TokenIndex]);
          end;
        ttSymbol:
          begin
            Temp := Tokens[TokenIndex];
            for I := Low(OperatorTokens) to High(OperatorTokens) do
            begin
              if Temp = OperatorTokens[I] then
              begin
                TokenType := OperatorCodes[I];
                Break;
              end;
            end;
          end;
        ttTime,ttDate,ttDateTime:
          begin
            TokenType := ttConstant;
            TokenValue:= EncodeDateTime(Iso8601ToDateTime(Tokens[TokenIndex]));
          end;
      end;

      if TokenType = ttUnknown then
        raise TZParseError.CreateResFmt(@SUnknownSymbol, [Tokens[TokenIndex]]);

      Inc(TokenIndex);
      FInitialTokens.Add(TZExpressionToken.Create(TokenType, TokenValue));
    end;
  finally
    Tokens.Free;
  end;
end;

{**
  Performs a syntax analyze at level 0.
}
procedure TZExpressionParser.SyntaxAnalyse;
var
  Token: TZExpressionToken;
begin
  if not HasMoreTokens then
    raise TZParseError.CreateRes(@SUnexpectedExprEnd);

  SyntaxAnalyse1;
  while HasMoreTokens do
  begin
    Token := GetToken;
    if not (Token.TokenType in [ttAnd, ttOr, ttXor]) then
      Break;
    ShiftToken;
    SyntaxAnalyse1;
    FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
  end;
end;

{**
  Performs a syntax analyze at level 1.
}
procedure TZExpressionParser.SyntaxAnalyse1;
var
  Token: TZExpressionToken;
begin
  if not HasMoreTokens then
    raise TZParseError.CreateRes(@SUnexpectedExprEnd);

  Token := GetToken;
  if Token.TokenType = ttNot then
  begin
    ShiftToken;
    SyntaxAnalyse2;
    FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
   end
   else
    SyntaxAnalyse2;
end;

{**
  Performs a syntax analyze at level 2.
}
procedure TZExpressionParser.SyntaxAnalyse2;
var
  Token: TZExpressionToken;
begin
  if not HasMoreTokens then
    raise TZParseError.CreateRes(@SUnexpectedExprEnd);

  SyntaxAnalyse3;
  while HasMoreTokens do
  begin
    Token := GetToken;
    if not (Token.TokenType in [ttEqual, ttNotEqual, ttMore, ttLess,
      ttEqualMore, ttEqualLess]) then
      Break;
    ShiftToken;
    SyntaxAnalyse3;
    FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
  end;
end;

{**
  Performs a syntax analyze at level 3.
}
procedure TZExpressionParser.SyntaxAnalyse3;
var
  Token: TZExpressionToken;
begin
  if not HasMoreTokens then
    raise TZParseError.CreateRes(@SUnexpectedExprEnd);

  SyntaxAnalyse4;
  while HasMoreTokens do
  begin
    Token := GetToken;
    if Token.TokenType in [ttPlus, ttMinus, ttLike] then
    begin
      ShiftToken;
      SyntaxAnalyse4;
      FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
    end
    else if CheckTokenTypes([ttNot, ttLike]) then
    begin
      SyntaxAnalyse4;
      FResultTokens.Add(TZExpressionToken.Create(ttNotLike, NullVariant));
    end
    else if CheckTokenTypes([ttIs, ttNull]) then
    begin
      FResultTokens.Add(TZExpressionToken.Create(ttIsNull, NullVariant));
    end
    else if CheckTokenTypes([ttIs, ttNot, ttNull]) then
    begin
      FResultTokens.Add(TZExpressionToken.Create(ttIsNotNull, NullVariant));
      end
      else
      Break;
  end;
end;

{**
  Performs a syntax analyze at level 4.
}
procedure TZExpressionParser.SyntaxAnalyse4;
var
  Token: TZExpressionToken;
begin
  if not HasMoreTokens then
    raise TZParseError.CreateRes(@SUnexpectedExprEnd);

  SyntaxAnalyse5;
  while HasMoreTokens do
  begin
    Token := GetToken;
    if not (Token.TokenType in [ttStar, ttSlash, ttProcent]) then
      Break;
    ShiftToken;
    SyntaxAnalyse5;
    FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
  end;
end;

{**
  Performs a syntax analyze at level 5.
}
procedure TZExpressionParser.SyntaxAnalyse5;
var
  Token: TZExpressionToken;
begin
  if not HasMoreTokens then
    raise TZParseError.CreateRes(@SUnexpectedExprEnd);

  SyntaxAnalyse6;
  while HasMoreTokens do
  begin
    Token := GetToken;
    if Token.TokenType <> ttPower then
      Break;
    ShiftToken;
    SyntaxAnalyse6;
    FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
  end;
end;

{**
  Performs a syntax analyze at level 6.
}
procedure TZExpressionParser.SyntaxAnalyse6;
var
  ParamsCount: Integer;
  Unary, Token: TZExpressionToken;
  Primitive, NextToken: TZExpressionToken;
  Temp: TZVariant;
begin
  if not HasMoreTokens then
    raise TZParseError.CreateRes(@SUnexpectedExprEnd);

  Unary := GetToken;
  if Unary.TokenType = ttPlus then
  begin
    Unary := nil;
    ShiftToken;
  end
  else if Unary.TokenType = ttMinus then
  begin
    Unary.TokenType := ttUnary;
    ShiftToken;
   end
   else
    Unary := nil;

  if not HasMoreTokens then
    raise TZParseError.CreateRes(@SUnexpectedExprEnd);

  Primitive := GetToken;
  NextToken := GetNextToken;
  if (Primitive.TokenType = ttVariable) and (NextToken <> nil)
    and (NextToken.TokenType = ttLeftBrace) then
    Primitive.TokenType := ttFunction;

  if Primitive.TokenType in [ttConstant, ttVariable] then
  begin
    ShiftToken;
    FResultTokens.Add(TZExpressionToken.Create(
      Primitive.TokenType, Primitive.Value));
  end
  else if Primitive.TokenType = ttLeftBrace then
  begin
    ShiftToken;
    SyntaxAnalyse;
    if not HasMoreTokens then
      raise TZParseError.CreateRes(@SUnexpectedExprEnd);
    Primitive := GetToken;
    if Primitive.TokenType <> ttRightBrace then
      raise TZParseError.CreateRes(@SRightBraceExpected);
    ShiftToken;
  end
  else if Primitive.TokenType = ttFunction then
  begin
    ShiftToken;
    Token := GetToken;
    if Token.TokenType <> ttLeftBrace then
      raise TZParseError.CreateRes(@SInternalError);
    ParamsCount := 0;
    repeat
      ShiftToken;
      Token := GetToken;
      if (Token = nil) or (Token.TokenType = ttRightBrace) then
        Break;
      Inc(ParamsCount);
      SyntaxAnalyse;
      Token := GetToken;
    until (Token = nil) or (Token.TokenType <> ttComma);

    if not HasMoreTokens then
      raise TZParseError.CreateRes(@SUnexpectedExprEnd);
    if Token.TokenType <> ttRightBrace then
      raise TZParseError.CreateRes(@SRightBraceExpected);
    ShiftToken;

    Temp:= EncodeInteger(ParamsCount);
    FResultTokens.Add(TZExpressionToken.Create(ttConstant, Temp));
    FResultTokens.Add(TZExpressionToken.Create(Primitive.TokenType,
      Primitive.Value));
   end
   else
    raise TZParseError.CreateRes(@SSyntaxError);

  if Unary <> nil then
    FResultTokens.Add(TZExpressionToken.Create(Unary.TokenType, NullVariant));
end;

end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZExprToken.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{        String tokenizing classes for Expressions        }
{                                                         }
{          Originally written by Sergey Seroukhov         }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZExprToken;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  Classes, SysUtils, ZSysUtils, ZTokenizer, SynCommons;

type

  {** Implements an Expression-specific number state object. }
  TZExpressionNumberState = class (TZNumberState)
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
  end;

  {** Implements an Expression-specific quote string state object. }
  TZExpressionQuoteState = class (TZQuoteState)
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;

    function EncodeString(const Value: RawUTF8; QuoteChar: AnsiChar): RawUTF8; override;
    function DecodeString(const Value: RawUTF8; QuoteChar: AnsiChar): RawUTF8; override;
  end;

  {**
    This state will either delegate to a comment-handling
    state, or return a token with just a slash in it.
  }
  TZExpressionCommentState = class (TZCppCommentState)
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
  end;

  {** Implements a symbol state object. }
  TZExpressionSymbolState = class (TZSymbolState)
  public
    constructor Create;
  end;

  {** Implements a word state object. }
  TZExpressionWordState = class (TZWordState)
  public
    constructor Create;
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
  end;

  {** Implements a default tokenizer object. }
  TZExpressionTokenizer = class (TZTokenizer)
  public
    constructor Create;
  end;

implementation

const
  {** List of keywords. }
  Keywords: array [0..8] of RawUTF8 = (
    'AND','OR','NOT','XOR','LIKE','IS','NULL','TRUE','FALSE'
  );

{ TZExpressionNumberState }


//gto: all operations on Streams should be done without presuming the size
//     of the read var, like Stream.Read(LastChar, 1), to read 1 AnsiChar
//
//     Instead, operations should use SizeOf(Type), like this:
//     Stream.Read(LastChar, 1 * SizeOf(AnsiChar))
//
//     This is unicode safe and ansi (Delphi under 2009) compatible

{**
  Return a number token from a reader.
  @return a number token from a reader
}
function TZExpressionNumberState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  TempChar: RawUTF8;
  FloatPoint: Boolean;
  LastChar: RawUTF8;

  function ReadDecDigits: RawUTF8;
  begin
    Result := '';
    LastChar[1] := #0;
    while Stream.Read(Pointer(LastChar)^, 1 * SizeOf(AnsiChar)) > 0 do
    begin
      if LastChar[1] in ['0'..'9'] then
      begin
        Result := Result + LastChar;
        LastChar[1] := #0;
      end
      else
      begin
        Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
        Break;
      end;
    end;
  end;

begin
  FloatPoint := FirstChar = '.';
  Result.Value := FirstChar;
  Result.TokenType := ttUnknown;
  LastChar := #0;
  SetLength(TempChar,1);

  { Reads the first part of the number before decimal point }
  if not FloatPoint then
  begin
    Result.Value := Result.Value + ReadDecDigits;
    FloatPoint := LastChar[1] = '.';
    if FloatPoint then
    begin
      Stream.Read(Pointer(TempChar)^, 1 * SizeOf(AnsiChar));
      Result.Value := Result.Value + TempChar;
    end;
  end;

  { Reads the second part of the number after decimal point }
  if FloatPoint then
    Result.Value := Result.Value + ReadDecDigits;

  { Reads a power part of the number }
  if LastChar[1] in ['e','E'] then
  begin
    Stream.Read(Pointer(TempChar)^, 1 * SizeOf(AnsiChar));
    Result.Value := Result.Value + TempChar;
    FloatPoint := True;

    Stream.Read(Pointer(TempChar)^, 1 * SizeOf(AnsiChar));
    if TempChar[1] in ['0'..'9','-','+'] then
      Result.Value := Result.Value + TempChar + ReadDecDigits
    else
    begin
      Result.Value := Copy(Result.Value, 1, Length(Result.Value) - 1);
      Stream.Seek(-(2 * SizeOf(AnsiChar)), soFromCurrent);
    end;
  end;

  { Prepare the result }
  if Result.Value = '.' then
  begin
    if Tokenizer.SymbolState <> nil then
      Result := Tokenizer.SymbolState.NextToken(Stream, FirstChar, Tokenizer);
  end
  else
  begin
    if FloatPoint then
      Result.TokenType := ttFloat
      else
         Result.TokenType := ttInteger;
  end;
end;

{ TZExpressionSQLQuoteState }

{**
  Return a quoted string token from a reader. This method
  will collect characters until it sees a match to the
  character that the tokenizer used to switch to this state.

  @return a quoted string token from a reader
}
function TZExpressionQuoteState.NextToken(Stream: TStream;
  FirstChar: AnsiChar; Tokenizer: TZTokenizer): TZToken;
var
  ReadChar: RawUTF8;
  LastChar: AnsiChar;
begin
  if FirstChar = '"' then
    Result.TokenType := ttWord else
    Result.TokenType := ttQuoted;
  Result.Value := RawUTF8(FirstChar);
  LastChar := #0;
  SetLength(ReadChar,1);

  while Stream.Read(Pointer(ReadChar)^, 1 * SizeOf(AnsiChar)) > 0 do
  begin
    if (LastChar = FirstChar) and (ReadChar[1] <> FirstChar) then
    begin
      Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
      Break;
    end;
    Result.Value := Result.Value + ReadChar;
    if LastChar = '\' then
      LastChar := #0
    else if (LastChar = FirstChar) and (ReadChar[1] = FirstChar) then
      LastChar := #0 else
      LastChar := ReadChar[1];
  end;
end;

{**
  Encodes a string value.
  @param Value a string value to be encoded.
  @param QuoteChar a string quote character.
  @returns an encoded string.
}
function TZExpressionQuoteState.EncodeString(const Value: RawUTF8;
  QuoteChar: AnsiChar): RawUTF8;
begin
  if QuoteChar in ['''', '"'] then
    Result := RawUTF8(QuoteChar) + EncodeCString(Value) + RawUTF8(QuoteChar) else
    Result := Value;
end;

{**
  Decodes a string value.
  @param Value a string value to be decoded.
  @param QuoteChar a string quote character.
  @returns an decoded string.
}
function TZExpressionQuoteState.DecodeString(const Value: RawUTF8;
  QuoteChar: AnsiChar): RawUTF8;
begin
  if (Length(Value) >= 2) and (QuoteChar in ['''', '"'])
    and (Value[1] = QuoteChar) and (Value[Length(Value)] = QuoteChar) then
    Result := DecodeCString(Copy(Value, 2, Length(Value) - 2))
   else
      Result := Value;
end;

{ TZExpressionCommentState }

{**
  Gets an Expression specific comments like /* */.
  @return either just a slash token, or the results of
    delegating to a comment-handling state
}
function TZExpressionCommentState.NextToken(Stream: TStream;
  FirstChar: AnsiChar; Tokenizer: TZTokenizer): TZToken;
var
  ReadChar: AnsiChar;
  ReadNum: Integer;
begin
  Result.TokenType := ttUnknown;
  Result.Value := FirstChar;

  if FirstChar = '/' then
  begin
    ReadNum := Stream.Read(ReadChar, 1 * SizeOf(AnsiChar));
    if (ReadNum > 0) and (ReadChar = '*') then
    begin
      Result.TokenType := ttComment;
      Result.Value := '/*' + GetMultiLineComment(Stream);
    end
    else
    begin
      if ReadNum > 0 then
        Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
    end;
  end;

  if (Result.TokenType = ttUnknown) and (Tokenizer.SymbolState <> nil) then
    Result := Tokenizer.SymbolState.NextToken(Stream, FirstChar, Tokenizer);
end;

{ TZExpressionSymbolState }

{**
  Creates this Expression-specific symbol state object.
}
constructor TZExpressionSymbolState.Create;
begin
  inherited Create;
  Add('<=');
  Add('>=');
  Add('<>');
  Add('!=');
end;

{ TZExpressionWordState }

{**
  Constructs this Expression-specific word state object.
}
constructor TZExpressionWordState.Create;
begin
  SetWordChars('a', 'z', True);
  SetWordChars('A', 'Z', True);
  SetWordChars('0', '9', True);
  include(FWordChars,'_');
  SetWordChars(AnsiChar($80), AnsiChar($ff), True); // all UTF-8 not ASCII chars
end;

{**
  Gets a word tokens or special operators.
  @return a processed token.
}
function TZExpressionWordState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  I: Integer;
  Temp: RawUTF8;
begin
  Result := inherited NextToken(Stream, FirstChar, Tokenizer);
  Temp := UpperCase(Result.Value);
  for I := Low(Keywords) to High(Keywords) do
  begin
    if Temp = Keywords[I] then
    begin
      Result.TokenType := ttKeyword;
      Break;
    end;
  end;
end;

{ TZExpressionTokenizer }

{**
  Constructs a tokenizer with a default state table (as
  described in the class comment).
}
constructor TZExpressionTokenizer.Create;
begin
  WhitespaceState := TZWhitespaceState.Create;

  SymbolState := TZExpressionSymbolState.Create;
  NumberState := TZExpressionNumberState.Create;
  QuoteState := TZExpressionQuoteState.Create;
  WordState := TZExpressionWordState.Create;
  CommentState := TZExpressionCommentState.Create;

  SetCharacterState(#0, #255, SymbolState);
  SetCharacterState(#0, ' ', WhitespaceState);

  SetCharacterState('a', 'z', WordState);
  SetCharacterState('A', 'Z', WordState);
  SetCharacterState(Chr($c0),  Chr($ff), WordState); //chars from #192 () ~ 255 ()
  SetCharacterState('_', '_', WordState);

  SetCharacterState('0', '9', NumberState);
  SetCharacterState('.', '.', NumberState);

  SetCharacterState('"', '"', QuoteState);
  SetCharacterState('''', '''', QuoteState);

  SetCharacterState('/', '/', CommentState);
end;

end.

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZExpression.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Expression classes and interfaces           }
{                                                         }
{          Originally written by Sergey Seroukhov         }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZExpression;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses SysUtils, Classes,
  ZClasses, ZCompatibility, ZVariant, ZTokenizer, ZExprParser, SynCommons;

type
  {** Defines an expression exception. }
  TZExpressionError = class (Exception);

  {** Defines an execution stack object. }
  TZExecutionStack = class (TObject)
  private
    FValues: TZVariantDynArray;
    FCount: Integer;
    FCapacity: Integer;

    function GetValue(Index: Integer): TZVariant;
  public
    constructor Create;

    procedure DecStackPointer(const Value : integer);
    function Pop: TZVariant;
    function Peek: TZVariant;
    procedure Push(Value: TZVariant);
    function GetParameter(Index: Integer): TZVariant;
    procedure Swap;

    procedure Clear;

    property Count: Integer read FCount;
    property Values[Index: Integer]: TZVariant read GetValue;
  end;

  {** Defines a list of variables. }
  IZVariablesList = interface (IZInterface)
    ['{F4347F46-32F3-4021-B6DB-7A39BF171275}']

    function GetCount: Integer;
    function GetName(Index: Integer): RawUTF8;
    function GetValue(Index: Integer): TZVariant;
    procedure SetValue(Index: Integer; const Value: TZVariant);
    function GetValueByName(const Name: RawUTF8): TZVariant;
    procedure SetValueByName(const Name: RawUTF8; const Value: TZVariant);

    procedure Add(const Name: RawUTF8; const Value: TZVariant);
    procedure Remove(const Name: RawUTF8);
    function FindByName(const Name: RawUTF8): Integer;

    procedure ClearValues;
    procedure Clear;

    property Count: Integer read GetCount;
    property Names[Index: Integer]: RawUTF8 read GetName;
    property Values[Index: Integer]: TZVariant read GetValue write SetValue;
    property NamedValues[const Index: RawUTF8]: TZVariant read GetValueByName
      write SetValueByName;
  end;

  {** Defines a function interface. }
  IZFunction = interface (IZInterface)
    ['{E9B3AFF9-6CD9-49C8-AB66-C8CF60ED8686}']

    function GetName: RawUTF8;

    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant;

    property Name: RawUTF8 read GetName;
  end;

  {** Defines a list of functions. }
  IZFunctionsList = interface (IZInterface)
    ['{54453054-F012-475B-84C3-7E5C46187FDB}']

    function GetCount: Integer;
    function GetName(Index: Integer): RawUTF8;
    function GetFunction(Index: Integer): IZFunction;

    procedure Add(Func: IZFunction);
    procedure Remove(const Name: RawUTF8);
    function FindByName(const Name: RawUTF8): Integer;
    procedure Clear;

    property Count: Integer read GetCount;
    property Names[Index: Integer]: RawUTF8 read GetName;
    property Functions[Index: Integer]: IZFunction read GetFunction;
  end;

  {** Defines an interface to expression calculator. }
  IZExpression = interface (IZInterface)
    ['{26F9D379-5618-446C-8999-D50FBB2F8560}']

    function GetTokenizer: IZTokenizer;
    procedure SetTokenizer(Value: IZTokenizer);
    function GetExpression: RawUTF8;
    procedure SetExpression(const Value: RawUTF8);
    function GetVariantManager: IZVariantManager;
    procedure SetVariantManager(Value: IZVariantManager);
    function GetDefaultVariables: IZVariablesList;
    procedure SetDefaultVariables(Value: IZVariablesList);
    function GetDefaultFunctions: IZFunctionsList;
    procedure SetDefaultFunctions(Value: IZFunctionsList);
    function GetAutoVariables: Boolean;
    procedure SetAutoVariables(Value: Boolean);

    function Evaluate: TZVariant;
    function Evaluate2(Variables: IZVariablesList): TZVariant;
    function Evaluate3(Variables: IZVariablesList;
      Functions: IZFunctionsList): TZVariant;
    function Evaluate4(Variables: IZVariablesList;
      Functions: IZFunctionsList; Stack: TZExecutionStack): TZVariant;

    procedure CreateVariables(Variables: IZVariablesList);
    procedure Clear;

    property Tokenizer: IZTokenizer read GetTokenizer write SetTokenizer;
    property Expression: RawUTF8 read GetExpression write SetExpression;
    property VariantManager: IZVariantManager read GetVariantManager
      write SetVariantManager;
    property DefaultVariables: IZVariablesList read GetDefaultVariables
      write SetDefaultVariables;
    property DefaultFunctions: IZFunctionsList read GetDefaultFunctions
      write SetDefaultFunctions;
    property AutoVariables: Boolean read GetAutoVariables
      write SetAutoVariables;
  end;

  {** Implements an expression calculator class. }
  TZExpression = class (TInterfacedObject, IZExpression)
  private
    FTokenizer: IZTokenizer;
    FDefaultVariables: IZVariablesList;
    FDefaultFunctions: IZFunctionsList;
    FVariantManager: IZVariantManager;
    FParser: TZExpressionParser;
    FAutoVariables: Boolean;

    function GetTokenizer: IZTokenizer;
    procedure SetTokenizer(Value: IZTokenizer);
    function GetExpression: RawUTF8;
    procedure SetExpression(const Value: RawUTF8);
    function GetVariantManager: IZVariantManager;
    procedure SetVariantManager(Value: IZVariantManager);
    function GetDefaultVariables: IZVariablesList;
    procedure SetDefaultVariables(Value: IZVariablesList);
    function GetDefaultFunctions: IZFunctionsList;
    procedure SetDefaultFunctions(Value: IZFunctionsList);
    function GetAutoVariables: Boolean;
    procedure SetAutoVariables(Value: Boolean);
  public
    constructor Create;
    constructor CreateWithExpression(const Expression: RawUTF8);
    destructor Destroy; override;

    function Evaluate: TZVariant;
    function Evaluate2(Variables: IZVariablesList): TZVariant;
    function Evaluate3(Variables: IZVariablesList;
      Functions: IZFunctionsList): TZVariant;
    function Evaluate4(Variables: IZVariablesList;
      Functions: IZFunctionsList; Stack: TZExecutionStack): TZVariant;

    procedure CreateVariables(Variables: IZVariablesList);
    procedure Clear;

    property Expression: RawUTF8 read GetExpression write SetExpression;
    property VariantManager: IZVariantManager read GetVariantManager
      write SetVariantManager;
    property DefaultVariables: IZVariablesList read GetDefaultVariables
      write SetDefaultVariables;
    property DefaultFunctions: IZFunctionsList read GetDefaultFunctions
      write SetDefaultFunctions;
    property AutoVariables: Boolean read GetAutoVariables
      write SetAutoVariables;
  end;

implementation

uses
  ZMessages, ZExprToken, ZVariables, ZFunctions, ZMatchPattern;

{ TZExecutionStack }

{**
  Creates this object.
}
constructor TZExecutionStack.Create;
begin
  FCapacity := 100;
  SetLength(FValues, FCapacity);
  FCount := 0;
end;

{**
  Gets a value from absolute position in the stack.
  @param Index a value index.
  @returns a variant value from requested position.
}
function TZExecutionStack.GetValue(Index: Integer): TZVariant;
begin
  Result := FValues[Index];
end;

{**
  Gets a value from the top of the stack without removing it.
  @returns a value from the top.
}
function TZExecutionStack.Peek: TZVariant;
begin
  if FCount > 0 then
    Result := FValues[FCount - 1]
  else Result := NullVariant;
end;

{**
  Gets a function parameter by index.
  @param a function parameter index. O is used for parameter count.
  @returns a parameter value.
}
function TZExecutionStack.GetParameter(Index: Integer): TZVariant;
begin
  if FCount <= Index then
    raise TZExpressionError.CreateRes(@SStackIsEmpty);
  Result := FValues[FCount - Index - 1];
end;

procedure TZExecutionStack.DecStackPointer(const Value : integer);
begin
  Dec(FCount, Value);
  if FCount < 0 then
  begin
    FCount := 0;
    raise TZExpressionError.CreateRes(@SStackIsEmpty);
  end;
end;

{**
  Gets a value from the top and removes it from the stack.
  @returns a value from the top.
}
function TZExecutionStack.Pop: TZVariant;
begin
  Result := NullVariant;
  if FCount <= 0 then
    raise TZExpressionError.CreateRes(@SStackIsEmpty);
  Dec(FCount);
  Result := FValues[FCount];
end;

{**
  Puts a value to the top of the stack.
}
procedure TZExecutionStack.Push(Value: TZVariant);
begin
  if FCapacity = FCount then
  begin
    Inc(FCapacity, 64);
    SetLength(FValues, FCapacity);
  end;
  DefVarManager.Assign(Value, FValues[FCount]);
  Inc(FCount);
end;

{**
  Swaps two values on the top of the stack.
}
procedure TZExecutionStack.Swap;
var
  Temp: TZVariant;
begin
  if FCount <= 1 then
    raise TZExpressionError.CreateRes(@SStackIsEmpty);
  Temp := FValues[FCount - 1];
  FValues[FCount - 1] := FValues[FCount - 2];
  FValues[FCount - 2] := Temp;
end;

{**
  Clears this stack.
}
procedure TZExecutionStack.Clear;
begin
  FCount := 0;
end;

{ TZExpression }

{**
  Creates this expression calculator object.
}
constructor TZExpression.Create;
begin
  FTokenizer := TZExpressionTokenizer.Create;
  FDefaultVariables := TZVariablesList.Create;
  FDefaultFunctions := TZDefaultFunctionsList.Create;
  FVariantManager := TZSoftVariantManager.Create;
  FParser := TZExpressionParser.Create(FTokenizer);
  FAutoVariables := True;
end;

{**
  Creates this expression calculator and assignes expression string.
  @param Expression an expression string.
}
constructor TZExpression.CreateWithExpression(const Expression: RawUTF8);
begin
  Create;
  SetExpression(Expression);
end;

{**
  Destroys this object and cleanups the memory.
}
destructor TZExpression.Destroy;
begin
  FTokenizer := nil;
  FDefaultVariables := nil;
  FDefaultFunctions := nil;
  FVariantManager := nil;
  FParser.Free;

  inherited Destroy;
end;

{**
  Gets the current auto variables create flag.
  @returns the auto variables create flag.
}
function TZExpression.GetAutoVariables: Boolean;
begin
  Result := FAutoVariables;
end;

{**
  Sets a new auto variables create flag.
  @param value a new auto variables create flag.
}
procedure TZExpression.SetAutoVariables(Value: Boolean);
begin
  FAutoVariables := Value;
end;

{**
  Gets a list of default functions.
  @returns a list of default functions.
}
function TZExpression.GetDefaultFunctions: IZFunctionsList;
begin
  Result := FDefaultFunctions;
end;

{**
  Sets a new list of functions.
  @param Value a new list of functions.
}
procedure TZExpression.SetDefaultFunctions(Value: IZFunctionsList);
begin
  FDefaultFunctions := Value;
end;

{**
  Gets a list of default variables.
  @returns a list of default variables.
}
function TZExpression.GetDefaultVariables: IZVariablesList;
begin
  Result := FDefaultVariables;
end;

{**
  Sets a new list of variables.
  @param Value a new list of variables.
}
procedure TZExpression.SetDefaultVariables(Value: IZVariablesList);
begin
  FDefaultVariables := Value;
end;

{**
  Gets the current set expression string.
  @returns the current expression string.
}
function TZExpression.GetExpression: RawUTF8;
begin
  Result := FParser.Expression;
end;

{**
  Sets a new expression string.
  @param Value a new expression string.
}
procedure TZExpression.SetExpression(const Value: RawUTF8);
begin
  FParser.Expression := Value;
  if FAutoVariables then
    CreateVariables(FDefaultVariables);
end;

{**
  Gets a reference to the current variant manager.
  @returns a reference to the current variant manager.
}
function TZExpression.GetVariantManager: IZVariantManager;
begin
  Result := FVariantManager;
end;

{**
  Sets a new variant manager.
  @param Value a new variant manager.
}
procedure TZExpression.SetVariantManager(Value: IZVariantManager);
begin
  FVariantManager := Value;
end;

{**
  Gets the current expression tokenizer.
  @returns the current expression tokenizer.
}
function TZExpression.GetTokenizer: IZTokenizer;
begin
  Result := FTokenizer;
end;

{**
  Sets a new expression tokenizer.
  @param Value a new expression tokenizer.
}
procedure TZExpression.SetTokenizer(Value: IZTokenizer);
begin
  FTokenizer := Value;
  FParser.Tokenizer := Value;
end;

{**
  Clears this class from all data.
}
procedure TZExpression.Clear;
begin
  FParser.Clear;
  FDefaultVariables.Clear;
end;

{**
  Creates an empty variables.
  @param Variables a list of variables.
}
procedure TZExpression.CreateVariables(Variables: IZVariablesList);
var
  I: Integer;
  Name: RawUTF8;
begin
  for I := 0 to FParser.Variables.Count - 1 do
  begin
    Name := FParser.Variables[I];
    if Variables.FindByName(Name) < 0 then
      Variables.Add(Name, NullVariant);
  end;
end;

{**
  Evaluates this expression.
  @returns an evaluated expression value.
}
function TZExpression.Evaluate: TZVariant;
begin
  Result := Evaluate3(FDefaultVariables, FDefaultFunctions);
end;

{**
  Evaluates this expression.
  @param Variables a list of variables.
  @returns an evaluated expression value.
}
function TZExpression.Evaluate2(Variables: IZVariablesList): TZVariant;
begin
  Result := Evaluate3(Variables, FDefaultFunctions);
end;

{**
  Evaluates this expression.
  @param Variables a list of variables.
  @param Functions a list of functions.
  @returns an evaluated expression value.
}
function TZExpression.Evaluate3(Variables: IZVariablesList;
  Functions: IZFunctionsList): TZVariant;
var
  Stack: TZExecutionStack;
begin
  Stack := TZExecutionStack.Create;
  try
    Result := Evaluate4(Variables, Functions, Stack);
  finally
    Stack.Free;
  end;
end;

{**
  Evaluates this expression.
  @param Variables a list of variables.
  @param Functions a list of functions.
  @param Stack an execution stack.
  @returns an evaluated expression value.
}
function TZExpression.Evaluate4(Variables: IZVariablesList;
  Functions: IZFunctionsList; Stack: TZExecutionStack): TZVariant;
var
  I, Index, ParamsCount: Integer;
  Current: TZExpressionToken;
  Value1, Value2: TZVariant;
begin
  Stack.Clear;

  for I := 0 to FParser.ResultTokens.Count - 1 do
  begin
    Current := TZExpressionToken(FParser.ResultTokens[I]);
    case Current.TokenType of
      ttConstant:
        Stack.Push(Current.Value);
      ttVariable:
        begin
          if Current.Value.VType = vtUTF8 then
          begin
            Index := Variables.FindByName(Current.Value.VUTF8);
            if Index < 0 then
            begin
              raise TZExpressionError.CreateResFmt(
                @SVariableWasNotFound, [Current.Value.VUTF8]);
            end;
           Current.Value := EncodeInteger(Index);
          end;
          if Current.Value.VType = vtInteger then
            Stack.Push(Variables.Values[Current.Value.VInteger])
          else
            raise TZExpressionError.CreateResFmt(
                @SSyntaxErrorNear, [SoftVarManager.GetAsUTF8(Current.Value)]);
        end;
      ttFunction:
        begin
          if Current.Value.VType = vtUTF8 then
          begin
            Index := Functions.FindByName(Current.Value.VUTF8);
            if Index < 0 then
            begin
              raise TZExpressionError.CreateResFmt(
                @SFunctionWasNotFound, [Current.Value.VUTF8]);
            end;
            Current.Value := EncodeInterface(Functions.Functions[Index]);
          end;
          if Current.Value.VType = vtInterface then
          begin
            Value1 := IZFunction(Current.Value.VInterface).Execute(Stack, FVariantManager);
            ParamsCount := DefVarManager.GetAsInteger(Stack.Pop);
            Stack.DecStackPointer(ParamsCount);
            Stack.Push(Value1);
          end
          else
            raise TZExpressionError.CreateResFmt(
                @SSyntaxErrorNear, [SoftVarManager.GetAsUTF8(Current.Value)]);
        end;
      ttAnd:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpAnd(Value1, Value2));
        end;
      ttOr:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpOr(Value1, Value2));
        end;
      ttXor:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpXor(Value1, Value2));
        end;
      ttNot:
        Stack.Push(FVariantManager.OpNot(Stack.Pop));
      ttPlus:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpAdd(Value1, Value2));
        end;
      ttMinus:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpSub(Value1, Value2));
        end;
      ttStar:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpMul(Value1, Value2));
        end;
      ttSlash:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpDiv(Value1, Value2));
        end;
      ttProcent:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpMod(Value1, Value2));
        end;
      ttEqual:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpEqual(Value1, Value2));
        end;
      ttNotEqual:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpNotEqual(Value1, Value2));
        end;
      ttMore:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpMore(Value1, Value2));
        end;
      ttLess:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpLess(Value1, Value2));
        end;
      ttEqualMore:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpMoreEqual(Value1, Value2));
        end;
      ttEqualLess:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpLessEqual(Value1, Value2));
        end;
      ttPower:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(FVariantManager.OpPow(Value1, Value2));
        end;
      ttUnary:
        Stack.Push(FVariantManager.OpNegative(Stack.Pop));
      ttLike:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(EncodeBoolean(
                       IsMatch(FVariantManager.GetAsUTF8(Value2),
                               FVariantManager.GetAsUTF8(Value1))));
        end;
      ttNotLike:
        begin
          Value2 := Stack.Pop;
          Value1 := Stack.Pop;
          Stack.Push(EncodeBoolean(
                       not IsMatch(FVariantManager.GetAsUTF8(Value2),
                                   FVariantManager.GetAsUTF8(Value1))));
        end;
      ttIsNull:
        begin
          Value1 := Stack.Pop;
          Stack.Push(EncodeBoolean(FVariantManager.IsNull(Value1)));
        end;
      ttIsNotNull:
        begin
          Value1 := Stack.Pop;
          Stack.Push(EncodeBoolean(not FVariantManager.IsNull(Value1)));
        end;
      else
        raise TZExpressionError.CreateRes(@SInternalError);
    end;
  end;

  if Stack.Count <> 1 then
    raise TZExpressionError.CreateRes(@SInternalError);
  Result := Stack.Pop;
end;

end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZFunctions.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Variables classes and interfaces            }
{                                                         }
{           Originally written by Sergey Seroukhov        }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZFunctions;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses SysUtils, Classes, ZClasses, ZCollections, ZCompatibility, ZVariant,
  ZExpression, SynCommons;

type

  {** Implements a list of functions. }

  { TZFunctionsList }

  TZFunctionsList = class (TInterfacedObject, IZFunctionsList)
  private
    FFunctions: IZCollection;
    FCapacity : Integer;
    FKeys     : array of cardinal;

    procedure SetKeyCapacity(const NewCapacity : Integer);
    procedure SetKey(const aKey : cardinal; const aPosition : Integer); {$ifdef HASINLINE}inline;{$endif}
    procedure RegenerateKey(const aPosition : Integer);
    procedure RegenerateKeys;
  protected
    property Functions: IZCollection read FFunctions write FFunctions;
    function FindByKeyAndName(const aKey : cardinal; const aName: RawUTF8): Integer;
  public
    constructor Create;
    destructor Destroy; override;

    function GetCount: Integer;
    function GetName(Index: Integer): RawUTF8;
    function GetFunction(Index: Integer): IZFunction;

    procedure Add(Func: IZFunction);
    procedure Remove(const Name: RawUTF8);
    function FindByName(const Name: RawUTF8): Integer;

    procedure Clear;
  end;

  {** Implements an abstract function. }

  { TZAbstractFunction }

  TZAbstractFunction = class (TInterfacedObject, IZFunction)
  private
    FName: RawUTF8;
  protected
    function GetName: RawUTF8;
    function CheckParamsCount(Stack: TZExecutionStack;
      ExpectedCount: Integer): Integer;
  public
    constructor Create(aName : RawUTF8);
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; virtual; abstract;

    property Name: RawUTF8 read GetName;
  end;

  {** Implements a default function list. }
  TZDefaultFunctionsList = class (TZFunctionsList)
  public
    constructor Create;
  end;



  
implementation

uses ZMessages, ZFunctionsMath, ZFunctionsDateTime, ZFunctionsStrings,
     ZFunctionsConvert, ZFunctionsOther;

{ TZFunctionsList }

{**
  Constructs this object.
}
constructor TZFunctionsList.Create;
begin
  FFunctions := TZCollection.Create;
  SetKeyCapacity(0);
end;

{**
  Destroys this object and cleanup the memory.
}
destructor TZFunctionsList.Destroy;
begin
  SetKeyCapacity(0);
  FFunctions := nil;
  inherited Destroy;
end;

{**
  Sets the capacity of the internal Keystorage.
}
procedure TZFunctionsList.SetKeyCapacity(const NewCapacity : Integer);
begin
  if NewCapacity <> FCapacity then
  begin
    SetLength(FKeys, NewCapacity);
    FCapacity := NewCapacity;
  end;
end;

{**
  Sets a key to the Keystorage
}
procedure TZFunctionsList.SetKey(const aKey: cardinal; const aPosition: Integer);
begin
  if aPosition >= FCapacity then
    SetKeyCapacity(FCapacity+32);
  FKeys[aPosition] := aKey
end;

{**
  Regenerates a given key
}
procedure TZFunctionsList.RegenerateKey(const aPosition : Integer);
begin
  SetKey(Hash32((FFunctions[aPosition] as IZFunction).Name), aPosition);
end;

{**
  Regenerates all keys
}
procedure TZFunctionsList.RegenerateKeys;
var
  I: Integer;
begin
  SetKeyCapacity(0);
  for I := 0 to FFunctions.Count - 1 do
    RegenerateKey(i);
end;

{**
  Finds a function reference by its Name and Hashkey
}
function TZFunctionsList.FindByKeyAndName(const aKey: cardinal; const aName: RawUTF8): Integer;
begin
  for result := 0 to FFunctions.Count - 1 do
    if (aKey=FKeys[result]) and (aName=(FFunctions[result] as IZFunction).Name) then
      exit;
  result := -1;
end;

{**
  Finds a function reference
}
function TZFunctionsList.FindByName(const Name: RawUTF8): Integer;
var
  aName: RawUTF8;
begin
  aName := Uppercase(Name);
  Result := FindByKeyAndName(Hash32(aName), aName);
end;

{**
  Adds a new function to this list.
  @param Func a function reference.
}
procedure TZFunctionsList.Add(Func: IZFunction);
var
  Index: Integer;
  aKey : cardinal;
  aName: RawUTF8;

begin
  aName := Uppercase(Func.Name);
  aKey  := Hash32(aName);
  Index := FindByKeyAndName(aKey, aName);
  if Index < 0 then
  begin
    FFunctions.Add(Func);
    SetKey(aKey, FFunctions.Count-1);
  end
  else
    raise TZExpressionError.CreateResFmt(@sFunctionAlreadyDefined,[Func.Name]);
end;

{**
  Removes a reference to a function by it's name.
  @param Name a name of the function to be removed.
}
procedure TZFunctionsList.Remove(const Name: RawUTF8);
var
  Index: Integer;
begin
  Index := FindByName(Name);
  if Index >= 0 then
  begin
    FFunctions.Delete(Index);
    RegenerateKeys;
  end;
end;

{**
  Cleans the list of registered functions.
}
procedure TZFunctionsList.Clear;
begin
  FFunctions.Clear;
  SetKeyCapacity(0);
end;

{**
  Gets a number of registered functions.
  @returns a number of registered functions.
}
function TZFunctionsList.GetCount: Integer;
begin
  Result := FFunctions.Count;
end;

{**
  Gets a function reference by it's index.
  @param Index a function index.
  @returns a function reference.
}
function TZFunctionsList.GetFunction(Index: Integer): IZFunction;
begin
  Result := FFunctions[Index] as IZFunction;
end;

{**
  Gets a name of the functions by it's index.
  @param Index a functon index.
  @returns a name of the function.
}
function TZFunctionsList.GetName(Index: Integer): RawUTF8;
begin
  Result := (FFunctions[Index] as IZFunction).Name;
end;

{ TZDefaultFunctionsList }

{**
  Constructs a default functions list and adds all available
  standard functions.
}
constructor TZDefaultFunctionsList.Create;
begin
  inherited Create;
  AddMathFunctions(Self);
  AddStringFunctions(Self);
  AddConvertFunctions(Self);
  AddOtherFunctions(Self);
  AddDateTimeFunctions(Self);
end;

{ TZAbstractFunction }

{**
  Creates the function with a user defined name.
}
constructor TZAbstractFunction.Create(aName : RawUTF8);
begin
  inherited Create;
  FName := UpperCase(aName);
end;

{**
  Gets the assigned function name.
  @returns the assigned function name.
}
function TZAbstractFunction.GetName: RawUTF8;
begin
  Result := FName;
end;

{**
  Checks the function parameter count number.
  @param Stack a stack object.
  @param ExpectedCount a number of expected parameters.
  @returns a real number of parameters.
}
function TZAbstractFunction.CheckParamsCount(Stack: TZExecutionStack;
  ExpectedCount: Integer): Integer;
begin
  Result := DefVarManager.GetAsInteger(Stack.GetParameter(0));
  if Result <> ExpectedCount then
  begin
    raise TZExpressionError.CreateResFmt(@SParametersError,
      [ExpectedCount, Result]);
  end;
end;

end.

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZFunctionsConvert.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Variables classes and interfaces            }
{                                                         }
{           Originally written by Sergey Seroukhov        }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZFunctionsConvert;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  SysUtils, ZClasses, ZFunctions, ZExpression, ZVariant, SynCommons;

{**  Conversion functions }

type

{**  Str <> Float}
  {** Implements a VAL function. }
  TZValFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{**  Str <> Date}
  {** Implements a CTOD function. }
  TZCtodFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a DTOS function. }
  TZDtosFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a DTOS function. }
  TZFormatDateTimeFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

procedure AddConvertFunctions(Functions : TZFunctionsList);


implementation

{var
  InternalDefaultFormatSettings: TFormatSettings;

{*******
    DefaultFormatSettings : TFormatSettings = (
    CurrencyFormat: 1;
    NegCurrFormat: 5;
    ThousandSeparator: ',';
    DecimalSeparator: '.';
    CurrencyDecimals: 2;
    DateSeparator: '-';
    TimeSeparator: ':';
    ListSeparator: ',';
    CurrencyString: '$';
    ShortDateFormat: 'd/m/y';
    LongDateFormat: 'dd" "mmmm" "yyyy';
    TimeAMString: 'AM';
    TimePMString: 'PM';
    ShortTimeFormat: 'hh:nn';
    LongTimeFormat: 'hh:nn:ss';
    ShortMonthNames: ('Jan','Feb','Mar','Apr','May','Jun',
                      'Jul','Aug','Sep','Oct','Nov','Dec');
    LongMonthNames: ('January','February','March','April','May','June',
                     'July','August','September','October','November','December');
    ShortDayNames: ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    LongDayNames:  ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
    TwoDigitYearCenturyWindow: 50;
  );
******}

 { TZValFunction }

function TZValFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result,
    GetExtended(pointer(Stack.GetParameter(1).VUTF8)));
  //StrToFloatDef(Stack.GetParameter(1).VString, 0, InternalDefaultFormatSettings));
end;

{ TZCtodFunction }

function TZCtodFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsDateTime(Result,
    GetExtended(pointer(Stack.GetParameter(1).VUTF8)));
end;

{ TZDtosFunction }

function TZDtosFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsUTF8(Result,
    DateToIso8601(Stack.GetParameter(1).VDateTime,false));
    // FormatDateTime('yyyymmdd', Value.VDateTime)); -> Expanded=false
end;

{ TZFormatDateTimeFunction }

function TZFormatDateTimeFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsUTF8(Result, StringToUTF8(
    FormatDateTime(UTF8ToString(Stack.GetParameter(2).VUTF8),
      Stack.GetParameter(1).VDateTime)));
end;

procedure AddConvertFunctions(Functions : TZFunctionsList);
begin
  Functions.Add(TZValFunction.Create('VAL'));
  Functions.Add(TZDtosFunction.Create('DTOS'));
  Functions.Add(TZCtodFunction.Create('CTOD'));
  Functions.Add(TZFormatDateTimeFunction.Create('FORMATDATETIME'));
end;

initialization
//  InternalDefaultFormatSettings := DefaultFormatSettings;
//  InternalDefaultFormatSettings.ThousandSeparator   := ',';
//  InternalDefaultFormatSettings.DecimalSeparator    := '.';
end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
























































































































































































































































































































































































Deleted zeos/core/ZFunctionsDateTime.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Variables classes and interfaces            }
{                                                         }
{           Originally written by Sergey Seroukhov        }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZFunctionsDateTime;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  SysUtils, ZClasses, ZFunctions, ZExpression, ZVariant;

{** Date & time functions}

type
  {** Implements a DATE function. }
  TZDateFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a TIME function. }
  TZTimeFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a NOW function. }
  TZNowFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a ENCODEDATE function. }
  TZEncodeDateFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a ENCODETIME function. }
  TZEncodeTimeFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a COMPOSEDATETIME function. }

  { TZComposeDateTimeFunction }

  TZComposeDateTimeFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a INCDATE function. }
  TZIncDateFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a INCTIME function. }
  TZIncTimeFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a ISLEAPYEAR function. }
  TZIsLeapYearFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{-------------------- Extracting functions ----------------------------}
  {** Implements a DATEOF function. }
  TZDateOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a TIMEOF function. }
  TZTimeOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a YEAROF function. }
  TZYearOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MONTHOF function. }
  TZMonthOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a DAYOF function. }
  TZDayOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a HOUROF function. }
  TZHourOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MINUTEOF function. }
  TZMinuteOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SECONDOF function. }
  TZSecondOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MILLISECONDOF function. }
  TZMilliSecondOfFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{-------------------- *OFTHEYEAR Extracting functions ----------------------------}
  {** Implements a WEEKOFTHEYEAR function. }
  TZWeekOfTheYearFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a DAYOFTHEYEAR function. }
  TZDayOfTheYearFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a HOUROFTHEYEAR function. }
  TZHourOfTheYearFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MINUTEOFTHEYEAR function. }
  TZMinuteOfTheYearFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SECONDOFTHEYEAR function. }
  TZSecondOfTheYearFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MILLISECONDOFTHEYEAR function. }
  TZMilliSecondOfTheYearFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{-------------------- *OFTHEMONTH Extracting functions ----------------------------}
  {** Implements a WEEKOFTHEMONTH function. }
  TZWeekOfTheMonthFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a HOUROFTHEMONTH function. }
  TZHourOfTheMonthFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MINUTEOFTHEMONTH function. }
  TZMinuteOfTheMonthFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SECONDOFTHEMONTH function. }
  TZSecondOfTheMonthFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MILLISECONDOFTHEMONTH function. }
  TZMilliSecondOfTheMonthFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{-------------------- *OFTHEWEEK Extracting functions ----------------------------}
  {** Implements a DAYOfTheWeek function. }
  TZDayOfTheWeekFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a HOUROfTheWeek function. }
  TZHourOfTheWeekFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MINUTEOfTheWeek function. }
  TZMinuteOfTheWeekFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SECONDOfTheWeek function. }
  TZSecondOfTheWeekFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MILLISECONDOfTheWeek function. }
  TZMilliSecondOfTheWeekFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;


{---------------- *OFTHEDAY Extracting functions --------------------}
  {** Implements a MINUTEOFTHEDAY function. }
  TZMinuteOfTheDayFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SECONDOFTHEDAY function. }
  TZSecondOfTheDayFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MILLISECONDOFTHEDAY function. }
  TZMilliSecondOfTheDayFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{---------------- *OfTheHour Extracting functions --------------------}
  {** Implements a SECONDOFTHEHOUR function. }
  TZSecondOfTheHourFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MILLISECONDOFTHEHOUR function. }
  TZMilliSecondOfTheHourFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{---------------- *OFTHEMINUTE Extracting functions --------------------}
  {** Implements a MILLISECONDOfTheHour function. }
  TZMilliSecondOfTheMinuteFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{---------------- *BETWEEN functions --------------------}
  {** Implements a YEARSBETWEEN function. }
  TZYearsBetweenFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MONTHSBETWEEN function. }
  TZMonthsBetweenFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a WEEKSBETWEEN function. }
  TZWeeksBetweenFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a DAYSBETWEEN function. }
  TZDaysBetweenFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a HOURSBETWEEN function. }
  TZHoursBetweenFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MINUTESBETWEEN function. }
  TZMinutesBetweenFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SECONDSBETWEEN function. }
  TZSecondsBetweenFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MILLISECONDSBETWEEN function. }
  TZMillisecondsBetweenFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

procedure AddDateTimeFunctions(Functions : TZFunctionsList);

implementation

uses
  ZMessages, DateUtils;

Function IncDate(const aDate : TDateTime; const aYear, aMonth, aWeek, aDay : LongInt) : TDateTime;
begin
  Result := aDate;
  if aYear  <> 0 then Result := IncYear(Result, aYear);
  if aMonth <> 0 then Result := IncMonth(Result, aMonth);
  if aWeek  <> 0 then Result := IncWeek(Result, aWeek);
  if aDay   <> 0 then Result := IncDay(Result, aDay);
end;

Function IncTime(const aDate : TDateTime; const aHour, aMinute, aSecond, aMillisec : LongInt) : TDateTime;
begin
  Result := IncHour(IncMinute(IncSecond(IncMillisecond(aDate, aMilliSec),aSecond),aMinute),aHour);
end;

{ TZDateFunction }

function TZDateFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 0);
  VariantManager.SetAsDateTime(Result, Date);
end;

{ TZTimeFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZTimeFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 0);
  VariantManager.SetAsDateTime(Result, Time);
end;

{ TZNowFunction }

function TZNowFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 0);
  VariantManager.SetAsDateTime(Result, Now);
end;

{ TZEncodeDateFunction }

function TZEncodeDateFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  ParamsCount: Integer;
  Year , Month, Day : LongInt;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));

  Year  := 0;
  Month := 1;
  Day   := 1;

  if ParamsCount > 0 then
    Year := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount));
  if ParamsCount > 1 then
    Month := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-1));
  if ParamsCount > 2 then
    Day := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-2));

  VariantManager.SetAsDateTime(Result, EncodeDate(Year,Month,Day));
end;

{ TZEncodeDateFunction }

function TZEncodeTimeFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  ParamsCount: Integer;
  Hour , Minute, Second, MilliSecond : LongInt;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));

  Hour        := 0;
  Minute      := 0;
  Second      := 0;
  MilliSecond := 0;

  if ParamsCount > 0 then
    Hour := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount));
  if ParamsCount > 1 then
    Minute := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-1));
  if ParamsCount > 2 then
    Second := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-2));
  if ParamsCount > 3 then
    MilliSecond := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-3));

  VariantManager.SetAsDateTime(Result, EncodeTime(Hour,Minute,Second,MilliSecond));
end;

{ TZComposeDateTimeFunction }

function TZComposeDateTimeFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsDateTime(Result, VariantManager.GetAsDateTime(Stack.GetParameter(2))+
    VariantManager.GetAsDateTime(Stack.GetParameter(1)));
end;

{ TZIncDateFunction }

function TZIncDateFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  ParamsCount: Integer;
  Date : TDateTime;
  Year , Month, Week, Day : LongInt;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));

  if (ParamsCount <= 2) then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);

  Date  := VariantManager.GetAsDateTime(Stack.GetParameter(ParamsCount));
  Year  := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-1));
  Month := 0;
  Week  := 0;
  Day   := 0;
  if ParamsCount > 2 then
     Month := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-2));
  if ParamsCount > 3 then
     Week := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-3));
  if ParamsCount > 4 then
     Day := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-4));

  VariantManager.SetAsDateTime(Result, IncDate(Date,Year,Month,Week,Day));
end;

{ TZIncTimeFunction }

function TZIncTimeFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  ParamsCount: Integer;
  Date : TDateTime;
  Hour , Minute, Second, MilliSecond : LongInt;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));

  if (ParamsCount <= 2) then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);

  Date := VariantManager.GetAsDateTime(Stack.GetParameter(ParamsCount));
  Hour := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-1));

  Minute      := 0;
  Second      := 0;
  MilliSecond := 0;

  if ParamsCount > 2 then
    Minute := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-2));
  if ParamsCount > 3 then
    Second := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-3));
  if ParamsCount > 4 then
    MilliSecond := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount-4));

  VariantManager.SetAsDateTime(Result, IncTime(Date, Hour,Minute,Second,MilliSecond));
end;

{ TZIsLeapYearFunction }

function TZIsLeapYearFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsBoolean(Result, IsLeapYear(
    VariantManager.GetAsInteger(Stack.GetParameter(1))));
end;

{ TZDateOfFunction }

function TZDateOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsDateTime(Result, DateOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZTimeOfFunction }

function TZTimeOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsDateTime(Result, TimeOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZYearOfFunction }

function TZYearOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, YearOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMonthOfFunction }

function TZMonthOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MonthOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZDayOfFunction }

function TZDayOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, DayOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZHourOfFunction }

function TZHourOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, HourOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMinuteOfFunction }

function TZMinuteOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MinuteOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZSecondOfFunction }

function TZSecondOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, SecondOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMilliSecondOfFunction }

function TZMilliSecondOfFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MilliSecondOf(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZWeekOfTheYearFunction }

function TZWeekOfTheYearFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, WeekOfTheYear(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZDayOfTheYearFunction }

function TZDayOfTheYearFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, DayOfTheYear(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZHourOfTheYearFunction }

function TZHourOfTheYearFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, HourOfTheYear(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMinuteOfTheYearFunction }

function TZMinuteOfTheYearFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MinuteOfTheYear(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZSecondOfTheYearFunction }

function TZSecondOfTheYearFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, SecondOfTheYear(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMilliSecondOfTheYearFunction }

function TZMilliSecondOfTheYearFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MilliSecondOfTheYear(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZWeekOfTheMonthFunction }

function TZWeekOfTheMonthFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, WeekOfTheMonth(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZHourOfTheMonthFunction }

function TZHourOfTheMonthFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, HourOfTheMonth(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMinuteOfTheMonthFunction }

function TZMinuteOfTheMonthFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MinuteOfTheMonth(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZSecondOfTheMonthFunction }

function TZSecondOfTheMonthFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, SecondOfTheMonth(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMilliSecondOfTheMonthFunction }

function TZMilliSecondOfTheMonthFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MilliSecondOfTheMonth(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZDayOfTheWeekFunction }

function TZDayOfTheWeekFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, DayOfTheWeek(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZHourOfTheWeekFunction }

function TZHourOfTheWeekFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, HourOfTheWeek(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMinuteOfTheWeekFunction }

function TZMinuteOfTheWeekFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MinuteOfTheWeek(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZSecondOfTheWeekFunction }

function TZSecondOfTheWeekFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, SecondOfTheWeek(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMilliSecondOfTheWeekFunction }

function TZMilliSecondOfTheWeekFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MilliSecondOfTheWeek(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMinuteOfTheDayFunction }

function TZMinuteOfTheDayFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MinuteOfTheDay(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZSecondOfTheDayFunction }

function TZSecondOfTheDayFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, SecondOfTheDay(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMilliSecondOfTheDayFunction }

function TZMilliSecondOfTheDayFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MilliSecondOfTheDay(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZSecondOfTheHourFunction }

function TZSecondOfTheHourFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, SecondOfTheHour(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMilliSecondOfTheHourFunction }

function TZMilliSecondOfTheHourFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MilliSecondOfTheHour(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMilliSecondOfTheMinuteFunction }

function TZMilliSecondOfTheMinuteFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, MilliSecondOfTheMinute(
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZYearsBetweenFunction }

function TZYearsBetweenFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, YearsBetween(
    VariantManager.GetAsDateTime(Stack.GetParameter(2)),
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMonthsBetweenFunction }

function TZMonthsBetweenFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, MonthsBetween(
    VariantManager.GetAsDateTime(Stack.GetParameter(2)),
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZWeeksBetweenFunction }

function TZWeeksBetweenFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, WeeksBetween(
    VariantManager.GetAsDateTime(Stack.GetParameter(2)),
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZDaysBetweenFunction }

function TZDaysBetweenFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, DaysBetween(
    VariantManager.GetAsDateTime(Stack.GetParameter(2)),
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZHoursBetweenFunction }

function TZHoursBetweenFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, HoursBetween(
    VariantManager.GetAsDateTime(Stack.GetParameter(2)),
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZMinutesBetweenFunction }

function TZMinutesBetweenFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, MinutesBetween(
    VariantManager.GetAsDateTime(Stack.GetParameter(2)),
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZSecondsBetweenFunction }

function TZSecondsBetweenFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, SecondsBetween(
    VariantManager.GetAsDateTime(Stack.GetParameter(2)),
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

{ TZHoursBetweenFunction }

function TZMillisecondsBetweenFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, MillisecondsBetween(
    VariantManager.GetAsDateTime(Stack.GetParameter(2)),
    VariantManager.GetAsDateTime(Stack.GetParameter(1))));
end;

procedure AddDateTimeFunctions(Functions : TZFunctionsList);
begin
  Functions.Add(TZDateFunction.Create('DATE'));
  Functions.Add(TZTimeFunction.Create('TIME'));
  Functions.Add(TZNowFunction.Create('NOW'));

// First the Aliases

  Functions.Add(TZEncodeDateFunction.Create('ENCD'));
  Functions.Add(TZEncodeTimeFunction.Create('ENCT'));
//  Functions.Add(TZComposeDateTimeFunction.Create('COMPDT'));

  Functions.Add(TZIncDateFunction.Create('INCD'));
  Functions.Add(TZIncTimeFunction.Create('INCT'));

  Functions.Add(TZIsLeapYearFunction.Create('LEAPY'));

//  Functions.Add(TZDateOfFunction.Create('DATEOF'));
//  Functions.Add(TZTimeOfFunction.Create('TIMEOF'));

//  Functions.Add(TZYearOfFunction.Create('YEAROF'));
//  Functions.Add(TZMonthOfFunction.Create('MONTHOF'));
//  Functions.Add(TZDayOfFunction.Create('DAYOF'));
//  Functions.Add(TZHourOfFunction.Create('HOUROF'));

  Functions.Add(TZMinuteOfFunction.Create('MINOF'));
  Functions.Add(TZSecondOfFunction.Create('SECOF'));
  Functions.Add(TZMilliSecondOfFunction.Create('MSECOF'));

  Functions.Add(TZWeekOfTheYearFunction.Create('WofY'));
  Functions.Add(TZDayOfTheYearFunction.Create('DofY'));
  Functions.Add(TZHourOfTheYearFunction.Create('HofY'));
  Functions.Add(TZMinuteOfTheYearFunction.Create('MINofY'));
  Functions.Add(TZSecondOfTheYearFunction.Create('SECofY'));
  Functions.Add(TZMilliSecondOfTheYearFunction.Create('MSECofY'));

  Functions.Add(TZWeekOfTheMonthFunction.Create('WofM'));
  Functions.Add(TZHourOfTheMonthFunction.Create('HofM'));
  Functions.Add(TZMinuteOfTheMonthFunction.Create('MINofM'));
  Functions.Add(TZSecondOfTheMonthFunction.Create('SECofM'));
  Functions.Add(TZMilliSecondOfTheMonthFunction.Create('MSECofM'));

  Functions.Add(TZDayOfTheWeekFunction.Create('DofW'));
  Functions.Add(TZHourOfTheWeekFunction.Create('HofW'));
  Functions.Add(TZMinuteOfTheWeekFunction.Create('MINofW'));
  Functions.Add(TZSecondOfTheWeekFunction.Create('SECofW'));
  Functions.Add(TZMilliSecondOfTheWeekFunction.Create('MSECofW'));

  Functions.Add(TZMinuteOfTheDayFunction.Create('MINofD'));
  Functions.Add(TZSecondOfTheDayFunction.Create('SECofD'));
  Functions.Add(TZMilliSecondOfTheDayFunction.Create('MSECofD'));

  Functions.Add(TZSecondOfTheHourFunction.Create('SECofH'));
  Functions.Add(TZMilliSecondOfTheHourFunction.Create('MSECofH'));

  Functions.Add(TZMilliSecondOfTheMinuteFunction.Create('MSECofMIN'));

  Functions.Add(TZYearsBetweenFunction.Create('YBTW'));
  Functions.Add(TZMonthsBetweenFunction.Create('MBTW'));
  Functions.Add(TZWeeksBetweenFunction.Create('WBTW'));
  Functions.Add(TZDaysBetweenFunction.Create('DBTW'));
  Functions.Add(TZHoursBetweenFunction.Create('HBTW'));
  Functions.Add(TZMinutesBetweenFunction.Create('MINBTW'));
  Functions.Add(TZSecondsBetweenFunction.Create('SECBTW'));
  Functions.Add(TZMilliSecondsBetweenFunction.Create('MSECBTW'));

// End of Aliases

  Functions.Add(TZEncodeDateFunction.Create('ENCODEDATE'));
  Functions.Add(TZEncodeTimeFunction.Create('ENCODETIME'));
  Functions.Add(TZComposeDateTimeFunction.Create('COMPOSEDATETIME'));

  Functions.Add(TZIncDateFunction.Create('INCDATE'));
  Functions.Add(TZIncTimeFunction.Create('INCTIME'));

  Functions.Add(TZIsLeapYearFunction.Create('ISLEAPYEAR'));

  Functions.Add(TZDateOfFunction.Create('DATEOF'));
  Functions.Add(TZTimeOfFunction.Create('TIMEOF'));

  Functions.Add(TZYearOfFunction.Create('YEAROF'));
  Functions.Add(TZMonthOfFunction.Create('MONTHOF'));
  Functions.Add(TZDayOfFunction.Create('DAYOF'));
  Functions.Add(TZHourOfFunction.Create('HOUROF'));

  Functions.Add(TZMinuteOfFunction.Create('MINUTEOF'));
  Functions.Add(TZSecondOfFunction.Create('SECONDOF'));
  Functions.Add(TZMilliSecondOfFunction.Create('MILLISECONDOF'));

  Functions.Add(TZWeekOfTheYearFunction.Create('WEEKOFTHEYEAR'));
  Functions.Add(TZDayOfTheYearFunction.Create('DAYOFTHEYEAR'));
  Functions.Add(TZHourOfTheYearFunction.Create('HOUROFTHEYEAR'));
  Functions.Add(TZMinuteOfTheYearFunction.Create('MINUTEOFTHEYEAR'));
  Functions.Add(TZSecondOfTheYearFunction.Create('SECONDOFTHEYEAR'));
  Functions.Add(TZMilliSecondOfTheYearFunction.Create('MILLISECONDOFTHEYEAR'));

  Functions.Add(TZWeekOfTheMonthFunction.Create('WEEKOFTHEMONTH'));
  Functions.Add(TZHourOfTheMonthFunction.Create('HOUROFTHEMONTH'));
  Functions.Add(TZMinuteOfTheMonthFunction.Create('MINUTEOFTHEMONTH'));
  Functions.Add(TZSecondOfTheMonthFunction.Create('SECONDOFTHEMONTH'));
  Functions.Add(TZMilliSecondOfTheMonthFunction.Create('MILLISECONDOFTHEMONTH'));

  Functions.Add(TZDayOfTheWeekFunction.Create('DAYOFTHEWEEK'));
  Functions.Add(TZHourOfTheWeekFunction.Create('HOUROFTHEWEEK'));
  Functions.Add(TZMinuteOfTheWeekFunction.Create('MINUTEOFTHEWEEK'));
  Functions.Add(TZSecondOfTheWeekFunction.Create('SECONDOFTHEWEEK'));
  Functions.Add(TZMilliSecondOfTheWeekFunction.Create('MILLISECONDOFTHEWEEK'));

  Functions.Add(TZMinuteOfTheDayFunction.Create('MINUTEOFTHEDAY'));
  Functions.Add(TZSecondOfTheDayFunction.Create('SECONDOFTHEDAY'));
  Functions.Add(TZMilliSecondOfTheDayFunction.Create('MILLISECONDOFTHEDAY'));

  Functions.Add(TZSecondOfTheHourFunction.Create('SECONDOFTHEHOUR'));
  Functions.Add(TZMilliSecondOfTheHourFunction.Create('MILLISECONDOFTHEHOUR'));

  Functions.Add(TZMilliSecondOfTheMinuteFunction.Create('MILLISECONDOFTHEMINUTE'));

  Functions.Add(TZYearsBetweenFunction.Create('YEARSBETWEEN'));
  Functions.Add(TZMonthsBetweenFunction.Create('MONTHSBETWEEN'));
  Functions.Add(TZWeeksBetweenFunction.Create('WEEKSBETWEEN'));
  Functions.Add(TZDaysBetweenFunction.Create('DAYSBETWEEN'));
  Functions.Add(TZHoursBetweenFunction.Create('HOURSBETWEEN'));
  Functions.Add(TZMinutesBetweenFunction.Create('MINUTESBETWEEN'));
  Functions.Add(TZSecondsBetweenFunction.Create('SECONDSBETWEEN'));
  Functions.Add(TZMilliSecondsBetweenFunction.Create('MILLISECONDSBETWEEN'));

end;

end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZFunctionsMath.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Variables classes and interfaces            }
{                                                         }
{           Originally written by Sergey Seroukhov        }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZFunctionsMath;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  SysUtils, ZClasses, ZFunctions, ZExpression, ZVariant, SynCommons;

{**  Math functions }

type
  {** Implements a E function. }
  TZEFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a PI function. }
  TZPIFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a RND function. }
  TZRndFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a ABS function. }
  TZAbsFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{** Trigonometric }
  {** Implements a COS function. }
  TZCosFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a COT function. }
  TZCotFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SIN function. }
  TZSinFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a TAN function. }
  TZTanFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a ACOS function. }
  TZAcosFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a ASIN function. }
  TZAsinFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a ATAN function. }
  TZAtanFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{** Rounding }
  {** Implements a ROUND function. }
  TZRoundFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a TRUNC function. }
  TZTruncFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a INT function. }
  TZIntFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a FRAC function. }
  TZFracFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a CEIL function. }
  TZCeilFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a FLOOR function. }
  TZFloorFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

{** Logarithmic }
  {** Implements a EXP function. }
  TZExpFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a LOG function. }
  TZLogFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a LOG10 function. }
  TZLog10Function = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SQR function. }
  TZSqrFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

procedure AddMathFunctions(Functions : TZFunctionsList);

implementation

uses
  Math;

{ TZEFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZEFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 0);
  VariantManager.SetAsFloat(Result, Exp(1));
end;

{ TZPIFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZPIFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 0);
  VariantManager.SetAsFloat(Result, PI);
end;

{ TZRndFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZRndFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 0);
  VariantManager.SetAsFloat(Result, Random);
end;

{ TZAbsFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZAbsFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  Value: TZVariant;
begin
  CheckParamsCount(Stack, 1);
  Value := Stack.GetParameter(1);
  if Value.VType = vtInteger then
    VariantManager.SetAsInteger(Result, Abs(Value.VInteger))
  else if Value.VType = vtFloat then
    VariantManager.SetAsFloat(Result, Abs(Value.VFloat))
  else
    Result := Value;
end;

{ TZExpFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZExpFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Exp(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZLogFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZLogFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Ln(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZLog10Function }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZLog10Function.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Log10(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZCosFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZCosFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Cos(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZCotFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZCotFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Cotan(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZSinFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZSinFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Sin(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZTanFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZTanFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Tan(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZAcosFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZAcosFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, ArcCos(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZAsinFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZAsinFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, ArcSin(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZAtanFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZAtanFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, ArcTan(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZCeilFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZCeilFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, Ceil(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZFloorFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZFloorFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, Floor(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZRoundFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZRoundFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, Round(VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZTruncFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZTruncFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, Trunc(VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZIntFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZIntFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Int(VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZFracFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZFracFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Frac(VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

{ TZSqrFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZSqrFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsFloat(Result, Sqrt(
    VariantManager.GetAsFloat(Stack.GetParameter(1))));
end;

procedure AddMathFunctions(Functions : TZFunctionsList);
begin
  Functions.Add(TZEFunction.Create('E'));
  Functions.Add(TZPIFunction.Create('PI'));
  Functions.Add(TZRndFunction.Create('RND'));
  Functions.Add(TZAbsFunction.Create('ABS'));
  Functions.Add(TZExpFunction.Create('EXP'));
  Functions.Add(TZLogFunction.Create('LOG'));
  Functions.Add(TZLog10Function.Create('LOG10'));
  Functions.Add(TZCosFunction.Create('COS'));
  Functions.Add(TZSinFunction.Create('SIN'));
  Functions.Add(TZTanFunction.Create('TAN'));
  Functions.Add(TZCotFunction.Create('COT'));
  Functions.Add(TZAcosFunction.Create('ACOS'));
  Functions.Add(TZAsinFunction.Create('ASIN'));
  Functions.Add(TZAtanFunction.Create('ATAN'));
  Functions.Add(TZRoundFunction.Create('ROUND'));
  Functions.Add(TZCeilFunction.Create('CEIL'));
  Functions.Add(TZFloorFunction.Create('FLOOR'));
  Functions.Add(TZIntFunction.Create('INT'));
  Functions.Add(TZTruncFunction.Create('TRUNC'));
  Functions.Add(TZFracFunction.Create('FRAC'));
  Functions.Add(TZSqrFunction.Create('SQR'));
  Functions.Add(TZSqrFunction.Create('SQRT'));
end;

end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZFunctionsOther.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Variables classes and interfaces            }
{                                                         }
{           Originally written by Sergey Seroukhov        }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZFunctionsOther;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  SysUtils, ZClasses, ZFunctions, ZExpression, ZVariant, SynCommons;

{** Other functions}

type

  {** Implements a EMPTY function. }
  TZEmptyFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MIN function. }
  TZMinFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a MAX function. }
  TZMaxFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SUM function. }
  TZSumFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a IIF function. }
  TZIIFFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a CASEF function. }
  TZCASEFFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

procedure AddOtherFunctions(Functions : TZFunctionsList);

implementation

uses
  ZMessages;

{ TZEmptyFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZEmptyFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  Value: TZVariant;
begin
  CheckParamsCount(Stack, 1);
  Value := Stack.GetParameter(1);
  VariantManager.SetAsBoolean(Result, VariantManager.IsNull(Value));
end;

{ TZMinFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZMinFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  I, ParamsCount: Integer;
  Value: TZVariant;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));
  if ParamsCount < 2 then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);
  Result := Stack.GetParameter(ParamsCount);
  for I := 1 to ParamsCount - 1 do
  begin
    Value := Stack.GetParameter(I);
    if VariantManager.Compare(Result, Value) > 0 then
      Result := Value;
  end;
end;

{ TZMaxFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZMaxFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  I, ParamsCount: Integer;
  Value: TZVariant;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));
  if ParamsCount < 2 then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);
  Result := Stack.GetParameter(ParamsCount);
  for I := 1 to ParamsCount - 1 do
  begin
    Value := Stack.GetParameter(I);
    if VariantManager.Compare(Result, Value) < 0 then
      Result := Value;
  end;
end;

{ TZSumFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZSumFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  I, ParamsCount: Integer;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));
  if ParamsCount < 2 then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);
  Result := Stack.GetParameter(ParamsCount);
  for I := ParamsCount - 1 downto 1 do
    Result := VariantManager.OpAdd(Result, Stack.GetParameter(I));
end;

{ TZIIFFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZIIFFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 3);
  if VariantManager.GetAsBoolean(Stack.GetParameter(3)) then
     Result := Stack.GetParameter(2)
   else
     Result := Stack.GetParameter(1);
end;

{ TZCASEFFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZCASEFFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  ParamsCount, Index : Integer;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));
  if ParamsCount < 2 then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);
  Index := VariantManager.GetAsInteger(Stack.GetParameter(ParamsCount));
  if ParamsCount < (Index+2) then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);
  Result := Stack.GetParameter(ParamsCount-Index-1)
end;

procedure AddOtherFunctions(Functions : TZFunctionsList);
begin
  Functions.Add(TZEmptyFunction.Create('EMPTY'));
  Functions.Add(TZMinFunction.Create('MIN'));
  Functions.Add(TZMaxFunction.Create('MAX'));
  Functions.Add(TZSumFunction.Create('SUM'));
  Functions.Add(TZIIFFunction.Create('IIF'));
  Functions.Add(TZCASEFFunction.Create('CASEF'));
end;

end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




































































































































































































































































































































































































































































































































Deleted zeos/core/ZFunctionsStrings.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Variables classes and interfaces            }
{                                                         }
{           Originally written by Sergey Seroukhov        }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZFunctionsStrings;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  SysUtils, ZClasses, ZFunctions, ZExpression, ZVariant, SynCommons;

{**  String functions}

type
  {** Implements a CONCAT function. }
  TZConcatFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SUBSTR function. }
  TZSubStrFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a LEFT function. }
  TZLeftFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a RIGHT function. }
  TZRightFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a STRPOS function. }
  TZStrPosFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a LENGTH function. }
  TZLengthFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a UPPER function. }
  TZUpperFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a LOWER function. }
  TZLowerFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a CAPITALIZE function. }
  TZCapitalizeFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a TRIM function. }
  TZTrimFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a LTRIM function. }
  TZLTrimFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a RTRIM function. }
  TZRTrimFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a SOUNDEX function.
  - modified from previous implementation: this function returns an Integer value,
   and accepts only one parameter (which is the text to be simplified) }
  TZSoundexFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

  {** Implements a LEVENSHTEINDIST function. }
  TZLevenshteinDistanceFunction = class (TZAbstractFunction)
  public
    function Execute(Stack: TZExecutionStack;
      VariantManager: IZVariantManager): TZVariant; override;
  end;

Function Capitalize(const s: RawUTF8; const Delims : RawUTF8 = ''): RawUTF8;
Function LevenshteinDistance(const s1, s2: RawUTF8; const DoUpcase : BOOLEAN = TRUE): Integer;
procedure AddStringFunctions(Functions: TZFunctionsList);

{$IFNDEF FPC}
{$ENDIF}

implementation

uses
  ZMessages, ZCompatibility;

Function Capitalize(const s: RawUTF8; const Delims: RawUTF8='') : RawUTF8;
var
  sDelims : TSetOfAnsiChar;
  i : integer;
begin
  if Delims = '' then
    sDelims := StdWordDelims
  else
  begin
    fillchar(sDelims,sizeof(sDelims),0);
    for i := 1 to Length(Delims) do
      Include(sDelims,Delims[i])
  end;
  Result := AnsiProperCase(s, sDelims);
end;

function Min(const A, B: Integer): Integer; {$ifdef HASINLINE}inline;{$endif}
begin
  if A < B then
    Result := A
  else
    Result := B;
end;

function LevenshteinDistance(const s1, s2: RawUTF8; const DoUpcase: BOOLEAN = TRUE): Integer;
var
  d: array of array of Integer;
  s, t: RawUTF8;
  Start, Len1, Len2, i, j, Cost : Integer;
begin
  Len1 := Length(s1);
  Len2 := Length(s2);
  if Len1 = 0 then
  begin
    Result := Len2;
    Exit;
  end;
  if Len2 = 0 then
  begin
    Result := Len1;
    Exit;
  end;
  if DoUpcase then
  begin
    s := Uppercase(s1);
    t := Uppercase(s2);
  end
  else
  begin
    s := s1;
    t := s2;
  end;
  start := 1;
  // trim off the matching items at the beginning
  while (start <= Len1) and (start <= Len2) and (s[start] = t[start]) do
    inc(start);
  // trim off the matching items at the end
  while (start <= Len1) and (start <= Len2) and (s[Len1] = t[Len2]) do
  begin
    dec(Len1);
    dec(Len2);
  end;
  dec(Start);
  dec(Len1, Start);
  dec(Len2, Start);
  if Len1 = 0 then
  begin
    Result := Len2;
    Exit;
  end;
  if Len2 = 0 then
  begin
    Result := Len1;
    Exit;
  end;
  SetLength(d, Len1 + 1, Len2 + 1);
  for i := 0 to Len1 do
    d[i, 0] := i;
  for j := 0 to Len2 do
    d[0, j] := j;
  // only loop over the items that are different
  for i := 1 to Len1 do
    for j := 1 to Len2 do
    begin
      if s[i+start] <> t[j+start] then
        Cost := 1 else
        Cost := 0;
      // Cost := ABS(ORD(s[i+start] <> t[j+start]));
      d[i, j] := Min(Min(d[i-1,j]+1,          // deletion
                         d[i,j-1]+1),         // insertion
                         d[i-1,j-1]+Cost);    // substitution
    end;
  Result := d[Len1, Len2];
end;


{ TZConcatFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZConcatFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  I, ParamsCount: Integer;
  Temp: RawUTF8;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));
  if ParamsCount < 2 then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);

  Temp := VariantManager.GetAsUTF8(Stack.GetParameter(ParamsCount));
  for I := ParamsCount - 1 downto 1 do
    Temp := Temp + VariantManager.GetAsUTF8(Stack.GetParameter(I));
  VariantManager.SetAsUTF8(Result, Temp);
end;

{ TZSubStrFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZSubStrFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 3);
  VariantManager.SetAsUTF8(Result, Copy(
    VariantManager.GetAsUTF8(Stack.GetParameter(3)),
    VariantManager.GetAsInteger(Stack.GetParameter(2)),
    VariantManager.GetAsInteger(Stack.GetParameter(1))));
end;

{ TZLeftFunction }
function TZLeftFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  Value1, Value2: TZVariant;
begin
  CheckParamsCount(Stack, 2);
  Value1 := Stack.GetParameter(2);
  Value2 := Stack.GetParameter(1);
  VariantManager.SetAsUTF8(Result, copy(Value1.VUTF8, 1, Value2.VInteger));
end;

{ TZRightFunction }
function TZRightFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  Value1, Value2: TZVariant;
  Value: RawUTF8;
begin
  CheckParamsCount(Stack, 2);
  Value1 := Stack.GetParameter(2);
  Value2 := Stack.GetParameter(1);
  Value := Value1.VUTF8;
  VariantManager.SetAsUTF8(Result,
    Copy(Value, Length(Value) + 1 - Value2.VInteger, Value2.VInteger));
end;                               

{ TZStrPosFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZStrPosFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 2);
  VariantManager.SetAsInteger(Result, Pos(
    VariantManager.GetAsUTF8(Stack.GetParameter(2)),
    VariantManager.GetAsUTF8(Stack.GetParameter(1))));
end;

{ TZLengthFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZLengthFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsInteger(Result, Length(VariantManager.GetAsUTF8(Stack.GetParameter(1))));
end;

{ TZLowerFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZLowerFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsUTF8(Result, LowerCase(
    VariantManager.GetAsUTF8(Stack.GetParameter(1))));
end;

{ TZUpperFunction }

{**
  Executes this function.
  @param Stack the stack object.
  @param VariantManager a reference to variant processor object.
  @returns a function value.
}
function TZUpperFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
begin
  CheckParamsCount(Stack, 1);
  VariantManager.SetAsUTF8(Result, UpperCase(
    VariantManager.GetAsUTF8(Stack.GetParameter(1))));
end;

{ TZCapitalizeFunction }

function TZCapitalizeFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  ParamsCount: Integer;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));
  if (ParamsCount < 1) then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);
  if (ParamsCount < 2) then
    VariantManager.SetAsUTF8(Result, Capitalize(
      VariantManager.GetAsUTF8(Stack.GetParameter(1))))
  else
    VariantManager.SetAsUTF8(Result, Capitalize(
      VariantManager.GetAsUTF8(Stack.GetParameter(2)),
      VariantManager.GetAsUTF8(Stack.GetParameter(1))))
end;

{ TZTrimFunction }

function TZTrimFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  Value: TZVariant;
begin
  CheckParamsCount(Stack, 1);
  Value := Stack.GetParameter(1);
  VariantManager.SetAsUTF8(Result, Trim(Value.VUTF8));
end;

{ TZLTrimFunction }

function TZLTrimFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  Value: TZVariant;
begin
  CheckParamsCount(Stack, 1);
  Value := Stack.GetParameter(1);
  VariantManager.SetAsUTF8(Result, TrimLeft(Value.VUTF8));
end;

{ TZRTrimFunction }

function TZRTrimFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  Value: TZVariant;
begin
  CheckParamsCount(Stack, 1);
  Value := Stack.GetParameter(1);
  VariantManager.SetAsUTF8(Result, TrimRight(Value.VUTF8));
end;

{ TZSoundexFunction }

function TZSoundexFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  ParamsCount: Integer;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));
  if (ParamsCount < 1) then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);
  VariantManager.SetAsInteger(Result, SoundExUTF8(pointer(
    VariantManager.GetAsUTF8(Stack.GetParameter(1)))))
end;

function TZLevenshteinDistanceFunction.Execute(Stack: TZExecutionStack;
  VariantManager: IZVariantManager): TZVariant;
var
  ParamsCount: Integer;
begin
  ParamsCount := VariantManager.GetAsInteger(Stack.GetParameter(0));
  if (ParamsCount < 2) then
    raise TZExpressionError.CreateRes(@SExpectedMoreParams);
  if (ParamsCount < 3) then
    VariantManager.SetAsInteger(Result,
                                  LevenshteinDistance(
                                    VariantManager.GetAsUTF8(Stack.GetParameter(2)),
                                    VariantManager.GetAsUTF8(Stack.GetParameter(1))))
  else
    VariantManager.SetAsInteger(Result,
                                LevenshteinDistance(
                                  VariantManager.GetAsUTF8(Stack.GetParameter(3)),
                                  VariantManager.GetAsUTF8(Stack.GetParameter(2)),
                                  VariantManager.GetAsBoolean(Stack.GetParameter(1))))
end;

procedure AddStringFunctions(Functions : TZFunctionsList);
begin
  Functions.Add(TZConcatFunction.Create('CONCAT'));
  Functions.Add(TZSubStrFunction.Create('SUBSTR'));
  Functions.Add(TZLeftFunction.Create('LEFT'));
  Functions.Add(TZRightFunction.Create('RIGHT'));
  Functions.Add(TZStrPosFunction.Create('STRPOS'));
  Functions.Add(TZLengthFunction.Create('LENGTH'));

  Functions.Add(TZUpperFunction.Create('UPPER'));
  Functions.Add(TZLowerFunction.Create('LOWER'));
  Functions.Add(TZCapitalizeFunction.Create('CAP'));
  Functions.Add(TZCapitalizeFunction.Create('CAPITALIZE'));

  Functions.Add(TZTrimFunction.Create('TRIM'));
  Functions.Add(TZLTrimFunction.Create('LTRIM'));
  Functions.Add(TZRTrimFunction.Create('RTRIM'));

  Functions.Add(TZSoundexFunction.Create('SOUNDEX'));
  Functions.Add(TZLevenshteinDistanceFunction.Create('LEVDIST'));
  Functions.Add(TZLevenshteinDistanceFunction.Create('LEVENSHTEINDISTANCE'));
end;

end.

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZMatchPattern.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{                  Regular Expressions                    }
{                                                         }
{            Originally written by Sergey Seroukhov       }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZMatchPattern;
{
  Author: Kevin Boylan
  Ported By: Sergey Seroukhov

  This code is meant to allow wildcard pattern matches.
  It is VERY useful for matching filename wildcard patterns.
  It allows unix grep-like pattern comparisons, for instance:

	?	   	Matches any single characer
	*	   	Matches any contiguous characters
	[abc]  	Matches a or b or c at that position
	[^abc]	Matches anything but a or b or c at that position
	[!abc]	Ditto
	[a-e]  	Matches a through e at that position

	'ma?ch.*'	-Would match match.exe, mavch.dat, march.on, etc
	'this [e-n]s a [!zy]est' - Would match 'this is a test',
                               but would not match 'this as a yest'

  This is a Delphi VCL translation from C code that was downloaded from CIS.
  C code was written by J. Kerceval and released to public domain 02/20/1991.
  This code is ofcourse also public domain. I would appreciate it if you would
  let me know if you find any bugs.  I would also appreciate any notes sent my
  way letting me know if you find it useful.
}

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

interface

uses SysUtils, SynCommons;

{ Check if Text equal to pattern }
function IsMatch(const Pattern, Text: RawUTF8): Boolean;

implementation

const
{ Match defines }
  MATCH_PATTERN	  = 6;
  MATCH_LITERAL	  = 5;
  MATCH_RANGE	  = 4;
  MATCH_ABORT	  = 3;
  MATCH_END	  = 2;
  MATCH_VALID	  = 1;
{ Pattern defines }
{  PATTERN_VALID	  =  0;
  PATTERN_ESC	  = -1;
  PATTERN_RANGE	  = -2;
  PATTERN_CLOSE	  = -3;
  PATTERN_EMPTY	  = -4;
}{ Character defines }
  MATCH_CHAR_SINGLE	        = '?';
  MATCH_CHAR_KLEENE_CLOSURE     = '*';
  MATCH_CHAR_RANGE_OPEN	        = '[';
  MATCH_CHAR_RANGE	        = '-';
  MATCH_CHAR_RANGE_CLOSE        = ']';
  MATCH_CHAR_CARET_NEGATE       = '^';
  MATCH_CHAR_EXCLAMATION_NEGATE	= '!';

function Matche(const Pattern, Text: RawUTF8): Integer; forward;
function MatchAfterStar(Pattern, Text: RawUTF8): Integer; forward;
//function IsPattern(Pattern: RawUTF8): Boolean; forward;

function IsMatch(const Pattern, Text: RawUTF8): Boolean;
begin
  Result := (Matche(LowerCase(Pattern), LowerCase(Text)) = 1);
end;

function Matche(const Pattern, Text: RawUTF8): Integer;
var
  RangeStart, RangeEnd, P, T, PLen, TLen: Integer;
  Invert, MemberMatch, Loop: Boolean;
begin
  P := 1;
  T := 1;
  PLen := Length(pattern);
  TLen := Length(text);
  Result := 0;
  while ((Result = 0) and (P <= PLen)) do
  begin
    if T > TLen then
    begin
      if (Pattern[P] = MATCH_CHAR_KLEENE_CLOSURE) and (P+1 > PLen) then
        Result := MATCH_VALID
      else
        Result := MATCH_ABORT;
      Exit;
    end
    else
      case (Pattern[P]) of
        MATCH_CHAR_KLEENE_CLOSURE:
          Result := MatchAfterStar(Copy(Pattern,P,PLen),Copy(Text,T,TLen));
        MATCH_CHAR_RANGE_OPEN:
          begin
            Inc(P);
            Invert := False;
            if (Pattern[P] = MATCH_CHAR_EXCLAMATION_NEGATE) or
              (Pattern[P] = MATCH_CHAR_CARET_NEGATE) then
            begin
              Invert := True;
              Inc(P);
            end;
            if (Pattern[P] = MATCH_CHAR_RANGE_CLOSE) then
            begin
              Result := MATCH_PATTERN;
              Exit;
            end;
            MemberMatch := False;
            Loop := True;
            while (Loop and (Pattern[P] <> MATCH_CHAR_RANGE_CLOSE)) do
            begin
              RangeStart := P;
              RangeEnd := P;
              Inc(P);
              if P > PLen then
              begin
                Result := MATCH_PATTERN;
                Exit;
              end;
              if Pattern[P] = MATCH_CHAR_RANGE then
              begin
                Inc(P);
                RangeEnd := P;
              if (P > PLen) or (Pattern[RangeEnd] = MATCH_CHAR_RANGE_CLOSE) then
              begin
                Result := MATCH_PATTERN;
                Exit;
              end;
              Inc(P);
            end;
            if P > PLen then
            begin
              Result := MATCH_PATTERN;
              Exit;
            end;
            if RangeStart < RangeEnd then
            begin
              if (Text[T] >= Pattern[RangeStart]) and
                (Text[T] <= Pattern[RangeEnd]) then
              begin
                MemberMatch := True;
                Loop := False;
              end;
            end
            else
            begin
              if (Text[T] >= Pattern[RangeEnd]) and
                (Text[T] <= Pattern[RangeStart]) then
              begin
                MemberMatch := True;
                Loop := False;
              end;
            end;
          end;
          if (Invert and MemberMatch) or (not (Invert or MemberMatch)) then
          begin
            Result := MATCH_RANGE;
            Exit;
          end;
          if MemberMatch then
            while (P <= PLen) and (Pattern[P] <> MATCH_CHAR_RANGE_CLOSE) do
              Inc(P);
            if P > PLen then
            begin
              Result := MATCH_PATTERN;
              Exit;
            end;
          end;
        else
          if Pattern[P] <> MATCH_CHAR_SINGLE then
            if Pattern[P] <> Text[T] then
              Result := MATCH_LITERAL;
      end;
    Inc(P);
    Inc(T);
  end;
  if Result = 0 then
    if T <= TLen then
      Result := MATCH_END
    else
      Result := MATCH_VALID;
end;

function MatchAfterStar(Pattern, Text: RawUTF8): Integer;
var
  P, T, PLen, TLen: Integer;
begin
  Result := 0;
  P := 1;
  T := 1;
  PLen := Length(Pattern);
  TLen := Length(Text);
  if TLen = 1 then
  begin
    Result := MATCH_VALID;
    Exit;
  end;
  if (PLen = 0) or (TLen = 0) then
  begin
    Result := MATCH_ABORT;
    Exit;
  end;
  while ((T <= TLen) and (P < PLen)) and ((Pattern[P] = MATCH_CHAR_SINGLE) or
    (Pattern[P] = MATCH_CHAR_KLEENE_CLOSURE)) do
  begin
    if Pattern[P] = MATCH_CHAR_SINGLE then
      Inc(T);
    Inc(P);
  end;
  if T >= TLen then
  begin
    Result := MATCH_ABORT;
    Exit;
  end;
  if P >= PLen then
  begin
    Result := MATCH_VALID;
    Exit;
  end;
  repeat
    if (Pattern[P] = Text[T]) or (Pattern[P] = MATCH_CHAR_RANGE_OPEN) then
    begin
      Pattern := Copy(Pattern, P, PLen);
      Text    := Copy(Text, T, TLen);
      PLen    := Length(Pattern);
      TLen    := Length(Text);
      p := 1;
      t := 1;
      Result  := Matche(Pattern, Text);
      if Result <> MATCH_VALID then
        Result := 0;//retry until end of Text, (check below) or Result valid
    end;
    Inc(T);
    if (T > TLen) or (P > PLen) then
    begin
      Result := MATCH_ABORT;
      Exit;
    end;
  until Result <> 0;
end;

end.


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
























































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZMessages.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Constant messages used by Zeos              }
{                                                         }
{ This unit contains all the messages that are output by  }
{ ZEOS methods. One of the given language can be activated}
{ by setting the language in ->                           }
{ ZEOS.inc (e.g.: $DEFINE GERMAN).                        }
{ If no language is defined english will be used.         }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZMessages;

interface

{$I ZCore.inc}

resourcestring

// -> ms, 09/05/2005
{$IFDEF PORTUGUESE}
  SSQLError1 = 'Erro SQL: %s';
  SSQLError2 = 'Erro SQL: %s Cdigo: %d';
  SSQLError3 = 'Erro SQL: %s Cdigo: %d SQL: %s';
  SSQLError4 = 'Erro SQL: %s Cdigo: %d Mensagem: %s';

  SListCapacityError = 'Capacidade da Lista fora do limite (%d)';
  SListCountError = 'Contagem da Lista fora do limite (%d)';
  SListIndexError = 'ndice da Lista fora do limite (%d)';

  SClonningIsNotSupported = 'Clonagem no  suportada por esta classe';
  SImmutableOpIsNotAllowed = 'A operao no  permitida para coleo imutvel';
  SStackIsEmpty = 'Pilha est vazia';
  SVariableWasNotFound = 'Varivel "%s" no foi encontrada';
  SFunctionWasNotFound = 'Function "%s" no foi encontrada';
  SInternalError = 'Erro interno';
  SSyntaxErrorNear = 'Erro de sintaxe prximo a "%s"';
  SSyntaxError = 'Erro de sintaxe';
  SUnknownSymbol = 'Smbolo desconhecido "%s"';
  SUnexpectedExprEnd = 'Final inesperado de expresso';
  SRightBraceExpected = ') esperado';
  SParametersError = 'Esperado %d parmetros mas foi encontrado %d';
  SExpectedMoreParams = 'Esperado mais que 2 parmetros';
  SInvalidVarByteArray = 'VarByte array invlido';
  SVariableAlreadyExists = 'Varivel "%s" j existe';
  STypesMismatch = 'Tipos no combinam';
  SUnsupportedVariantType = 'Tipo variante no suportado';
  SUnsupportedOperation = 'Operao no suportada';

  STokenizerIsNotDefined = 'Sinalizador no definido';
  SLibraryNotFound = 'Nenhuma biblioteca dinmica da lista %s foi encontrada';
  SEncodeDateIsNotSupported = 'Esta verso no suporta isc_encode_sql_date';
  SEncodeTimeIsNotSupported = 'Esta verso no suporta supported isc_encode_sql_time';
  SEncodeTimestampIsNotSupported = 'Esta verso no suporta supported isc_encode_sql_timestamp';
  SDecodeDateIsNotSupported = 'Esta verso no suporta isc_decode_sql_date';
  SDecodeTimeIsNotSupported = 'Esta verso no suporta isc_decode_sql_time';
  SDecodeTimestampIsNotSupported = 'Esta verso no suporta isc_decode_sql_timestamp';

  SCanNotRetrieveResultSetData = 'No foi possvel obter os dados do ResultSet';
  SRowBufferIsNotAssigned = 'Buffer da Linha no atribudo';
  SColumnIsNotAccessable = 'Coluna com ndice %d no  acessvel';
  SConversionIsNotPossible = 'A converso da coluna %d de %s para %s no  possvel';
  SCanNotAccessBlobRecord = 'No  possvel acessar um registro BLOB na coluna %d com o tipo %s';
  SRowDataIsNotAvailable = 'Dados na Linha no disponveis';
  SResolverIsNotSpecified = 'Resolver no foi especificado para este ResultSet';
  SResultsetIsAlreadyOpened = 'ResultSet j est aberto';
  SCanNotUpdateEmptyRow = 'No  possvel atualizar uma linha vazia';
  SCanNotUpdateDeletedRow = 'No  possvel atualizar uma linha apagada';
  SCanNotDeleteEmptyRow = 'No  possvel apagar uma linha vazia';
  SCannotUseCommit = 'Voc no pode usar Commit no modo AutoCommit';
  SCannotUseRollBack = 'Voc no pode usar Rollback no modo AutoCommit';
  SCanNotUpdateComplexQuery = 'No  possvel atualizar uma query complexa com mais de uma tabela';
  SCanNotUpdateThisQueryType = 'No  possvel atualizar este tipo de query';
  SDriverWasNotFound = 'O driver de banco de dados requisitado no foi encontrado';
  SCanNotConnectToServer = 'No foi possvel conectar ao servidor SQL';
  STableIsNotSpecified = 'Tabela no especificada';
  SLiveResultSetsAreNotSupported = 'Live query no  suportado por esta classe';
  SInvalidInputParameterCount = 'A contagem do parmetro de entrada  menor que o esperado';
  SIsolationIsNotSupported = 'O nvel de isolamento da Transao no  suportado';
  SColumnWasNotFound = 'Coluna com o nome "%s" no foi encontrada';
  SWrongTypeForBlobParameter = 'Tipo errado para parmetro Blob';
  SIncorrectConnectionURL = 'Conexo incorreta URL: %s';
  SUnsupportedProtocol = 'Protocolo no suportado: %s';
  SUnsupportedByDriver    = 'O Driver no suporta este recurso nativamente: [%s]';

  SConnectionIsNotOpened = 'Conexo ainda no est aberta.';
  SInvalidOpInAutoCommit = 'Operao invlida no modo AutoCommit.';
  SInvalidOpInNonAutoCommit = 'Operao invlida quando o modo AutoCommit  False.';
  SInvalidOpPrepare = 'Prepare transaction somente  possvel aps comandar StartTransaction';

  SConnectionIsNotAssigned = 'Componente de conexo de banco de dados no atribudo';
  SQueryIsEmpty = 'A consulta SQL est vazia';
  SCanNotExecuteMoreQueries = 'No  possvel executar mais que uma query';
  SOperationIsNotAllowed1 = 'Operao no permitida no modo FORWARD ONLY';
  SOperationIsNotAllowed2 = 'Operao no permitida no modo READ ONLY';
  SOperationIsNotAllowed3 = 'Operao no permitida no modo %s';
  SOperationIsNotAllowed4 = 'Operao no permitida para DataSet fechado';
  SNoMoreRecords = 'Nenhum registro no ResultSet';
  SCanNotOpenResultSet = 'No foi possvel abrir o ResultSet';
  SCanNotOpenDataSetWhenDestroying ='Translate : Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink = 'DataSource possui um link circular';
  SBookmarkWasNotFound = 'Bookmark no foi encontrado';
  SIncorrectSearchFieldsNumber = 'Nmero incorreto de valores de campos de procura';
  SInvalidOperationInTrans = 'Operao invlida no modo de transao explcita';
  SIncorrectSymbol = 'Smbolo incorreto na lista de campos "%s".';
  SIncorrectToken = 'Sinal incorreto seguido por ":"';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'O nvel selecionado do isolamento da transao no  suportado';
  SDriverNotSupported = 'Driver no suportado %s';
  SPattern2Long = 'Padro  muito longo';
  SDriverNotCapableOutParameters = 'O Driver no suporta a passagem de parmetros';
  SStatementIsNotAllowed = 'Declarao no permitida';
  SStoredProcIsNotAllowed = 'A stored procedure no  permitida';
  SCannotPerformOperation = 'No  possvel executar a operao num ResultSet fechado';
  SInvalidState = 'Estado invlido';
  SErrorConversion = 'Erro de converso';
  SDataTypeDoesNotSupported = 'Tipo de dado no suportado';
  SUnsupportedParameterType = 'Tipo de parmetro no suportado';
  SUnsupportedDataType = 'Tipo de dado no suportado';
  SErrorConversionField = 'Erro de converso para do campo "%s" para SQLType "%s"';
  SBadOCI = 'Verso de OCI incompatvel [% s]. Requer 8.0.3 ou mais antigo';
  SConnect2AsUser = 'Conecte "% s" como usurio "% s"';
  SUnknownError = 'Erro desconhecido';
  SFieldNotFound1 = 'Campo "%s" no foi encontrado';
  SFieldNotFound2 = 'Campo %d no foi encontrado';

  SLoginPromptFailure = 'No foi possvel encontrar o dilogo padro de login. Por favor adicione DBLogDlg para a seo uses de seu arquivo principal.';

  SPropertyQuery = 'A Query poder demorar em bancos de dados grandes!';
  SPropertyTables = 'Voc deveria limitar por Catalogo e/ou Esquema.';
  SPropertyColumns = 'Voc deveria limitar por Catalogo, Esquema e/ou Tabela.';
  SPropertyProcedures = 'Voc deveria limitar por Catalogo e/ou Esquema.';
  SPropertySequences = 'Voc deveria limitar por Catalogo e/ou Esquema..';
  SPropertyExecute = 'Executar a Query de qualquer maneira?';

  SFormTest = 'Teste Editor ZEOS SQL';
  SButtonClose = '&Fechar';
  SFormEditor = 'Editor ZEOS SQL';
  STabSheetSelect = 'SQL Select';
  SMenuLoad = 'Carregar';
  SMenuSave = 'Salvar';
  SButtonGenerate = '&Gerar';
  SButtonCheck = '&Verificar';
  SButtonTest = '&Testar';
  SButtonOk = '&OK';
  SButtonCancel = '&Cancelar';
  STableAlias = '&Alias Tabela';
  SReplaceSQL = '&Substituir SQL';
  SDialogOpenTitle = 'Abrir Arquivo SQL';
  SDialogSaveTitle = 'Salvar Arquivo SQL';
  SSQLEditor = 'Editor SQL';
  SDatabaseDialog = 'Abrir Banco de Dados existente';

  SUpdateSQLNoResult = 'SQL Update Refresh resultou num conjunto vazio';
  SUpdateSQLRefreshStatementcount ='Usar somente 1 declarao SQL para Update Refresh';
  {$IFDEF FPC}
  SNotEditing = 'Dataset no est em modo de edio ou insero';
  SFieldTypeMismatch = 'Tipo invlido para o campo ''%s'', esperado: %s atual: %s';
  SFieldSizeMismatch = 'Tamanho Invlido para o campo ''%s'', esperado: %d atual: %d';
  {$ENDIF}
  SNeedField               = 'O campo %s  obrigatrio, mas no foi preenchido.';

  SFailedtoInitPrepStmt   = 'A declarao preparada falhou ao inicializar'; 
  SFailedtoPrepareStmt    = 'A declarao falhou durante o processo de preparo'; 
  SFailedToBindAllValues  = 'A Aplicao falhou na traduo de todos os valores';
  SAttemptExecOnBadPrep   = 'Tentativa de executar uma declarao que no foi corretamente preparada';
  SBindingFailure         = 'Falha ao traduzir o conjunto de parmetros';
  SPreparedStmtExecFailure = 'A declarao preparada falhou ao executar';
  SBoundVarStrIndexMissing = 'ndice de texto "%s" da varivel de limite no existe';
  SBindVarOutOfRange      = 'ndice da varivel de limite fora de alcance: %d';
  SFailedToBindResults    = 'A Aplicao falhou ao tratar o result set';
  

  SRefreshRowOnlySupportedWithUpdateObject = 'O mtodo RefreshRow somente  suportado com um update object';
  SMustBeInBrowseMode = 'A Operao  permitida somente no modo dsBrowse';

  SUnKnownParamDataType = 'Param.DataType  de tipo desconhecido';
  SFieldReadOnly        = 'O campo %d  somente leitura e no pde receber dados';
  SInvalidUpdateCount   = '%d registro(s) atualizados. Apenas um registro deveria ter sido atualizado.'; 

  SRowBufferWidthExceeded ='O tamanho do buffer para linhas (Rows) foi excedido. Tente usar menos ou mais colunas na query SQL';
{$ELSE}

{$IFDEF DUTCH}
  SSQLError1 = 'SQL Fout: %s';
  SSQLError2 = 'SQL Fout: %s Code: %d';
  SSQLError3 = 'SQL Fout: %s Code: %d SQL: %s';
  SSQLError4 = 'SQL Fout: %s Code: %d Bericht: %s';

  SListCapacityError = 'Lijst capaciteit buiten bereik (%d)';
  SListCountError = 'Lijst aantal buiten bereik (%d)';
  SListIndexError = 'Lijst index buiten bereik (%d)';

  SClonningIsNotSupported = 'Kloonen worden niet ondersteund in deze klasse';
  SImmutableOpIsNotAllowed = 'Deze operatie is niet ondersteund voor immutable collection';
  SStackIsEmpty = 'Stack is leeg';
  SVariableWasNotFound = 'Variabele "%s" niet gevonden';
  SFunctionWasNotFound = 'Functie "%s" niet gevonden';
  SInternalError = 'Interne fout';
  SSyntaxErrorNear = 'Syntaxis fout bij "%s"';
  SSyntaxError = 'Syntaxis fout';
  SUnknownSymbol = 'Onbekend symbool "%s"';
  SUnexpectedExprEnd = 'Onverwacht einde van de expressie';
  SRightBraceExpected = ') verwacht';
  SParametersError = 'Verwacht worden %d parameters maar er zijn er %d gevonden';
  SExpectedMoreParams = 'Meer dan 2 parameters werden verwacht';
  SInvalidVarByteArray = 'Ongeldig VarByte array';
  SVariableAlreadyExists = 'Variabele "%s" bestaat al';
  STypesMismatch = 'Types komen niet overeen';
  SUnsupportedVariantType = 'Niet ondersteund variant type';
  SUnsupportedOperation = 'Niet ondersteunde operatie';

  STokenizerIsNotDefined = 'Tokenizer is niet gedefinieerd';
  SLibraryNotFound = 'DLL van de lijst %s werd niet gevonden';
  SEncodeDateIsNotSupported = 'Deze versie ondersteunt isc_encode_sql_date niet';
  SEncodeTimeIsNotSupported = 'Deze versie ondersteunt isc_encode_sql_time niet';
  SEncodeTimestampIsNotSupported = 'Deze versie ondersteunt isc_encode_sql_timestamp niet';
  SDecodeDateIsNotSupported = 'Deze versie ondersteunt isc_decode_sql_date niet';
  SDecodeTimeIsNotSupported = 'Deze versie ondersteunt isc_decode_sql_time niet';
  SDecodeTimestampIsNotSupported = 'Deze versie ondersteunt isc_decode_sql_timestamp niet';

  SCanNotRetrieveResultSetData = 'Kan ResultSet data niet ophalen';
  SRowBufferIsNotAssigned = 'Row buffer is niet toegekend';
  SColumnIsNotAccessable = 'Kolom met index %d is niet bereikbaar';
  SConversionIsNotPossible = 'Conversie is niet mogelijk voor kolom %d van %s tot %s';
  SCanNotAccessBlobRecord = 'Kan het blob record in kolom %d met type %s niet benaderen';
  SRowDataIsNotAvailable = 'Rij data is niet beschikbaar';
  SResolverIsNotSpecified = 'Resolver is niet gespecificeerd voor deze ResultSet';
  SResultsetIsAlreadyOpened = 'ResultSet is al geopend';
  SCanNotUpdateEmptyRow = 'Kan een lege rij niet updaten';
  SCanNotUpdateDeletedRow = 'Kan een verwijderde rij niet updaten';
  SCanNotDeleteEmptyRow = 'Kan een lege rij niet verwijderen';
  SCannotUseCommit = 'Commit in autocommit mode is niet mogelijk';
  SCannotUseRollBack = 'Rollback in autocommit mode is niet mogelijk';
  SCanNotUpdateComplexQuery = 'Kan een complexe query met meerdere tabellen niet updaten';
  SCanNotUpdateThisQueryType = 'Kan dit query type niet updaten';
  SDriverWasNotFound = 'Gevraagde database driver is niet gevonden';
  SCanNotConnectToServer = 'Kan geen verbinding maken met de SQL server';
  STableIsNotSpecified = 'Tabel is niet gespecifieerd';
  SLiveResultSetsAreNotSupported = 'Live query is niet ondersteund door deze klasse';
  SInvalidInputParameterCount = 'Input parameter aantal is lager dan verwacht';
  SIsolationIsNotSupported = 'Transactie isolatie niveau wordt niet ondersteund';
  SColumnWasNotFound = 'Kolom met naam "%s" bestaat niet';
  SWrongTypeForBlobParameter = 'Verkeerde type voor Blob parameter';
  SIncorrectConnectionURL = 'Ongeldige connectie URL: %s';
  SUnsupportedProtocol = 'Niet ondersteund protocol: %s';
  SUnsupportedByDriver    = 'De driver ondersteunt deze functie niet: [%s]';

  SConnectionIsNotOpened = 'Verbinding is niet gemaakt.';
  SInvalidOpInAutoCommit = 'Ongeldige operatie in AutoCommit mode.';
  SInvalidOpInNonAutoCommit = 'Ongeldige operatie in non AutoCommit mode.';
  SInvalidOpPrepare = 'Transactie voorbereiden is enkel mogelijk bij de eerste aanroep van Starttransaction!';

  SConnectionIsNotAssigned = 'Database connectie component is niet toegekend';
  SQueryIsEmpty = 'SQL Query is leeg';
  SCanNotExecuteMoreQueries = 'Kan niet meerdere queries uitvoeren';
  SOperationIsNotAllowed1 = 'Bewerking is niet toegestaan in FORWARD ONLY mode';
  SOperationIsNotAllowed2 = 'Bewerking is niet toegestaan in READ ONLY mode';
  SOperationIsNotAllowed3 = 'Bewerking is niet toegestaan in %s mode';
  SOperationIsNotAllowed4 = 'Bewerking is niet toegestaan voor gesloten dataset';
  SNoMoreRecords = 'Geen records meer aanwezig in ResultSet';
  SCanNotOpenResultSet = 'Kan een ResultSet niet openen';
  SCanNotOpenDataSetWhenDestroying ='Kan een Dataset niet openen wanneer de componentstate=dsDestroying';
  SCircularLink = 'Databron maakt een oneindige verbindingslus';
  SBookmarkWasNotFound = 'Bookmark niet gevonden';
  SIncorrectSearchFieldsNumber = 'Incorrect aantal zoekvelden';
  SInvalidOperationInTrans = 'Ongeldige operatie in explicit transaction mode';
  SIncorrectSymbol = 'Ongeldig symbool in veld lijst "%s".';
  SIncorrectToken = 'Ongeldig teken gevolgd door ":"';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'Geselecteerd transactie isolatie niveau niet ondersteund';
  SDriverNotSupported = 'Driver niet ondersteund %s';
  SPattern2Long = 'Patroon is te lang';
  SDriverNotCapableOutParameters = 'Driver ondersteunt geen out parameters';
  SStatementIsNotAllowed = 'Statement is niet toegestaan';
  SStoredProcIsNotAllowed = 'Stored procedures zijn niet toegestaan';
  SCannotPerformOperation = 'Kan operatie niet uitvoeren op een gesloten ResultSet';
  SInvalidState = 'Ongeldige status';
  SErrorConversion = 'Conversiefout';
  SDataTypeDoesNotSupported = 'Data type is niet onderstuend';
  SUnsupportedParameterType = 'Niet ondersteund parameter type';
  SUnsupportedDataType = 'Niet ondersteund data type';
  SErrorConversionField = 'Conversie fout voor veld "%s" naar SQLType "%s"';
  SBadOCI = 'Ongeschikte OCI version [%s]. Vereist is 8.0.3 of nieuwer';
  SConnect2AsUser = 'Verbinden met "%s" als gebruiker "%s"';
  SUnknownError = 'Onbekende fout';
  SFieldNotFound1 = 'Veld "%s" niet gevonden';
  SFieldNotFound2 = 'Veld %d niet gevonden';

  SLoginPromptFailure = 'Kan de standaard login prompt niet vinden.  Voeg DBLogDlg toe aan de uses sectie.';

  SPropertyQuery = 'De Query kan enige tijd duren bij grote databases!';
  SPropertyTables = 'Limiet op Catalog en/of Schema is vereist.';
  SPropertyColumns = 'Limiet op Catalog, Schema en/of tablenaam is vereist.';
  SPropertyProcedures = 'Limiet op Catalog en/of Schema is vereist.';
  SPropertySequences = 'Limiet op Catalog en/of Schema is vereist.';
  SPropertyExecute = 'Dient de Query toch te worden uitgevoerd?';

  SFormTest = 'ZEOS SQL Editor Test';
  SButtonClose = '&Sluiten';
  SFormEditor = 'ZEOS SQL Editor';
  STabSheetSelect = 'Select SQL';
  SMenuLoad = 'Laden';
  SMenuSave = 'Opslaan';
  SButtonGenerate = '&Genereren';
  SButtonCheck = 'C&heck';
  SButtonTest = '&Test';
  SButtonOk = '&OK';
  SButtonCancel = '&Annuleren';
  STableAlias = 'Tabel al&ias';
  SReplaceSQL = '&Vervang SQL';
  SDialogOpenTitle = 'SQL Bestand Openen';
  SDialogSaveTitle = 'SQL Bestand Opslaan';
  SSQLEditor = 'SQL Editor';
  SDatabaseDialog = 'Open bestaande database';

  SUpdateSQLNoResult = 'Der zuvor aktualisierte SQL liefert kein Resultset zurck';
  SUpdateSQLRefreshStatementcount ='Update Refresh SQL Statement count moet 1 zijn';

  {$IFDEF FPC}
  SNotEditing = 'Dataset is niet in edit of insert modus';
  SFieldTypeMismatch = 'Type mismatch voor veld ''%s'', verwacht: %s actueel: %s';
  SFieldSizeMismatch = 'Size mismatch voor veld ''%s'', verwacht: %d actueel: %d';
  {$ENDIF}
  SNeedField               = 'Veld %s is verplicht, maar niet ingevuld.';

  SFailedtoInitPrepStmt   = 'Initialisatie van Prepared statement mislukt';
  SFailedtoPrepareStmt    = 'Statement mislukt tijdens prepare';
  SFailedToBindAllValues  = 'Pre-bind van alle waarden is mislukt';
  SAttemptExecOnBadPrep   = 'Poging om een statement uit te voeren voor een succesvolle prepare';
  SBindingFailure         = 'Binding van parameterset mislukt';
  SPreparedStmtExecFailure = 'Uitvoeren van Prepared statement mislukt';
  SBoundVarStrIndexMissing = 'Tekst index van bound variable bestaat niet: "%s"';
  SBindVarOutOfRange      = 'Bound variable index buiten bereik: %d';
  SFailedToBindResults    = 'Binding van resultaat mislukt';

  SRefreshRowOnlySupportedWithUpdateObject = 'De refreshrow methode is enkel ondersteund vooreen update object';
  SMustBeInBrowseMode = 'Bewerking is enkel toegestaan in dsBROWSE status';

  SUnKnownParamDataType = 'Param.DataType is onbekend';
  SFieldReadOnly        = 'Readonly veld kan geen waarde toegewezen krijgen: %d';
  SInvalidUpdateCount     = '%d record(s) gewijzigd. Slechts 1 record had gewijzigd mogen zijn.'; 

  SRowBufferWidthExceeded ='Rij buffer grootte overschreden. Probeer minder kolommen te gebruiken in je SQL query.';
{$ELSE}
// <- ms, 09/05/2005

// -> ms, 03/05/2005
{$IFDEF GERMAN}
  SSQLError1 = 'SQL Fehler: %s';
  SSQLError2 = 'SQL Fehler: %s Code: %d';
  SSQLError3 = 'SQL Fehler: %s Code: %d SQL: %s';
  SSQLError4 = 'SQL Fehler: %s Code: %d Meldung: %s';

  SListCapacityError = 'Die Listenkapazitt bersteigt die definierte Grenze (%d)';
  SListCountError = 'Der Listenzhler ist auerhalb seiner definierten Grenzen (%d)';
  SListIndexError = 'Der Listenindex ist auerhalb der definierten Grenzen (%d)';

  SClonningIsNotSupported = 'Diese Klasse kann nicht geklont werden';
  SImmutableOpIsNotAllowed = 'Diese Operation ist bei nicht nderbaren Collections nicht erlaubt';
  SStackIsEmpty = 'Der Stack ist leer';
  SVariableWasNotFound = 'Die Variable "%s" wurde nicht gefunden';
  SFunctionWasNotFound = 'Die Funktion "%s" wurde nicht gefunden';
  SInternalError = 'Interner Fehler';
  SSyntaxErrorNear = 'Syntax Fehler bei "%s"';
  SSyntaxError = 'Syntax Fehler';
  SUnknownSymbol = 'Unbekanntes Symbol "%s"';
  SUnexpectedExprEnd = 'Unerwartetes Ende des Ausdrucks';
  SRightBraceExpected = ') erwartet';
  SParametersError = 'Es werden %d Parameter erwartet, aber nur %d Parameter gefunden';
  SExpectedMoreParams = 'Es werden mehr als zwei Parameter erwartet';
  SInvalidVarByteArray = 'Ungltiges VarByte Array';
  SVariableAlreadyExists = 'Die Variable "%s" existiert bereits';
  STypesMismatch = 'Inkompatible Typen';
  SUnsupportedVariantType = 'Nicht untersttzter Variant-Typ';
  SUnsupportedOperation = 'Nicht untersttzte Operation';
  SUnsupportedByDriver    = 'Der Treiber untersttzt dieses Feature nicht von haus aus: [%s]';

  STokenizerIsNotDefined = 'Tokenizer wurde nicht definiert';
  SLibraryNotFound = 'Es wurde keine der in %s gelisteten DLL''s gefunden';
  SEncodeDateIsNotSupported = 'Diese Version untersttzt "isc_encode_sql_date" nicht';
  SEncodeTimeIsNotSupported = 'Diese Version untersttzt "isc_encode_sql_time" nicht';
  SEncodeTimestampIsNotSupported = 'Diese Version untersttzt "isc_encode_sql_timestamp" nicht';
  SDecodeDateIsNotSupported = 'Diese Version untersttzt "isc_decode_sql_date" nicht';
  SDecodeTimeIsNotSupported = 'Diese Version untersttzt "isc_decode_sql_time" nicht';
  SDecodeTimestampIsNotSupported = 'Diese Version untersttzt "isc_decode_sql_timestamp" nicht';

  SCanNotRetrieveResultSetData = 'Die Ergebnismenge kann nicht ermittelt werden';
  SRowBufferIsNotAssigned = 'Der Zeilen-Buffer ist nicht zugewiesen';
  SColumnIsNotAccessable = 'Auf die Spalte (Tabellenfeld) mit dem Index %d kann nicht zugegriffen werden';
  SConversionIsNotPossible = 'Eine Konvertierung der Spalte (Tabellenfeld) %d von %s bis %s kann nicht durchgefhrt werden';
  SCanNotAccessBlobRecord = 'Auf den BLOB-Datensatz in Spalte (Tabellenfeld) %d vom Typ %s kann nicht zugegriffen werden';
  SRowDataIsNotAvailable = 'Die Zeilendaten (Datensatzdaten) sind nicht verfgbar';
  SResolverIsNotSpecified = 'Fr diese Ergebnismenge wurde kein sog. "Resolver" angegeben';
  SResultsetIsAlreadyOpened = 'Die Ergebnismenge ist bereits geffnet';
  SCanNotUpdateEmptyRow = 'Eine leere Datenzeile kann nicht aktualisiert werden';
  SCanNotUpdateDeletedRow = 'Eine gelschte Datenzeile kann nicht aktualisiert werden';
  SCanNotDeleteEmptyRow = 'Eine leere Datenzeile kann nicht gelscht werden';
  SCannotUseCommit = 'COMMIT kann im AUTOCOMMIT-Modus nicht verwendet werden';
  SCannotUseRollBack = 'ROLLBACK kann im AUTOCOMMIT-Modus nicht verwendet werden';
  SCanNotUpdateComplexQuery = 'Ein Query, dessen Ergebnismenge aus mehr als einer Tabelle stammt, kann nicht aktualisiert werden';
  SCanNotUpdateThisQueryType = 'Diese Art von Queries kann nicht aktualisiert werden';
  SDriverWasNotFound = 'Der angegebene Datenbanktreiber wurde nicht gefunden';
  SCanNotConnectToServer = 'Kann keine Verbindung zum SQL Server herstellen';
  STableIsNotSpecified = 'Tabelle ist nicht spezifiziert';
  SLiveResultSetsAreNotSupported = 'Ein "Live Query" wird von dieser Klasse nicht untersttzt';
  SInvalidInputParameterCount = 'Es wurden weniger Eingabeparameter angegeben, als erwartet';
  SIsolationIsNotSupported = 'Der gewhlte Trasaktions-Isolationslevel wird nicht untersttzt';
  SColumnWasNotFound = 'Eine Tabellenspalte namens "%s" wurde nicht gefunden';
  SWrongTypeForBlobParameter = 'Falscher Typ fr einen BLOB-Parameter';
  SIncorrectConnectionURL = 'Falsche Verbindungs-URL: %s';
  SUnsupportedProtocol = 'Nicht untersttztes Protokoll: %s';

  SConnectionIsNotOpened = 'Die Verbindung zur Datenbank ist noch nicht hergestellt';
  SInvalidOpInAutoCommit = 'Ungltige Operation im AUTOCOMMIT-Modus';
  SInvalidOpInNonAutoCommit = 'Ungltige Operation auerhalb des AUTOCOMMIT-Modus';
  SInvalidOpPrepare = 'Transaktion vorzubereiten ist nur beim ersten Aufruf von Starttransaction mglich!';

  SConnectionIsNotAssigned = 'Die Datenbank-Verbindungskomponente ist nicht angegeben';
  SQueryIsEmpty = 'SQL Query leer';
  SCanNotExecuteMoreQueries = 'Mehr als ein Query kann nicht abgearbeitet werden';
  SOperationIsNotAllowed1 = 'Die Operation ist im FORWARD ONLY Modus nicht erlaubt';
  SOperationIsNotAllowed2 = 'Die Operation ist im READ ONLY Modus nicht erlaubt';
  SOperationIsNotAllowed3 = 'Die Operation ist im %s Modus nicht erlaubt';
  SOperationIsNotAllowed4 = 'Die Operation ist bei einem geschlossenen DataSet nicht erlaubt';
  SNoMoreRecords = 'Es gibt keine weiteren Datenstze in der Ergebnismenge';
  SCanNotOpenResultSet = 'Die Ergebnismenge kann nicht geffnet werden';
  SCanNotOpenDataSetWhenDestroying ='Translate : Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink = 'Die DataSource hat einen zirkulren Verweis';
  SBookmarkWasNotFound = 'Das Lesezeichen (Bookmark) wurde nicht gefunden';
  SIncorrectSearchFieldsNumber = 'Die Anzahl der Suchfeldwerte ist nicht korrekt';
  SInvalidOperationInTrans = 'Ungltige Operatio im Zustand einer expliziten Transaktion';
  SIncorrectSymbol = 'Falsches Symbol in der Feldliste "%s".';
  SIncorrectToken = 'Falsches Token gefolgt von ":"';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'Der gewhlte Transaktions-Isolationslevel wird nicht untersttzt';
  SDriverNotSupported = 'Der Treiber wird nicht untersttzt: %s';
  SPattern2Long = 'Das Muster (Pattern) ist zu lang';
  SDriverNotCapableOutParameters = 'Der Treiber beherrscht keine Parameter';
  SStatementIsNotAllowed = 'Diese Anweisung ist nicht erlaubt';
  SStoredProcIsNotAllowed = 'Diese Stored Procedure ist nicht erlaubt';
  SCannotPerformOperation = 'Auf eine geschlossene Ergebnismenge knnen keine Operationen ausgefhrt werden';
  SInvalidState = 'Ungltiger Status';
  SErrorConversion = 'Konvertierungsfehler';
  SDataTypeDoesNotSupported = 'Der Datentyp wird nicht untersttzt';
  SUnsupportedParameterType = 'Der Parametertyp wird nicht untersttzt';
  SUnsupportedDataType = 'Der Datentyp wird nicht untersttzt';
  SErrorConversionField = 'Konvertierungsfehler bei Feld "%s" nach SQL-Typ "%s"';
  SBadOCI = 'Die OCI Version 8.0.3 (oder lter) wird bentigt! Aktuelle Version: %s';
  SConnect2AsUser = 'Verbinde zu "%s" als User "%s"';
  SUnknownError = 'Unbekannter Fehler';
  SFieldNotFound1 = 'Das Feld "%s" wurde nicht gefunden';
  SFieldNotFound2 = 'Das Feld %d wurde nicht gefunden';

  SLoginPromptFailure = 'Der Standard-Login-Dialog konnte nicht gefunden werden. Bitte DBLogDlg in die USES-Sektion der Haupt-Unit hinzufgen';

  SPropertyQuery = 'Die Abfrage kann bei groen Datenbanken eine Weile dauern!';
  SPropertyTables = 'Sie sollte durch die Angabe von Catalog und/oder Schema eingeschrnkt werden.';
  SPropertyColumns = 'Sie sollte durch die Angabe von Catalog, Schema und/oder Tabellenname eingeschrnkt werden.';
  SPropertyProcedures = 'Sie sollte durch die Angabe von Catalog und/oder Schema eingeschrnkt werden.';
  SPropertySequences = 'Sie sollte durch die Angabe von Catalog und/oder Schema eingeschrnkt werden.';
  SPropertyExecute = 'Soll die Abfrage trotzdem ausgefhrt werden?';

  SFormTest = 'ZEOS SQL Editor Test';
  SButtonClose = '&Schlieen';
  SFormEditor = 'ZEOS SQL Editor';
  STabSheetSelect = 'SQL aus&whlen';
  SMenuLoad = 'ffnen';
  SMenuSave = 'Speichern';
  SButtonGenerate = '&Generieren';
  SButtonCheck = 'Syntax &Prfen';
  SButtonTest = 'Befehl &Testen';
  SButtonOk = '&OK';
  SButtonCancel = '&Abbruch';
  STableAlias = 'Tabllen-Alias';
  SReplaceSQL = 'SQL &ersetzen';
  SDialogOpenTitle = 'SQL Script ffnen';
  SDialogSaveTitle = 'SQL Script speichern';
  SSQLEditor = 'SQL Editor';
  SDatabaseDialog = 'Existierende Datenbank ffnen';

  SUpdateSQLNoResult = 'Translate : Update Refresh SQL delivered no resultset';
  SUpdateSQLRefreshStatementcount ='Translate : Update Refresh SQL Statement count must be 1';

  {$IFDEF FPC}
  SNotEditing = 'Das DataSet ist nicht im "edit" oder "insert" Modus.';
  SFieldTypeMismatch = 'Der Typ fr Feld ''%s'' stimmt nicht. Erwartet wird %s der Typ ist aber momentan %s';
  SFieldSizeMismatch = 'Die Gre des Feldes ''%s'' stimmt nicht. Erwartet wird  %d die Gre ist aber momentan %d';
  {$ENDIF}
  SNeedField               = 'Translate: Field %s is required, but not supplied.';

  SFailedtoInitPrepStmt   = 'Translate: Prepared statement failed to initialize';
  SFailedtoPrepareStmt    = 'Translate: Statement failed during prepare process';
  SFailedToBindAllValues  = 'Translate: Application failed to pre-bind all values';
  SAttemptExecOnBadPrep   = 'Translate: Attempt made to execute a statement before a successful preparation.';
  SBindingFailure         = 'Translate: Failed to bind parameter set';
  SPreparedStmtExecFailure = 'Translate: Prepared statement failed to execute';
  SBoundVarStrIndexMissing = 'Translate: Bound variable text index "%s" does not exist';
  SBindVarOutOfRange      = 'Translate: Bound variable index out of range: %d';
  SFailedToBindResults    = 'Translate: Application failed to bind to the result set';

  SRefreshRowOnlySupportedWithUpdateObject = 'TRANSLATE: The refreshrow method is only supported with an update object';
  SMustBeInBrowseMode = 'TRANSLATE: Operation is only allowed in dsBROWSE state';

  SUnKnownParamDataType = 'TRANSLATE: Unknown Param.DataType';
  SFieldReadOnly          = 'Translate : Readonly field can''t be assigned a value: %d';
  SInvalidUpdateCount     = 'Translate : %d record(s) updated. Only one record should have been updated.'; 

  SRowBufferWidthExceeded ='Translate: Row buffer width exceeded. Try using fewer or longer columns in SQL query.';
{$ELSE}
  // -> fduenas, 28/06/2005
{$IFDEF SPANISH} //Spanish translations
  SSQLError1 = 'Error SQL: %s';
  SSQLError2 = 'Error SQL: %s Cdigo: %d';
  SSQLError3 = 'Error SQL: %s Cdigo: %d SQL: %s';
  SSQLError4 = 'Error SQL: %s Cdigo: %d Mensage: %s';

  SListCapacityError = 'List capacity fuera de lmites (%d)';
  SListCountError = 'List count fuera de lmites (%d)';
  SListIndexError = 'List index fuera de lmites (%d)';

  SClonningIsNotSupported = 'La Clonacin no est soportada por esta clase';
  SImmutableOpIsNotAllowed = 'Operacin no permitida en colecciones no modificables';
  SStackIsEmpty = 'La Pila (Stack) est vaca';
  SVariableWasNotFound = 'Variable "%s" no encontrada';
  SFunctionWasNotFound = 'Funcin "%s" no encontrada';
  SInternalError = 'Error interno';
  SSyntaxErrorNear = 'Error de sintaxis cerca de "%s"';
  SSyntaxError = 'Error de sintaxis';
  SUnknownSymbol = 'Smbolo "%s" desconocido';
  SUnexpectedExprEnd = 'Fin de expresin inesperado';
  SRightBraceExpected = ') esperado';
  SParametersError = 'Se esperaban %d parmetros pero solo %d fueron encontrados';
  SExpectedMoreParams = 'Se esperaban ms de dos parmetros';
  SInvalidVarByteArray = 'Arreglo VarByte invlido';
  SVariableAlreadyExists = 'La variable "%s" ya existe';
  STypesMismatch = 'Los Tipos no coinciden';
  SUnsupportedVariantType = 'Tipo de Variant no soportando';
  SUnsupportedOperation = 'Operacin no soportada';

  STokenizerIsNotDefined = 'El objeto Tokenizer no est definido';
  SLibraryNotFound = 'Ninguna librera dinmica de la lista %s fue encontrada';
  SEncodeDateIsNotSupported = 'Esta versin no soporta isc_encode_sql_date';
  SEncodeTimeIsNotSupported = 'Esta versin no soporta isc_encode_sql_time';
  SEncodeTimestampIsNotSupported = 'Esta versin no soporta isc_encode_sql_timestamp';
  SDecodeDateIsNotSupported = 'Esta versin no soporta isc_decode_sql_date';
  SDecodeTimeIsNotSupported = 'Esta versin no soporta isc_decode_sql_time';
  SDecodeTimestampIsNotSupported = 'Esta versin no soporta isc_decode_sql_timestamp';

  SCanNotRetrieveResultSetData = 'No se pueden obtener datos del Resultset';
  SRowBufferIsNotAssigned = 'Buffer de lnea no asignado';
  SColumnIsNotAccessable = 'La columna con ndice %d no est accesible';
  SConversionIsNotPossible = 'La conversin no es posible para la columna %d de %s a %s';
  SCanNotAccessBlobRecord = 'No se puede accesar al registro del blob en la columna %d con tipo %s';
  SRowDataIsNotAvailable = 'Datos de lnea no disponibles';
  SResolverIsNotSpecified = 'El objeto Resolver no est especificado para este ResultSet';
  SResultsetIsAlreadyOpened = 'El Resultset ya est abierto';
  SCanNotUpdateEmptyRow = 'No se puede actualizar una lnea vaca';
  SCanNotUpdateDeletedRow = 'No se puede actualizar una lnea borrada';
  SCanNotDeleteEmptyRow = 'No se puede borrar una lnea vaca';
  SCannotUseCommit = 'No se puede usar COMMIT en modo AUTOCOMMIT';
  SCannotUseRollBack = 'No se puede usar ROLLBACK en modo AUTOCOMMIT';
  SCanNotUpdateComplexQuery = 'No se puede actualizar una consulta compleja que haga referencia a ms de una tabla';
  SCanNotUpdateThisQueryType = 'No se puede actualizar este tipo de consulta';
  SDriverWasNotFound = 'No se encontr el controlador de base de datos solicitado';
  SCanNotConnectToServer = 'No puede conectarse al servidor SQL';
  STableIsNotSpecified = 'La Tabla no est especificada';
  SLiveResultSetsAreNotSupported = 'La consulta actualizable no es soportada por esta clase';
  SInvalidInputParameterCount = 'El nmero de parmetros de tipo Input es menor al esperado';
  SIsolationIsNotSupported = 'Nivel de aislamiento de transaccin no soportado';
  SColumnWasNotFound = 'Columna con nombre "%s" no encontrada';
  SWrongTypeForBlobParameter = 'Tipo incorrecto para el parmetro Blob';
  SIncorrectConnectionURL = 'URL de conexin incorrecta: %s';
  SUnsupportedProtocol = 'Protocolo no soportado: %s';
  SUnsupportedByDriver    = 'Translate: Driver can not support this feature natively: [%s]';

  SConnectionIsNotOpened = 'La conexin no ha sido abierta todava';
  SInvalidOpInAutoCommit = 'Operacin invlida en modo AutoCommit';
  SInvalidOpInNonAutoCommit = 'Operacin invlida en modo No-AutoCommit';
  SInvalidOpPrepare = 'Translate : Prepare transaction only possible on matching first(!) Starttransaction';

  SConnectionIsNotAssigned = 'El componente de conexin a base de datos no est asigando';
  SQueryIsEmpty = 'La Consulta SQL est vaca';
  SCanNotExecuteMoreQueries = 'No se puede ejecutar ms de una consulta';
  SOperationIsNotAllowed1 = 'Operacin no permitida en modo FORWARD ONLY';
  SOperationIsNotAllowed2 = 'Operacin no permitida en modo READ ONLY (Solo lectura)';
  SOperationIsNotAllowed3 = 'Operacin no permitida en modo %s';
  SOperationIsNotAllowed4 = 'Operacin no permitida en un dataset cerrado';
  SNoMoreRecords = 'No hay ms registros en el Resultset';
  SCanNotOpenResultSet = 'No se puede abrir el Resultset';
  SCanNotOpenDataSetWhenDestroying ='Translate : Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink = 'Datasource hace una referencia cclica';
  SBookmarkWasNotFound = 'Bookmark no encontrado';
  SIncorrectSearchFieldsNumber = 'Nmero incorrecto de valores de bsqueda';
  SInvalidOperationInTrans = 'Operacin invlida en modo de transaccin explcita';
  SIncorrectSymbol = 'Smbolo incorrecto en la lista de campos "%s".';
  SIncorrectToken = 'Token incorrecto seguido de ":"';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'El Nivel seleccionado de aislamiento de transaccin no est soportado';
  SDriverNotSupported = 'Controlador %s no soportado';
  SPattern2Long = 'Patrn de bsqueda demasiado largo';
  SDriverNotCapableOutParameters = 'El controlador no tiene cualidades para manejar parmetros';
  SStatementIsNotAllowed = 'Sentencia no permitida';
  SStoredProcIsNotAllowed = 'El procedimiento alamacenado no est permitido';
  SCannotPerformOperation = 'No se puede efectuar la operacin en un resultset cerrado';
  SInvalidState = 'Estado Invlido';
  SErrorConversion = 'Error de conversin';
  SDataTypeDoesNotSupported = 'Tipo de datos no soportado';
  SUnsupportedParameterType = 'Tipo de parmetro no soportado';
  SUnsupportedDataType = 'Tipo de datos no soportado';
  SErrorConversionField = 'Error de conversin del campo "%s" al Tipo SQL "%s"';
  SBadOCI = 'Versin de OCI [%s] no aceptable. Se requiere versin 8.0.3 o menor';
  SConnect2AsUser = 'Conectando a "%s" como usuario "%s"';
  SUnknownError = 'Error desconocido';
  SFieldNotFound1 = 'Campo "%s" no encontrado';
  SFieldNotFound2 = 'Campo %d no encontrado';

  SLoginPromptFailure = 'Cuadro de Dilogo por omisin para autenticacin no encontrado.'+#10#13+
                        'Por favor agregue la unidad DBLogDlg a la seccin uses de la unidad principal de su proyecto.';

  SPropertyQuery = 'La Consulta puede tardar un poco en bases de datos extensas!';
  SPropertyTables = 'Debera limitarlas mediante Catalog y/o Schema.';
  SPropertyColumns = 'Debera limitarlas mediante Catalog, Schema y/o TableName.';
  SPropertyProcedures = 'Debera limitarlos mediante Catalog y/or Schema.';
  SPropertySequences = 'Debera limitarlos mediante Catalog y/or Schema.';
  SPropertyExecute = 'Desea ejecutar la consulta de todos modos?';

  SFormTest = 'Prueba del Editor ZEOS SQL';
  SButtonClose = '&Cerrar';
  SFormEditor = 'Editor ZEOS SQL';
  STabSheetSelect = 'Seleccionar SQL';
  SMenuLoad = 'Cargar...';
  SMenuSave = 'Guardar...';
  SButtonGenerate = '&Generar';
  SButtonCheck = 'C&hecar';
  SButtonTest = 'Pro&bar';
  SButtonOk = '&Aceptar';
  SButtonCancel = '&Cancelar';
  STableAlias = 'A&lias de la tabla';
  SReplaceSQL = '&Reemplazar SQL';
  SDialogOpenTitle = 'Abrir archivo SQL';
  SDialogSaveTitle = 'Guardar archivo SQL';
  SSQLEditor = 'Editor SQL';
  SDatabaseDialog = 'Abrir base de datos existente';

  SUpdateSQLNoResult = 'Translate : Update Refresh SQL delivered no resultset';
  SUpdateSQLRefreshStatementcount ='Translate : Update Refresh SQL Statement count must be 1';

  {$IFDEF FPC}
  SNotEditing = 'El Dataset no se encuentra en modo de edicin o insercin';
  SFieldTypeMismatch = 'El Tipo de dato no coincide para el campo ''%s'', se espera: %s, actual: %s';
  SFieldSizeMismatch = 'El Tamao de dato no coincide para el campo ''%s'', se espera: %d, actual: %d';
  {$ENDIF}
  SNeedField               = 'Translate: Field %s is required, but not supplied.';

  SFailedtoInitPrepStmt   = 'Translate: Prepared statement failed to initialize';
  SFailedtoPrepareStmt    = 'Translate: Statement failed during prepare process';
  SFailedToBindAllValues  = 'Translate: Application failed to pre-bind all values';
  SAttemptExecOnBadPrep   = 'Translate: Attempt made to execute a statement before a successful preparation.';
  SBindingFailure         = 'Translate: Failed to bind parameter set';
  SPreparedStmtExecFailure = 'Translate: Prepared statement failed to execute';
  SBoundVarStrIndexMissing = 'Translate: Bound variable text index "%s" does not exist';
  SBindVarOutOfRange      = 'Translate: Bound variable index out of range: %d';
  SFailedToBindResults    = 'Translate: Application failed to bind to the result set';

  SRefreshRowOnlySupportedWithUpdateObject = 'TRANSLATE: The refreshrow method is only supported with an update object';
  SMustBeInBrowseMode = 'TRANSLATE: Operation is only allowed in dsBROWSE state';

  SUnKnownParamDataType = 'TRANSLATE: Unknown Param.DataType';
  SFieldReadOnly          = 'Translate : Readonly field can''t be assigned a value: %d';
  SInvalidUpdateCount     = 'Translate : %d record(s) updated. Only one record should have been updated.'; 

  SRowBufferWidthExceeded ='Translate: Row buffer width exceeded. Try using fewer or longer columns in SQL query.';
{$ELSE}

{$IFDEF ROMANA}


 SSQLError1 = 'SQL Eroare: %s';
  SSQLError2 = 'SQL Eroare: %s Cod: %d';
  SSQLError3 = 'SQL Eroare: %s Cod: %d SQL: %s';
  SSQLError4 = 'SQL Eroare: %s Cod: %d Mesaj: %s';

  SListCapacityError = 'Capacitatea listei este n afara limitelor (%d)';
  SListCountError = 'Contorul listei este n afara limitelor (%d)';
  SListIndexError = 'Indexul listei este n afara limitelor (%d)';

  SClonningIsNotSupported = 'Clonning nu este suportat de aceast clas';
  SImmutableOpIsNotAllowed = 'Operaia nu este permis ori colecia nu este modificabil';
  SStackIsEmpty = 'Stiva este goal';
  SVariableWasNotFound = 'Variabila "%s" nu a fost gsit';
  SFunctionWasNotFound = 'Funcia "%s" nu a fost gsit';
  SInternalError = 'Eroare Intern';
  SSyntaxErrorNear = 'Eroare de sintax lng "%s"';
  SSyntaxError = 'Eroare de sintax';
  SUnknownSymbol = 'Simbol necunoscut "%s"';
  SUnexpectedExprEnd = 'Final neateptat pentru expresie';
  SRightBraceExpected = ') ateptat';
  SParametersError = 'parametrul %d a fost ateptat dar %d a fost gsit';
  SExpectedMoreParams = 'Mai nult de doi parametrii sunt ateptai';
  SInvalidVarByteArray = 'Arie VarByte invalid';
  SVariableAlreadyExists = 'Variabila "%s" deja exist';
  STypesMismatch = 'Tip nepotrivit';
  SUnsupportedVariantType = 'Tip variant neasteptat';
  SUnsupportedOperation = 'Operaie nesuportat';

  STokenizerIsNotDefined = 'Simbolistica nu este definit';
  SLibraryNotFound = 'None of the dynamic libraries can be found: %s';
  SEncodeDateIsNotSupported = 'Aceast versiune nu suport isc_encode_sql_date';
  SEncodeTimeIsNotSupported = 'Aceast versiune nu suport isc_encode_sql_time';
  SEncodeTimestampIsNotSupported = 'Aceast versiune nu suport isc_encode_sql_timestamp';
  SDecodeDateIsNotSupported = 'Aceast versiune nu suport isc_decode_sql_date';
  SDecodeTimeIsNotSupported = 'Aceast versiune nu suport isc_decode_sql_time';
  SDecodeTimestampIsNotSupported = 'Aceast versiune nu suport isc_decode_sql_timestamp';

  SCanNotRetrieveResultSetData = 'Nu pot returna  Resultset data';
  SRowBufferIsNotAssigned = 'Row buffer nu este asignat';
  SColumnIsNotAccessable = 'Column with index %d nu este accesibil';
  SConversionIsNotPossible = 'Conversia nu este posibil pentru coloana %d din %s n %s';
  SCanNotAccessBlobRecord = 'Nu pot aceesa nregistrarea blob n coloana %d cu tipul %s';
  SRowDataIsNotAvailable = 'Row data nu este disponibil';
  SResolverIsNotSpecified = 'Resolver nu este specificat pentru acest ResultSet';
  SResultsetIsAlreadyOpened = 'Resultset este deja deschis';
  SCanNotUpdateEmptyRow = 'Nu pot updata o nregistrare goal';
  SCanNotUpdateDeletedRow = 'Nu pot updata o nregistrare tears';
  SCanNotDeleteEmptyRow = 'Nu pot terge o nregistrare goal';
  SCannotUseCommit = 'Nu poi folosi COMMIT n modul AUTOCOMMIT ';
  SCannotUseRollBack = 'Nu poi folosi ROLLBACK n modul AUTOCOMMIT ';
  SCanNotUpdateComplexQuery = 'Nu pot updata un query complex cu mai mult de un tabel';
  SCanNotUpdateThisQueryType = 'Nu pot updata acest tip de query';
  SDriverWasNotFound = 'Driverul pentru baza de date nu a fost gsit';
  SCanNotConnectToServer = 'Nu ma pot conecta la serverul SQL';
  STableIsNotSpecified = 'Tbelul nu este specificat';
  SLiveResultSetsAreNotSupported = 'Live query is not supported by this class';
  SInvalidInputParameterCount = 'Input parameter count is less then expected';
  SIsolationIsNotSupported = 'Transaction isolation level nu este suportat';
  SColumnWasNotFound = 'Coloana cu numele "%s" nu a fost fsit';
  SWrongTypeForBlobParameter = 'Tip greit pentru parametru Blob';
  SIncorrectConnectionURL = 'Conexiune URL incorect: %s';
  SUnsupportedProtocol = 'Protocol nesuportat: %s';
  SUnsupportedByDriver    = 'Driver nu poate suporta aceast facilitate : [%s]';

  SConnectionIsNotOpened = 'Conexiune nu este deschis inc';
  SInvalidOpInAutoCommit = 'Operaie invalid n modul AutoCommit';
  SInvalidOpInNonAutoCommit = 'Operaie invalid n modul non AutoCommit ';
  SInvalidOpPrepare = 'Prepare transaction only possible on matching first(!) Starttransaction';

  SConnectionIsNotAssigned = 'Nu este asignat o component Database connection';
  SQueryIsEmpty = 'SQL Query este gol';
  SCanNotExecuteMoreQueries = 'Nu pot executa mai mult de un query';
  SOperationIsNotAllowed1 = 'Operaia nu este permis n modul FORWARD ONLY ';
  SOperationIsNotAllowed2 = 'Operaia nu este permis n modul READ ONLY';
  SOperationIsNotAllowed3 = 'Operaia nu este permis n modul %s ';
  SOperationIsNotAllowed4 = 'Operaia nu este permis pentru n dataset nchis';
  SNoMoreRecords = 'Nu mai sunt nregistrri n Resultset';
  SCanNotOpenResultSet = 'Nu pot deschide Resultset';
  SCanNotOpenDataSetWhenDestroying ='Translate : Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink = 'Datasource makes a circular link';
  SBookmarkWasNotFound = 'Bookmark nu a fost gsit';
  SIncorrectSearchFieldsNumber = 'Numr incorect of search field values';
  SInvalidOperationInTrans = 'Operaie invalid n modul explicit transaction';
  SIncorrectSymbol = 'Simbol incorect n lista de cmpuri  "%s".';
  SIncorrectToken = 'Incorect token dup ":"';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'Selected transaction isolation level is not supported';
  SDriverNotSupported = 'Driver nesuportat %s';
  SPattern2Long = 'Pattern is too long';
  SDriverNotCapableOutParameters = 'Driver nu este capabil s mnuie parametrii';
  SStatementIsNotAllowed = 'Statement nu sunt permise';
  SStoredProcIsNotAllowed = 'The stored proc nu sunt permise';
  SCannotPerformOperation = 'Nu se pot face operaii cu Resultset nchis';
  SInvalidState = 'Stare invalid';
  SErrorConversion = 'Eroare de conversie';
  SDataTypeDoesNotSupported = 'Tip de dat nesuportat';
  SUnsupportedParameterType = 'Tip parametru nesuportat';
  SUnsupportedDataType = 'Tip dat nesuportat';
  SErrorConversionField = 'Eroare de conversie pentru cmpul "%s" n TipSQL "%s"';
  SBadOCI = 'Bad OCI version [%s]. Version 8.0.3 or older is required';
  SConnect2AsUser = 'Conectare la "%s" ca utlizator "%s"';
  SUnknownError = 'Eroare necunoscut';
  SFieldNotFound1 = 'Cmpul "%s" nu a fost gsit';
  SFieldNotFound2 = 'Cmpul %d nu a fost gsit';

  SLoginPromptFailure = 'Nu gsesc fereastra de dialog implicit pentru login. V rog adugai DBLogDlg n seciunea uses.';

  SPropertyQuery = 'The Query may last a while on large databases!';
  SPropertyTables = 'You should limit it by Catalog and/or Schema.';
  SPropertyColumns = 'You should limit it by Catalog, Schema and/or TableName.';
  SPropertyProcedures = 'You should limit it by Catalog and/or Schema.';
  SPropertySequences = 'You should limit it by Catalog and/or Schema.';
  SPropertyExecute = 'Query va fi executat oricum?';

  SFormTest = 'ZEOS SQL Editor Test';
  SButtonClose = 'n&chide';
  SFormEditor = 'ZEOS SQL Editor';
  STabSheetSelect = 'Select SQL';
  SMenuLoad = 'Deschide';
  SMenuSave = 'Salvare';
  SButtonGenerate = '&Generare';
  SButtonCheck = 'Verificare';
  SButtonTest = '&Test';
  SButtonOk = '&OK';
  SButtonCancel = 'Revo&care';
  STableAlias = 'T&able alias';
  SReplaceSQL = '&Replace SQL';
  SDialogOpenTitle = 'Deschide Fiier SQL';
  SDialogSaveTitle = 'Salveaz Fiier SQL';
  SSQLEditor = 'SQL Editor';
  SDatabaseDialog = 'Deschide baz date existent';

  SUpdateSQLNoResult = '"Update Refresh SQL" furnizat nu este un recordset';
  SUpdateSQLRefreshStatementcount ='Declaraia "Update Refresh SQL" ca numr trebuie s fie una';

  {$IFDEF FPC}
  SNotEditing = 'Dataset nu este n modul de editare sau inserare';
  SFieldTypeMismatch = 'Tip nepotrivit pentru cmpul ''%s'', ateptat: %s actual: %s';
  SFieldSizeMismatch = 'Dimensiune nepotrivit pentru cmpul  ''%s'', ateptat: %d actual: %d';
  {$ENDIF}
  SNeedField               = 'Translate: Field %s is required, but not supplied.';

  SFailedtoInitPrepStmt   = 'Translate: Prepared statement failed to initialize';
  SFailedtoPrepareStmt    = 'Translate: Statement failed during prepare process';
  SFailedToBindAllValues  = 'Translate: Application failed to pre-bind all values';
  SAttemptExecOnBadPrep   = 'Translate: Attempt made to execute a statement before a successful preparation.';
  SBindingFailure         = 'Translate: Failed to bind parameter set';
  SPreparedStmtExecFailure = 'Translate: Prepared statement failed to execute';
  SBoundVarStrIndexMissing = 'Translate: Bound variable text index "%s" does not exist';
  SBindVarOutOfRange      = 'Translate: Bound variable index out of range: %d';
  SFailedToBindResults    = 'Translate: Application failed to bind to the result set';

  SRefreshRowOnlySupportedWithUpdateObject = 'TRANSLATE: The refreshrow method is only supported with an update object';
  SMustBeInBrowseMode = 'TRANSLATE: Operation is only allowed in dsBROWSE state';

  SUnKnownParamDataType = 'TRANSLATE: Unknown Param.DataType';

  SRowBufferWidthExceeded ='Translate: Row buffer width exceeded. Try using fewer or longer columns in SQL query.';
  // <-- added by tohenk
  {$ELSE}
  {$IFDEF INDONESIAN}
  SSQLError1 = 'Kesalahan SQL: %s';
  SSQLError2 = 'Kesalahan SQL: %s Kode: %d';
  SSQLError3 = 'Kesalahan SQL: %s Kode: %d SQL: %s';
  SSQLError4 = 'Kesalahan SQL: %s Kode: %d Pesan: %s';

  SListCapacityError = 'Kapasitas List diluar jangkauan (%d)';
  SListCountError = 'Jumlah List diluar jangkauan (%d)';
  SListIndexError = 'Indeks List diluar jangkauan (%d)';

  SClonningIsNotSupported = 'Class ini tidak mendukung kloning';
  SImmutableOpIsNotAllowed = 'Operasi tidak diperkenankan pada koleksi yang tidak dapat diubah';
  SStackIsEmpty = 'Stack kosong';
  SVariableWasNotFound = 'Variabel "%s" tidak ada';
  SFunctionWasNotFound = 'Fungsi "%s" tidak ada';
  SInternalError = 'Kesalahan internal';
  SSyntaxErrorNear = 'Kesalahan Syntax di dekat "%s"';
  SSyntaxError = 'Kesalahan Syntax';
  SUnknownSymbol = 'Simbol tidak dikenali "%s"';
  SUnexpectedExprEnd = 'Tidak dibutuhkan, akhir dari ekspresi';
  SRightBraceExpected = ') dibutuhkan';
  SParametersError = '%d parameter dibutuhkan tapi terdapat %d parameter';
  SExpectedMoreParams = 'Dibutuhkan lebih dari dua parameter';
  SInvalidVarByteArray = 'array VarByte tidak valid';
  SVariableAlreadyExists = 'Variabel "%s" sudah ada';
  STypesMismatch = 'Tipe tidak sesuai';
  SUnsupportedVariantType = 'Tipe variant tidak didukung';
  SUnsupportedOperation = 'Operasi tidak didukung';

  STokenizerIsNotDefined = 'Tokenizer belum ditentukan';
  SLibraryNotFound = 'Tidak ada library ditemukan: %s';
  SEncodeDateIsNotSupported = 'Versi ini tidak mendukung isc_encode_sql_date';
  SEncodeTimeIsNotSupported = 'Versi ini tidak mendukung isc_encode_sql_time';
  SEncodeTimestampIsNotSupported = 'Versi ini tidak mendukung isc_encode_sql_timestamp';
  SDecodeDateIsNotSupported = 'Versi ini tidak mendukung isc_decode_sql_date';
  SDecodeTimeIsNotSupported = 'Versi ini tidak mendukung isc_decode_sql_time';
  SDecodeTimestampIsNotSupported = 'Versi ini tidak mendukung isc_decode_sql_timestamp';

  SCanNotRetrieveResultSetData = 'Tidak dapat mengambil data Resultset';
  SRowBufferIsNotAssigned = 'Row buffer tidak disediakan';
  SColumnIsNotAccessable = 'Kolom dengan indeks %d tidak dapat diakses';
  SConversionIsNotPossible = 'Konversi tidak dimungkinkan pada kolom %d dari %s ke %s';
  SCanNotAccessBlobRecord = 'Tidak dapat mengakses rekord `blob` pada kolom %d dengan tipe %s';
  SRowDataIsNotAvailable = 'Data Row tidak tersedia';
  SResolverIsNotSpecified = 'Resolver belum ditentukan pada ResultSet ini';
  SResultsetIsAlreadyOpened = 'Resultset sudah terbuka';
  SCanNotUpdateEmptyRow = 'Tidak dapat meng-update row kosong';
  SCanNotUpdateDeletedRow = 'Tidak dapat meng-update row terhapus';
  SCanNotDeleteEmptyRow = 'Tidak dapat meng-hapus row kosong';
  SCannotUseCommit = 'COMMIT tidak dapat digunakan pada mode AUTOCOMMIT';
  SCannotUseRollBack = 'ROLLBACK tidak dapat digunakan pada mode AUTOCOMMIT';
  SCanNotUpdateComplexQuery = 'Tidak dapat meng-update query kompleks dengan lebih dari satu tabel';
  SCanNotUpdateThisQueryType = 'Tidak dapat meng-update query dengan tipe ini';
  SDriverWasNotFound = 'Driver database yang diminta tidak ada';
  SCanNotConnectToServer = 'Tidak dapat terhubung ke server SQL';
  STableIsNotSpecified = 'Tabel belum ditentukan';
  SLiveResultSetsAreNotSupported = 'Live query tidak didukung oleh Class ini';
  SInvalidInputParameterCount = 'Jumlah parameter Input kurang dari yang dibutuhkan';
  SIsolationIsNotSupported = 'Level Isolasi Transaksi tidak didukung';
  SColumnWasNotFound = 'Kolom dengan nama "%s" tidak ada';
  SWrongTypeForBlobParameter = 'Salah tipe untuk parameter Blob';
  SIncorrectConnectionURL = 'Salah koneksi URL: %s';
  SUnsupportedProtocol = 'Protokol tidak didukung: %s';
  SUnsupportedByDriver    = 'Driver tidak mendukung fitur: [%s]';

  SConnectionIsNotOpened = 'Koneksi belum dibuka';
  SInvalidOpInAutoCommit = 'Operasi tidak valid pada mode AUTOCOMMIT';
  SInvalidOpInNonAutoCommit = 'Operasi tidak valid pada mode non AUTOCOMMIT';
  SInvalidOpPrepare = 'Persiapan transaksi hanya mungkin pada (!) Starttransaction pertama';

  SConnectionIsNotAssigned = 'Komponen koneksi Database tidak ditentukan';
  SQueryIsEmpty = 'Query SQL kosong';
  SCanNotExecuteMoreQueries = 'Tidak dapat meng-eksekusi lebih dari satu query';
  SOperationIsNotAllowed1 = 'Operasi tidak diperkenankan pada mode FORWARD ONLY';
  SOperationIsNotAllowed2 = 'Operasi tidak diperkenankan pada mode READ ONLY';
  SOperationIsNotAllowed3 = 'Operasi tidak diperkenankan pada mode %s';
  SOperationIsNotAllowed4 = 'Operasi tidak diperkenankan pada dataset tertutup';
  SNoMoreRecords = 'Tidak ada rekord lagi pada Resultset';
  SCanNotOpenResultSet = 'Tidak dapat membuka Resultset';
  SCanNotOpenDataSetWhenDestroying ='Translate : Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink = 'Terjadi hubungan Datasource circular';
  SBookmarkWasNotFound = 'Bookmark tidak ada';
  SIncorrectSearchFieldsNumber = 'Salah jumlah nilai field pada pencarian';
  SInvalidOperationInTrans = 'Operasi tidak valid pada mode explicit transaction';
  SIncorrectSymbol = 'Simbol salah pada daftar field "%s".';
  SIncorrectToken = 'Token salah setelah ":"';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'Level Isolasi Transaksi terpilih tidak didukung';
  SDriverNotSupported = 'Driver tidak mendukung %s';
  SPattern2Long = 'Pola terlalu panjang';
  SDriverNotCapableOutParameters = 'Driver tidak mampu menangani parameter';
  SStatementIsNotAllowed = 'Statement tidak diperbolehkan';
  SStoredProcIsNotAllowed = 'StoredProc tidak diperbolehkan';
  SCannotPerformOperation = 'Tidak dapat melakukan operasi pada Resultset tertutup';
  SInvalidState = 'Sate tidak valid';
  SErrorConversion = 'Kesalahan konversi';
  SDataTypeDoesNotSupported = 'Tipe Data tidak didukung';
  SUnsupportedParameterType = 'Tidak mendukung tipe parameter';
  SUnsupportedDataType = 'Tidak mendukung tipe data';
  SErrorConversionField = 'Kesalahan konversi field "%s" ke Tipe SQL "%s"';
  SBadOCI = 'OCI version [%s] tidak sah. Dibutuhkan versi 8.0.3 atau terdahulu';
  SConnect2AsUser = 'Koneksi ke "%s" dengan user "%s"';
  SUnknownError = 'Kesalahan tidak diketahui';
  SFieldNotFound1 = 'Field "%s" tidak ada';
  SFieldNotFound2 = 'Field %d tidak ada';

  SLoginPromptFailure = 'Tidak ada dialog Login default. Silahkan tambahkan DBLogDlg ke klausula `uses` pada file utama.';

  SPropertyQuery = 'Query mungkin berlangsung lama pada database besar!';
  SPropertyTables = 'Batasi dengan Katalog data/atau Skema.';
  SPropertyColumns = 'Batasi dengan Katalog, Skema dan/atau Nama Tabel.';
  SPropertyProcedures = 'Batasi dengan Katalog dan/atau Skema.';
  SPropertySequences = 'Batasi dengan Katalog dan/atau Skema.';
  SPropertyExecute = 'Apakah Query jadi dieksekusi?';

  SFormTest = 'Tes Editor SQLZEOS';
  SButtonClose = '&Tutup';
  SFormEditor = 'Editor SQL ZEOS';
  STabSheetSelect = 'SQL Select';
  SMenuLoad = 'Ambil';
  SMenuSave = 'Simpan';
  SButtonGenerate = '&Generate';
  SButtonCheck = '&Cek';
  SButtonTest = 'T&es';
  SButtonOk = '&OK';
  SButtonCancel = '&Batal';
  STableAlias = 'Alias T&abel';
  SReplaceSQL = 'SQL &Replace';
  SDialogOpenTitle = 'Buka File SQL';
  SDialogSaveTitle = 'Simpan File SQL';
  SSQLEditor = 'Editor SQL';
  SDatabaseDialog = 'Buka database yang tersedia';

  SUpdateSQLNoResult = 'Tidak ada Resultset pada Update Refresh SQL';
  SUpdateSQLRefreshStatementcount ='Jumlah Statement pada Update Refresh SQL harus 1';

  {$IFDEF FPC}
  SNotEditing = 'Dataset tidak dalam mode edit atau sisip';
  SFieldTypeMismatch = 'Tipe tidak sesuai pada field ''%s'', seharusnya: %s aktual: %s';
  SFieldSizeMismatch = 'Ukuran tidak sesuai pada field ''%s'', seharusnya: %d aktual: %d';
  {$ENDIF}
  SNeedField               = 'Field %s diperlukan, namun tidak disediakan.';

  SFailedtoInitPrepStmt   = 'Gagal inisialisasi Prepared statement';
  SFailedtoPrepareStmt    = 'Statemen gagal sewaktu proses persiapan';
  SFailedToBindAllValues  = 'Aplikasi gagal dalam penggabungan pendahuluan semua nilai';
  SAttemptExecOnBadPrep   = 'Percobaan eksekusi statemen dilakukan sebelum persiapan berhasil.';
  SBindingFailure         = 'Gagal menggabungkan parameter';
  SPreparedStmtExecFailure = 'Prepared Statement gagal dieksekusi';
  SBoundVarStrIndexMissing = 'Teks variabel indeks "%s" tidak ada';
  SBindVarOutOfRange      = 'Variabel indeks diluar jangkauan: %d';
  SFailedToBindResults    = 'Aplikasi gagal pada penggabungan ke Resultset';

  SRefreshRowOnlySupportedWithUpdateObject = 'Metode RefreshRow hanya didukung oleh obyek Update';
  SMustBeInBrowseMode = 'Operasi hanya diperbolehkan pada status dsBrowse';

  SUnKnownParamDataType = 'Param.DataType tidak dikenal';
  SFieldReadOnly          = 'Field readonly tidak dapat diberikan nilai: %d';
  SInvalidUpdateCount     = '%d rekord terupdate. Seharusnya hanya satu rekord yang terupdate.';

  SRowBufferWidthExceeded = 'Lebar buffer baris terlampaui. Coba kurangi atau gunakan kolom yang lebih panjang dalam query SQL.';
  // <--- end added by tohenk
  //--- begin added by ORMADA --------------------------------------------------
{$ELSE}
{$IFDEF RUSSIAN}
  SSQLError1                               = '  SQL : %s';
  SSQLError2                               = '  SQL : %s  : %d';
  SSQLError3                               = '  SQL : %s  : %d SQL: %s';
  SSQLError4                               = '  SQL : %s  : %d : %s';

  SListCapacityError                       = '     (%d)';
  SListCountError                          = '     (%d)';
  SListIndexError                          = '     (%d)';

  SClonningIsNotSupported                  = '    ';
  SImmutableOpIsNotAllowed                 = '     ';
  SStackIsEmpty                            = ' ';
  SVariableWasNotFound                     = ' "%s"  ';
  SFunctionWasNotFound                     = ' "%s"  ';
  SInternalError                           = ' ';
  SSyntaxErrorNear                         = '   "%s"';
  SSyntaxError                             = '  ';
  SUnknownSymbol                           = '  "%s"';
  SUnexpectedExprEnd                       = '  ';
  SRightBraceExpected                      = ') ';
  SParametersError                         = ' %d ,  %d';
  SExpectedMoreParams                      = '  2- ';
  SInvalidVarByteArray                     = '  (VarByte)';
  SVariableAlreadyExists                   = ' "%s"  ';
  STypesMismatch                           = ' ';
  SUnsupportedVariantType                  = '  (variant) ';
  SUnsupportedOperation                    = ' ';

  STokenizerIsNotDefined                   = '  ';
  SLibraryNotFound                         = '     : %s';
  SEncodeDateIsNotSupported                = '    isc_encode_sql_date';
  SEncodeTimeIsNotSupported                = '    isc_encode_sql_time';
  SEncodeTimestampIsNotSupported           = '    isc_encode_sql_timestamp';
  SDecodeDateIsNotSupported                = '    isc_decode_sql_date';
  SDecodeTimeIsNotSupported                = '    isc_decode_sql_time';
  SDecodeTimestampIsNotSupported           = '    isc_decode_sql_timestamp';

  SCanNotRetrieveResultSetData             = '    (Resultset)';
  SRowBufferIsNotAssigned                  = '   ';
  SColumnIsNotAccessable                   = '    %d';
  SConversionIsNotPossible                 = '    %d  %s  %s';
  SCanNotAccessBlobRecord                  = '    blob    %d   %s';
  SRowDataIsNotAvailable                   = '  ';
  SResolverIsNotSpecified                  = '    (ResultSet)   Resolver';
  SResultsetIsAlreadyOpened                = '  (Resultset)  ';
  SCanNotUpdateEmptyRow                    = '   ';
  SCanNotUpdateDeletedRow                  = '   ';
  SCanNotDeleteEmptyRow                    = '   ';
  SCannotUseCommit                         = '  COMMIT  AUTOCOMMIT ';
  SCannotUseRollBack                       = '  ROLLBACK  AUTOCOMMIT ';
  SCanNotUpdateComplexQuery                = '        ';
  SCanNotUpdateThisQueryType               = '    ';
  SDriverWasNotFound                       = '    ';
  SCanNotConnectToServer                   = '   SQL ';
  STableIsNotSpecified                     = '  ';
  SLiveResultSetsAreNotSupported           = '      ';
  SInvalidInputParameterCount              = '   is   ';
  SIsolationIsNotSupported                 = '    ';
  SColumnWasNotFound                       = '     "%s"';
  SWrongTypeForBlobParameter               = '   Blob ';
  SIncorrectConnectionURL                  = '  (URL)  : %s';
  SUnsupportedProtocol                     = ' : %s';
  SUnsupportedByDriver                     = '     : [%s]';

  SConnectionIsNotOpened                   = '  ';
  SInvalidOpInAutoCommit                   = '     (AutoCommit)';
  SInvalidOpInNonAutoCommit                = '      (non AutoCommit)';
  SInvalidOpPrepare                        = '      (!) StartTransaction';

  SConnectionIsNotAssigned                 = '    ';
  SQueryIsEmpty                            = 'SQL  ';
  SCanNotExecuteMoreQueries                = '    ';
  SOperationIsNotAllowed1                  = '       (FORWARD ONLY)';
  SOperationIsNotAllowed2                  = '        (READ ONLY)';
  SOperationIsNotAllowed3                  = '    %s ';
  SOperationIsNotAllowed4                  = '      ';
  SNoMoreRecords                           = '   (Resultset)  ';
  SCanNotOpenResultSet                     = '    (Resultset)';
  SCanNotOpenDataSetWhenDestroying ='Translate : Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink                            = '  (Datasource)   ';
  SBookmarkWasNotFound                     = ' (Bookmark)  ';
  SIncorrectSearchFieldsNumber             = '   Incorrect number of search field values';
  SInvalidOperationInTrans                 = '    ';
  SIncorrectSymbol                         = '     "%s".';
  SIncorrectToken                          = '   ":"';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation            = '     ';
  SDriverNotSupported                      = '   %s';
  SPattern2Long                            = '  ';
  SDriverNotCapableOutParameters           = '    ';
  SStatementIsNotAllowed                   = '  ';
  SStoredProcIsNotAllowed                  = '   ';
  SCannotPerformOperation                  = '       (Resultset)';
  SInvalidState                            = ' ';
  SErrorConversion                         = ' ';
  SDataTypeDoesNotSupported                = '   ';
  SUnsupportedParameterType                = '  ';
  SUnsupportedDataType                     = '  ';
  SErrorConversionField                    = '    "%s"  SQLType "%s"';
  SBadOCI                                  = '  OCI [%s].   8.0.3  ';
  SConnect2AsUser                          = '   "%s"  "%s"';
  SUnknownError                            = ' ';
  SFieldNotFound1                          = ' "%s"  ';
  SFieldNotFound2                          = ' %d  ';

  SLoginPromptFailure                      = '     .   DBLogDlg   uses   .';

  SPropertyQuery                           = '        The Query may last a while on large databases!';
  SPropertyTables                          = '  (Catalog) /  (Schema)';
  SPropertyColumns                         = '   (Catalog),  (Schema) /  (TableName).';
  SPropertyProcedures                      = '  (Catalog) /  (Schema).';
  SPropertySequences                       = '  (Catalog) /  (Schema).';
  SPropertyExecute                         = '    ?';

  SFormTest                                = 'ZEOS SQL  ';
  SButtonClose                             = '&';
  SFormEditor                              = 'ZEOS SQL ';
  STabSheetSelect                          = ' SQL';
  SMenuLoad                                = '';
  SMenuSave                                = '';
  SButtonGenerate                          = '&';
  SButtonCheck                             = '&';
  SButtonTest                              = '&';
  SButtonOk                                = '&';
  SButtonCancel                            = '&';
  STableAlias                              = '& ';
  SReplaceSQL                              = '& SQL';
  SDialogOpenTitle                         = ' SQL ';
  SDialogSaveTitle                         = ' SQL ';
  SSQLEditor                               = 'SQL ';
  SDatabaseDialog                          = '  ';

  SUpdateSQLNoResult                       = '   (Refresh)   ';
  SUpdateSQLRefreshStatementcount          = 'Refresh     ';

{$IFDEF FPC}
  SNotEditing                              = '  (Dataset)      ';
  SFieldTypeMismatch                       = '    ''%s'',  %s : %s';
  SFieldSizeMismatch                       = '  ''%s''  , : %d : %d';
{$ENDIF}
  SNeedField               = 'Translate: Field %s is required, but not supplied.';

  SFailedtoInitPrepStmt                    = '   ';
  SFailedtoPrepareStmt                     = '     ';
  SFailedToBindAllValues                   = '  - ';
  SAttemptExecOnBadPrep                    = '     .';
  SBindingFailure                          = '   ';
  SPreparedStmtExecFailure                 = '   ';
  SBoundVarStrIndexMissing                 = '     "%s"  ';
  SBindVarOutOfRange                       = '     : %d';
  SFailedToBindResults                     = ' (bind)  ';

  SRefreshRowOnlySupportedWithUpdateObject = '   (RefreshRow)     ';
  SMustBeInBrowseMode                      = '      (dsBROWSE)';

  SUnKnownParamDataType                    = '   (Param.DataType)';
  //--- end added by ORMADA ----------------------------------------------------
  SFieldReadOnly          = 'Translate : Readonly field can''t be assigned a value: %d';
  SInvalidUpdateCount     = 'Translate : %d record(s) updated. Only one record should have been updated.';

  SRowBufferWidthExceeded ='Translate: Row buffer width exceeded. Try using fewer or longer columns in SQL query.';
{$ELSE}

//--- added by Petr Stasiak - pestasoft.com ------------------------------------
{$IFDEF CZECH}
  SSQLError1 = 'SQL chyba: %s';
  SSQLError2 = 'SQL chyba: %s kd: %d';
  SSQLError3 = 'SQL chyba: %s kd: %d SQL: %s';
  SSQLError4 = 'SQL chyba: %s kd: %d Hlen: %s';

  SListCapacityError = 'Kapacita seznamu je mimo rozsah (%d)';
  SListCountError = 'Poet seznam je mimo rozsah (%d)';
  SListIndexError = 'Index v seznamu je mimo rozsah (%d)';

  SClonningIsNotSupported = 'Klonovn nen v tto td podporovno';
  SImmutableOpIsNotAllowed = 'Tato operace nen povolena na nemniteln "collections"';
  SStackIsEmpty = 'Zsobnk je przdn';
  SVariableWasNotFound = 'Promn "%s" neexistuje';
  SFunctionWasNotFound = 'Funkce "%s" neexistuje';
  SInternalError = 'Intern chyba';
  SSyntaxErrorNear = 'Chybn syntaxe "%s"';
  SSyntaxError = 'Chybn syntaxe';
  SUnknownSymbol = 'Neznm symbol "%s"';
  SUnexpectedExprEnd = 'Neoekvan konec vrazu';
  SRightBraceExpected = ') oekvn(o/a/y)';
  SParametersError = '%d parametr oekvno, ale %d existuje';
  SExpectedMoreParams = 'Je oekvno vce, ne 2 parametry';
  SInvalidVarByteArray = 'Nesprvn VarByte array';
  SVariableAlreadyExists = 'Promn "%s" ji existuje';
  STypesMismatch = 'Nesouhlasn typy';
  SUnsupportedVariantType = 'Nepodporovan typ variant';
  SUnsupportedOperation = 'Nepodporovan operace';

  STokenizerIsNotDefined = 'Nen definovn "Tokenizer"';
  SLibraryNotFound = 'Neexistuje dll knihovna(y): %s';
  SEncodeDateIsNotSupported = 'Tato verze nepodporuje isc_encode_sql_date';
  SEncodeTimeIsNotSupported = 'Tato verze nepodporuje isc_encode_sql_time';
  SEncodeTimestampIsNotSupported = 'Tato verze nepodporuje isc_encode_sql_timestamp';
  SDecodeDateIsNotSupported = 'Tato verze nepodporuje isc_decode_sql_date';
  SDecodeTimeIsNotSupported = 'Tato verze nepodporuje isc_decode_sql_time';
  SDecodeTimestampIsNotSupported = 'Tato verze nepodporuje isc_decode_sql_timestamp';

  SCanNotRetrieveResultSetData = 'Nelze zskat data "Resultset"';
  SRowBufferIsNotAssigned = 'Nen piazen dkov buffer';
  SColumnIsNotAccessable = 'Sloupec s indexem %d nen pstupn';
  SConversionIsNotPossible = 'Pevod sloupce %d  nen mon z %s na %s';
  SCanNotAccessBlobRecord = 'Nelze pistupovat k blob zznamu ze zloupce %d pes typ %s';
  SRowDataIsNotAvailable = 'dkov data nejsou pstupn';
  SResolverIsNotSpecified = 'Nen specifikovn "rozklada" pro tento vsledek';
  SResultsetIsAlreadyOpened = '"Resultset" byl ji oteven';
  SCanNotUpdateEmptyRow = 'Nelze aktualizovat przdn dek';
  SCanNotUpdateDeletedRow = 'Nelze aktualizovat smazan dek';
  SCanNotDeleteEmptyRow = 'Nelze vymazat przdn dek';
  SCannotUseCommit = 'Nepouvejte COMMIT v mdu AUTOCOMMIT';
  SCannotUseRollBack = 'Nelze pout ROLLBACK v AUTOCOMMIT mdu';
  SCanNotUpdateComplexQuery = 'Nelze aktualizovat komplexn dotaz pro vce, ne jednu tabulku';
  SCanNotUpdateThisQueryType = 'Nelze aktualizovat tento typ dotazu';
  SDriverWasNotFound = 'Poadovan databzov ovlada nenalezen';
  SCanNotConnectToServer = 'Nezdailo se pipojen k SQL serveru';
  STableIsNotSpecified = 'Tabulka nen specifikovna';
  SLiveResultSetsAreNotSupported = '"iv" dotaz nen podporovn v tto td';
  SInvalidInputParameterCount = 'Poet vstupnch parametr neodpovd oekvanmu potu';
  SIsolationIsNotSupported = 'Mra izolace transakce nen podporovna';
  SColumnWasNotFound = 'Sloupec s nzvem "%s" neexistuje';
  SWrongTypeForBlobParameter = 'Nesprvn typ pro Blob parametr';
  SIncorrectConnectionURL = 'Nesprvn tvar URL adresy: %s';
  SUnsupportedProtocol = 'Nepodporovan protokol: %s';
  SUnsupportedByDriver    = 'Ovlada nepodporuje tuto vlastnost: [%s]';

  SConnectionIsNotOpened = 'Spojen nen oteveno';
  SInvalidOpInAutoCommit = 'Nesprvn operace v mdu AutoCommit';
  SInvalidOpInNonAutoCommit = 'Nesprvn operace v mdu NE AutoCommit';
  SInvalidOpPrepare = '"Prepare" transakce je mon pouze jako prvn! Starttransaction';

  SConnectionIsNotAssigned = 'Nen piazen komponent "connection"';
  SQueryIsEmpty = 'SQL dotaz je przdn';
  SCanNotExecuteMoreQueries = 'Nelze spustit vce, ne 1 dotaz';
  SOperationIsNotAllowed1 = 'Operace nen povolena v mdu "FORWARD ONLY"';
  SOperationIsNotAllowed2 = 'Operace nen povolena v mdu "READ ONLY"';
  SOperationIsNotAllowed3 = 'Operace nen povolena v mdu "%s"';
  SOperationIsNotAllowed4 = 'Operace nen povolena pro zaven zdroj dat (dataset)';
  SNoMoreRecords = 'Nejsou dal zznamy';
  SCanNotOpenResultSet = 'Nelze otevt vsledek dotazu';
  SCanNotOpenDataSetWhenDestroying ='Translate : Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink = 'Datasource vytv cyklick dotaz';
  SBookmarkWasNotFound = 'Zloka neexistuje';
  SIncorrectSearchFieldsNumber = 'Nesprvn poet vyhledvanch poloek';
  SInvalidOperationInTrans = 'Nesprvn operace v explicitnm transaknm mdu';
  SIncorrectSymbol = 'Nesprvn symbol v seznamu poloek "%s".';
  SIncorrectToken = 'Za ":" nsleduje nesprvn znak';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'Vybran mra izolace transakc nen podporovna';
  SDriverNotSupported = 'Ovlada %s nen podporovn';
  SPattern2Long = 'Pattern je pli dlouh';
  SDriverNotCapableOutParameters = 'Ovlada nen schopen pijmat parametry';
  SStatementIsNotAllowed = 'Pkaz nen povolen';
  SStoredProcIsNotAllowed = '"stored proc" nen povolena';
  SCannotPerformOperation = 'Nelze provst operaci na uzavenm vsledku dotazu (Resultset)';
  SInvalidState = 'Nesprvn stav';
  SErrorConversion = 'Chyba pevodu';
  SDataTypeDoesNotSupported = 'Tento typ dat nen podporovn';
  SUnsupportedParameterType = 'Nepodporovan typ parametru';
  SUnsupportedDataType = 'Nepodporovan typ dat';
  SErrorConversionField = 'Chyba pevodu sloupce "%s" na SQLTyp "%s"';
  SBadOCI = 'patn verze OCI [%s]. Je vyadovna 8.0.3 nebo star';
  SConnect2AsUser = 'Pipojit k "%s" jako "%s"';
  SUnknownError = 'Neznm chyba';
  SFieldNotFound1 = 'Sloupec "%s" neexistuje';
  SFieldNotFound2 = 'Sloupec %d neexistuje';

  SLoginPromptFailure = 'Nelze najt vchoz pihlaovac dialog. Prosm pidejte DBLogDlg do sekce USES vaeho zdrojovho souboru.';

  SPropertyQuery = 'Dotaz me bt posledn u vlelkch databz!';
  SPropertyTables = 'Mlo by bt limitovno katalogen a/nebo schmatem.';
  SPropertyColumns = 'Mlo by bt limitovno katalogem, schmatem a/nebo nzvem tabulky.';
  SPropertyProcedures = 'Mlo by bt limitovno katalogen a/nebo schmatem.';
  SPropertySequences = 'Mlo by bt limitovno katalogen a/nebo schmatem.';
  SPropertyExecute = 'M se dotaz pesto vykonat?';

  SFormTest = 'ZEOS SQL Editor Test';
  SButtonClose = '&Zavt';
  SFormEditor = 'ZEOS SQL Editor';
  STabSheetSelect = 'Select SQL';
  SMenuLoad = 'Nast';
  SMenuSave = 'Uloit';
  SButtonGenerate = '&Generovat';
  SButtonCheck = '&Kontrola';
  SButtonTest = '&Test';
  SButtonOk = '&OK';
  SButtonCancel = 'Z&ruit';
  STableAlias = '&Alias tabulky';
  SReplaceSQL = 'Nah&radit SQL';
  SDialogOpenTitle = 'Otevt SQL soubor';
  SDialogSaveTitle = 'Uloit SQL soubor';
  SSQLEditor = 'SQL Editor';
  SDatabaseDialog = 'Otevt existujc databzi';

  SUpdateSQLNoResult = 'Update Refresh SQL nevrtilo dn vsledek';
  SUpdateSQLRefreshStatementcount ='Poet Update Refresh SQL pkaz mus bt 1';

  {$IFDEF FPC}
  SNotEditing = 'Dataset nen v editanm (edit), ani vkldacm (insert) reimu';
  SFieldTypeMismatch = 'Nesprvn typ pro sloupec ''%s'', oekvno: %s aktuln: %s';
  SFieldSizeMismatch = 'Nesprvn velikost sloupce ''%s'', oekvno: %d aktuln: %d';
  {$ENDIF}
  SNeedField               = 'Sloupce %s je poadovn, ale nezadn.';

  SFailedtoInitPrepStmt   = 'Pipravovan pkaz nelze inicializovat';
  SFailedtoPrepareStmt    = 'Pkaz selhal bhem ppravy procesu';
  SFailedToBindAllValues  = 'Aplikace zkolabovala ped ppravou vech hodnot';
  SAttemptExecOnBadPrep   = 'Pokoute sespustit pkaz ped dokonenm jeho ppravy.';
  SBindingFailure         = 'Chyba pi zskvn sady parametr';
  SPreparedStmtExecFailure = 'Pipravovan pkaz selhal pi vykonvn';
  SBoundVarStrIndexMissing = 'Index textov promn "%s" neexistuje';
  SBindVarOutOfRange      = 'Index promen je mimo rozsah: %d';
  SFailedToBindResults    = 'Aplikace selhala pi zskvn vsledk dotazu';

//FOS+ 07112006
  SRefreshRowOnlySupportedWithUpdateObject = 'Metoda "refreshrow" je podporovna pouze v "update object"';
  SMustBeInBrowseMode = 'Operace je povolena pouze ve stavu dsBROWSE';

  SUnKnownParamDataType = 'Neznm parametr.typ dat (Param.DataType)';
  SFieldReadOnly        = 'Sloupec pouze pro ten neme bt piazen k hodnot: %d';
  SInvalidUpdateCount     = '%d zznam() aktualizovno. Pouze jeden zznam byl zmnn.';

  SRowBufferWidthExceeded ='Translate: Row buffer width exceeded. Try using fewer or longer columns in SQL query.';
//--- end added by Petr Stasiak - pestasoft.com ------------------------------------

{$ELSE}

//--- added by pawelsel --------------------------------------------------------
{$IFDEF POLISH}

  SSQLError1 = 'Bd SQL: %s';
  SSQLError2 = 'Bd SQL: %s Kod: %d';
  SSQLError3 = 'Bd SQL: %s Kod: %d SQL: %s';
  SSQLError4 = 'Bd SQL: %s Kod: %d Komunikat: %s';

  SListCapacityError = 'Przekroczona pojemno listy (%d)';
  SListCountError = 'Licznik listy poza zakresem (%d)';
  SListIndexError = 'Indeks listy poza zakresem (%d)';

  SClonningIsNotSupported = 'Ta klasa nie obsuguje klonowania';
  SImmutableOpIsNotAllowed = 'Niedozwolona operacja na niezmienialnych kolekcjach';
  SStackIsEmpty = 'Stos jest pusty';
  SVariableWasNotFound = 'Nie znaleziono zmiennej "%s"';
  SFunctionWasNotFound = 'Nie znaleziono funkcji "%s"';
  SInternalError = 'Bd wewntrzny';
  SSyntaxErrorNear = 'Bd skadni przy "%s"';
  SSyntaxError = 'Bd skadni';
  SUnknownSymbol = 'Nieznany symbol "%s"';
  SUnexpectedExprEnd = 'Nieoczekiwany koniec wyraenia';
  SRightBraceExpected = 'Oczekiwano znaku )';
  SParametersError = 'Oczekiwana ilo parametrw: %d, znaleziono: %d';
  SExpectedMoreParams = 'Oczekiwano wicej ni dwa parametry';
  SInvalidVarByteArray = 'Bdna tablica VarByte';
  SVariableAlreadyExists = 'Zmienna "%s" ju istnieje';
  STypesMismatch = 'Niezgodno typw';
  SUnsupportedVariantType = 'Nieznany typ danych';
  SUnsupportedOperation = 'Nieznana operacja';

  STokenizerIsNotDefined = 'Nie zdefiniowano tokenizera';
  SLibraryNotFound = 'Nie znaleziono adnej z bibliotek dynamicznych: %s';
  SEncodeDateIsNotSupported = 'Ta wersja nie obsuguje isc_encode_sql_date';
  SEncodeTimeIsNotSupported = 'Ta wersja nie obsuguje isc_encode_sql_time';
  SEncodeTimestampIsNotSupported = 'Ta wersja nie obsuguje isc_encode_sql_timestamp';
  SDecodeDateIsNotSupported = 'Ta wersja nie obsuguje isc_decode_sql_date';
  SDecodeTimeIsNotSupported = 'Ta wersja nie obsuguje isc_decode_sql_time';
  SDecodeTimestampIsNotSupported = 'Ta wersja nie obsuguje isc_decode_sql_timestamp';

  SCanNotRetrieveResultSetData = 'Nie mona pobra danych wynikowych';
  SRowBufferIsNotAssigned = 'Nie przypisano bufora wiersza';
  SColumnIsNotAccessable = 'Kolumna o numerze %d jest niedostpna';
  SConversionIsNotPossible = 'Konwersja kolumny o numerze %d z %s na %s jest niemoliwa';
  SCanNotAccessBlobRecord = 'Brak dostpu do rekordu typu blob w kolumnie %d z typem %s';
  SRowDataIsNotAvailable = 'Dane wiersza s niedostpne';
  SResolverIsNotSpecified = 'Ten ResultSet nie ma okrelonego Resolver-a';
  SResultsetIsAlreadyOpened = 'ResultSet jest ju otwarty';
  SCanNotUpdateEmptyRow = 'Nie mona aktualizowa pustego wiersza';
  SCanNotUpdateDeletedRow = 'Nie mona aktualizowa usunitego wiersza';
  SCanNotDeleteEmptyRow = 'Nie mona usun pustego wiersza';
  SCannotUseCommit = 'Nie mona uy COMMIT w trybie AUTOCOMMIT';
  SCannotUseRollBack = 'Nie mona uy ROLLBACK w trybie AUTOCOMMIT';
  SCanNotUpdateComplexQuery = 'Nie mona aktualizowa zapytania zoonego z wicej ni jednej tabeli';
  SCanNotUpdateThisQueryType = 'Nie mona aktualizowa tego typu zapytania';
  SDriverWasNotFound = 'Nie znaleziono wymaganego sterownika bazy danych';
  SCanNotConnectToServer = 'Nie mona poczy si z serwerem SQL';
  STableIsNotSpecified = 'Nie okrelono tabeli';
  SLiveResultSetsAreNotSupported = '"Live query" nie jest obsugiwane przez t klas';
  SInvalidInputParameterCount = 'Liczba parametrw wejsciowych jest mniejsza ni oczekiwana';
  SIsolationIsNotSupported = 'Poziom izolacji transakcji nie jest obsugiwany';
  SColumnWasNotFound = 'Nie znaleziono kolumny o nazwie "%s"';
  SWrongTypeForBlobParameter = 'Bdny typ parametru Blob';
  SIncorrectConnectionURL = 'Bdny URL poczenia: %s';
  SUnsupportedProtocol = 'Nieobsugiwany protok: %s';
  SUnsupportedByDriver    = 'Sterownik nie obsuguje tej waciwoci natywnie: [%s]';

  SConnectionIsNotOpened = 'Jeszcze nie nawizano poczenia';
  SInvalidOpInAutoCommit = 'Bdna operacja w trybie AutoCommit';
  SInvalidOpInNonAutoCommit = 'Bdna operacja przy wyczonym AutoCommit';
  SInvalidOpPrepare = 'Przygotowanie transakcji moliwe jest tylko przy pierwszym(!) Starttransaction';

  SConnectionIsNotAssigned = 'Nie przypisano komponentu poczenia do bazy danych';
  SQueryIsEmpty = 'Zapytanie SQL jest puste';
  SCanNotExecuteMoreQueries = 'Nie mona wykona wicej ni jednego zapytania';
  SOperationIsNotAllowed1 = 'Niedozwolona operacja w trybie FORWARD ONLY';
  SOperationIsNotAllowed2 = 'Niedozwolona operacja w trybie READ ONLY';
  SOperationIsNotAllowed3 = 'Niedozwolona operacja w trybie %s';
  SOperationIsNotAllowed4 = 'Niedozwolona operacja przy zamnitym rdle danych';
  SNoMoreRecords = 'Nie ma ju wicej rekordw wynikowych';
  SCanNotOpenResultSet = 'Nie mozna otworzy danych wynikowych';
  SCanNotOpenDataSetWhenDestroying ='Translate : Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink = 'Datasource tworzy powizanie cykliczne';
  SBookmarkWasNotFound = 'Nie znaleziono zakadki (Bookmark)';
  SIncorrectSearchFieldsNumber = 'Bdna liczba pl do wyszukiwania';
  SInvalidOperationInTrans = 'Bdna operacja w trybie transakcji';
  SIncorrectSymbol = 'Bdny symbol w licie pl "%s".';
  SIncorrectToken = 'Bdny wyraz za ":"';
  SIncorrectParamChar = 'TRANSLATE : Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'Wybrany poziom izolacji transakcji nie jest obsugiwany';
  SDriverNotSupported = 'Nie obsugiwany sterownik %s';
  SPattern2Long = 'Wzorzec jest zbyt dugi';
  SDriverNotCapableOutParameters = 'Sterownik nie potrafi obsuy parametrw';
  SStatementIsNotAllowed = 'Niedozwolone wyraenie';
  SStoredProcIsNotAllowed = 'Niedozwolona procedura skadowana';
  SCannotPerformOperation = 'Nie mona wykona operacji na zamknitym zbiorze danych';
  SInvalidState = 'Bdny stan';
  SErrorConversion = 'Bd konwersji';
  SDataTypeDoesNotSupported = 'Nieobsugiwany typ dannych';
  SUnsupportedParameterType = 'Nieobsugiwany typ parametru';
  SUnsupportedDataType = 'Nieobsugiwany typ danych';
  SErrorConversionField = 'Bd konwersji pola "%s" na SQLType "%s"';
  SBadOCI = 'Za wersja OCI [%s]. Wymagana wersja 8.0.3 lub starsza';
  SConnect2AsUser = 'Poczenie z "%s" jako uytkownik "%s"';
  SUnknownError = 'Nieznany bd';
  SFieldNotFound1 = 'Nie znaleziono pola "%s"';
  SFieldNotFound2 = 'Nie znaleziono pola %d';

  SLoginPromptFailure = 'Nie znaleziono domylnego dialogu logowania. Prosz doda DBLogDlg do sekcji uses gwnego pliku aplikacji.';

  SPropertyQuery = 'Zapytanie moe chwil potrwa na wikszej bazie danych!';
  SPropertyTables = 'Powiniene ucili Katalog i/lub Schemat.';
  SPropertyColumns = 'Powiniene ucili Katalog, Schemat i/lub NazwTabeli.';
  SPropertyProcedures = 'Powiniene ucili Katalog i/lub Schemat.';
  SPropertySequences = 'Powiniene ucili Katalog i/lub Schemat.';
  SPropertyExecute = 'Czy mimo to wykona zapytanie?';

  SFormTest = 'Test Edytora SQL ZEOS';
  SButtonClose = '&Zamknij';
  SFormEditor = 'Edytor SQL ZEOS';
  STabSheetSelect = 'Wybr SQL';
  SMenuLoad = 'aduj';
  SMenuSave = 'Zapisz';
  SButtonGenerate = '&Generuj';
  SButtonCheck = '&Sprawd';
  SButtonTest = '&Test';
  SButtonOk = '&OK';
  SButtonCancel = 'A&nuluj';
  STableAlias = '&Alias tabeli';
  SReplaceSQL = 'Za&mie SQL';
  SDialogOpenTitle = 'Otwrz plik SQL';
  SDialogSaveTitle = 'Zapisz plik SQL';
  SSQLEditor = 'Edytor SQL';
  SDatabaseDialog = 'Otwrz istniejc baz';

  SUpdateSQLNoResult = 'Update Refresh SQL nie zwrcio adnych danych';
  SUpdateSQLRefreshStatementcount ='Wyraenie Update Refresh SQL musi zwrci 1 rekord danych';

  {$IFDEF FPC}
  SNotEditing = 'Dataset nie jest w trybie "edit" lub "insert"';
  SFieldTypeMismatch = 'Niezgodno typw dla pola ''%s'', oczekiwano: %s otrzymano: %s';
  SFieldSizeMismatch = 'Niezgodno rozmiarw pola ''%s'', oczekiwano: %d otrzymano: %d';
  {$ENDIF}
  SNeedField               = 'Pole %s jest wymagane.';

  SFailedtoInitPrepStmt   = 'Nie udao si zainicjalizowa przygotowanego zapytania';
  SFailedtoPrepareStmt    = 'Bd w wyraeniu podczas procesu przygotowania';
  SFailedToBindAllValues  = 'Bd aplikacji podczas przypisywania danych';
  SAttemptExecOnBadPrep   = 'Prba uruchomienia wyraenia przed zakoczeniem przygotowywania.';
  SBindingFailure         = 'Bd przypisywania zbioru parametrw';
  SPreparedStmtExecFailure = 'Bd wykonania przygotowanego zapytania';
  SBoundVarStrIndexMissing = 'Nie istnieje zmienna licznikowa "%s"';
  SBindVarOutOfRange      = 'Warto zmiennej licznikowej poza zakresem: %d';
  SFailedToBindResults    = 'Bd aplikacji podczas czenia do wynikw zapytania';

//FOS+ 07112006
  SRefreshRowOnlySupportedWithUpdateObject = 'Metoda refreshrow jest obsugiwana tylko przez obiekt typu "update"';
  SMustBeInBrowseMode = 'Operacja jest dozwolona tylko w stanie dsBROWSE';

  SUnKnownParamDataType = 'Nieznany Param.DataType';
  SFieldReadOnly        = 'Nie mona przypisa do pola tylko do odczytu wartoci: %d';
  SInvalidUpdateCount     = 'Liczba zaktualizowanych rekordw: %d. tylko jeden rekord powinien by zaktualizowany.';

  SRowBufferWidthExceeded ='Translate: Row buffer width exceeded. Try using fewer or longer columns in SQL query.';

{$ELSE} // default: ENGLISH


  SSQLError1 = 'SQL Error: %s';
  SSQLError2 = 'SQL Error: %s Code: %d';
  SSQLError3 = 'SQL Error: %s Code: %d SQL: %s';
  SSQLError4 = 'SQL Error: %s Code: %d Message: %s';

  SListCapacityError = 'List capacity out of bounds (%d)';
  SListCountError = 'List count out of bounds (%d)';
  SListIndexError = 'List index out of bounds (%d)';

  SClonningIsNotSupported = 'Clonning is not supported by this class';
  SImmutableOpIsNotAllowed = 'The operation is not allowed on not changeable collections';
  SStackIsEmpty = 'Stack is empty';
  SVariableWasNotFound = 'Variable "%s" was not found';
  SFunctionWasNotFound = 'Function "%s" was not found';
  SInternalError = 'Internal error';
  SSyntaxErrorNear = 'Syntax error near "%s"';
  SSyntaxError = 'Syntax error';
  SUnknownSymbol = 'Unknown symbol "%s"';
  SUnexpectedExprEnd = 'Unexpected end of expression';
  SRightBraceExpected = ') expected';
  SParametersError = '%d parameters were expected but %d were found';
  SExpectedMoreParams = 'More than two parameters are expected';
  SInvalidVarByteArray = 'Invalid VarByte array';
  SVariableAlreadyExists = 'Variable "%s" already exists';
  STypesMismatch = 'Types mismatch';
  SUnsupportedVariantType = 'Unsupported variant type';
  SUnsupportedOperation = 'Unsupported operation';

  STokenizerIsNotDefined = 'Tokenizer is not defined';
  SLibraryNotFound = 'None of the dynamic libraries can be found: %s';
  SEncodeDateIsNotSupported = 'This version does not support isc_encode_sql_date';
  SEncodeTimeIsNotSupported = 'This version does not support isc_encode_sql_time';
  SEncodeTimestampIsNotSupported = 'This version does not support isc_encode_sql_timestamp';
  SDecodeDateIsNotSupported = 'This version does not support isc_decode_sql_date';
  SDecodeTimeIsNotSupported = 'This version does not support isc_decode_sql_time';
  SDecodeTimestampIsNotSupported = 'This version does not support isc_decode_sql_timestamp';

  SCanNotRetrieveResultSetData = 'Cannot retrieve Resultset data';
  SRowBufferIsNotAssigned = 'Row buffer is not assigned';
  SColumnIsNotAccessable = 'Column with index %d is not accessable';
  SConversionIsNotPossible = 'Conversion is not possible for column %d from %s to %s';
  SCanNotAccessBlobRecord = 'Cannot access blob record in column %d with type %s';
  SRowDataIsNotAvailable = 'Row data is not available';
  SResolverIsNotSpecified = 'Resolver is not specified for this ResultSet';
  SResultsetIsAlreadyOpened = 'Resultset is already open';
  SCanNotUpdateEmptyRow = 'Cannot update an empty row';
  SCanNotUpdateDeletedRow = 'Cannot update a deleted row';
  SCanNotDeleteEmptyRow = 'Cannot delete an empty row';
  SCannotUseCommit = 'You cannot use COMMIT in AUTOCOMMIT mode';
  SCannotUseRollBack = 'You cannot use ROLLBACK in AUTOCOMMIT mode';
  SCanNotUpdateComplexQuery = 'Cannot update a complex query with more then one table';
  SCanNotUpdateThisQueryType = 'Cannot update this query type';
  SDriverWasNotFound = 'Requested database driver was not found';
  SCanNotConnectToServer = 'Cannot connect to SQL server';
  STableIsNotSpecified = 'Table is not specified';
  SLiveResultSetsAreNotSupported = 'Live query is not supported by this class';
  SInvalidInputParameterCount = 'Input parameter count is less then expected';
  SIsolationIsNotSupported = 'Transaction isolation level is not supported';
  SColumnWasNotFound = 'Column with name "%s" was not found';
  SWrongTypeForBlobParameter = 'Wrong type for Blob parameter';
  SIncorrectConnectionURL = 'Incorrect connection URL: %s';
  SUnsupportedProtocol = 'Unsupported protocol: %s';
  SUnsupportedByDriver    = 'Driver can not support this feature natively: [%s]';

  SConnectionIsNotOpened = 'Connection is not opened yet';
  SInvalidOpInAutoCommit = 'Invalid operation in AutoCommit mode';
  SInvalidOpInNonAutoCommit = 'Invalid operation in non AutoCommit mode';
  SInvalidOpPrepare = 'Prepare transaction only possible on matching first(!) Starttransaction';

  SConnectionIsNotAssigned = 'Database connection component is not assigned';
  SQueryIsEmpty = 'SQL Query is empty';
  SCanNotExecuteMoreQueries = 'Cannot execute more then one query';
  SOperationIsNotAllowed1 = 'Operation is not allowed in FORWARD ONLY mode';
  SOperationIsNotAllowed2 = 'Operation is not allowed in READ ONLY mode';
  SOperationIsNotAllowed3 = 'Operation is not allowed in %s mode';
  SOperationIsNotAllowed4 = 'Operation is not allowed for closed dataset';
  SNoMoreRecords = 'No more records in the Resultset';
  SCanNotOpenResultSet = 'Can not open a Resultset';
  SCanNotOpenDataSetWhenDestroying ='Cannot open a dataset when the componentstate is dsDestroying';
  SCircularLink = 'Datasource makes a circular link';
  SBookmarkWasNotFound = 'Bookmark was not found';
  SIncorrectSearchFieldsNumber = 'Incorrect number of search field values';
  SInvalidOperationInTrans = 'Invalid operation in explicit transaction mode';
  SIncorrectSymbol = 'Incorrect symbol in field list "%s".';
  SIncorrectToken = 'Incorrect token followed by ":"';
  SIncorrectParamChar = 'Invalid value for ParamChar';

  SSelectedTransactionIsolation = 'Selected transaction isolation level is not supported';
  SDriverNotSupported = 'Driver not supported %s';
  SPattern2Long = 'Pattern is too long';
  SDriverNotCapableOutParameters = 'Driver is not capable to handle parameters';
  SStatementIsNotAllowed = 'Statement is not allowed';
  SStoredProcIsNotAllowed = 'The stored proc is not allowed';
  SCannotPerformOperation = 'Can not perform operation on closed Resultset';
  SInvalidState = 'Invalid state';
  SErrorConversion = 'Conversion error';
  SDataTypeDoesNotSupported = 'Data type is not supported';
  SUnsupportedParameterType = 'Unsupported parameter type';
  SUnsupportedDataType = 'Unsupported data type';
  SErrorConversionField = 'Conversion error for field "%s" to SQLType "%s"';
  SBadOCI = 'Bad OCI version [%s]. Version 8.0.3 or older is required';
  SConnect2AsUser = 'Connect to "%s" as user "%s"';
  SUnknownError = 'Unknown error';
  SFieldNotFound1 = 'Field "%s" was not found';
  SFieldNotFound2 = 'Field %d was not found';

  SLoginPromptFailure = 'Can not find default login prompt dialog. Please add DBLogDlg to the uses section of your main file.';

  SPropertyQuery = 'The Query may last a while on large databases!';
  SPropertyTables = 'You should limit it by Catalog and/or Schema.';
  SPropertyColumns = 'You should limit it by Catalog, Schema and/or TableName.';
  SPropertyProcedures = 'You should limit it by Catalog and/or Schema.';
  SPropertySequences = 'You should limit it by Catalog and/or Schema.';
  SPropertyExecute = 'Should the Query be executed anyway?';

  SFormTest = 'ZEOS SQL Editor Test';
  SButtonClose = '&Close';
  SFormEditor = 'ZEOS SQL Editor';
  STabSheetSelect = 'Select SQL';
  SMenuLoad = 'Load';
  SMenuSave = 'Save';
  SButtonGenerate = '&Generate';
  SButtonCheck = 'C&heck';
  SButtonTest = '&Test';
  SButtonOk = '&OK';
  SButtonCancel = '&Cancel';
  STableAlias = 'T&able alias';
  SReplaceSQL = '&Replace SQL';
  SDialogOpenTitle = 'Open SQL File';
  SDialogSaveTitle = 'Save SQL File';
  SSQLEditor = 'SQL Editor';
  SDatabaseDialog = 'Open existing database';

  SUpdateSQLNoResult = 'Update Refresh SQL delivered no resultset';
  SUpdateSQLRefreshStatementcount ='Update Refresh SQL Statement count must be 1';

  {$IFDEF FPC}
  SNotEditing = 'Dataset not in edit or insert mode';
  SFieldTypeMismatch = 'Type mismatch for field ''%s'', expecting: %s actual: %s';
  SFieldSizeMismatch = 'Size mismatch for field ''%s'', expecting: %d actual: %d';
  {$ENDIF}
  SNeedField               = 'Field %s is required, but not supplied.';

  SFailedtoInitPrepStmt   = 'Prepared statement failed to initialize';
  SFailedtoPrepareStmt    = 'Statement failed during prepare process';
  SFailedToBindAllValues  = 'Application failed to pre-bind all values';
  SAttemptExecOnBadPrep   = 'Attempt made to execute a statement before a successful preparation.';
  SBindingFailure         = 'Failed to bind parameter set';
  SPreparedStmtExecFailure = 'Prepared statement failed to execute';
  SBoundVarStrIndexMissing = 'Bound variable text index "%s" does not exist';
  SBindVarOutOfRange      = 'Bound variable index out of range: %d';
  SFailedToBindResults    = 'Application failed to bind to the result set';

//FOS+ 07112006
  SRefreshRowOnlySupportedWithUpdateObject = 'The refreshrow method is only supported with an update object';
  SMustBeInBrowseMode = 'Operation is only allowed in dsBROWSE state';

  SUnKnownParamDataType = 'Unknown Param.DataType';
  SFieldReadOnly        = 'Readonly field can''t be assigned a value: %d';
  SInvalidUpdateCount     = '%d record(s) updated. Only one record should have been updated.';

  SRowBufferWidthExceeded ='Row buffer width exceeded. Try using fewer or longer columns in SQL query.';

// added since mORMot fork:
  SFunctionAlreadyDefined = 'Function "%s" already defined';
  SInvalidURLN = 'URI "%s" invalid';

{$ENDIF} // POLISH

{$ENDIF} // CZECH

{$ENDIF} // RUSSIAN

{$ENDIF}   // INDONESIAN <--- added by tohenk

{$ENDIF}   // ROMANA

{$ENDIF} //SPANISH

{$ENDIF} // GERMAN

{$ENDIF} // DUTCH

{$ENDIF} // PORTUGUESE

implementation

end.





<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZSysUtils.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{           System Utility Classes and Functions          }
{                                                         }
{          Originally written by Sergey Seroukhov         }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZSysUtils;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  Variants, ZMessages, ZCompatibility, Classes, SysUtils, Types, SynCommons;

type
  {** Modified comaprison function. }
  TZListSortCompare = function (Item1, Item2: Pointer): Integer of object;

  {** Modified list of pointers. }
  TZSortedList = class (TList)
  protected
    ///   Performs quick sort algorithm for the list.
    procedure QuickSort(SortList: PPointerList; L, R: Integer;
      SCompare: TZListSortCompare);
  public
    /// Performs sorting for this list.
    // @param Compare a comparison function.
    procedure Sort(Compare: TZListSortCompare);
  end;

{**
  Determines a position of a first delimiter.
  @param Delimiters a RawUTF8 with possible delimiters.
  @param Str a RawUTF8 to be checked.
  @return a position of the first found delimiter or 0 if no delimiters was found.
}
function FirstDelimiter(const Delimiters, Str: RawUTF8): Integer;

{**
  Determines a position of a LAST delimiter.
  @param Delimiters a RawUTF8 with possible delimiters.
  @param Str a RawUTF8 to be checked.
  @return a position of the last found delimiter or 0 if no delimiters was found.
}
function LastDelimiter(const Delimiters, Str: RawUTF8): Integer;


{**
  Compares two PAnsiChars without stopping at #0
  @param P1 first PAnsiChar
  @param P2 seconds PAnsiChar
  @return <code>True</code> if the memory at P1 and P2 are equal
}
function MemLCompAnsi(P1, P2: PAnsiChar; Len: Integer): Boolean; {$ifdef HASINLINE}inline;{$endif}

{**
  Checks is the RawUTF8 starts with substring.
  @param Str a RawUTF8 to be checked.
  @param SubStr a RawUTF8 to test at the start of the Str.
  @return <code>True</code> if Str started with SubStr;
}
function StartsWith(const Str, SubStr: RawUTF8): Boolean;

{**
  Checks is the RawUTF8 ends with substring.
  @param Str a RawUTF8 to be checked.
  @param SubStr a RawUTF8 to test at the end of the Str.
  @return <code>True</code> if Str ended with SubStr;
}
function EndsWith(const Str, SubStr: RawUTF8): Boolean;

{**
  Converts SQL RawUTF8 into float value.
  @param Str an SQL RawUTF8 with comma delimiter.
  @param Def a default value if the RawUTF8 can not be converted.
  @return a converted value or Def if conversion was failt.
}
function SQLStrToFloatDef(Str: PUTF8Char; Def: Extended): Extended;

{**
  Converts SQL RawUTF8 into float value.
  @param Str an SQL RawUTF8 with comma delimiter.
  @return a converted value or Def if conversion was failt.
}
function SQLStrToFloat(Str: PUTF8Char): Extended;

{**
  Converts a character buffer into pascal RawUTF8.
  @param Buffer a character buffer pointer.
  @param Length a buffer length.
  @return a RawUTF8 retrived from the buffer.
}
function BufferToStr(Buffer: PAnsiChar; Length: LongInt): RawUTF8; {$ifdef HASINLINE}inline;{$endif}

{**
  Converts a RawUTF8 into boolean value.
  @param Str a RawUTF8 value.
  @return <code>True</code> is Str = 'Y'/'YES'/'T'/'TRUE'/<>0
}
function StrToBoolEx(const Str: RawUTF8): Boolean;

{**
  Converts a boolean into RawUTF8 value.
  @param Bool a boolean value.
  @return <code>"True"</code> or <code>"False"</code>
}
function BoolToStrEx(Bool: Boolean): RawUTF8;

{**
  Checks if the specified RawUTF8 can represent an IP address.
  @param Str a RawUTF8 value.
  @return <code>True</code> if the RawUTF8 can represent an IP address
    or <code>False</code> otherwise.
}
function IsIpAddr(const Str: RawUTF8): Boolean;

{**
  Splits RawUTF8 using the multiple chars.
  @param Str the source RawUTF8
  @param Delimiters the delimiters RawUTF8
  @return the result list where plased delimited RawUTF8
}
function SplitString(const Str, Delimiters: RawUTF8): TRawUTF8List;

{**
  Puts to list a splitted RawUTF8 using the multiple chars which replaces
  the previous list content.
  @param List a list with strings.
  @param Str the source RawUTF8
  @param Delimiters the delimiters RawUTF8
}
procedure PutSplitString(List: TRawUTF8List; const Str, Delimiters: RawUTF8);

{**
  Appends to list a splitted RawUTF8 using the multiple chars.
  @param List a list with strings.
  @param Str the source RawUTF8
  @param Delimiters the delimiters RawUTF8
}
procedure AppendSplitString(List: TRawUTF8List; const Str, Delimiters: RawUTF8);

{**
  Composes a RawUTF8 string from the specified strings list delimited with
  a special character.
  @param List a list of strings.
  @param Delimiter a delimiter RawUTF8.
  @return a composed RawUTF8 from the list.
}
function ComposeString(List: TRawUTF8List; const Delimiter: RawUTF8): RawUTF8;

{**
  Converts a float value into SQL RawUTF8 with '.' delimiter.
  @param Value a float value to be converted.
  @return a converted RawUTF8 value.
}
function FloatToSQLStr(Value: Extended): RawUTF8;

{**
  Puts to list a splitted RawUTF8 using the delimiter RawUTF8 which replaces
  the previous list content.
  @param List a list with strings.
  @param Str the source RawUTF8
  @param Delimiters the delimiter RawUTF8
}
procedure PutSplitStringEx(List: TRawUTF8List; const Str, Delimiter: RawUTF8);

{**
  Splits RawUTF8 using the delimiter RawUTF8.
  @param Str the source RawUTF8
  @param Delimiters the delimiter RawUTF8
  @return the result list where plased delimited RawUTF8
}
function SplitStringEx(const Str, Delimiter: RawUTF8): TRawUTF8List;

{**
  Appends to list a splitted RawUTF8 using the delimeter RawUTF8.
  @param List a list with strings.
  @param Str the source RawUTF8
  @param Delimiters the delimiters RawUTF8
}
procedure AppendSplitStringEx(List: TRawUTF8List; const Str, Delimiter: RawUTF8);

{**
  Converts bytes into a AnsiString representation.
  @param Value an array of bytes to be converted.
  @return a converted AnsiString.
}
function BytesToStr(const Value: TByteDynArray): RawByteString; {$ifdef HASINLINE}inline;{$endif}

{**
  Converts AnsiString into an array of bytes.
  @param Value a AnsiString to be converted.
  @return a converted array of bytes.
}
function StrToBytes(const Value: RawByteString): TByteDynArray;

{**
  Converts bytes into a variant representation.
  @param Value an array of bytes to be converted.
  @return a converted variant.
}
function BytesToVar(const Value: TByteDynArray): Variant;

{**
  Converts variant into an array of bytes.
  @param Value a varaint to be converted.
  @return a converted array of bytes.
}
function VarToBytes(const Value: Variant): TByteDynArray;

{**
  Converts Ansi SQL Date/Time to TDateTime
  @param Value a date and time RawUTF8.
  @return a decoded TDateTime value.
}
function AnsiSQLDateToDateTime(const Value: RawUTF8): TDateTime; {$ifdef HASINLINE}inline;{$endif}

{**
  Converts Timestamp RawUTF8 to TDateTime
  @param Value a timestamp RawUTF8.
  @return a decoded TDateTime value.
}
function TimestampStrToDateTime(const Value: RawUTF8): TDateTime;

{**
  Converts TDateTime to Ansi SQL Date/Time
  @param Value an encoded TDateTime value.
  @return a  date and time RawUTF8.
}
function DateTimeToAnsiSQLDate(Value: TDateTime): RawUTF8;

{**
  Converts an RawUTF8 into escape PostgreSQL format.
  @param Value a regular RawUTF8.
  @return a RawUTF8 in PostgreSQL escape format.
}
function EncodeCString(const Value: RawUTF8): RawUTF8;

{**
  Converts an RawUTF8 from escape PostgreSQL format.
  @param Value a RawUTF8 in PostgreSQL escape format.
  @return a regular RawUTF8.
}
function DecodeCString(const Value: RawUTF8): RawUTF8;

{**
  Replace chars in the RawUTF8
  @param Source a char to search.
  @param Target a char to replace.
  @param Str a source RawUTF8.
  @return a RawUTF8 with replaced chars.
}
function ReplaceChar(const Source, Target: AnsiChar; const Str: RawUTF8): RawUTF8; {$ifdef HASINLINE}inline;{$endif}

{**
   Copy buffer to the pascal RawUTF8
   @param Buffer a buffer with data
   @param Length a buffer length
   @return a buffer content
}
function MemPas(Buffer: PAnsiChar; Length: LongInt): RawUTF8;

{**
  Decodes a Full Version Value encoded with the format:
   (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
  into separated major, minor and subversion values
  @param FullVersion an integer containing the Full Version to decode.
  @param MajorVersion an integer containing the Major Version decoded.
  @param MinorVersion an integer containing the Minor Version decoded.
  @param SubVersion an integer contaning the Sub Version (revision) decoded.
}
procedure DecodeSQLVersioning(const FullVersion: Integer;
 out MajorVersion: Integer; out MinorVersion: Integer;
 out SubVersion: Integer);

{**
  Encodes major, minor and subversion (revision) values in this format:
   (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
  For example, 4.1.12 is returned as 4001012.
  @param MajorVersion an integer containing the Major Version.
  @param MinorVersion an integer containing the Minor Version.
  @param SubVersion an integer containing the Sub Version (revision).
  @return an integer containing the full version.
}
function EncodeSQLVersioning(const MajorVersion: Integer;
 const MinorVersion: Integer; const SubVersion: Integer): Integer;

{**
  Formats a Zeos SQL Version format to X.Y.Z where:
   X = major_version
   Y = minor_version
   Z = sub version
  @param SQLVersion an integer
  @return Formated Zeos SQL Version Value.
}
function FormatSQLVersion( const SQLVersion: Integer ): RawUTF8;

implementation

uses ZMatchPattern;

function FirstDelimiter(const Delimiters, Str: RawUTF8): Integer;
var // RawByteString() typecast make Pos() work fast with Delphi 6 up to XE
  I, Index: Integer;
begin
  Result := 0;
  for I := 1 to Length(Delimiters) do
  begin
    Index := Pos(RawByteString(Delimiters[I]), RawByteString(Str));
    if (Index > 0) and ((Index < Result) or (Result = 0)) then
      Result := Index;
  end;
end;

function LastDelimiter(const Delimiters, Str: RawUTF8): Integer;
var // RawByteString() typecast make Pos() work fast with Delphi 6 up to XE
  I, Index: Integer;
begin
  Result := 0;
  for I := Length(Str) downto 1 do
  begin
    Index := Pos(RawByteString(Str[I]), RawByteString(Delimiters));
    if (Index > 0) then
    begin
      Result := I;
      Break;
    end;
  end;
end;


function MemLCompAnsi(P1, P2: PAnsiChar; Len: Integer): Boolean;
begin
  result := CompareMem(P1,P2,Len);
end;

function StartsWith(const Str, SubStr: RawUTF8): Boolean;
var
  LenSubStr: Integer;
begin
  LenSubStr := Length(SubStr);
  if SubStr = '' then
    Result := True
   else if LenSubStr <= Length(Str) then
   Result := CompareMem(pointer(Str),pointer(SubStr),LenSubStr)
  else
    Result := False;
end;

function EndsWith(const Str, SubStr: RawUTF8): Boolean;
var
  LenSubStr: Integer;
  LenStr: Integer;
begin
  if SubStr = '' then
    Result := False // act like Delphi's AnsiEndsStr()
  else
  begin
    LenSubStr := Length(SubStr);
    LenStr := Length(Str);
    if LenSubStr <= LenStr then
      Result := CompareMem(PAnsiChar(Pointer(Str)) + LenStr - LenSubStr,
         Pointer(SubStr), LenSubStr)
    else
      Result := False;
  end;
end;

function SQLStrToFloatDef(Str: PUTF8Char; Def: Extended): Extended;
var Error: integer;
begin // Zeos did use ThousandSeparator, we don't
  if Str=nil then
    result := Def else begin
    if Str='$' then
      inc(Str) else
    if PCardinal(Str)^ and $ffffff=$ac82e2 then
      inc(Str,3); // ignore Euro sign (UTF-8 encoded as 0xE2, 0x82, 0xAC)
    if Str^=#0 then
      result := Def else begin
      result := GetExtended(Str,Error);
      if Error<>0 then
        result := Def;
    end;
  end;
end;

function SQLStrToFloat(Str: PUTF8Char): Extended;
var Error: integer;
begin
  result := GetExtended(Str,Error);
  if Error<>0 then
    raise EConvertError.Create('SQLStrToFloat');
end;

function BufferToStr(Buffer: PAnsiChar; Length: LongInt): RawUTF8;
begin
  SetString(Result, Buffer, Length);
end;

function StrToBoolEx(const Str: RawUTF8): Boolean;
begin
  case length(Str) of
  0: result := false;
  1: result := (Str[1] in ['y','Y','t','T']);
  else
    result := IdemPChar(pointer(Str),'YES') or IdemPChar(pointer(Str),'TRUE') or
     (GetInteger(Pointer(Str))<>0);
  end;
end;

function BoolToStrEx(Bool: Boolean): RawUTF8;
begin
  if Bool then
    Result := 'True'
  else
    Result := 'False';
end;

function IsIpAddr(const Str: RawUTF8): Boolean;
var
  I, N, M, Pos, V, Err: Integer;
begin
  if IsMatch('*.*.*.*', Str) then
  begin
    N := 0;
    M := 0;
    Pos := 1;
    for I := 1 to Length(Str) do
    begin
      if I - Pos > 3 then
        Break;
      if Str[I] = '.' then
      begin
       V := GetInteger(pointer(Copy(Str, Pos, I - Pos)),Err);
       if (Err<>0) or (V>255) then
         Break;
       Inc(N);
       Pos := I + 1;
      end;
      if Str[I] in ['0'..'9'] then
        Inc(M);
    end;
    Result := (M + N = Length(Str)) and (N = 3);
  end
  else
    Result := False;
end;

procedure SplitToStringList(List: TRawUTF8List; Str: RawUTF8; const Delimiters: RawUTF8);
var
  DelimPos: Integer;
begin
  repeat
    DelimPos := FirstDelimiter(Delimiters, Str);
    if DelimPos > 0 then
    begin
      if DelimPos > 1 then
        List.Add(Copy(Str, 1, DelimPos - 1));
      Str := Copy(Str, DelimPos + 1, Length(Str) - DelimPos);
      end
      else
      Break;
  until DelimPos <= 0;
  if Str <> '' then
    List.Add(Str);
end;

function SplitString(const Str, Delimiters: RawUTF8): TRawUTF8List;
begin
  Result := TRawUTF8List.Create;
  try
    SplitToStringList(Result, Str, Delimiters);
  except
    FreeAndNil(Result);
    raise;
  end;
end;

procedure PutSplitString(List: TRawUTF8List; const Str, Delimiters: RawUTF8);
begin
  List.Clear;
  SplitToStringList(List, Str, Delimiters);
end;

procedure AppendSplitString(List: TRawUTF8List; const Str, Delimiters: RawUTF8);
begin
  SplitToStringList(List, Str, Delimiters);
end;

function ComposeString(List: TRawUTF8List; const Delimiter: RawUTF8): RawUTF8;
begin
  result := List.GetText(Delimiter);
end;

function FloatToSQLStr(Value: Extended): RawUTF8;
begin
  result := ExtendedToStr(Value,15);
end;

procedure SplitToStringListEx(List: TRawUTF8List; const Str, Delimiter: RawUTF8);
var
   temp, temp2: RawUTF8;
begin
  temp := Str + Delimiter;
  repeat
    // RawByteString() typecast make Pos() work fast with Delphi 6 up to XE
    temp2 := Copy(temp, 0, Pos(RawByteString(Delimiter), RawByteString(temp)) - 1);
    List.Add(temp2);
    Delete(temp, 1, length(temp2) + Length(Delimiter));
  until temp = '';
end;

procedure PutSplitStringEx(List: TRawUTF8List; const Str, Delimiter: RawUTF8);
begin
  List.Clear;
  SplitToStringListEx(List, Str, Delimiter);
end;

function SplitStringEx(const Str, Delimiter: RawUTF8): TRawUTF8List;
begin
  Result := TRawUTF8List.Create;
  try
    SplitToStringListEx(Result, Str, Delimiter);
  except
    FreeAndNil(Result);
    raise;
  end;
end;

procedure AppendSplitStringEx(List: TRawUTF8List; const Str, Delimiter: RawUTF8);
begin
  SplitToStringListEx(List, Str, Delimiter);
end;

function BytesToStr(const Value: TByteDynArray): RawByteString;
begin
  SetString(Result, PAnsiChar(pointer(Value)), Length(Value))
end;

function StrToBytes(const Value: RawByteString): TByteDynArray;
var L: PtrInt;
begin
  L := Length(Value);
  SetLength(Result, L);
  if L>0 then
    Move(pointer(Value)^, result, L);
end;

function BytesToVar(const Value: TByteDynArray): Variant;
var
  I: Integer;
begin
  Result := VarArrayCreate([0, Length(Value) - 1], varByte);
  for I := 0 to Length(Value) - 1 do
    Result[I] := Value[I];
end;

function VarToBytes(const Value: Variant): TByteDynArray;
var
  I: Integer;
begin
  if not (VarIsArray(Value) and (VarArrayDimCount(Value) = 1) and
     ((VarType(Value) and VarTypeMask) = varByte)) then
    raise Exception.CreateRes(@SInvalidVarByteArray);

  SetLength(Result, VarArrayHighBound(Value, 1) + 1);
  for I := 0 to VarArrayHighBound(Value, 1) do
    Result[I] := Value[I];
end;

function AnsiSQLDateToDateTime(const Value: RawUTF8): TDateTime;
begin
  result := Iso8601ToDateTimePUTF8Char(pointer(Value),length(Value));
end;

function TimestampStrToDateTime(const Value: RawUTF8): TDateTime;
var 
  Year, Month, Day, Hour, Min, Sec: Integer; 
  StrLength, StrPos, StrPosPrev: Integer;
  P: PUTF8Char;
  Date: TDateTime;

  function CharMatch(const matchchars: RawUTF8 ): boolean; 
  // try to match as much characters as possible 
  begin
    StrPosPrev:= StrPos;
    Result:= false;
    while StrPos<=StrLength do
      // RawByteString() typecast make Pos() work fast with Delphi 6 up to XE
      if pos(RawByteString(Value[StrPos]), RawByteString(matchchars)) > 0 then
        begin
           inc(StrPos);
           Result := true;
        end
      else
        break;
  end;
begin 
  Result := 0; 
  StrPos:= 1; 
  StrLength := Length(Value);
  if StrLength=0 then
    exit; 
  P := pointer(Value);
  if not CharMatch('1234567890') then
     exit; // year
  Year := GetInteger(P+StrPosPrev-1);
  if not CharMatch('-/\') then
     exit;
  if not CharMatch('1234567890') then
     exit; // month
  Month:= GetInteger(P+StrPosPrev-1); 
  if (Month>12) or not CharMatch('-/\') then
     exit;
  if not CharMatch('1234567890') then
     exit; // day
  Day:= GetInteger(P+StrPosPrev-1);
  if not TryEncodeDate(Year, Month, Day, Date) then
    exit;
  if not CharMatch(' ') then
     exit;
  if not CharMatch('1234567890') then
     exit; // hour
  Hour := GetInteger(P+StrPosPrev-1); 
  if not CharMatch('-/\') then
     exit;
  if not CharMatch('1234567890') then
     exit; // minute
  Min:= GetInteger(P+StrPosPrev-1); 
  if not CharMatch('-/\') then
     exit;
  if not CharMatch('1234567890') then
     exit; // second
  Sec := GetInteger(P+StrPosPrev-1);
  if TryEncodeTime(Hour, Min, Sec, 0, result) then
    result := result+Date; 
end; 


function DateTimeToAnsiSQLDate(Value: TDateTime): RawUTF8;
var tmp: array[0..31] of AnsiChar;
begin
  DateToIso8601PChar(Value,tmp,true);
  TimeToIso8601PChar(Value,@tmp[10],true,' ');
  SetString(result,tmp,19);
  // faster than Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Value);
end;

{ TZSortedList }

procedure TZSortedList.QuickSort(SortList: PPointerList; L, R: Integer;
  SCompare: TZListSortCompare);
var
  I, J: Integer;
  P, T: Pointer;
begin
  repeat
    I := L;
    J := R;
    P := SortList^[(L + R) shr 1];
    repeat
      while SCompare(SortList^[I], P) < 0 do
        Inc(I);
      while SCompare(SortList^[J], P) > 0 do
        Dec(J);
      if I <= J then
      begin
        T := SortList^[I];
        SortList^[I] := SortList^[J];
        SortList^[J] := T;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(SortList, L, J, SCompare);
    L := I;
  until I >= R;
end;

procedure TZSortedList.Sort(Compare: TZListSortCompare);
begin
  if (List <> nil) and (Count > 0) then
    QuickSort(List, 0, Count - 1, Compare);
end;

function EncodeCString(const Value: RawUTF8): RawUTF8;
var
  I: Integer;
  SrcLength, DestLength: Integer;
  SrcBuffer, DestBuffer: PUTF8Char;
begin
  result := '';
  SrcLength := Length(Value);
  if SrcLength=0 then
    exit;
  SrcBuffer := pointer(Value);
  DestLength := 0;
  for I := 1 to SrcLength do
  begin
    if SrcBuffer^ in [#0] then
      Inc(DestLength, 4)
    else if SrcBuffer^ in ['"', '''', '\'] then
      Inc(DestLength, 2)
    else
       Inc(DestLength);
    Inc(SrcBuffer);
  end;

  SrcBuffer := pointer(Value);
  SetLength(Result, DestLength);
  DestBuffer := pointer(Result);
  for I := 1 to SrcLength do
  begin
    if SrcBuffer^ in [#0] then
    begin
      DestBuffer[0] := '\';
      DestBuffer[1] := AnsiChar(Ord('0') + (Byte(SrcBuffer^) shr 6));
      DestBuffer[2] := AnsiChar(Ord('0') + ((Byte(SrcBuffer^) shr 3) and $07));
      DestBuffer[3] := AnsiChar(Ord('0') + (Byte(SrcBuffer^) and $07));
      Inc(DestBuffer, 4);
    end
    else if SrcBuffer^ in ['"', '''', '\'] then
    begin
      DestBuffer[0] := '\';
      DestBuffer[1] := SrcBuffer^;
      Inc(DestBuffer, 2);
    end
    else
    begin
      DestBuffer^ := SrcBuffer^;
      Inc(DestBuffer);
    end;
    Inc(SrcBuffer);
  end;
end;
                            
function DecodeCString(const Value: RawUTF8): RawUTF8;
var
  SrcLength, DestLength: Integer;
  SrcBuffer, DestBuffer: PUTF8Char;
begin
  result := '';
  SrcLength := Length(Value);
  if SrcLength=0 then
    exit;
  SrcBuffer := pointer(Value);
  SetLength(Result, SrcLength);
  DestLength := 0;
  DestBuffer := pointer(Result);
  while SrcLength > 0 do
  begin
    if SrcBuffer^ = '\' then
    begin
      Inc(SrcBuffer);
      if SrcBuffer^ in ['0'..'9'] then
      begin
        DestBuffer^ := AnsiChar(((Byte(SrcBuffer[0]) - Ord('0')) shl 6)
          or ((Byte(SrcBuffer[1]) - Ord('0')) shl 3)
          or ((Byte(SrcBuffer[2]) - Ord('0'))));
        Inc(SrcBuffer, 3);
        Dec(SrcLength, 4);
      end
      else
      begin
        case SrcBuffer^ of
          'r': DestBuffer^ := #13;
          'n': DestBuffer^ := #10;
          't': DestBuffer^ := #9;
        else
               DestBuffer^ := SrcBuffer^;
        end;
        Inc(SrcBuffer);
        Dec(SrcLength, 2);
      end
    end
    else
    begin
      DestBuffer^ := SrcBuffer^;
      Inc(SrcBuffer);
      Dec(SrcLength);
    end;
    Inc(DestBuffer);
    Inc(DestLength);
  end;
  SetLength(Result, DestLength);
end;

function ReplaceChar(const Source, Target: AnsiChar; const Str: RawUTF8): RawUTF8;
begin
  result := StringReplaceChars(Str,Source,Target);
end;

function MemPas(Buffer: PAnsiChar; Length: LongInt): RawUTF8;
begin
  Result := '';
  if Assigned(Buffer) then
    SetString(Result, Buffer, Length);
end;

procedure DecodeSQLVersioning(const FullVersion: Integer;
 out MajorVersion: Integer; out MinorVersion: Integer;
 out SubVersion: Integer);
begin
  MajorVersion := FullVersion div 1000000;
  MinorVersion := (FullVersion - (MajorVersion * 1000000)) div 1000;
  SubVersion   := FullVersion-(MajorVersion*1000000)-(MinorVersion*1000);
end;

function EncodeSQLVersioning(const MajorVersion: Integer;
 const MinorVersion: Integer; const SubVersion: Integer): Integer;
begin
  Result := (MajorVersion * 1000000) + (MinorVersion * 1000) + SubVersion;
end;

function FormatSQLVersion(const SQLVersion: Integer): RawUTF8;
var
   MajorVersion, MinorVersion, SubVersion: Integer;
begin
  DecodeSQLVersioning(SQLVersion, MajorVersion, MinorVersion, SubVersion);
  result := FormatUTF8('%.%.%',[MajorVersion,MinorVersion,SubVersion]);
end;

end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZTokenizer.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{        String tokenizing classes and interfaces         }
{                                                         }
{         Originally written by Sergey Seroukhov          }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZTokenizer;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
   Classes, SysUtils, ZClasses, SynCommons;

type

  {**
    Objects of this class represent a type of token,
    such as "number", "symbol" or "word".
  }
  TZTokenType = (ttUnknown, ttEOF, ttFloat, ttInteger, ttHexDecimal,
    ttNumber, ttSymbol, ttQuoted, ttQuotedIdentifier, ttWord, ttKeyword, ttWhitespace,
    ttComment, ttSpecial, ttTime, ttDate, ttDateTime);

  {**
    Defines options for tokenizing strings.
  }
  TZTokenOption = (toSkipUnknown, toSkipWhitespaces, toSkipComments,
    toSkipEOF, toUnifyWhitespaces, toUnifyNumbers, toDecodeStrings);
  TZTokenOptions = set of TZTokenOption;

  {**
    A token represents a logical chunk of a string. For
    example, a typical tokenizer would break the string
    <code>"1.23 <= 12.3"</code> into three tokens: the number
    1.23, a less-than-or-equal symbol, and the number 12.3. A
    token is a receptacle, and relies on a tokenizer to decide
    precisely how to divide a string into tokens.
  }
  TZToken = packed record
    Value: RawUTF8;
    TokenType: TZTokenType;
  end;

  {** Defines a dynamic array of tokens. }
  TZTokenDynArray = array of TZToken;

  // Forward declaration
  TZTokenizer = class;

  {**
    A tokenizerState returns a token, given a reader, an initial character
    read from the reader, and a tokenizer that is conducting an overall
    tokenization of the reader. The tokenizer will typically have a character
    state table that decides which state to use, depending on an initial
    character. If a single character is insufficient, a state such
    as <code>SlashState</code> will read a second character, and may delegate
    to another state, such as <code>SlashStarState</code>. This prospect
    of delegation is the reason that the <code>nextToken()</code> method has a
    tokenizer argument.
  }
  TZTokenizerState = class (TObject)
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; virtual; abstract;
  end;

  {**
    A NumberState object returns a number from a reader. This
    state's idea of a number allows an optional, initial
    minus sign, followed by one or more digits. A decimal
    point and another string of digits may follow these digits.
  }
  TZNumberState = class (TZTokenizerState)
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
  end;

  {**
    A quoteState returns a quoted string token from a reader.
    This state will collect characters until it sees a match
    to the character that the tokenizer used to switch to
    this state. For example, if a tokenizer uses a double-
    quote character to enter this state, then <code>
    nextToken()</code> will search for another double-quote
    until it finds one or finds the end of the reader.
  }
  TZQuoteState = class (TZTokenizerState)
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;

    function EncodeString(const Value: RawUTF8; QuoteChar: AnsiChar): RawUTF8; virtual;
    function DecodeString(const Value: RawUTF8; QuoteChar: AnsiChar): RawUTF8; virtual;
  end;

  {**
    A CommentState object returns a comment from a reader.
  }
  TZCommentState = class (TZTokenizerState)
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
  end;

  {**
    This state will either delegate to a comment-handling
    state, or return a token with just a slash in it.
  }
  TZCppCommentState = class (TZCommentState)
  protected
    function GetMultiLineComment(Stream: TStream): RawUTF8;
    function GetSingleLineComment(Stream: TStream): RawUTF8;
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
  end;

  {**
    This state will either delegate to a comment-handling
    state, or return a token with just a slash in it.
  }
  TZCCommentState = class (TZCppCommentState)
  public
    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
  end;

  {*Fix for C++ Builder hpp generation bug - #817612 *}
  (*$HPPEMIT 'namespace Ztokenizer {class DELPHICLASS TZSymbolNode;}' *)
  // Forward declaration
  TZSymbolNode = class;
  TZSymbolNodeArray = array[byte] of TZSymbolNode;

  {**
    A <code>SymbolNode</code> object is a member of a tree that
    contains all possible prefixes of allowable symbols. Multi-
    character symbols appear in a <code>SymbolNode</code> tree
    with one node for each character.

    For example, the symbol <code>=:~</code> will appear in a
    tree as three nodes. The first node contains an equals sign,
    and has a child; that child contains a colon and has a
    child; this third child contains a tilde, and has no
    children of its own. If the colon node had another child
    for a dollar sign character, then the tree would contain
    the symbol <code>=:$</code>.

    A tree of <code>SymbolNode</code> objects collaborate to
    read a (potentially multi-character) symbol from an input
    stream. A root node with no character of its own finds an
    initial node that represents the first character in the
    input. This node looks to see if the next character in the
    stream matches one of its children. If so, the node
    delegates its reading task to its child. This approach
    walks down the tree, pulling symbols from the input that
    match the path down the tree.

    When a node does not have a child that matches the next
    character, we will have read the longest possible symbol
    prefix. This prefix may or may not be a valid symbol.
    Consider a tree that has had <code>=:~</code> added and has
    not had <code>=:</code> added. In this tree, of the three
    nodes that contain <code>=:~</code>, only the first and
    third contain complete symbols. If, say, the input contains
    <code>=:a</code>, the colon node will not have a child that
    matches the 'a' and so it will stop reading. The colon node
    has to "unread": it must push back its character, and ask
    its parent to unread. Unreading continues until it reaches
    an ancestor that represents a valid symbol.
  }
  TZSymbolNode = class (TObject)
  private
    FCharacter: AnsiChar;
    FValid: Boolean;
    FParent: TZSymbolNode;
    FChildren: TZSymbolNodeArray;
  protected
    procedure AddDescendantLine(const Value: RawUTF8);
    function DeepestRead(Stream: TStream): TZSymbolNode;
    function EnsureChildWithChar(Value: AnsiChar): TZSymbolNode;
    function FindChildWithChar(Value: AnsiChar): TZSymbolNode; virtual;
    function FindDescendant(const Value: RawUTF8): TZSymbolNode;
    function UnreadToValid(Stream: TStream): TZSymbolNode;

    property Children: TZSymbolNodeArray read FChildren write FChildren;
    property Character: AnsiChar read FCharacter write FCharacter;
    property Valid: Boolean read FValid write FValid;
    property Parent: TZSymbolNode read FParent write FParent;
  public
    constructor Create(Parent: TZSymbolNode; Character: AnsiChar);
    destructor Destroy; override;

    function Ancestry: RawUTF8; virtual;
  end;

  {**
    This class is a special case of a <code>SymbolNode</code>. A
    <code>SymbolRootNode</code> object has no symbol of its
    own, but has children that represent all possible symbols.
  }
  TZSymbolRootNode = class (TZSymbolNode)
  protected
    function FindChildWithChar(Value: AnsiChar): TZSymbolNode; override;
  public
    constructor Create;

    procedure Add(const Value: RawUTF8);
    function Ancestry: RawUTF8; override;
    function NextSymbol(Stream: TStream; FirstChar: AnsiChar): RawUTF8;
  end;

  {**
    The idea of a symbol is a character that stands on its
    own, such as an ampersand or a parenthesis. For example,
    when tokenizing the expression <code>(isReady)&
    (isWilling) </code>, a typical tokenizer would return 7
    tokens, including one for each parenthesis and one for
    the ampersand. Thus a series of symbols such as
    <code>)&( </code> becomes three tokens, while a series
    of letters such as <code>isReady</code> becomes a single
    word token.
    <p>
    Multi-character symbols are an exception to the rule
    that a symbol is a standalone character.  For example, a
    tokenizer may want less-than-or-equals to tokenize as a
    single token. This class provides a method for
    establishing which multi-character symbols an object of
    this class should treat as single symbols. This allows,
    for example, <code>"cat <= dog"</code> to tokenize as
    three tokens, rather than splitting the less-than and
    equals symbols into separate tokens.
    <p>
    By default, this state recognizes the following multi-
    character symbols: <code>!=, :-, <=, >=</code>
  }
  TZSymbolState = class (TZTokenizerState)
  private
    FSymbols: TZSymbolRootNode;
  protected
    property Symbols: TZSymbolRootNode read FSymbols write FSymbols;
  public
    constructor Create;
    destructor Destroy; override;

    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
    procedure Add(const Value: RawUTF8); virtual;
  end;

  {**
    A whitespace state ignores whitespace (such as blanks
    and tabs), and returns the tokenizer's next token. By
    default, all characters from 0 to 32 are whitespace.
  }
  TZWhitespaceState = class (TZTokenizerState)
  private
    FWhitespaceChars: array[0..255] of Boolean;
  public
    constructor Create;

    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
    procedure SetWhitespaceChars(FromChar: AnsiChar; ToChar: AnsiChar; Enable: Boolean);
  end;

  {**
    A wordState returns a word from a reader. Like other
    states, a tokenizer transfers the job of reading to this
    state, depending on an initial character. Thus, the
    tokenizer decides which characters may begin a word, and
    this state determines which characters may appear as a
    second or later character in a word. These are typically
    different sets of characters; in particular, it is typical
    for digits to appear as parts of a word, but not as the
    initial character of a word.
    <p>
    By default, the following characters may appear in a word.
    The method <code>setWordChars()</code> allows customizing
    this.
    <blockquote><pre>
        From    To
         'a', 'z'
         'A', 'Z'
         '0', '9'

        as well as: minus sign, underscore, and apostrophe.
    </pre></blockquote>
  }
  TZWordState = class (TZTokenizerState)
  protected
    FWordChars: set of AnsiChar;
  public
    constructor Create;

    function NextToken(Stream: TStream; FirstChar: AnsiChar;
      Tokenizer: TZTokenizer): TZToken; override;
    procedure SetWordChars(FromChar: AnsiChar; ToChar: AnsiChar; Enable: Boolean);
  end;

  {**
    A tokenizer divides a string into tokens. This class is
    highly customizable with regard to exactly how this division
    occurs, but it also has defaults that are suitable for many
    languages. This class assumes that the character values read
    from the string lie in the range 0-255. For example, the
    Unicode value of a capital A is 65, so
    <code> System.out.println((AnsiChar)65); </code> prints out a
    capital A.
    <p>
    The behavior of a tokenizer depends on its character state
    table. This table is an array of 256 <code>TokenizerState
    </code>  states. The state table decides which state to
    enter upon reading a character from the input string.
    <p>
    For example, by default, upon reading an 'A', a tokenizer
    will enter a "word" state. This means the tokenizer will
    ask a <code>WordState</code> object to consume the 'A',
    along with the characters after the 'A' that form a word.
    The state's responsibility is to consume characters and
    return a complete token.
    <p>
    The default table sets a SymbolState for every character
    from 0 to 255, and then overrides this with:
    <blockquote><pre>
        From    To     State
          0     ' '    whitespaceState
         'a'    'z'    wordState
         'A'    'Z'    wordState
        160     255    wordState
         '0'    '9'    numberState
         '-'    '-'    numberState
         '.'    '.'    numberState
         '"'    '"'    quoteState
        '\''   '\''    quoteState
         '/'    '/'    slashState
    </pre></blockquote>
    In addition to allowing modification of the state table,
    this class makes each of the states above available. Some
    of these states are customizable. For example, wordState
    allows customization of what characters can be part of a
    word, after the first character.
  }
  IZTokenizer = interface (IZInterface)
    ['{C7CF190B-C45B-4AB4-A406-5999643DF6A0}']

    function TokenizeBufferToList(const Buffer: RawUTF8; Options: TZTokenOptions):
      TRawUTF8List;
    function TokenizeStreamToList(Stream: TStream; Options: TZTokenOptions):
      TRawUTF8List;

    function TokenizeBuffer(const Buffer: RawUTF8; Options: TZTokenOptions):
      TZTokenDynArray;
    function TokenizeStream(Stream: TStream; Options: TZTokenOptions):
      TZTokenDynArray;

    function GetCommentState: TZCommentState;
    function GetNumberState: TZNumberState;
    function GetQuoteState: TZQuoteState;
    function GetSymbolState: TZSymbolState;
    function GetWhitespaceState: TZWhitespaceState;
    function GetWordState: TZWordState;
    function GetCharacterState(StartChar: AnsiChar): TZTokenizerState;
  end;

  {** Implements a default tokenizer object. }
  TZTokenizer = class (TZAbstractObject, IZTokenizer)
  private
    FCommentState: TZCommentState;
    FNumberState: TZNumberState;
    FQuoteState: TZQuoteState;
    FSymbolState: TZSymbolState;
    FWhitespaceState: TZWhitespaceState;
    FWordState: TZWordState;
    FCharacterStates: array[AnsiChar] of TZTokenizerState;
  public
    constructor Create;
    destructor Destroy; override;

    function TokenizeBufferToList(const Buffer: RawUTF8; Options: TZTokenOptions):
      TRawUTF8List;
    function TokenizeStreamToList(Stream: TStream; Options: TZTokenOptions):
      TRawUTF8List;

    function TokenizeBuffer(const Buffer: RawUTF8; Options: TZTokenOptions):
      TZTokenDynArray;
    function TokenizeStream(Stream: TStream; Options: TZTokenOptions):
      TZTokenDynArray;

    function GetCharacterState(StartChar: AnsiChar): TZTokenizerState; {$ifdef HASINLINE}inline;{$endif}
    procedure SetCharacterState(FromChar, ToChar: AnsiChar; State: TZTokenizerState);

    function GetCommentState: TZCommentState;
    function GetNumberState: TZNumberState;
    function GetQuoteState: TZQuoteState;
    function GetSymbolState: TZSymbolState;
    function GetWhitespaceState: TZWhitespaceState;
    function GetWordState: TZWordState;

    property CommentState: TZCommentState read FCommentState write FCommentState;
    property NumberState: TZNumberState read FNumberState write FNumberState;
    property QuoteState: TZQuoteState read FQuoteState write FQuoteState;
    property SymbolState: TZSymbolState read FSymbolState write FSymbolState;
    property WhitespaceState: TZWhitespaceState read FWhitespaceState
      write FWhitespaceState;
    property WordState: TZWordState read FWordState write FWordState;
  end;

implementation

uses
  Math, ZCompatibility;

{ TZNumberState }

{**
  Return a number token from a reader.
  @return a number token from a reader
}
function TZNumberState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  ReadNum: Integer;
  AbsorbedLeadingMinus: Boolean;
  AbsorbedDot: Boolean;
  GotAdigit: Boolean;

  function AbsorbDigits: RawUTF8;
  begin
    Result := '';
    while FirstChar in ['0'..'9'] do
    begin
      GotAdigit := True;
      Result := Result + RawUTF8(FirstChar);
      ReadNum := Stream.Read(FirstChar, 1 * SizeOf(AnsiChar));
      if ReadNum = 0 then
        Break;
    end;
  end;

begin
  { Initializes the process. }
  ReadNum := 0;
  AbsorbedLeadingMinus := False;
  AbsorbedDot := False;
  GotAdigit := False;

  Result.TokenType := ttUnknown;
  Result.Value := '';

  { Parses left part of the number. }
  if FirstChar = '-' then
  begin
    ReadNum := Stream.Read(FirstChar, 1 * SizeOf(AnsiChar));
    Result.Value := '-';
    AbsorbedLeadingMinus := True;
  end;
  Result.Value := Result.Value + AbsorbDigits;

  { Parses right part of the number. }
  if FirstChar = '.' then
  begin
    AbsorbedDot := True;
    Result.Value := Result.Value + '.';
    ReadNum := Stream.Read(FirstChar, 1 * SizeOf(AnsiChar));
    if ReadNum > 0 then
      Result.Value := Result.Value + AbsorbDigits;
  end;

  { Pushback wrong symbols. }
  Stream.Seek(-ReadNum, soFromCurrent);

  { Gets a token result. }
  if not GotAdigit then
  begin
    if AbsorbedLeadingMinus and AbsorbedDot then
    begin
      Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
      if Tokenizer.SymbolState <> nil then
        Result := Tokenizer.SymbolState.NextToken(Stream, '-', Tokenizer);
    end
    else if AbsorbedLeadingMinus then
    begin
      if Tokenizer.SymbolState <> nil then
        Result := Tokenizer.SymbolState.NextToken(Stream, '-', Tokenizer);
    end
    else if AbsorbedDot then
    begin
      if Tokenizer.SymbolState <> nil then
        Result := Tokenizer.SymbolState.NextToken(Stream, '.', Tokenizer);
    end;
  end
  else
  begin
    if AbsorbedDot then
      Result.TokenType := ttFloat
    else
      Result.TokenType := ttInteger;
  end;
end;

{ TZQuoteState }

{**
  Return a quoted string token from a reader. This method
  will collect characters until it sees a match to the
  character that the tokenizer used to switch to this state.

  @return a quoted string token from a reader
}
function TZQuoteState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  TempChar: RawUTF8;
  TempStr: RawUTF8;
begin
  TempStr := FirstChar;
  SetLength(TempChar,1); // RawUTF8 makes it faster than AnsiChar
  repeat
    if Stream.Read(pointer(TempChar)^, 1 * SizeOf(AnsiChar)) = 0 then
      TempChar[1] := FirstChar;
    TempStr := TempStr + TempChar;
  until TempChar[1] = FirstChar;

  Result.TokenType := ttQuoted;
  Result.Value := TempStr;
end;

{**
  Encodes a string value.
  @param Value a string value to be encoded.
  @param QuoteChar a string quote character.
  @returns an encoded string.
}
function TZQuoteState.EncodeString(const Value: RawUTF8; QuoteChar: AnsiChar): RawUTF8;
begin
  Result := RawUTF8(QuoteChar) + Value + RawUTF8(QuoteChar);
end;

{**
  Decodes a string value.
  @param Value a string value to be decoded.
  @param QuoteChar a string quote character.
  @returns an decoded string.
}
function TZQuoteState.DecodeString(const Value: RawUTF8; QuoteChar: AnsiChar): RawUTF8;
begin
  if (Length(Value) >= 2) and (Value[1] = QuoteChar)
    and (Value[Length(Value)] = Value[1]) then
    Result := Copy(Value, 2, Length(Value) - 2)
  else
    Result := Value;
end;

{ TZBasicCommentState }

{**
  Either delegate to a comment-handling state, or return a
  token with just a slash in it.

  @return either just a slash token, or the results of
    delegating to a comment-handling state
}
function TZCommentState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  ReadChar: AnsiChar;
  ReadStr: RawUTF8;
begin
  ReadStr := FirstChar;
  while (Stream.Read(ReadChar, 1 * SizeOf(AnsiChar)) > 0) and not (ReadChar in [#10, #13]) do
    ReadStr := ReadStr + RawUTF8(ReadChar);
  if ReadChar in [#10, #13] then
    Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
  Result.TokenType := ttComment;
  Result.Value := ReadStr;
end;

{ TZCppCommentState }

{**
  Ignore everything up to a closing star and slash, and
  then return the tokenizer's next token.
  @return the tokenizer's next token
}
function TZCppCommentState.GetMultiLineComment(Stream: TStream): RawUTF8;
var
  ReadChar: RawUTF8;
  LastChar: AnsiChar;
begin
  LastChar := #0;
  SetLength(ReadChar,1); // faster as RawUTF8 than AnsiChar
  Result := '';
  while Stream.Read(pointer(ReadChar)^, 1 * SizeOf(AnsiChar)) > 0 do
  begin
    Result := Result + ReadChar;
    if (LastChar = '*') and (ReadChar[1] = '/') then
      Break;
    LastChar := ReadChar[1];
  end;
end;

{**
  Ignore everything up to an end-of-line and return the tokenizer's next token.
  @return the tokenizer's next token
}
function TZCppCommentState.GetSingleLineComment(Stream: TStream): RawUTF8;
var
  ReadChar: RawUTF8;
begin
  Result := '';
  SetLength(ReadChar,1); // faster as RawUTF8 than AnsiChar
  while (Stream.Read(pointer(ReadChar)^, 1 * SizeOf(AnsiChar)) > 0) and
      not (ReadChar[1] in [#10, #13]) do
    Result := Result + ReadChar;
  // mdaems : for single line comments the line ending must be included
  // as it should never be stripped off or unified with other whitespace characters
  if ReadChar[1] in [#10, #13] then
    begin
      Result := Result + ReadChar;
      if (Stream.Read(pointer(ReadChar)^, 1 * SizeOf(AnsiChar)) > 0) then
        if (ReadChar[1] in [#10, #13]) then
          Result := Result + ReadChar else
          Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
    end;
end;

{**
  Either delegate to a comment-handling state, or return a
  token with just a slash in it.

  @return either just a slash token, or the results of
    delegating to a comment-handling state
}
function TZCppCommentState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  ReadChar: AnsiChar;
  ReadNum: Integer;
begin
  Result.TokenType := ttUnknown;
  Result.Value := FirstChar;

  ReadNum := Stream.Read(ReadChar, 1 * SizeOf(AnsiChar));
  if (ReadNum > 0) and (ReadChar = '*') then
  begin
    Result.TokenType := ttComment;
    Result.Value := '/*' + GetMultiLineComment(Stream);
  end
  else if (ReadNum > 0) and (ReadChar = '/') then
  begin
    Result.TokenType := ttComment;
    Result.Value := '//' + GetSingleLineComment(Stream);
  end
  else
  begin
    if ReadNum > 0 then
      Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
    if Tokenizer.SymbolState <> nil then
      Result := Tokenizer.SymbolState.NextToken(Stream, FirstChar, Tokenizer);
  end;
end;

{ TZCCommentState }

{**
  Gets a C specific comments like /* */.
  @return either just a slash token, or the results of
    delegating to a comment-handling state
}
function TZCCommentState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  ReadChar: AnsiChar;
  ReadNum: Integer;
begin
  Result.TokenType := ttUnknown;
  Result.Value := FirstChar;

  if FirstChar = '/' then
  begin
    ReadNum := Stream.Read(ReadChar, 1 * SizeOf(AnsiChar));
    if (ReadNum > 0) and (ReadChar = '*') then
    begin
      Result.TokenType := ttComment;
      Result.Value := '/*' + GetMultiLineComment(Stream);
    end
    else
    begin
      if ReadNum > 0 then
        Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
    end;
  end;

  if (Result.TokenType = ttUnknown) and (Tokenizer.SymbolState <> nil) then
    Result := Tokenizer.SymbolState.NextToken(Stream, FirstChar, Tokenizer);
end;

{ TZSymbolNode }

{**
  Constructs a SymbolNode with the given parent, representing
  the given character.
  @param Parent this node's parent
  @param Character this node's character
}
constructor TZSymbolNode.Create(Parent: TZSymbolNode; Character: AnsiChar);
begin
  FParent := Parent;
  FCharacter := Character;
  FValid := False;
end;

{**
  Destroys this symbol object and cleanups the memory.
}
destructor TZSymbolNode.Destroy;
var
  I: Integer;
begin
  for I := 0 to high(FChildren) do
    if FChildren[I] <> nil then
      FChildren[I].Free
    else
      Break;
  inherited Destroy;
end;

{**
  Add a line of descendants that represent the characters in the given string.
}
procedure TZSymbolNode.AddDescendantLine(const Value: RawUTF8);
var
  Node: TZSymbolNode;
begin
  if Length(Value) > 0 then
  begin
    Node := EnsureChildWithChar(Value[1]);
    Node.AddDescendantLine(Copy(Value, 2, Length(Value) - 1));
  end;
end;

{**
  Show the symbol this node represents.
  @return the symbol this node represents
}
function TZSymbolNode.Ancestry: RawUTF8;
begin
  Result := FParent.Ancestry + RawUTF8(FCharacter);
end;

{**
  Find the descendant that takes as many characters as possible from the input.
}
function TZSymbolNode.DeepestRead(Stream: TStream): TZSymbolNode;
var
  TempChar: AnsiChar;
  Node: TZSymbolNode;
  ReadNum: Integer;
begin
  ReadNum := Stream.Read(TempChar, 1 * SizeOf(AnsiChar));
  if ReadNum > 0 then
    Node := FindChildWithChar(TempChar)
  else
    Node := nil;

  if Node = nil then
  begin
    Stream.Seek(-ReadNum, soFromCurrent);
    Result := Self;
  end
  else
    Result := Node.DeepestRead(Stream);
end;

{**
  Find or create a child for the given character.
}
function TZSymbolNode.EnsureChildWithChar(Value: AnsiChar): TZSymbolNode;
var
  N: Integer;
begin
  Result := FindChildWithChar(Value);
  if Result = nil then
  begin
    N := 0;
    while (FChildren[N] <> nil) and (N <= high(FChildren)) do
      Inc(N);
    if N <= high(FChildren) then
    begin
      Result := TZSymbolNode.Create(Self, Value);
      FChildren[N] := Result;
    end;
  end;
end;

{**
  Find a child with the given character.
}
function TZSymbolNode.FindChildWithChar(Value: AnsiChar): TZSymbolNode;
var
  I: Integer;
begin
  for I := 0 to high(fChildren) do
  begin
    Result := fChildren[I];
    if (Result = nil) or (Result.Character = Value) then
      exit;
  end;
  Result := nil;
end;

{**
  Find a descendant which is down the path the given string indicates.
}
function TZSymbolNode.FindDescendant(const Value: RawUTF8): TZSymbolNode;
var
  TempChar: AnsiChar;
begin
  if Length(Value) > 0 then
    TempChar := Value[1]
  else
    TempChar := #0;
  Result := FindChildWithChar(TempChar);
  if (Length(Value) > 1) and (Result <> nil) then
    Result := Result.FindDescendant(Copy(Value, 2, Length(Value) - 1));
end;

{**
  Unwind to a valid node; this node is "valid" if its
  ancestry represents a complete symbol. If this node is
  not valid, put back the character and ask the parent to unwind.
}
function TZSymbolNode.UnreadToValid(Stream: TStream): TZSymbolNode;
begin
  if not FValid then
  begin
    Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
    Result := FParent.UnreadToValid(Stream);
  end
  else
    Result := Self;
end;

{ TZSymbolRootNode }

{**
  Create and initialize a root node.
}
constructor TZSymbolRootNode.Create;
var
  I: Integer;
begin
  inherited Create(nil, #0);
  for I := 0 to high(FChildren) do
  begin
    FChildren[I] := TZSymbolNode.Create(Self, AnsiChar(I));
    FChildren[I].Valid := True;
  end;
end;

{**
  Add the given string as a symbol.
  @param   String   the character sequence to add
}
procedure TZSymbolRootNode.Add(const Value: RawUTF8);
var
  TempChar: AnsiChar;
  Node: TZSymbolNode;
begin
  if Length(Value) > 0 then
    TempChar := Value[1]
  else
     TempChar := #0;
  Node := EnsureChildWithChar(TempChar);
  Node.AddDescendantLine(Copy(Value, 2, Length(Value) - 1));
  FindDescendant(Value).Valid := True;
end;

{**
  A root node has no parent and no character of its own, so its ancestry is "".
  @return an empty string
}
function TZSymbolRootNode.Ancestry: RawUTF8;
begin
  Result := '';
end;

{**
  A root node maintains its children in an array instead of
  a Vector, to be faster.
}
function TZSymbolRootNode.FindChildWithChar(Value: AnsiChar): TZSymbolNode;
begin
  Result := FChildren[Ord(Value)];
end;

{**
  Return a symbol string from a reader.

  @param Stream a reader to read from
  @param FirstChar the first character of this symbol, already
    read from the reader
  @return a symbol string from a reader
}
function TZSymbolRootNode.NextSymbol(Stream: TStream; FirstChar: AnsiChar): RawUTF8;
var
  Node: TZSymbolNode;
begin
  Node := FindChildWithChar(FirstChar);
  Node := Node.DeepestRead(Stream);
  Node := Node.UnreadToValid(Stream);
  Result := Node.Ancestry;
end;

{ TZSymbolState }

{**
  Constructs a symbol state with a default idea of what
  multi-character symbols to accept (as described in the class comment).
}
constructor TZSymbolState.Create;
begin
  FSymbols := TZSymbolRootNode.Create;
end;

{**
  Destroys this object and cleanups the memory.
}
destructor TZSymbolState.Destroy;
begin
  FSymbols.Free;
  inherited Destroy;
end;

{**
  Add a multi-character symbol.
  @param Value the symbol to add, such as "=:="
}
procedure TZSymbolState.Add(const Value: RawUTF8);
begin
  FSymbols.Add(Value);
end;

{**
  Return a symbol token from a reader.
  @return a symbol token from a reader
}
function TZSymbolState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
begin
  Result.TokenType := ttSymbol;
  Result.Value := FSymbols.NextSymbol(Stream, FirstChar);
end;

{ TZWhitespaceState }

{**
  Constructs a whitespace state with a default idea of what
  characters are, in fact, whitespace.
}
constructor TZWhitespaceState.Create;
begin
  SetWhitespaceChars(' ', Chr(255), False);
  SetWhitespaceChars(Chr(0), ' ', True);
end;

{**
  Ignore whitespace (such as blanks and tabs), and return
  the tokenizer's next token.
  @return the tokenizer's next token
}
function TZWhitespaceState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  ReadNum: Integer;
  ReadChar: RawUTF8;
  ReadStr: RawUTF8;
begin
  ReadStr := RawUTF8(FirstChar);
  SetLength(ReadChar,1); // RawUTF8 is faster than AnsiChar
  ReadNum := 0;
  while True do
  begin
    ReadNum := Stream.Read(pointer(ReadChar)^, 1 * SizeOf(AnsiChar));
    if (ReadNum = 0) or not FWhitespaceChars[Ord(ReadChar[1])] then
      Break;
    ReadStr := ReadStr + ReadChar;
  end;

  if ReadNum > 0 then
    Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
  Result.TokenType := ttWhitespace;
  Result.Value := ReadStr;
end;

{**
  Establish the given characters as whitespace to ignore.
  @param FromChar first character index.
  @param ToChar last character index.
  @param Enable true, if this state should ignore characters in the given range
}
procedure TZWhitespaceState.SetWhitespaceChars(FromChar, ToChar: AnsiChar;
  Enable: Boolean);
var
  I: Integer;
begin
  for I := Ord(FromChar) to MinIntValue([Ord(ToChar), 255]) do
    FWhitespaceChars[I] := Enable;
end;

{ TZWordState }

{**
  Constructs a word state with a default idea of what characters
  are admissible inside a word (as described in the class comment).
}
constructor TZWordState.Create;
begin
  SetWordChars('a', 'z', True);
  SetWordChars('A', 'Z', True);
  SetWordChars('0', '9', True);
  include(FWordChars,'-');
  include(FWordChars,'_');
  include(FWordChars,'''');
  SetWordChars(AnsiChar($80), AnsiChar($ff), True); // all UTF-8 not ASCII chars
end;

{**
  Return a word token from a reader.
  @return a word token from a reader
}
function TZWordState.NextToken(Stream: TStream; FirstChar: AnsiChar;
  Tokenizer: TZTokenizer): TZToken;
var
  TempChar: RawUTF8;
  ReadNum: Integer;
  Value: RawUTF8;
begin
  Value := FirstChar;
  SetLength(TempChar,1); // RawUTF8 is faster than AnsiChar
  repeat
    ReadNum := Stream.Read(pointer(TempChar)^, 1 * SizeOf(AnsiChar));
    if (ReadNum = 0) or not (TempChar[1] in FWordChars) then
      Break;
    Value := Value + TempChar;
  until False;

  if ReadNum > 0 then
    Stream.Seek(-(1 * SizeOf(AnsiChar)), soFromCurrent);
  Result.TokenType := ttWord;
  Result.Value := Value;
end;

{**
  Establish characters in the given range as valid
  characters for part of a word after the first character.
  Note that the tokenizer must determine which characters
  are valid as the beginning character of a word.
  @param FromChar first character index.
  @param ToChar last character index.
  @param Enable true, if this state should ignore characters in the given range
}
procedure TZWordState.SetWordChars(FromChar, ToChar: AnsiChar; Enable: Boolean);
var
  C: AnsiChar;
begin
  if Enable then
    for C := FromChar to ToChar do
      include(FWordChars,C) else
    for C := FromChar to ToChar do
      exclude(FWordChars,C);
end;

{ TZTokenizer }

{**
  Constructs a tokenizer with a default state table (as
  described in the class comment).
}
constructor TZTokenizer.Create;
begin
  FSymbolState := TZSymbolState.Create;
  with TZSymbolState(FSymbolState) do
  begin
    Add('<>');
    Add('<=');
    Add('>=');
  end;

  FNumberState := TZNumberState.Create;
  FQuoteState := TZQuoteState.Create;
  FWhitespaceState := TZWhitespaceState.Create;
  FWordState := TZWordState.Create;
  FCommentState := TZCppCommentState.Create;

  SetCharacterState(#0, #255, FSymbolState);
  SetCharacterState(#0, ' ', FWhitespaceState);
  SetCharacterState('a', 'z', FWordState);
  SetCharacterState('A', 'Z', FWordState);
  SetCharacterState(Chr($c0),  Chr($ff), FWordState); //chars from #192 () ~ 255 ()
  SetCharacterState('0', '9', FNumberState);
  SetCharacterState('-', '-', FNumberState);
  SetCharacterState('.', '.', FNumberState);
  SetCharacterState('"', '"', FQuoteState);
  SetCharacterState('''', '''', FQuoteState);
  SetCharacterState('/', '/', FCommentState);
end;

{**
  Destroys this object and cleanups the memory.
}
destructor TZTokenizer.Destroy;
begin
  if FCommentState <> nil then
    FCommentState.Free;
  if FNumberState <> nil then
    FNumberState.Free;
  if FQuoteState <> nil then
    FQuoteState.Free;
  if FSymbolState <> nil then
    FSymbolState.Free;
  if FWhitespaceState <> nil then
    FWhitespaceState.Free;
  if FWordState <> nil then
    FWordState.Free;

  inherited Destroy;
end;

{**
  Gets an initial state object for the specified character.
  @return an initial state object for the character.
}
function TZTokenizer.GetCharacterState(StartChar: AnsiChar): TZTokenizerState;
begin
  Result := FCharacterStates[StartChar];
end;

{**
  Change the state the tokenizer will enter upon reading
  any character between "from" and "to".

  @param FromChar first character index.
  @param ToChar last character index.
  @param State the state to enter upon reading a
    character between "fromChar" and "toChar"
}
procedure TZTokenizer.SetCharacterState(FromChar, ToChar: AnsiChar;
  State: TZTokenizerState);
var
  C: AnsiChar;
begin
  for C := FromChar to ToChar do
    FCharacterStates[C] := State;
end;

{**
  Tokenizes a string buffer into a dynamic array of tokens.
  @param Buffer a string buffer to be tokenized.
  @param Options a set of tokenizer options.
  @returns a dynamic array of tokens
}
function TZTokenizer.TokenizeBuffer(const Buffer: RawUTF8;
  Options: TZTokenOptions): TZTokenDynArray;
var
  Stream: TStream;
begin
  Stream := TRawUTF8Stream.Create(Buffer);
  try
    Result := TokenizeStream(Stream, Options);
  finally
    Stream.Free;
  end;
end;

{**
  Tokenizes a string buffer into a list of tokens.
  @param Buffer a string buffer to be tokenized.
  @param Options a set of tokenizer options.
  @returns a string list where Items are tokens and
    Objects are token types.
}
function TZTokenizer.TokenizeBufferToList(const Buffer: RawUTF8;
  Options: TZTokenOptions): TRawUTF8List;
var
  Stream: TStream;
begin
  Stream := TRawUTF8Stream.Create(Buffer);
  try
    Result := TokenizeStreamToList(Stream, Options);
  finally
    Stream.Free;
  end;
end;

{**
  Tokenizes a stream into a dynamic array of tokens.
  @param Stream a stream to be tokenized.
  @param Options a set of tokenizer options.
  @returns a dynamic array of tokens
}
function TZTokenizer.TokenizeStream(Stream: TStream;
  Options: TZTokenOptions): TZTokenDynArray;
var
  I: Integer;
  List: TRawUTF8List;
begin
  List := TokenizeStreamToList(Stream, Options);
  try
    SetLength(Result, List.Count);
    for I := 0  to List.Count - 1 do
    begin
      Result[I].Value := List[I];
      Result[I].TokenType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
        List.Objects[I]{$IFDEF FPC}){$ENDIF});
    end;
  finally
    List.Free;
  end;
end;

{**
  Tokenizes a stream into a string list of tokens.
  @param Stream a stream to be tokenized.
  @param Options a set of tokenizer options.
  @returns a string list where Items are tokens and
    Objects are token types.
}
function TZTokenizer.TokenizeStreamToList(Stream: TStream;
  Options: TZTokenOptions): TRawUTF8List;
var
  FirstChar: AnsiChar;
  Token: TZToken;
  LastTokenType: TZTokenType;
  State: TZTokenizerState;
begin
  Result := TRawUTF8List.Create;
  LastTokenType := ttUnknown;

  while Stream.Read(FirstChar, 1 * SizeOf(AnsiChar)) > 0 do
  begin
    State := FCharacterStates[FirstChar];
    if State <> nil then
    begin
      Token := State.NextToken(Stream, FirstChar, Self);
      { Decode strings. }
      if (State is TZQuoteState)
        and (toDecodeStrings in Options) then
      begin
        Token.Value := (State as TZQuoteState).DecodeString(
          Token.Value, FirstChar);
      end;
      { Skips comments if option set. }
      if (Token.TokenType = ttComment)
        and (toSkipComments in Options) then
        Continue;
      { Skips whitespaces if option set. }
      if (Token.TokenType = ttWhitespace)
        and (toSkipWhitespaces in Options) then
        Continue;
      { Unifies whitespaces if option set. }
      if (Token.TokenType = ttWhitespace)
        and (toUnifyWhitespaces in Options) then
      begin
        if LastTokenType = ttWhitespace then
          Continue;
        Token.Value := ' ';
      end;
      { Unifies numbers if option set. }
      if (Token.TokenType in [ttInteger, ttFloat, ttHexDecimal])
        and (toUnifyNumbers in Options) then
        Token.TokenType := ttNumber;
      { If an integer is immediately followed by a string they should be seen as one string}
      if ((Token.TokenType = ttWord)and(LastTokenType = ttInteger)) then
      begin
        Token.Value := Result[Result.Count-1] + Token.Value;
        Result.Delete(Result.Count-1);
      end; 
      { Add a read token. }
      LastTokenType := Token.TokenType;
      Result.AddObject(Token.Value, TObject(Ord(Token.TokenType)));
    end
    { Skips unknown chars if option set. }
    else if not (toSkipUnknown in Options) then
      Result.AddObject(FirstChar, TObject(Ord(ttUnknown)));
  end;
  { Adds an EOF if option is not set. }
  if not (toSkipEOF in Options) then
    Result.AddObject('', TObject(Ord(ttEOF)));
end;

{**
  Gets a tokenizer default comment state.
  @returns a tokenizer default comment state.
}
function TZTokenizer.GetCommentState: TZCommentState;
begin
  Result := CommentState;
end;

{**
  Gets a tokenizer default number state.
  @returns a tokenizer default number state.
}
function TZTokenizer.GetNumberState: TZNumberState;
begin
  Result := NumberState;
end;

{**
  Gets a tokenizer default quote state.
  @returns a tokenizer default quote state.
}
function TZTokenizer.GetQuoteState: TZQuoteState;
begin
  Result := QuoteState;
end;

{**
  Gets a tokenizer default symbol state.
  @returns a tokenizer default symbol state.
}
function TZTokenizer.GetSymbolState: TZSymbolState;
begin
  Result := SymbolState;
end;

{**
  Gets a tokenizer default whitespace state.
  @returns a tokenizer default whitespace state.
}
function TZTokenizer.GetWhitespaceState: TZWhitespaceState;
begin
  Result := WhitespaceState;
end;

{**
  Gets a tokenizer default word state.
  @returns a tokenizer default word state.
}
function TZTokenizer.GetWordState: TZWordState;
begin
  Result := WordState;
end;

end.

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/core/ZURL.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{                        TZURL Class                      }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}
unit ZURL;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  Classes, SysUtils, SynCommons;

type
  /// handle ZDBC URI encoding/decoding
  TZURL = class
  private
    FPrefix: RawUTF8;
    FProtocol: RawUTF8;
    FHostName: RawUTF8;
    FPort: Integer;
    FDatabase: RawUTF8;
    FUserName: RawUTF8;
    FPassword: RawUTF8;
    FProperties: TRawUTF8List;
    function GetURL: RawUTF8;
    procedure SetURL(const Value: RawUTF8);
    procedure OnPropertiesChange(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    property Prefix: RawUTF8 read FPrefix write FPrefix;
    property Protocol: RawUTF8 read FProtocol write FProtocol;
    property HostName: RawUTF8 read FHostName write FHostName;
    property Port: Integer read FPort write FPort;
    property Database: RawUTF8 read FDatabase write FDatabase;
    property UserName: RawUTF8 read FUserName write FUserName;
    property Password: RawUTF8 read FPassword write FPassword;
    property Properties: TRawUTF8List read FProperties;
    property URL: RawUTF8 read GetURL write SetURL;
  end;

implementation

uses
  ZCompatibility, ZMessages;

{ TZURL }

constructor TZURL.Create;
begin
  inherited;
  FPrefix := 'zdbc';
  FProperties := TRawUTF8List.Create;
  FProperties.OnChange := OnPropertiesChange;
end;

destructor TZURL.Destroy;
begin
  FProperties.Free;
  inherited;
end;

function TZURL.GetURL: RawUTF8;
var
  I: Integer;
  PropName: RawUTF8;
  PropValue: RawUTF8;
begin
  Result := FormatUTF8('%:%:',[Prefix,Protocol]);
  if HostName <> '' then
  begin
    Result := Result + '//' + HostName;
    if Port <> 0 then
      Result := FormatUTF8('%:%',[Result,Port]);
  end;
  if Database <> '' then
    Result := Result + '/' + Database;
  if (FUserName <> '') or (FPassword <> '') or (Properties.Count > 0) then
    Result := Result + '?';
  if FUserName <> '' then
    Result := Result + 'username=' + FUserName;
  if FPassword <> '' then
  begin
    if Result[Length(Result)] <> '?' then
      Result := Result + ';';
    Result := Result + 'password=' + FPassword
  end;
  for I := 0 to Properties.Count - 1 do
  begin
    PropName := FProperties.Names[I];
    PropValue := LowerCase(FProperties.GetValueAt(i));
    if (PropValue<>'') and
       (PropValue<>'uid') and (PropValue<>'pwd') and
       (PropValue<>'username') and (PropValue<>'password') then
    begin
      if Result[Length(Result)]<>'?' then
        Result := Result + ';';
      Result := Result + FProperties[I]
    end;
  end;
end;

procedure TZURL.SetURL(const Value: RawUTF8);
var
  AValue: RawUTF8;
  P, PDeb: PUTF8Char;
begin
  FProperties.OnChange := nil;
  try
    FProperties.Clear;
    FHostName := '';
    FPort := 0;
    P := pointer(Value);
    FPrefix := GetNextItem(P,':');
    FProtocol := GetNextItem(P,':');
    if (P=nil) or (FPrefix='') or (FProtocol='') then
      raise Exception.CreateResFmt(@SInvalidURLN,[Value]);
    if PWord(P)^=ord('/')+ord('/') shl 8 then begin
      inc(P,2);
      PDeb := P;
      while not (P^ in [#0,':','/','?']) do inc(P);
      SetString(FHostName,PDeb,P-PDeb);
      if P^=':' then begin
        inc(P);
        FPort := GetInteger(P);
        while not (P^ in [#0,'/','?']) do inc(P);
      end;
    end;
    if P^='/' then
      inc(P);
    PDeb := P;
    P := PosChar(P,'?');
    if P=nil then
      FDataBase := PDeb else begin
      SetString(FDataBase,PDeb,P-PDeb);
      inc(P);
      while P<>nil do begin
        AValue := GetNextItem(P,';');
        if AValue<>'' then
          FProperties.Add(AValue);
      end;
    end;
  finally
    OnPropertiesChange(nil); // set FUserName+FPassword+FProperties.OnChange
  end;
end;

procedure TZURL.OnPropertiesChange(Sender: TObject);
begin
  FProperties.OnChange := nil;
  try
    FProperties.UpdateValue('UID',FUserName,true);
    FProperties.UpdateValue('username',FUserName,true);
    FProperties.UpdateValue('PWD',FPassword,true);
    FProperties.UpdateValue('password',FPassword,true);
  finally
    FProperties.OnChange := OnPropertiesChange;
  end;
end;

end.

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




































































































































































































































































































































































































































Deleted zeos/core/ZVariables.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{             Variables classes and interfaces            }
{                                                         }
{            Originally written by Sergey Seroukhov       }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZVariables;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  SysUtils, Classes, Contnrs, ZCompatibility, ZVariant, ZExpression,
  SynCommons;

type
  {** Implements a variable holder object. }
  TZVariable = class(TObject)
  private
    FName: RawUTF8;
    FValue: TZVariant;
  public
    constructor Create(const Name: RawUTF8; const Value: TZVariant);
    property Name: RawUTF8 read FName write FName;
    property Value: TZVariant read FValue write FValue;
  end;

  {** Implements a variables list. }
  TZVariablesList = class(TInterfacedObject, IZVariablesList)
  private
    FVariables: TObjectList;
  public
    constructor Create;
    destructor Destroy; override;

    function GetCount: Integer;
    function GetName(Index: Integer): RawUTF8;
    function GetValue(Index: Integer): TZVariant;
    procedure SetValue(Index: Integer; const Value: TZVariant);
    function GetValueByName(const Name: RawUTF8): TZVariant;
    procedure SetValueByName(const Name: RawUTF8; const Value: TZVariant);

    procedure Add(const Name: RawUTF8; const Value: TZVariant);
    procedure Remove(const Name: RawUTF8);
    function FindByName(const Name: RawUTF8): Integer;

    procedure ClearValues;
    procedure Clear;
  end;

implementation

uses ZMessages;

{ TZVariable }

{**
  Creates a new instance of variable
  @param Name a variable name.
  @param Value a variable value.
}
constructor TZVariable.Create(const Name: RawUTF8; const Value: TZVariant);
begin
  FName := Name;
  FValue := Value;
end;

{ TZVariablesList }

{**
  Creates this variable list object.
}
constructor TZVariablesList.Create;
begin
  FVariables := TObjectList.Create;
end;

{**
  Destroys this object and cleanups the memory.
}
destructor TZVariablesList.Destroy;
begin
  FVariables.Free;
  inherited Destroy;
end;

{**
  Finds a variable by specified name.
  @param Name a name of the variable.
  @returns a found variable index or <code>-1</code> otherwise.
}
function TZVariablesList.FindByName(const Name: RawUTF8): Integer;
var
  UpperName: RawUTF8;
begin
  UpperName := UpperCase(Name);
  for result := 0 to FVariables.Count - 1 do
    if TZVariable(FVariables[result]).Name = UpperName then
      exit;
  result := -1;
end;

{**
  Adds a new variable with value.
  @param Name a name of the new variable.
  @param Value a value for the new variable.
}
procedure TZVariablesList.Add(const Name: RawUTF8; const Value: TZVariant);
begin
  if FindByName(Name) >= 0 then
    raise Exception.CreateResFmt(@SVariableAlreadyExists, [Name]);
  FVariables.Add(TZVariable.Create(UpperCase(Name), Value));
end;

{**
  Removes a variable by specified name.
  @param Name a name of variable to be removed.
}
procedure TZVariablesList.Remove(const Name: RawUTF8);
var
  Index: Integer;
begin
  Index := FindByName(Name);
  if Index >= 0 then
    FVariables.Delete(Index);
end;

{**
  Clears all variables.
}
procedure TZVariablesList.Clear;
begin
  FVariables.Clear;
end;

{**
  Clears only variable values.
}
procedure TZVariablesList.ClearValues;
var
  I: Integer;
begin
  for I := 0 to FVariables.Count - 1 do
    TZVariable(FVariables[I]).Value := NullVariant;
end;

{**
  Gets a number of registered variables.
  @returns a number of all registered variables.
}
function TZVariablesList.GetCount: Integer;
begin
  Result := FVariables.Count;
end;

{**
  Gets a variable name by it's index.
  @param Index a variable index.
  @returns a variable name.
}
function TZVariablesList.GetName(Index: Integer): RawUTF8;
begin
  Result := TZVariable(FVariables[Index]).Name;
end;

{**
  Gets a variable value by it's index.
  @param Index a variable index.
  @returns a variable value
}
function TZVariablesList.GetValue(Index: Integer): TZVariant;
begin
  Result := TZVariable(FVariables[Index]).Value;
end;

{**
  Gets a variable name by it's name.
  @param Name a variable name.
  @returns a variable value.
}
function TZVariablesList.GetValueByName(const Name: RawUTF8): TZVariant;
var
  Index: Integer;
begin
  Index := FindByName(Name);
  if Index >= 0 then
    Result := TZVariable(FVariables[Index]).Value
  else
    Result := NullVariant;
end;

{**
  Sets a variable name by it's index.
  @param Index a variable index.
  @param Value a variable value.
}
procedure TZVariablesList.SetValue(Index: Integer; const Value: TZVariant);
begin
  TZVariable(FVariables[Index]).Value := Value;
end;

{**
  Sets a variable name by it's name.
  @param Index a variable name.
  @param Value a variable value.
}
procedure TZVariablesList.SetValueByName(const Name: RawUTF8; const Value: TZVariant);
var
  Index: Integer;
begin
  Index := FindByName(Name);
  if Index >= 0 then
    TZVariable(FVariables[Index]).Value := Value
  else
    Add(Name, Value);
end;

end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































































































































































































































































































































































































































































































Deleted zeos/core/ZVariant.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{               Variant Processing Classes                }
{                                                         }
{            Originally written by Sergey Seroukhov       }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZVariant;

interface

{$I ZCore.inc}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  Classes, SysUtils, ZCompatibility, ZClasses, ZSysUtils, SynCommons;

const
  {** Precision for float values comparison }
  FLOAT_COMPARE_PRECISION = 1.e-5;

type
  {** Defines variant types. }
  TZVariantType = (vtNull, vtBoolean, vtInteger, vtFloat, vtUTF8,
    vtDateTime, vtPointer, vtInterface);

  {** Defines a variant structure. }
  TZVariant = record // not packed for best performance 
    VUTF8: RawUTF8;
    VInterface: IZInterface;
    case VType: TZVariantType of
      vtBoolean: (VBoolean: Boolean);
      vtInteger: (VInteger: Int64);
      vtFloat: (VFloat: Extended);
      VtDateTime: (VDateTime: TDateTime);
      VtPointer: (VPointer: Pointer);
  end;

  PZVariant = ^TZVariant;

  {** Defines an array of variants. }
  TZVariantDynArray = array of TZVariant;

  {** Defines a variant processing exception. }
  EZVariantException = class (Exception);

  {** Defines an interface for variant data. }
  {** Defines a Variant Manager interface. }
  IZVariantManager = interface (IZInterface)
    ['{DAA373D9-1A98-4AA8-B65E-4C23167EE83F}']

    function IsNull(const Value: TZVariant): Boolean;
    procedure SetNull(var Value: TZVariant);

    function Convert(const Value: TZVariant; NewType: TZVariantType): TZVariant;
    procedure Assign(const SrcValue: TZVariant; var DstValue: TZVariant);
    function Clone(const Value: TZVariant): TZVariant;
    function Compare(const Value1, Value2: TZVariant): Integer;

    function GetAsBoolean(const Value: TZVariant): Boolean;
    function GetAsInteger(const Value: TZVariant): Int64;
    function GetAsFloat(const Value: TZVariant): Extended;
    function GetAsUTF8(const Value: TZVariant): RawUTF8;
    function GetAsDateTime(const Value: TZVariant): TDateTime;
    function GetAsPointer(const Value: TZVariant): Pointer;
    function GetAsInterface(const Value: TZVariant): IZInterface;

    procedure SetAsBoolean(var Value: TZVariant; Data: Boolean);
    procedure SetAsInteger(var Value: TZVariant; Data: Int64);
    procedure SetAsFloat(var Value: TZVariant; Data: Extended);
    procedure SetAsUTF8(var Value: TZVariant; const Data: RawUTF8);
    procedure SetAsDateTime(var Value: TZVariant; Data: TDateTime);
    procedure SetAsPointer(var Value: TZVariant; Data: Pointer);
    procedure SetAsInterface(var Value: TZVariant; Data: IZInterface);

    function OpAdd(const Value1, Value2: TZVariant): TZVariant;
    function OpSub(const Value1, Value2: TZVariant): TZVariant;
    function OpMul(const Value1, Value2: TZVariant): TZVariant;
    function OpDiv(const Value1, Value2: TZVariant): TZVariant;
    function OpMod(const Value1, Value2: TZVariant): TZVariant;
    function OpPow(const Value1, Value2: TZVariant): TZVariant;
    function OpAnd(const Value1, Value2: TZVariant): TZVariant;
    function OpOr(const Value1, Value2: TZVariant): TZVariant;
    function OpXor(const Value1, Value2: TZVariant): TZVariant;
    function OpNot(const Value: TZVariant): TZVariant;
    function OpNegative(const Value: TZVariant): TZVariant;
    function OpEqual(const Value1, Value2: TZVariant): TZVariant;
    function OpNotEqual(const Value1, Value2: TZVariant): TZVariant;
    function OpMore(const Value1, Value2: TZVariant): TZVariant;
    function OpLess(const Value1, Value2: TZVariant): TZVariant;
    function OpMoreEqual(const Value1, Value2: TZVariant): TZVariant;
    function OpLessEqual(const Value1, Value2: TZVariant): TZVariant;
  end;

  {** Implements a variant manager with strict conversion rules. }
  TZDefaultVariantManager = class (TInterfacedObject, IZVariantManager)
  protected
    procedure RaiseTypeMismatchError;
    procedure RaiseUnsupportedOperation;
  public
    function Convert(const Value: TZVariant; NewType: TZVariantType): TZVariant; virtual;
    procedure Assign(const SrcValue: TZVariant; var DstValue: TZVariant);
    function Clone(const Value: TZVariant): TZVariant;
    function Compare(const Value1, Value2: TZVariant): Integer;

    function IsNull(const Value: TZVariant): Boolean; {$ifdef HASINLINE}inline;{$endif}
    procedure SetNull(var Value: TZVariant); {$ifdef HASINLINE}inline;{$endif}

    function GetAsBoolean(const Value: TZVariant): Boolean; {$ifdef HASINLINE}inline;{$endif}
    function GetAsInteger(const Value: TZVariant): Int64; {$ifdef HASINLINE}inline;{$endif}
    function GetAsFloat(const Value: TZVariant): Extended; {$ifdef HASINLINE}inline;{$endif}
    function GetAsUTF8(const Value: TZVariant): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    function GetAsDateTime(const Value: TZVariant): TDateTime; {$ifdef HASINLINE}inline;{$endif}
    function GetAsPointer(const Value: TZVariant): Pointer; {$ifdef HASINLINE}inline;{$endif}
    function GetAsInterface(const Value: TZVariant): IZInterface; {$ifdef HASINLINE}inline;{$endif}

    procedure SetAsBoolean(var Value: TZVariant; Data: Boolean); {$ifdef HASINLINE}inline;{$endif}
    procedure SetAsInteger(var Value: TZVariant; Data: Int64); {$ifdef HASINLINE}inline;{$endif}
    procedure SetAsFloat(var Value: TZVariant; Data: Extended); {$ifdef HASINLINE}inline;{$endif}
    procedure SetAsUTF8(var Value: TZVariant; const Data: RawUTF8); {$ifdef HASINLINE}inline;{$endif}
    procedure SetAsDateTime(var Value: TZVariant; Data: TDateTime); {$ifdef HASINLINE}inline;{$endif}
    procedure SetAsPointer(var Value: TZVariant; Data: Pointer); {$ifdef HASINLINE}inline;{$endif}
    procedure SetAsInterface(var Value: TZVariant; Data: IZInterface); {$ifdef HASINLINE}inline;{$endif}

    function OpAdd(const Value1, Value2: TZVariant): TZVariant;
    function OpSub(const Value1, Value2: TZVariant): TZVariant;
    function OpMul(const Value1, Value2: TZVariant): TZVariant;
    function OpDiv(const Value1, Value2: TZVariant): TZVariant;
    function OpMod(const Value1, Value2: TZVariant): TZVariant;
    function OpPow(const Value1, Value2: TZVariant): TZVariant;
    function OpAnd(const Value1, Value2: TZVariant): TZVariant;
    function OpOr(const Value1, Value2: TZVariant): TZVariant;
    function OpXor(const Value1, Value2: TZVariant): TZVariant;
    function OpNot(const Value: TZVariant): TZVariant;
    function OpNegative(const Value: TZVariant): TZVariant;
    function OpEqual(const Value1, Value2: TZVariant): TZVariant;
    function OpNotEqual(const Value1, Value2: TZVariant): TZVariant;
    function OpMore(const Value1, Value2: TZVariant): TZVariant;
    function OpLess(const Value1, Value2: TZVariant): TZVariant;
    function OpMoreEqual(const Value1, Value2: TZVariant): TZVariant;
    function OpLessEqual(const Value1, Value2: TZVariant): TZVariant;
  end;

  {** Implements a variant manager with soft conversion rules. }
  TZSoftVariantManager = class (TZDefaultVariantManager)
  public
    function Convert(const Value: TZVariant; NewType: TZVariantType): TZVariant;
      override;
  end;

type

  {** Represents any value interface. }
  IZAnyValue = interface (IZClonnable)
    ['{E81988B3-FD0E-4524-B658-B309B02F0B6A}']

    function IsNull: Boolean;
    function GetValue: TZVariant;

    function GetBoolean: Boolean;
    function GetInteger: Int64;
    function GetFloat: Extended;
    function GetUTF8: RawUTF8;
    function GetDateTime: TDateTime;
  end;

  {** Implements an any value object. }
  TZAnyValue = class(TZAbstractObject, IZAnyValue, IZComparable)
  private
    FValue: TZVariant;
  public
    constructor Create(const Value: TZVariant);
    constructor CreateWithBoolean(Value: Boolean);
    constructor CreateWithInteger(Value: Int64);
    constructor CreateWithFloat(Value: Extended);
    constructor CreateWithUTF8(const Value: RawUTF8);
    constructor CreateWithDateTime(Value: TDateTime);

    function IsNull: Boolean;
    function GetValue: TZVariant;

    function GetBoolean: Boolean;
    function GetInteger: Int64;
    function GetFloat: Extended;
    function GetUTF8: RawUTF8;
    function GetDateTime: TDateTime;

    function Equals(const Value: IZInterface): Boolean; override;
    function Clone: IZInterface; override;
    function ToUTF8: RawUTF8; override;
  end;

{**
  Encodes a custom variant value into standard variant.
  @param Value a custom variant value to be encoded.
  @returns an encoded standard variant.
}
function EncodeVariant(const Value: TZVariant): Variant;

{**
  Encodes an array of custom variant values into array of standard variants.
  @param Value an array of custom variant values to be encoded.
  @returns an encoded array of standard variants.
}
function EncodeVariantArray(const Value: TZVariantDynArray): Variant; 

{**
  Decodes a standard variant value into custom variant.
  @param Value a standard variant value to be decoded.
  @returns an decoded custom variant.
}
function DecodeVariant(const Value: Variant): TZVariant;

{**
  Decodes an array of standard variant values into array of custom variants.
  @param Value an array of standard variant values to be decoded.
  @returns an decoded array of custom variants.
}
function DecodeVariantArray(const Value: Variant): TZVariantDynArray; 

{**
  Encodes null into a custom variant.
  @returns an decoded custom variant.
}
function EncodeNull : TZVariant; {$ifdef HASINLINE}inline;{$endif}

{**
  Encodes a boolean into a custom variant.
  @param Value a boolean value to be encoded.
  @returns an encoded custom variant.
}
function EncodeBoolean(const Value: Boolean): TZVariant; {$ifdef HASINLINE}inline;{$endif}

{**
  Encodes an integer into a custom variant.
  @param Value an intger value to be encoded.
  @returns an encoded custom variant.
}
function EncodeInteger(const Value: Int64): TZVariant; {$ifdef HASINLINE}inline;{$endif}

{**
  Encodes a float into a custom variant.
  @param Value a float value to be encoded.
  @returns an encoded custom variant.
}
function EncodeFloat(const Value: Extended): TZVariant; {$ifdef HASINLINE}inline;{$endif}

{**
  Encodes an UTF-8 string into a custom variant.
  @param Value a string value to be encoded.
  @returns an encoded custom variant.
}
function EncodeUTF8(const Value: RawUTF8): TZVariant; {$ifdef HASINLINE}inline;{$endif}

{**
  Encodes a TDateTime into a custom variant.
  @param Value a TDateTime value to be encoded.
  @returns an encoded custom variant.
}
function EncodeDateTime(const Value: TDateTime): TZVariant; {$ifdef HASINLINE}inline;{$endif}

{**
  Encodes a pointer into a custom variant.
  @param Value a pointer value to be encoded.
  @returns an encoded custom variant.
}
function EncodePointer(const Value: Pointer): TZVariant; {$ifdef HASINLINE}inline;{$endif}

{**
  Encodes an interface into a custom variant.
  @param Value an interface value to be encoded.
  @returns an encoded custom variant.
}
function EncodeInterface(const Value: IZInterface): TZVariant; {$ifdef HASINLINE}inline;{$endif}

var
  {** Declares a default variant manager with strict conversion rules. }
  DefVarManager: IZVariantManager;

  {** Declares a variant manager with soft conversion rules. }
  SoftVarManager: IZVariantManager;

  {** A NULL Variant Value. }
  NullVariant: TZVariant;

implementation

uses
  Variants, Math, ZMessages;

{ TZDefaultVariantManager }

{**
  Assignes one variant value to another one.
  @param SrcValue a source variant value.
  @param DstValue a destination variant value.
}
procedure TZDefaultVariantManager.Assign(const SrcValue: TZVariant;
  var DstValue: TZVariant);
begin
  DstValue.VType := SrcValue.VType;
  case SrcValue.VType of
    vtBoolean: DstValue.VBoolean := SrcValue.VBoolean;
    vtInteger: DstValue.VInteger := SrcValue.VInteger;
    vtFloat: DstValue.VFloat := SrcValue.VFloat;
    vtUTF8: DstValue.VUTF8 := SrcValue.VUTF8;
    vtDateTime: DstValue.VDateTime := SrcValue.VDateTime;
    vtPointer: DstValue.VPointer := SrcValue.VPointer;
    vtInterface: DstValue.VInterface := SrcValue.VInterface;
  end;
end;

{**
  Clones a variant value.
  @param Value a source variant value.
  @returns a clonned variant value.
}
function TZDefaultVariantManager.Clone(const Value: TZVariant): TZVariant;
begin
  Assign(Value, Result);
end;

{**
  Raises a type mismatch exception.
}
procedure TZDefaultVariantManager.RaiseTypeMismatchError;
begin
  raise EZVariantException.CreateRes(@STypesMismatch);
end;

{**
  Raises an unsupported operation exception.
}
procedure TZDefaultVariantManager.RaiseUnsupportedOperation;
begin
  raise EZVariantException.CreateRes(@SUnsupportedOperation);
end;

{**
  Converts a specified variant value to a new type.
  @param Value a variant value to be converted.
  @param NewType a type of the result variant value.
  @returns a converted variant value.
}
function TZDefaultVariantManager.Convert(const Value: TZVariant;
  NewType: TZVariantType): TZVariant;
begin
  Result.VType := NewType;
  case NewType of
    vtBoolean:
      case Value.VType of
        vtNull:
          Result.VBoolean := False;
        vtBoolean:
          Result.VBoolean := Value.VBoolean;
        else
          RaiseTypeMismatchError;
      end;
    vtInteger:
      case Value.VType of
        vtNull:
          Result.VInteger := 0;
        vtBoolean:
          if Value.VBoolean then
            Result.VInteger := 1
          else
            Result.VInteger := 0;
        vtInteger:
          Result.VInteger := Value.VInteger;
        else
          RaiseTypeMismatchError;
      end;
    vtFloat:
      case Value.VType of
        vtNull:
          Result.VFloat := 0;
        vtBoolean:
          if Value.VBoolean then
            Result.VFloat := 1
          else
            Result.VFloat := 0;
        vtInteger:
          Result.VFloat := Value.VInteger;
        vtFloat:
          Result.VFloat := Value.VFloat;
        else
          RaiseTypeMismatchError;
      end;
    vtUTF8:
      case Value.VType of
        vtNull:
          Result.VUTF8 := '';
        vtUTF8:
          Result.VUTF8 := Value.VUTF8;
        else
          RaiseTypeMismatchError;
      end;
    vtDateTime:
      case Value.VType of
        vtNull:
          Result.VDateTime := 0;
        vtDateTime:
          Result.VDateTime := Value.VDateTime;
        else
          RaiseTypeMismatchError;
      end;
    vtPointer:
      case Value.VType of
        vtNull:
          Result.VPointer := nil;
        vtPointer:
          Result.VPointer := Value.VPointer;
        else
          RaiseTypeMismatchError;
      end;
    vtInterface:
      case Value.VType of
        vtNull:
          Result.VInterface := nil;
        vtInterface:
          Result.VInterface := Value.VInterface;
        else
          RaiseTypeMismatchError;
      end;
  end;
end;

{**
  Compares two variant values.
  @param Value1 the first variant value.
  @param Value2 the second variant value.
  @return <0 if Value1 < Value 2, =0 if Value1 = Value2, >0 if Value1 > Value2
}
function TZDefaultVariantManager.Compare(const Value1, Value2: TZVariant): Integer;
var
  TempFloat: Extended;
  TempDateTime: TDateTime;
begin
  case Value1.VType of
    vtNull:
      begin
        if IsNull(Value2) then
          Result := 0
        else
          Result := -1;
      end;
    vtBoolean:
      begin
        if GetAsBoolean(Value2) then
        begin
          if Value1.VBoolean then
            Result := 0
          else
            Result := -1;
        end
        else
        begin
          if Value1.VBoolean then
            Result := 1
          else
            Result := 0;
        end;
      end;
    vtInteger:
      Result := Value1.VInteger - GetAsInteger(Value2);
    vtFloat:
      begin
        TempFloat := Value1.VFloat - GetAsFloat(Value2);
        if TempFloat < -FLOAT_COMPARE_PRECISION then
          Result := -1
        else if TempFloat > FLOAT_COMPARE_PRECISION then
          Result := 1
        else
          Result := 0;
      end;
    vtUTF8:
      Result := StrComp(pointer(Value1.VUTF8), pointer(GetAsUTF8(Value2)));
    vtDateTime:
      begin
        TempDateTime := GetAsDateTime(Value2);
        if Value1.VDateTime < TempDateTime then
          Result := -1
        else if Value1.VDateTime > TempDateTime then
          Result := 1
        else
          Result := 0;
      end;
    vtPointer:
      Result := LongInt(Value1.VPointer) - GetAsInteger(Value2);
    else
      Result := 0;
  end;
end;

{**
  Checks is the specified value NULL.
  @param Value a value to be checked.
  @returns <code>True</code> if variant has NULL value.
}
function TZDefaultVariantManager.IsNull(const Value: TZVariant): Boolean;
begin
  Result := Value.VType = vtNull;
end;

{**
  Sets the NULL value to specified variant.
  @param Value variant value to be set to NULL.
}
procedure TZDefaultVariantManager.SetNull(var Value: TZVariant);
begin
  Value := EncodeNull;
end;

{**
  Gets a variant to boolean value.
  @param Value a variant to be converted.
  @param a result value.
}
function TZDefaultVariantManager.GetAsBoolean(const Value: TZVariant): Boolean;
begin
  Result := Convert(Value, vtBoolean).VBoolean;
end;

{**
  Gets a variant to integer value.
  @param Value a variant to be converted.
  @param a result value.
}
function TZDefaultVariantManager.GetAsInteger(const Value: TZVariant): Int64;
begin
  Result := Convert(Value, vtInteger).VInteger;
end;

{**
  Gets a variant to float value.
  @param Value a variant to be converted.
  @param a result value.
}
function TZDefaultVariantManager.GetAsFloat(const Value: TZVariant): Extended;
begin
  Result := Convert(Value, vtFloat).VFloat;
end;

{**
  Gets a variant to string value.
  @param Value a variant to be converted.
  @param a result value.
}
function TZDefaultVariantManager.GetAsUTF8(const Value: TZVariant): RawUTF8;
begin
  Result := Convert(Value, vtUTF8).VUTF8;
end;

{**
  Gets a variant to date and time value.
  @param Value a variant to be converted.
  @param a result value.
}
function TZDefaultVariantManager.GetAsDateTime(const Value: TZVariant): TDateTime;
begin
  Result := Convert(Value, vtDateTime).VDateTime;
end;

{**
  Gets a variant to pointer value.
  @param Value a variant to be converted.
  @param a result value.
}
function TZDefaultVariantManager.GetAsPointer(const Value: TZVariant): Pointer;
begin
  Result := Convert(Value, vtPointer).VPointer;
end;

{**
  Gets a variant to interface value.
  @param Value a variant to be converted.
  @param a result value.
}
function TZDefaultVariantManager.GetAsInterface(const Value: TZVariant): IZInterface;
begin
  Result := Convert(Value, vtInterface).VInterface;
end;

{**
  Assignes a boolean value to variant.
  @param Value a variant to store the value.
  @param Data a value to be assigned.
}
procedure TZDefaultVariantManager.SetAsBoolean(var Value: TZVariant;
  Data: Boolean);
begin
  Value := EncodeBoolean(Data);
end;

{**
  Assignes an integer value to variant.
  @param Value a variant to store the value.
  @param Data a value to be assigned.
}
procedure TZDefaultVariantManager.SetAsInteger(var Value: TZVariant;
  Data: Int64);
begin
  Value := EncodeInteger(Data);
end;

{**
  Assignes a float value to variant.
  @param Value a variant to store the value.
  @param Data a value to be assigned.
}
procedure TZDefaultVariantManager.SetAsFloat(var Value: TZVariant;
  Data: Extended);
begin
  Value := EncodeFloat(Data);
end;

{**
  Assignes a string value to variant.
  @param Value a variant to store the value.
  @param Data a value to be assigned.
}
procedure TZDefaultVariantManager.SetAsUTF8(var Value: TZVariant;
  const Data: RawUTF8);
begin
  Value := EncodeUTF8(Data);
end;

{**
  Assignes a datetime value to variant.
  @param Value a variant to store the value.
  @param Data a value to be assigned.
}
procedure TZDefaultVariantManager.SetAsDateTime(var Value: TZVariant;
  Data: TDateTime);
begin
  Value := EncodeDateTime(Data);
end;

{**
  Assignes a pointer value to variant.
  @param Value a variant to store the value.
  @param Data a value to be assigned.
}
procedure TZDefaultVariantManager.SetAsPointer(var Value: TZVariant;
  Data: Pointer);
begin
  Value := EncodePointer(Data);
end;

{**
  Assignes a interface value to variant.
  @param Value a variant to store the value.
  @param Data a value to be assigned.
}
procedure TZDefaultVariantManager.SetAsInterface(var Value: TZVariant;
  Data: IZInterface);
begin
  Value := EncodeInterface(Data);
end;

{**
  Performs '+' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpAdd(const Value1,
  Value2: TZVariant): TZVariant;
begin
  case Value1.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: RaiseUnsupportedOperation;
    vtInteger: Result := EncodeInteger(Value1.VInteger + GetAsInteger(Value2));
    vtFloat: Result := EncodeFloat(Value1.VFloat + GetAsFloat(Value2));
    vtUTF8: Result := EncodeUTF8(Value1.VUTF8 + GetAsUTF8(Value2));
    vtDateTime: Result := EncodeDateTime(Value1.VDateTime + GetAsDateTime(Value2));
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '&' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpAnd(const Value1,
  Value2: TZVariant): TZVariant;
begin
  case Value1.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: Result := EncodeBoolean(Value1.VBoolean and GetAsBoolean(Value2));
    vtInteger: Result := EncodeInteger(Value1.VInteger and GetAsInteger(Value2));
    vtFloat: RaiseUnsupportedOperation;
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '/' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpDiv(const Value1,
  Value2: TZVariant): TZVariant;
begin
  case Value1.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: RaiseUnsupportedOperation;
    vtInteger: Result := EncodeInteger(Value1.VInteger div GetAsInteger(Value2));
    vtFloat: Result := EncodeFloat(Value1.VFloat / GetAsFloat(Value2));
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '=' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpEqual(const Value1,
  Value2: TZVariant): TZVariant;
begin
  Result := EncodeBoolean(Compare(Value1, Value2) = 0);
end;

{**
  Performs '<' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpLess(const Value1,
  Value2: TZVariant): TZVariant;
begin
  Result := EncodeBoolean(Compare(Value1, Value2) < 0);
end;

{**
  Performs '<=' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpLessEqual(const Value1,
  Value2: TZVariant): TZVariant;
begin
  Result := EncodeBoolean(Compare(Value1, Value2) <= 0);
end;

{**
  Performs '%' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpMod(const Value1,
  Value2: TZVariant): TZVariant;
begin
  case Value1.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: RaiseUnsupportedOperation;
    vtInteger: Result := EncodeInteger(Value1.VInteger mod GetAsInteger(Value2));
    vtFloat: RaiseUnsupportedOperation;
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '>' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpMore(const Value1,
  Value2: TZVariant): TZVariant;
begin
  Result := EncodeBoolean(Compare(Value1, Value2) > 0);
end;

{**
  Performs '>=' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpMoreEqual(const Value1,
  Value2: TZVariant): TZVariant;
begin
  Result := EncodeBoolean(Compare(Value1, Value2) >= 0);
end;

{**
  Performs '*' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpMul(const Value1,
  Value2: TZVariant): TZVariant;
begin
  case Value1.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: RaiseUnsupportedOperation;
    vtInteger: Result := EncodeInteger(Value1.VInteger * GetAsInteger(Value2));
    vtFloat: Result := EncodeFloat(Value1.VFloat * GetAsFloat(Value2));
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs unary '-' operation.
  @param Value the variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpNegative(const Value: TZVariant): TZVariant;
begin
  case Value.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: RaiseUnsupportedOperation;
    vtInteger: Result := EncodeInteger(-Value.VInteger);
    vtFloat: Result := EncodeFloat(-Value.VFloat);
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '~' operation.
  @param Value the variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpNot(const Value: TZVariant): TZVariant;
begin
  case Value.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: Result := EncodeBoolean(not Value.VBoolean);
    vtInteger: Result := EncodeInteger(not Value.VInteger);
    vtFloat: RaiseUnsupportedOperation;
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '<>' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpNotEqual(const Value1,
  Value2: TZVariant): TZVariant;
begin
  Result := EncodeBoolean(Compare(Value1, Value2) <> 0);
end;

{**
  Performs '|' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpOr(const Value1,
  Value2: TZVariant): TZVariant;
begin
  case Value1.VType of
    vtNull: SetNull(Result);
    vtBoolean: Result := EncodeBoolean(Value1.VBoolean or GetAsBoolean(Value2));
    vtInteger: Result := EncodeInteger(Value1.VInteger or GetAsInteger(Value2));
    vtFloat: RaiseUnsupportedOperation;
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '^' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpPow(const Value1,
  Value2: TZVariant): TZVariant;
begin
  case Value1.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: RaiseUnsupportedOperation;
    vtInteger: Result := EncodeFloat(Power(Value1.VInteger, GetAsInteger(Value2)));
    vtFloat: Result := EncodeFloat(Power(Value1.VFloat, GetAsFloat(Value2)));
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '-' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpSub(const Value1,
  Value2: TZVariant): TZVariant;
begin
  case Value1.VType of
    vtNull: Result := EncodeNull;
    vtBoolean: RaiseUnsupportedOperation;
    vtInteger: Result := EncodeInteger(Value1.VInteger - GetAsInteger(Value2));
    vtFloat: Result := EncodeFloat(Value1.VFloat - GetAsFloat(Value2));
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{**
  Performs '^' operation.
  @param Value1 the first variant argument.
  @param Value2 the second variant argument.
  @returns an operation result.
}
function TZDefaultVariantManager.OpXor(const Value1,
  Value2: TZVariant): TZVariant;
var
  TempBool1, TempBool2: Boolean;
  TempInteger1, TempInteger2: Int64;
begin
  case Value1.VType of
    vtNull: Result := EncodeNull;
    vtBoolean:
      begin
        TempBool1 := Value1.VBoolean;
        TempBool2 := GetAsBoolean(Value2);
        Result := EncodeBoolean((TempBool1 and not TempBool2)
          or (not TempBool1 and TempBool2));
      end;
    vtInteger:
      begin
        TempInteger1 := Value1.VInteger;
        TempInteger2 := GetAsInteger(Value2);
        Result := EncodeInteger((TempInteger1 and not TempInteger2)
          or (not TempInteger1 and TempInteger2));
      end;
    vtFloat: RaiseUnsupportedOperation;
    vtUTF8: RaiseUnsupportedOperation;
    vtDateTime: RaiseUnsupportedOperation;
    vtPointer: RaiseUnsupportedOperation;
    vtInterface: RaiseUnsupportedOperation;
  end;
end;

{ TZSoftVariantManager }

{**
  Converts a specified variant value to a new type.
  @param Value a variant value to be converted.
  @param NewType a type of the result variant value.
  @returns a converted variant value.
}
function TZSoftVariantManager.Convert(const Value: TZVariant;
  NewType: TZVariantType): TZVariant;
begin
  Result.VType := NewType;
  case NewType of
    vtBoolean:
      case Value.VType of
        vtNull:
          Result.VBoolean := False;
        vtBoolean:
          Result.VBoolean := Value.VBoolean;
        vtInteger:
          Result.VBoolean := Value.VInteger <> 0;
        vtFloat:
          Result.VBoolean := Value.VFloat <> 0;
        vtUTF8:
          Result.VBoolean := StrToBoolEx(Value.VUTF8);
        vtDateTime:
          Result.VBoolean := Value.VDateTime <> 0;
        vtPointer:
          RaiseTypeMismatchError;
        vtInterface:
          RaiseTypeMismatchError;
      end;
    vtInteger:
      case Value.VType of
        vtNull:
          Result.VInteger := 0;
        vtBoolean:
          if Value.VBoolean then
            Result.VInteger := 1
          else
            Result.VInteger := 0;
        vtInteger:
          Result.VInteger := Value.VInteger;
        vtFloat:
          Result.VInteger := Trunc(Value.VFloat);
        vtUTF8:
          Result.VInteger := GetInteger(pointer(Value.VUTF8));
        vtDateTime:
          Result.VInteger := Trunc(Value.VDateTime);
        vtPointer:
          Result.VInteger := Integer(Value.VPointer);
        vtInterface:
          RaiseTypeMismatchError;
      end;
    vtFloat:
      case Value.VType of
        vtNull:
          Result.VFloat := 0;
        vtBoolean:
          if Value.VBoolean then
            Result.VFloat := 1
          else
            Result.VFloat := 0;
        vtInteger:
          Result.VFloat := Value.VInteger;
        vtFloat:
          Result.VFloat := Value.VFloat;
        vtUTF8:
          Result.VFloat := GetExtended(pointer(Value.VUTF8));
        vtDateTime:
          Result.VFloat := Value.VDateTime;
        vtPointer:
          RaiseTypeMismatchError;
        vtInterface:
          RaiseTypeMismatchError;
      end;
    vtUTF8:
      case Value.VType of
        vtNull:
          Result.VUTF8 := '';
        vtBoolean:
          if Value.VBoolean then
            Result.VUTF8 := 'TRUE'
          else
            Result.VUTF8 := 'FALSE';
        vtInteger:
          Result.VUTF8 := Int64ToUTF8(Value.VInteger);
        vtFloat:
          Result.VUTF8 := FloatToSqlStr(Value.VFloat);
          // gto: Not a real threat, as it's converting numbers (unicode safe)
        vtUTF8:
          Result.VUTF8 := Value.VUTF8;
        vtDateTime:
          Result.VUTF8 := DateTimeToAnsiSQLDate(Value.VDateTime);
          // gto: Not a real threat, as it's converting dates (unicode safe)
        vtPointer:
          RaiseTypeMismatchError;
        vtInterface:
          RaiseTypeMismatchError;
      end;
    vtDateTime:
      case Value.VType of
        vtNull:
          Result.VDateTime := 0;
        vtBoolean:
          RaiseTypeMismatchError;
        vtInteger:
          Result.VDateTime := Value.VInteger;
        vtFloat:
          Result.VDateTime := Value.VFloat;
        vtUTF8:
          Result.VDateTime := AnsiSQLDateToDateTime(Value.VUTF8);
        vtDateTime:
          Result.VDateTime := Value.VDateTime;
        vtPointer:
          RaiseTypeMismatchError;
        vtInterface:
          RaiseTypeMismatchError;
      end;
    vtPointer:
      case Value.VType of
        vtNull:
          Result.VPointer := nil;
        vtBoolean:
          RaiseTypeMismatchError;
        vtInteger:
          Result.VPointer := Pointer(Value.VInteger);
        vtFloat:
          RaiseTypeMismatchError;
        vtUTF8:
          RaiseTypeMismatchError;
        vtDateTime:
          RaiseTypeMismatchError;
        vtPointer:
          Result.VPointer := Value.VPointer;
        vtInterface:
          RaiseTypeMismatchError;
      end;
    vtInterface:
      case Value.VType of
        vtNull:
          Result.VInterface := nil;
        vtBoolean:
          RaiseTypeMismatchError;
        vtInteger:
          RaiseTypeMismatchError;
        vtFloat:
          RaiseTypeMismatchError;
        vtUTF8:
          RaiseTypeMismatchError;
        vtDateTime:
          RaiseTypeMismatchError;
        vtPointer:
          RaiseTypeMismatchError;
        vtInterface:
          Result.VInterface := Value.VInterface;
      end;
  end;
end;

{ TZAnyValue }

{**
  Constructs this object and assignes the main properties.
  @param Value an any value.
}
constructor TZAnyValue.Create(const Value: TZVariant);
begin
  FValue := Value;
end;

{**
  Constructs this object and assignes the main properties.
  @param Value a boolean value.
}
constructor TZAnyValue.CreateWithBoolean(Value: Boolean);
begin
  FValue := EncodeBoolean(Value);
end;

{**
  Constructs this object and assignes the main properties.
  @param Value a datetime value.
}
constructor TZAnyValue.CreateWithDateTime(Value: TDateTime);
begin
  FValue := EncodeDateTime(Value);
end;

{**
  Constructs this object and assignes the main properties.
  @param Value a float value.
}
constructor TZAnyValue.CreateWithFloat(Value: Extended);
begin
  FValue := EncodeFloat(Value);
end;

{**
  Constructs this object and assignes the main properties.
  @param Value a integer value.
}
constructor TZAnyValue.CreateWithInteger(Value: Int64);
begin
  FValue := EncodeInteger(Value);
end;

{**
  Constructs this object and assignes the main properties.
  @param Value a string value.
}
constructor TZAnyValue.CreateWithUTF8(const Value: RawUTF8);
begin
  FValue := EncodeUTF8(Value);
end;

{**
  Clones an object instance.
  @return a clonned object instance.
}
function TZAnyValue.Clone: IZInterface;
begin
  Result := TZAnyValue.Create(FValue);
end;

{**
  Compares this and another property.
  @return <code>True</code> is properties are equal.
}
function TZAnyValue.Equals(const Value: IZInterface): Boolean;
var
  Temp: IZAnyValue;
begin
  if Value <> nil then
  begin
    if Value.QueryInterface(IZAnyValue, Temp) = 0 then
    begin
      Result := SoftVarManager.Compare(FValue, Temp.GetValue) = 0;
      Temp := nil;
    end
    else
      Result := inherited Equals(Value);
  end
  else
    Result := False;
end;

{**
  Gets a stored any value.
  @return a stored any value.
}
function TZAnyValue.GetValue: TZVariant;
begin
  Result := FValue;
end;

{**
  Converts this object into the string representation.
  @return a string representation for this object.
}
function TZAnyValue.ToUTF8: RawUTF8;
begin
  Result := GetUTF8;
end;

{**
  Checks is the stored value contains NULL.
  @returns <code>True</code> if NULL is stored.
}
function TZAnyValue.IsNull: Boolean;
begin
  Result := SoftVarManager.IsNull(FValue);
end;

{**
  Gets a stored value converted to double.
  @return a stored value converted to double.
}
function TZAnyValue.GetFloat: Extended;
begin
  Result := SoftVarManager.GetAsFloat(FValue);
end;

{**
  Gets a stored value converted to integer.
  @return a stored value converted to integer.
}
function TZAnyValue.GetInteger: Int64;
begin
  Result := SoftVarManager.GetAsInteger(FValue);
end;

{**
  Gets a stored value converted to string.
  @return a stored value converted to string.
}
function TZAnyValue.GetUTF8: RawUTF8;
begin
  Result := SoftVarManager.GetAsUTF8(FValue);
end;

{**
  Gets a stored value converted to boolean.
  @return a stored value converted to boolean.
}
function TZAnyValue.GetBoolean: Boolean;
begin
  Result := SoftVarManager.GetAsBoolean(FValue);
end;

{**
{**
  Gets a stored value converted to datetime.
  @return a stored value converted to datetime.
}
function TZAnyValue.GetDateTime: TDateTime;
begin
  Result := SoftVarManager.GetAsDateTime(FValue);
end;

{**
  Encodes a custom variant value into standard variant.
  @param Value a custom variant value to be encoded.
  @returns an encoded standard variant.
}
function EncodeVariant(const Value: TZVariant): Variant;
begin
  case Value.VType of
    vtBoolean: Result := Value.VBoolean;
    vtInteger:
      if (Value.VInteger > -MaxInt) and (Value.VInteger < MaxInt) then
        Result := Integer(Value.VInteger)
      else
        Result := Int64ToUtf8(Value.VInteger);
    vtFloat: Result := Value.VFloat;
    vtUTF8: Result := Value.VUTF8;
    vtDateTime: Result := Value.VDateTime;
    vtPointer: Result := LongInt(Value.VPointer);
    vtInterface: Result := Value.VInterface;
  else
    Result := Null;
  end;
end;

{**
  Encodes an array of custom variant values into array of standard variants.
  @param Value an array of custom variant values to be encoded.
  @returns an encoded array of standard variants.
}
function EncodeVariantArray(const Value: TZVariantDynArray): Variant;
var
  I, L: Integer;
begin
  L := Length(Value);
  Result := VarArrayCreate([0, L - 1], varVariant);
  for I := 0 to L - 1 do
    Result[I] := EncodeVariant(Value[I]);
end;

{**
  Decodes a standard variant value into custom variant.
  @param Value a standard variant value to be decoded.
  @returns an decoded custom variant.
}
function DecodeVariant(const Value: Variant): TZVariant;
begin
  case VarType(Value) of
    varSmallint, varInteger, varByte:
      Result := EncodeInteger(Integer(Value));
    varBoolean: Result := EncodeBoolean(Value);
    varString: Result := EncodeUTF8(StringToUTF8(Value));
   {$IFDEF DELPHI12_UP}
   varUString: Result := EncodeUTF8(StringToUTF8(Value));
   {$ENDIF}
    varSingle, varDouble, varCurrency:
      Result := EncodeFloat(Value);
    varUnknown: Result := EncodeInterface(Value);
    varOleStr:
      Result := EncodeUTF8(StringToUTF8(Value));
    varDate: Result := EncodeDateTime(Value);
    varShortInt, varWord, varLongWord:
      Result := EncodeInteger(Value);
    varInt64{$IFDEF BDS5_UP},varUInt64{$ENDIF}:
      Result := EncodeInteger(Value);
  else
    Result := EncodeNull;
  end;
end;

{**
  Decodes an array of standard variant values into array of custom variants.
  @param Value an array of standard variant values to be decoded.
  @returns an decoded array of custom variants.
}
function DecodeVariantArray(const Value: Variant): TZVariantDynArray;
var
  I, L, H: Integer;
begin
  if VarIsArray(Value) then
  begin
    L := VarArrayLowBound(Value, 1);
    H := VarArrayHighBound(Value, 1);
    SetLength(Result, H - L + 1);
    for I := L to H do
      Result[I - L] := DecodeVariant(Value[I]);
  end
  else
  begin
    SetLength(Result, 1);
    Result[0] := DecodeVariant(Value);
  end;
end;

{**
  Creates a null variant.
}
function EncodeNull: TZVariant;
begin
  Result.VType := vtNull;
end;

{**
  Creates a boolean variant.
  @param Value a value to be assigned.
}
function EncodeBoolean(const Value: Boolean): TZVariant;
begin
  Result.VType := vtBoolean;
  Result.VBoolean := Value;
end;

{**
  Creates a integer variant.
  @param Value a value to be assigned.
}
function EncodeInteger(const Value: Int64): TZVariant;
begin
  Result.VType := vtInteger;
  Result.VInteger := Value;
end;

{**
  Creates a float variant.
  @param Value a value to be assigned.
}
function EncodeFloat(const Value: Extended): TZVariant;
begin
  Result.VType := vtFloat;
  Result.VFloat := Value;
end;

{**
  Creates a string variant.
  @param Value a value to be assigned.
}
function EncodeUTF8(const Value: RawUTF8): TZVariant;
begin
  Result.VType := vtUTF8;
  Result.VUTF8 := Value;
end;

{**
  Creates a TDateTime variant.
  @param Value a value to be assigned.
}
function EncodeDateTime(const Value: TDateTime): TZVariant;
begin
  Result.VType := vtDateTime;
  Result.VDateTime := Value;
end;

{**
  Creates a pointer variant.
  @param Value a value to be assigned.
}
function EncodePointer(const Value: Pointer): TZVariant;
begin
  Result.VType := vtPointer;
  Result.VPointer := Value;
end;

{**
  Creates an Interface variant.
  @param Value a value to be assigned.
}
function EncodeInterface(const Value: IZInterface): TZVariant;
begin
  Result.VType := vtInterface;
  Result.VInterface := Value;
end;

initialization
  DefVarManager  := TZDefaultVariantManager.Create;
  SoftVarManager := TZSoftVariantManager.Create;
  NullVariant    := EncodeNull;
finalization
  DefVarManager  := nil;
  SoftVarManager := nil;
end.


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/dbc/ZDbc.inc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

{$IFDEF LINUX}
  {$DEFINE UNIX}
{$ENDIF}

{$IFNDEF UNIX}
{$I ..\Zeos.inc}
{$ELSE}
{$I ../Zeos.inc}
{$ENDIF}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































Deleted zeos/dbc/ZDbcASA.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{         Interbase Database Connectivity Classes         }
{                                                         }
{        Originally written by Sergey Merkuriev           }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZDbcASA;

interface

{$I ZDbc.inc}

uses
  ZCompatibility, Types,
  Classes, Contnrs, SysUtils, ZDbcIntfs,
  ZDbcConnection, ZPlainASADriver, ZSysUtils, ZTokenizer,
  ZDbcGenericResolver, ZGenericSqlAnalyser;

type
  {** Implements a ASA Database Driver. }
  TZASADriver = class(TZAbstractDriver)
  private
    FASA7PlainDriver: IZASA7PlainDriver;
    FASA8PlainDriver: IZASA8PlainDriver;
    FASA9PlainDriver: IZASA9PlainDriver;
  protected
    function GetPlainDriver(const Url: string): IZASAPlainDriver;
  public
    constructor Create;
    function Connect(const Url: string; Info: TStrings): IZConnection; override;

    function GetSupportedProtocols: TStringDynArray; override;
    function GetMajorVersion: Integer; override;
    function GetMinorVersion: Integer; override;
    function GetTokenizer: IZTokenizer; override;
    function GetStatementAnalyser: IZStatementAnalyser; override;
  end;

  {** Represents a ASA specific connection interface. }
  IZASAConnection = interface (IZConnection)
    ['{FAAAFCE0-F550-4098-96C6-580145813EBF}']
    function GetDBHandle: PZASASQLCA;
    function GetPlainDriver: IZASAPlainDriver;
//    procedure CreateNewDatabase(SQL: String);
  end;

  {** Implements ASA Database Connection. }
  TZASAConnection = class(TZAbstractConnection, IZASAConnection)
  private
    FSQLCA: TZASASQLCA;
    FHandle: PZASASQLCA;
    FPlainDriver: IZASAPlainDriver;
  private
    procedure StartTransaction; virtual;
  public
    constructor Create(Driver: IZDriver; const Url: string;
      PlainDriver: IZASAPlainDriver;
      const HostName: string; Port: Integer; const Database: string;
      const User: string; const Password: string; Info: TStrings);
    destructor Destroy; override;

    function GetDBHandle: PZASASQLCA;
    function GetPlainDriver: IZASAPlainDriver;
//    procedure CreateNewDatabase(SQL: String);

    function CreateRegularStatement(Info: TStrings): IZStatement; override;
    function CreatePreparedStatement(const SQL: string; Info: TStrings):
      IZPreparedStatement; override;
    function CreateCallableStatement(const SQL: string; Info: TStrings):
      IZCallableStatement; override;

    procedure Commit; override;
    procedure Rollback; override;
    procedure SetOption(Temporary: Integer; User: PAnsiChar; const Option: string;
      const Value: string);

    procedure Open; override;
    procedure Close; override;
  end;

  {** Implements a specialized cached resolver for ASA. }
  TZASACachedResolver = class(TZGenericCachedResolver)
  public
     function FormCalculateStatement(Columns: TObjectList): string; override;
  end;


var
  {** The common driver manager object. }
  ASADriver: IZDriver;

implementation

uses
  ZDbcASAMetadata, ZDbcASAStatement, ZDbcASAUtils, ZSybaseToken,
  ZSybaseAnalyser, ZDbcUtils, ZDbcLogging;

{ TZASADriver }

{**
  Attempts to make a database connection to the given URL.
  The driver should return "null" if it realizes it is the wrong kind
  of driver to connect to the given URL.  This will be common, as when
  the JDBC driver manager is asked to connect to a given URL it passes
  the URL to each loaded driver in turn.

  <P>The driver should raise a SQLException if it is the right
  driver to connect to the given URL, but has trouble connecting to
  the database.

  <P>The java.util.Properties argument can be used to passed arbitrary
  string tag/value pairs as connection arguments.
  Normally at least "user" and "password" properties should be
  included in the Properties.

  @param url the URL of the database to which to connect
  @param info a list of arbitrary string tag/value pairs as
    connection arguments. Normally at least a "user" and
    "password" property should be included.
  @return a <code>Connection</code> object that represents a
    connection to the URL
}
function TZASADriver.Connect(const Url: string; Info: TStrings): IZConnection;
var
  TempInfo: TStrings;
  HostName, Database, UserName, Password: string;
  Port: Integer;
  PlainDriver: IZASAPlainDriver;
begin
 TempInfo := TStringList.Create;
 try
   ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
      UserName, Password, TempInfo);
   PlainDriver := GetPlainDriver(Url);
   Result := TZASAConnection.Create(Self, Url, PlainDriver, HostName, Port,
     Database, UserName, Password, TempInfo);
 finally
   TempInfo.Free;
 end;
end;

{**
  Constructs this object with default properties.
}
constructor TZASADriver.Create;
begin
  FASA7PlainDriver := TZASA7PlainDriver.Create;
  FASA8PlainDriver := TZASA8PlainDriver.Create;
  FASA9PlainDriver := TZASA9PlainDriver.Create;
end;

{**
  Gets the driver's major version number. Initially this should be 1.
  @return this driver's major version number
}
function TZASADriver.GetMajorVersion: Integer;
begin
  Result := 1;
end;

{**
  Gets the driver's minor version number. Initially this should be 0.
  @return this driver's minor version number
}
function TZASADriver.GetMinorVersion: Integer;
begin
  Result := 0;
end;

{**
  Gets a SQL syntax tokenizer.
  @returns a SQL syntax tokenizer object.
}
function TZASADriver.GetTokenizer: IZTokenizer;
begin
  if Tokenizer = nil then
    Tokenizer := TZSybaseTokenizer.Create;
  Result := Tokenizer;
end;

{**
  Creates a statement analyser object.
  @returns a statement analyser object.
}
function TZASADriver.GetStatementAnalyser: IZStatementAnalyser;
begin
  if Analyser = nil then
    Analyser := TZSybaseStatementAnalyser.Create;
  Result := Analyser;
end;

{**
  Gets plain driver for selected protocol.
  @param Url a database connection URL.
  @return a selected protocol.
}
function TZASADriver.GetPlainDriver(const Url: string): IZASAPlainDriver;
var
  Protocol: string;
begin
  Protocol := ResolveConnectionProtocol(Url, GetSupportedProtocols);

  if Protocol = FASA7PlainDriver.GetProtocol then
    Result := FASA7PlainDriver
  else if Protocol = FASA8PlainDriver.GetProtocol then
    Result := FASA8PlainDriver
  else if Protocol = FASA9PlainDriver.GetProtocol then
    Result := FASA9PlainDriver;
  Result.Initialize;
end;

{**
  Get a name of the supported subprotocol.
  For example: mysql, oracle8 or postgresql72
}
function TZASADriver.GetSupportedProtocols: TStringDynArray;
begin
  SetLength(Result, 3);
  Result[0] := FASA7PlainDriver.GetProtocol;
  Result[1] := FASA8PlainDriver.GetProtocol;
  Result[2] := FASA9PlainDriver.GetProtocol;
end;


{ TZASAConnection }

{**
  Releases a Connection's database and JDBC resources
  immediately instead of waiting for
  them to be automatically released.

  <P><B>Note:</B> A Connection is automatically closed when it is
  garbage collected. Certain fatal errors also result in a closed
  Connection.
}
procedure TZASAConnection.Close;
begin
  if Closed then
     Exit;

  if AutoCommit then
    Commit
  else
    Rollback;

  FPlainDriver.db_string_disconnect( FHandle, nil);
  CheckASAError( FPlainDriver, FHandle, lcDisconnect);

  FHandle := nil;
  if FPlainDriver.db_fini( @FSQLCA) = 0 then
  begin
    DriverManager.LogError( lcConnect, FPlainDriver.GetProtocol, 'Inititalizing SQLCA',
      0, 'Error closing SQLCA');
    raise EZSQLException.CreateWithCode( 0,
      'Error closing SQLCA');
  end;

  DriverManager.LogMessage(lcDisconnect, FPlainDriver.GetProtocol,
      Format('DISCONNECT FROM "%s"', [Database]));

  inherited Close;
end;

{**
   Commit current transaction
}
procedure TZASAConnection.Commit;
begin
  if Closed or AutoCommit then
     Exit;

  if FHandle <> nil then
  begin
    FPlainDriver.db_commit( FHandle, 0);
    CheckASAError( FPlainDriver, FHandle, lcTransaction);
    DriverManager.LogMessage(lcTransaction,
      FPlainDriver.GetProtocol, 'TRANSACTION COMMIT');
  end;
end;

{**
  Constructs this object and assignes the main properties.
  @param Driver the parent ZDBC driver.
  @param HostName a name of the host.
  @param Port a port number (0 for default port).
  @param Database a name pof the database.
  @param User a user name.
  @param Password a user password.
  @param Info a string list with extra connection parameters.
}
constructor TZASAConnection.Create(Driver: IZDriver; const Url: string;
  PlainDriver: IZASAPlainDriver; const HostName: string; Port: Integer;
  const Database, User, Password: string; Info: TStrings);
begin
  inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
    TZASADatabaseMetadata.Create(Self, Url, Info));

  FPlainDriver := PlainDriver;
  Self.PlainDriver := PlainDriver;
end;

{**
  Creates a <code>CallableStatement</code> object for calling
  database stored procedures.
  The <code>CallableStatement</code> object provides
  methods for setting up its IN and OUT parameters, and
  methods for executing the call to a stored procedure.

  <P><B>Note:</B> This method is optimized for handling stored
  procedure call statements. Some drivers may send the call
  statement to the database when the method <code>prepareCall</code>
  is done; others
  may wait until the <code>CallableStatement</code> object
  is executed. This has no
  direct effect on users; however, it does affect which method
  throws certain SQLExceptions.

  Result sets created using the returned CallableStatement will have
  forward-only type and read-only concurrency, by default.

  @param sql a SQL statement that may contain one or more '?'
    parameter placeholders. Typically this  statement is a JDBC
    function call escape string.
  @param Info a statement parameters.
  @return a new CallableStatement object containing the
    pre-compiled SQL statement
}
function TZASAConnection.CreateCallableStatement(const SQL: string;
  Info: TStrings): IZCallableStatement;
begin
  if IsClosed then
     Open;
  Result := TZASACallableStatement.Create(Self, SQL, Info);
end;

{**
  Creates a <code>PreparedStatement</code> object for sending
  parameterized SQL statements to the database.

  A SQL statement with or without IN parameters can be
  pre-compiled and stored in a PreparedStatement object. This
  object can then be used to efficiently execute this statement
  multiple times.

  <P><B>Note:</B> This method is optimized for handling
  parametric SQL statements that benefit from precompilation. If
  the driver supports precompilation,
  the method <code>prepareStatement</code> will send
  the statement to the database for precompilation. Some drivers
  may not support precompilation. In this case, the statement may
  not be sent to the database until the <code>PreparedStatement</code> is
  executed.  This has no direct effect on users; however, it does
  affect which method throws certain SQLExceptions.

  Result sets created using the returned PreparedStatement will have
  forward-only type and read-only concurrency, by default.

  @param sql a SQL statement that may contain one or more '?' IN
    parameter placeholders
  @return a new PreparedStatement object containing the
    pre-compiled statement
}
function TZASAConnection.CreatePreparedStatement(const SQL: string;
  Info: TStrings): IZPreparedStatement;
begin
  if IsClosed then
     Open;
  Result := TZASAPreparedStatement.Create(Self, SQL, Info);
end;

{**
  Creates a <code>Statement</code> object for sending
  SQL statements to the database.
  SQL statements without parameters are normally
  executed using Statement objects. If the same SQL statement
  is executed many times, it is more efficient to use a
  <code>PreparedStatement</code> object.
  <P>
  Result sets created using the returned <code>Statement</code>
  object will by default have forward-only type and read-only concurrency.

  @param Info a statement parameters.
  @return a new Statement object
}
function TZASAConnection.CreateRegularStatement(
  Info: TStrings): IZStatement;
begin
  if IsClosed then
     Open;
  Result := TZASAStatement.Create(Self, Info);
end;

{**
  Destroys this object and cleanups the memory.
}
destructor TZASAConnection.Destroy;
begin
  if not Closed then
    Close;

  inherited;
end;

{**
   Get database connection handle.
   @return database handle
}
function TZASAConnection.GetDBHandle: PZASASQLCA;
begin
  Result := FHandle;
end;

{**
   Return native interbase plain driver
   @return plain driver
}
function TZASAConnection.GetPlainDriver: IZASAPlainDriver;
begin
  Result := FPlainDriver;
end;

{**
  Opens a connection to database server with specified parameters.
}
procedure TZASAConnection.Open;
var
  ConnectionString, Links: string;
begin
  if not Closed then
     Exit;

  FHandle := nil;
  ConnectionString := '';
  try
    if FPlainDriver.db_init( @FSQLCA) = 0 then
    begin
      DriverManager.LogError( lcConnect, FPlainDriver.GetProtocol, 'Inititalizing SQLCA',
        0, 'Error initializing SQLCA');
      raise EZSQLException.CreateWithCode( 0,
        'Error initializing SQLCA');
    end;
    FHandle := @FSQLCA;

    { Create new db if needed }
{    if Info.Values['createNewDatabase'] <> '' then
    begin
      CreateNewDatabase(Info.Values['createNewDatabase']);
      DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol,
        Format('CREATE DATABASE "%s"', [Info.Values['createNewDatabase']]));
    end;}

{    for i := 0 to Info.Count-1 do
      ConnectionString := ConnectionString + Info[i] + '; ';}

    if HostName <> '' then
      ConnectionString := ConnectionString + 'ENG="' + HostName + '"; ';
    if User <> '' then
      ConnectionString := ConnectionString + 'UID="' + User + '"; ';
    if Password <> '' then
      ConnectionString := ConnectionString + 'PWD="' + Password + '"; ';
    if Database <> '' then
    begin
      if CompareText( ExtractFileExt( Database), '.db') = 0 then
        ConnectionString := ConnectionString + 'DBF="' + Database + '"; '
      else
        ConnectionString := ConnectionString + 'DBN="' + Database + '"; ';
    end;

    Links := '';
    if Info.Values['CommLinks'] <> ''
      then Links := 'CommLinks=' + Info.Values['CommLinks'];
    if Info.Values['LINKS'] <> ''
      then Links := 'LINKS=' + Info.Values['LINKS'];
    if (Links = '') and (Port <> 0)
      then Links := 'LINKS=tcpip(PORT=' + IntToStr(Port) + ')';
    if Links <> ''
      then ConnectionString := ConnectionString + Links + '; ';

    FPlainDriver.db_string_connect(FHandle, PAnsiChar(ConnectionString));
    CheckASAError( FPlainDriver, FHandle, lcConnect);

    DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol,
      Format('CONNECT TO "%s" AS USER "%s"', [Database, User]));

    StartTransaction;

    //SetConnOptions     RowCount;

  except
    on E: Exception do
    begin
      if Assigned( FHandle) then
        FPlainDriver.db_fini( FHandle);
      FHandle := nil;
      raise;
    end;
  end;

  inherited Open;
end;

{**
  Drops all changes made since the previous
  commit/rollback and releases any database locks currently held
  by this Connection. This method should be used only when auto-
  commit has been disabled.
  @see #setAutoCommit
}
procedure TZASAConnection.Rollback;
begin
  if Closed or AutoCommit then
     Exit;

  if Assigned( FHandle) then
  begin
    FPlainDriver.db_rollback( FHandle, 0);
    CheckASAError( FPlainDriver, FHandle, lcTransaction);
    DriverManager.LogMessage(lcTransaction,
      FPlainDriver.GetProtocol, 'TRANSACTION ROLLBACK');
  end;
end;

procedure TZASAConnection.SetOption(Temporary: Integer; User: PAnsiChar;
  const Option: string; const Value: string);
var
  SQLDA: PASASQLDA;
  Sz: Integer;
  S: string;
begin
  if Assigned( FHandle) then
  begin
    Sz := SizeOf( TASASQLDA) - 32767 * SizeOf( TZASASQLVAR);
    SQLDA := AllocMem( Sz);
    try
      StrPLCopy( SQLDA.sqldaid, 'SQLDA   ', 8);
      SQLDA.sqldabc := Sz;
      SQLDA.sqln := 1;
      SQLDA.sqld := 1;
      SQLDA.sqlVar[0].sqlType := DT_STRING;
      SQLDA.sqlVar[0].sqlLen := Length( Value)+1;
      SQLDA.sqlVar[0].sqlData := PAnsiChar(Value);
      FPlainDriver.db_setoption(FHandle, Temporary, User, PAnsiChar(Option), SQLDA);

      CheckASAError( FPlainDriver, FHandle, lcOther);
      S := User;
      DriverManager.LogMessage( lcOther, FPlainDriver.GetProtocol,
        Format( 'SET OPTION %s.%s = %s', [ S, Option, Value]));
    finally
      FreeMem( SQLDA);
    end;
  end;
end;

{**
   Start transaction
}
procedure TZASAConnection.StartTransaction;
var
  ASATL: integer;
begin
  if AutoCommit then
    SetOption( 1, nil, 'CHAINED', 'OFF')
  else
    SetOption( 1, nil, 'CHAINED', 'ON');
  ASATL := Ord( TransactIsolationLevel);
  if ASATL > 1 then
    ASATL := ASATL - 1;
  SetOption( 1, nil, 'ISOLATION_LEVEL', IntToStr( ASATL));
end;

{ TZASACachedResolver }

{**
  Forms a where clause for SELECT statements to calculate default values.
  @param Columns a collection of key columns.
  @param OldRowAccessor an accessor object to old column values.
}
function TZASACachedResolver.FormCalculateStatement(
  Columns: TObjectList): string;
var
  I: Integer;
  Current: TZResolverParameter;
begin
  Result := '';
  if Columns.Count = 0 then
     Exit;

  for I := 0 to Columns.Count - 1 do
  begin
    Current := TZResolverParameter(Columns[I]);
    if Result <> '' then
      Result := Result + ',';
    if Current.DefaultValue <> '' then
      Result := Result + Current.DefaultValue
    else
      Result := Result + 'NULL';
  end;
  Result := 'SELECT ' + Result;
end;

initialization
  ASADriver := TZASADriver.Create;
  DriverManager.RegisterDriver(ASADriver);

finalization
  if Assigned(DriverManager) then
    DriverManager.DeregisterDriver(ASADriver);
  ASADriver := nil;
end.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted zeos/dbc/ZDbcASAMetadata.pas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
{*********************************************************}
{                                                         }
{                 Zeos Database Objects                   }
{         Interbase Database Connectivity Classes         }
{                                                         }
{        Originally written by Sergey Merkuriev           }
{                                                         }
{*********************************************************}

{@********************************************************}
{    Copyright (c) 1999-2006 Zeos Development Group       }
{                                                         }
{ License Agreement:                                      }
{                                                         }
{ This library is distributed in the hope that it will be }
{ useful, but WITHOUT ANY WARRANTY; without even the      }
{ implied warranty of MERCHANTABILITY or FITNESS FOR      }
{ A PARTICULAR PURPOSE.  See the GNU Lesser General       }
{ Public License for more details.                        }
{                                                         }
{ The source code of the ZEOS Libraries and packages are  }
{ distributed under the Library GNU General Public        }
{ License (see the file COPYING / COPYING.ZEOS)           }
{ with the following  modification:                       }
{ As a special exception, the copyright holders of this   }
{ library give you permission to link this library with   }
{ independent modules to produce an executable,           }
{ regardless of the license terms of these independent    }
{ modules, and to copy and distribute the resulting       }
{ executable under terms of your choice, provided that    }
{ you also meet, for each linked independent module,      }
{ the terms and conditions of the license of that module. }
{ An independent module is a module which is not derived  }
{ from or based on this library. If you modify this       }
{ library, you may extend this exception to your version  }
{ of the library, but you are not obligated to do so.     }
{ If you do not wish to do so, delete this exception      }
{ statement from your version.                            }
{                                                         }
{                                                         }
{ The project web site is located on:                     }
{   http://zeos.firmos.at  (FORUM)                        }
{   http://zeosbugs.firmos.at (BUGTRACKER)                }
{   svn://zeos.firmos.at/zeos/trunk (SVN Repository)      }
{                                                         }
{   http://www.sourceforge.net/projects/zeoslib.          }
{   http://www.zeoslib.sourceforge.net                    }
{                                                         }
{                                                         }
{                                                         }
{                                 Zeos Development Group. }
{********************************************************@}

unit ZDbcASAMetadata;

interface

{$I ZDbc.inc}

uses
  Types, Classes, SysUtils, ZSysUtils, ZDbcIntfs, ZDbcMetadata, ZCompatibility,
  ZDbcConnection, ZDbcASA;

type

  // technobot 2008-06-28 - methods moved as is from TZASADatabaseMetadata:
  {** Implements ASA Database Information. }
  TZASADatabaseInfo = class(TZAbstractDatabaseInfo)
  public
    constructor Create(const Metadata: TZAbstractDatabaseMetadata);
    destructor Destroy; override;

    // database/driver/server info:
    function GetDatabaseProductName: string; override;
    function GetDatabaseProductVersion: string; override;
    function GetDriverName: string; override;
//    function GetDriverVersion: string; override; -> Same as parent
    function GetDriverMajorVersion: Integer; override;
    function GetDriverMinorVersion: Integer; override;
//    function GetServerVersion: string; -> Not implemented

    // capabilities (what it can/cannot do):
//    function AllProceduresAreCallable: Boolean; override; -> Not implemented
//    function AllTablesAreSelectable: Boolean; override; -> Not implemented
    function SupportsMixedCaseIdentifiers: Boolean; override;
    function SupportsMixedCaseQuotedIdentifiers: Boolean; override;
//    function SupportsAlterTableWithAddColumn: Boolean; override; -> Not implemented
//    function SupportsAlterTableWithDropColumn: Boolean; override; -> Not implemented
//    function SupportsColumnAliasing: Boolean; override; -> Not implemented
//    function SupportsConvert: Boolean; override; -> Not implemented
//    function SupportsConvertForTypes(FromType: TZSQLType; ToType: TZSQLType):
//      Boolean; override; -> Not implemented
//    function SupportsTableCorrelationNames: Boolean; override; -> Not implemented
//    function SupportsDifferentTableCorrelationNames: Boolean; override; -> Not implemented
    function SupportsExpressionsInOrderBy: Boolean; override;
    function SupportsOrderByUnrelated: Boolean; override;
    function SupportsGroupBy: Boolean; override;
    function SupportsGroupByUnrelated: Boolean; override;
    function SupportsGroupByBeyondSelect: Boolean; override;
//    function SupportsLikeEscapeClause: Boolean; override; -> Not implemented
//    function SupportsMultipleResultSets: Boolean; override; -> Not implemented
//    function SupportsMultipleTransactions: Boolean; override; -> Not implemented
//    function SupportsNonNullableColumns: Boolean; override; -> Not implemented
//    function SupportsMinimumSQLGrammar: Boolean; override; -> Not implemented
//    function SupportsCoreSQLGrammar: Boolean; override; -> Not implemented
//    function SupportsExtendedSQLGrammar: Boolean; override; -> Not implemented
//    function SupportsANSI92EntryLevelSQL: Boolean; override; -> Not implemented
//    function SupportsANSI92IntermediateSQL: Boolean; override; -> Not implemented
//    function SupportsANSI92FullSQL: Boolean; override; -> Not implemented
    function SupportsIntegrityEnhancementFacility: Boolean; override;
//    function SupportsOuterJoins: Boolean; override; -> Not implemented
//    function SupportsFullOuterJoins: Boolean; override; -> Not implemented
//    function SupportsLimitedOuterJoins: Boolean; override; -> Not implemented
    function SupportsSchemasInDataManipulation: Boolean; override;
    function SupportsSchemasInProcedureCalls: Boolean; override;
    function SupportsSchemasInTableDefinitions: Boolean; override;
    function SupportsSchemasInIndexDefinitions: Boolean; override;
    function SupportsSchemasInPrivilegeDefinitions: Boolean; override;
    function SupportsCatalogsInDataManipulation: Boolean; override;
    function SupportsCatalogsInProcedureCalls: Boolean; override;
    function SupportsCatalogsInTableDefinitions: Boolean; override;
    function SupportsCatalogsInIndexDefinitions: Boolean; override;
    function SupportsCatalogsInPrivilegeDefinitions: Boolean; override;
    function SupportsPositionedDelete: Boolean; override;
    function SupportsPositionedUpdate: Boolean; override;
    function SupportsSelectForUpdate: Boolean; override;
    function SupportsStoredProcedures: Boolean; override;
    function SupportsSubqueriesInComparisons: Boolean; override;
    function SupportsSubqueriesInExists: Boolean; override;
    function SupportsSubqueriesInIns: Boolean; override;
    function SupportsSubqueriesInQuantifieds: Boolean; override;
    function SupportsCorrelatedSubqueries: Boolean; override;
    function SupportsUnion: Boolean; override;
    function SupportsUnionAll: Boolean; override;
    function SupportsOpenCursorsAcrossCommit: Boolean; override;
    function SupportsOpenCursorsAcrossRollback: Boolean; override;
    function SupportsOpenStatementsAcrossCommit: Boolean; override;
    function SupportsOpenStatementsAcrossRollback: Boolean; override;
    function SupportsTransactions: Boolean; override;
    function SupportsTransactionIsolationLevel(Level: TZTransactIsolationLevel):
      Boolean; override;
    function SupportsDataDefinitionAndDataManipulationTransactions: Boolean; override;
    function SupportsDataManipulationTransactionsOnly: Boolean; override;
    function SupportsResultSetType(_Type: TZResultSetType): Boolean; override;
    function SupportsResultSetConcurrency(_Type: TZResultSetType;
      Concurrency: TZResultSetConcurrency): Boolean; override;
//    function SupportsBatchUpdates: Boolean; override; -> Not implemented

    // maxima:
    function GetMaxBinaryLiteralLength: Integer; override;
    function GetMaxCharLiteralLength: Integer; override;
    function GetMaxColumnNameLength: Integer; override;
    function GetMaxColumnsInGroupBy: Integer; override;
    function GetMaxColumnsInIndex: Integer; override;
    function GetMaxColumnsInOrderBy: Integer; override;
    function GetMaxColumnsInSelect: Integer; override;
    function GetMaxColumnsInTable: Integer; override;
    function GetMaxConnections: Integer; override;
    function GetMaxCursorNameLength: Integer; override;
    function GetMaxIndexLength: Integer; override;
    function GetMaxSchemaNameLength: Integer; override;
    function GetMaxProcedureNameLength: Integer; override;
    function GetMaxCatalogNameLength: Integer; override;
    function GetMaxRowSize: Integer; override;
    function GetMaxStatementLength: Integer; override;
    function GetMaxStatements: Integer; override;
    function GetMaxTableNameLength: Integer; override;
    function GetMaxTablesInSelect: Integer; override;
    function GetMaxUserNameLength: Integer; override;

    // policies (how are various data and operations handled):
//    function IsReadOnly: Boolean; override; -> Not implemented
//    function IsCatalogAtStart: Boolean; override; -> Not implemented
    function DoesMaxRowSizeIncludeBlobs: Boolean; override;
//    function NullsAreSortedHigh: Boolean; override; -> Not implemented
//    function NullsAreSortedLow: Boolean; override; -> Not implemented
    function NullsAreSortedAtStart: Boolean; override;
//    function NullsAreSortedAtEnd: Boolean; override; -> Not implemented
//    function NullPlusNonNullIsNull: Boolean; override; -> Not implemented
    function UsesLocalFiles: Boolean; override;
    function UsesLocalFilePerTable: Boolean; override;
    function StoresUpperCaseIdentifiers: Boolean; override;
    function StoresLowerCaseIdentifiers: Boolean; override;
    function StoresMixedCaseIdentifiers: Boolean; override;
    function StoresUpperCaseQuotedIdentifiers: Boolean; override;
    function StoresLowerCaseQuotedIdentifiers: Boolean; override;
    function StoresMixedCaseQuotedIdentifiers: Boolean; override;
    function GetDefaultTransactionIsolation: TZTransactIsolationLevel; override;
    function DataDefinitionCausesTransactionCommit: Boolean; override;
    function DataDefinitionIgnoredInTransactions: Boolean; override;

    // interface details (terms, keywords, etc):
//    function GetIdentifierQuoteString: string; override; -> Not implemented
    function GetSchemaTerm: string; override;
    function GetProcedureTerm: string; override;
    function GetCatalogTerm: string; override;
    function GetCatalogSeparator: string; override;
    function GetSQLKeywords: string; override;
    function GetNumericFunctions: string; override;
    function GetStringFunctions: string; override;
    function GetSystemFunctions: string; override;
    function GetTimeDateFunctions: string; override;
    function GetSearchStringEscape: string; override;
    function GetExtraNameCharacters: string; override;
  end;

  {** Implements ASA Database Metadata. }
  TZASADatabaseMetadata = class(TZAbstractDatabaseMetadata)
  private
    FASAConnection: TZASAConnection;
  protected
    function CreateDatabaseInfo: IZDatabaseInfo; override; // technobot 2008-06-28

    function UncachedGetTables(const Catalog: string; const SchemaPattern: string;
      const TableNamePattern: string; const Types: TStringDynArray): IZResultSet; override;
    function UncachedGetSchemas: IZResultSet; override;
//    function UncachedGetCatalogs: IZResultSet; override; -> Not implemented
    function UncachedGetTableTypes: IZResultSet; override;
    function UncachedGetColumns(const Catalog: string; const SchemaPattern: string;
      const TableNamePattern: string; const ColumnNamePattern: string): IZResultSet; override;
    function UncachedGetTablePrivileges(const Catalog: string; const SchemaPattern: string;
      const TableNamePattern: string): IZResultSet; override;
    function UncachedGetColumnPrivileges(const Catalog: string; const Schema: string;
      const Table: string; const ColumnNamePattern: string): IZResultSet; override;
    function UncachedGetPrimaryKeys(const Catalog: string; const Schema: string;
      const Table: string): IZResultSet; override;
    function UncachedGetImportedKeys(const Catalog: string; const Schema: string;
      const Table: string): IZResultSet; override;
    function UncachedGetExportedKeys(const Catalog: string; const Schema: string;
      const Table: string): IZResultSet; override;
    function UncachedGetCrossReference(const PrimaryCatalog: string; const PrimarySchema: string;
      const PrimaryTable: string; const ForeignCatalog: string; const ForeignSchema: string;
      const ForeignTable: string): IZResultSet; override;
    function UncachedGetIndexInfo(const Catalog: string; const Schema: string; const Table: string;
      Unique: Boolean; Approximate: Boolean): IZResultSet; override;
//     function UncachedGetSequences(const Catalog: string; const SchemaPattern: string;
//      const SequenceNamePattern: string): IZResultSet; virtual; -> Not implemented
    function UncachedGetProcedures(const Catalog: string; const SchemaPattern: string;
      const ProcedureNamePattern: string): IZResultSet; override;
    function UncachedGetProcedureColumns(const Catalog: string; const SchemaPattern: string;
      const ProcedureNamePattern: string; const ColumnNamePattern: string):
      IZResultSet; override;
    function UncachedGetVersionColumns(const Catalog: string; const Schema: string;
      const Table: string): IZResultSet; override;
    function UncachedGetTypeInfo: IZResultSet; override;
    function UncachedGetUDTs(const Catalog: string; const SchemaPattern: string;
      const TypeNamePattern: string; const Types: TIntegerDynArray): IZResultSet; override;
  public
    constructor Create(Connection: TZAbstractConnection; Url: string; Info: TStrings);
    destructor Destroy; override;
  end;

implementation

uses ZDbcASAUtils, ZDbcUtils;

{ TZASADatabaseInfo }

{**
  Constructs this object.
  @param Metadata the interface of the correpsonding database metadata object
}
constructor TZASADatabaseInfo.Create(const Metadata: TZAbstractDatabaseMetadata);
begin
  inherited;
end;

{**
  Destroys this object and cleanups the memory.
}
destructor TZASADatabaseInfo.Destroy;
begin
  inherited;
end;

//----------------------------------------------------------------------
// First, a variety of minor information about the target database.

{**
  Are NULL values sorted at the start regardless of sort order?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.NullsAreSortedAtStart: Boolean;
begin
  Result := True;
end;

{**
  What's the name of this database product?
  @return database product name
}
function TZASADatabaseInfo.GetDatabaseProductName: string;
begin
  Result := 'Sybase ASA';
end;

{**
  What's the version of this database product?
  @return database version
}
function TZASADatabaseInfo.GetDatabaseProductVersion: string;
begin
  Result := '7.0+';
end;

{**
  What's the name of this JDBC driver?
  @return JDBC driver name
}
function TZASADatabaseInfo.GetDriverName: string;
begin
  Result := 'Zeos Database Connectivity Driver for Sybase ASA';
end;

{**
  What's this JDBC driver's major version number?
  @return JDBC driver major version
}
function TZASADatabaseInfo.GetDriverMajorVersion: Integer;
begin
  Result := 1;
end;

{**
  What's this JDBC driver's minor version number?
  @return JDBC driver minor version number
}
function TZASADatabaseInfo.GetDriverMinorVersion: Integer;
begin
  Result := 0;
end;

{**
  Does the database store tables in a local file?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.UsesLocalFiles: Boolean;
begin
  Result := False;
end;

{**
  Does the database use a file for each table?
  @return true if the database uses a local file for each table
}
function TZASADatabaseInfo.UsesLocalFilePerTable: Boolean;
begin
  Result := False;
end;

{**
  Does the database treat mixed case unquoted SQL identifiers as
  case sensitive and as a result store them in mixed case?
  A JDBC Compliant<sup><font size=-2>TM</font></sup> driver will always return false.
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsMixedCaseIdentifiers: Boolean;
begin
  Result := False;
end;

{**
  Does the database treat mixed case unquoted SQL identifiers as
  case insensitive and store them in upper case?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.StoresUpperCaseIdentifiers: Boolean;
begin
  Result := False;
end;

{**
  Does the database treat mixed case unquoted SQL identifiers as
  case insensitive and store them in lower case?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.StoresLowerCaseIdentifiers: Boolean;
begin
  Result := False;
end;

{**
  Does the database treat mixed case unquoted SQL identifiers as
  case insensitive and store them in mixed case?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.StoresMixedCaseIdentifiers: Boolean;
begin
  Result := True;
end;

{**
  Does the database treat mixed case quoted SQL identifiers as
  case sensitive and as a result store them in mixed case?
  A JDBC Compliant<sup><font size=-2>TM</font></sup> driver will always return true.
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsMixedCaseQuotedIdentifiers: Boolean;
begin
  Result := False;
end;

{**
  Does the database treat mixed case quoted SQL identifiers as
  case insensitive and store them in upper case?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.StoresUpperCaseQuotedIdentifiers: Boolean;
begin
  Result := False;
end;

{**
  Does the database treat mixed case quoted SQL identifiers as
  case insensitive and store them in lower case?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.StoresLowerCaseQuotedIdentifiers: Boolean;
begin
  Result := False;
end;

{**
  Does the database treat mixed case quoted SQL identifiers as
  case insensitive and store them in mixed case?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.StoresMixedCaseQuotedIdentifiers: Boolean;
begin
  Result := True;
end;

{**
  Gets a comma-separated list of all a database's SQL keywords
  that are NOT also SQL92 keywords.
  @return the list
}
function TZASADatabaseInfo.GetSQLKeywords: string;
begin
  Result := 'add,all,alter,and,any,as,asc,backup,begin,between,bigint,binary,'+
            'bit,bottom,break,by,call,capability,cascade,case,cast,char,'+
            'char_convert,character,check,checkpoint,close,comment,commit,'+
            'connect,constraint,contains,continue,convert,create,cross,cube,'+
            'current,cursor,date,dbspace,deallocate,dec,decimal,declare,'+
            'default,delete,deleting,desc,distinct,do,double,drop,dynamic,'+
            'else,elseif,encrypted,end,endif,escape,exception,exec,execute,'+
            'existing,exists,externlogin,fetch,first,float,for,foreign,'+
            'forward,from,full,goto,grant,group,having,holdlock,identified,'+
            'if,in,index,inner,inout,insensitive,insert,inserting,install,'+
            'instead,int,integer,integrated,into,iq,is,isolation,join,key,'+
            'left,like,lock,login,long,match,membership,message,mode,modify,'+
            'natural,new,no,noholdlock,not,notify,null,numeric,of,off,on,open,'+
            'option,options,or,order,others,out,outer,over,passthrough,'+
            'precision,prepare,primary,print,privileges,proc,procedure,'+
            'publication,raiserror,readtext,real,reference,references,release,'+
            'remote,remove,rename,reorganize,resource,restore,restrict,return'+
            'revoke,right,rollback,rollup,save,savepoint,schedule,scroll,'+
            'select,sensitive,session,set,setuser,share,smallint,some,sqlcode,'+
            'sqlstate,start,stop,subtrans,subtransaction,synchronize,'+
            'syntax_error,table,temporary,then,time,timestamp,tinyint,to,top,'+
            'tran,trigger,truncate,tsequal,union,unique,unknown,unsigned,'+
            'update,updating,user,using,validate,values,varbinary,varchar,'+
            'variable,varying,view,wait,waitfor,when,where,while,with,'+
            'with_lparen,work,writetext';
end;

{**
  Gets a comma-separated list of math functions.  These are the
  X/Open CLI math function names used in the JDBC function escape
  clause.
  @return the list
}
function TZASADatabaseInfo.GetNumericFunctions: string;
begin
  Result := 'ABS,ACOS,ASIN,ATAN,ATN2,CEILING,COS,COT,DEGREES,EXP,FLOOR,LOG,'+
            'LOG10,MOD,PI,POWER,RADIANS,RAND,REMAINDER,ROUND,SIGN,SIN,SQRT,'+
            'TAN,TRUNCATE,TRUNCNUM';
end;

{**
  Gets a comma-separated list of string functions.  These are the
  X/Open CLI string function names used in the JDBC function escape
  clause.
  @return the list
}
function TZASADatabaseInfo.GetStringFunctions: string;
begin
  Result := 'ASCII,BYTE_LENGTH,BYTE_SUBSTR,CHAR,CHARINDEX,CHAR_LENGTH,COMPARE,'+
            'CSCONVERT,DIFFERENCE,INSERTSTR,LCASE,LEFT,LENGTH,LOCATE,LOWER,'+
            'LTRIM,PATINDEX,REPEAT,REPLACE,REPLICATE,RIGHT,RTRIM,SIMILAR,'+
            'SORTKEY,SOUNDEX,SPACE,STR,STRING,STRTOUUID,STUFF,SUBSTRING,TRIM,'+
            'UCASE,UPPER,UUIDTOSTR';
end;

{**
  Gets a comma-separated list of system functions.  These are the
  X/Open CLI system function names used in the JDBC function escape
  clause.
  @return the list
}
function TZASADatabaseInfo.GetSystemFunctions: string;
begin
  Result := 'CONNECTION_PROPERTY,DATALENGTH,DB_ID,DB_NAME,DB_PROPERTY,'+
            'EVENT_CONDITION,EVENT_CONDITION_NAME,EVENT_PARAMETER,'+
            'NEXT_CONNECTION,NEXT_DATABASE,PROPERTY,PROPERTY_DESCRIPTION,'+
            'PROPERTY_NAME,PROPERTY_NUMBER,Col_length,Col_name,Datalength,'+
            'Index_col,Object_id,Object_name,Suser_id,Suser_name,Tsequal,'+
            'User_id,User_name,ARGN,COALESCE,ESTIMATE,ESTIMATE_SOURCE,'+
            'EXPERIENCE_ESTIMATE,EXPLANATION,GET_IDENTITY,GRAPHICAL_PLAN,'+
            'GRAPHICAL_ULPLAN,GREATER,IDENTITY,IFNULL,INDEX_ESTIMATE,ISNULL,'+
            'LESSER,LONG_ULPLAN,NEWID,NULLIF,NUMBER,PLAN,REWRITE,SHORT_ULPLAN,'+
            'SQLDIALECT,TRACEBACK,TRANSACTSQL,VAREXISTS,WATCOMSQL,TEXTPTR';
end;

{**
  Gets a comma-separated list of time and date functions.
  @return the list
}
function TZASADatabaseInfo.GetTimeDateFunctions: string;
begin
  Result := 'DATE,DATEADD,DATEDIFF,DATEFORMAT,DATENAME,DATEPART,DATETIME,DAY,'+
            'DAYNAME,DAYS,DOW,GETDATE,HOUR,HOURS,MINUTE,MINUTES,MONTH,'+
            'MONTHNAME,MONTHS,NOW,QUARTER,SECOND,SECONDS,TODAY,WEEKS,YEARS,YMD';
end;

{**
  Gets the string that can be used to escape wildcard characters.
  This is the string that can be used to escape '_' or '%' in
  the string pattern style catalog search parameters.

  <P>The '_' character represents any single character.
  <P>The '%' character represents any sequence of zero or
  more characters.

  @return the string used to escape wildcard characters
}
function TZASADatabaseInfo.GetSearchStringEscape: string;
begin
  Result := '\';
end;

{**
  Gets all the "extra" characters that can be used in unquoted
  identifier names (those beyond a-z, A-Z, 0-9 and _).
  @return the string containing the extra characters
}
function TZASADatabaseInfo.GetExtraNameCharacters: string;
begin
  Result := '@#$';
end;

//--------------------------------------------------------------------
// Functions describing which features are supported.

{**
  Are expressions in "ORDER BY" lists supported?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsExpressionsInOrderBy: Boolean;
begin
  Result := True;
end;

{**
  Can an "ORDER BY" clause use columns not in the SELECT statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsOrderByUnrelated: Boolean;
begin
  Result := True;
end;

{**
  Is some form of "GROUP BY" clause supported?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsGroupBy: Boolean;
begin
  Result := True;
end;

{**
  Can a "GROUP BY" clause use columns not in the SELECT?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsGroupByUnrelated: Boolean;
begin
  Result := True;
end;

{**
  Can a "GROUP BY" clause add columns not in the SELECT
  provided it specifies all the columns in the SELECT?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsGroupByBeyondSelect: Boolean;
begin
  Result := False;
end;

{**
  Is the SQL Integrity Enhancement Facility supported?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsIntegrityEnhancementFacility: Boolean;
begin
  Result := True;
end;

{**
  What's the database vendor's preferred term for "schema"?
  @return the vendor term
}
function TZASADatabaseInfo.GetSchemaTerm: string;
begin
  Result := 'OWNER';
end;

{**
  What's the database vendor's preferred term for "procedure"?
  @return the vendor term
}
function TZASADatabaseInfo.GetProcedureTerm: string;
begin
  Result := 'PROCEDURE';
end;

{**
  What's the database vendor's preferred term for "catalog"?
  @return the vendor term
}
function TZASADatabaseInfo.GetCatalogTerm: string;
begin
  Result := '';
end;

{**
  What's the separator between catalog and table name?
  @return the separator string
}
function TZASADatabaseInfo.GetCatalogSeparator: string;
begin
  Result := '';
end;

{**
  Can a schema name be used in a data manipulation statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsSchemasInDataManipulation: Boolean;
begin
  Result := True;
end;

{**
  Can a schema name be used in a procedure call statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsSchemasInProcedureCalls: Boolean;
begin
  Result := True;
end;

{**
  Can a schema name be used in a table definition statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsSchemasInTableDefinitions: Boolean;
begin
  Result := True;
end;

{**
  Can a schema name be used in an index definition statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsSchemasInIndexDefinitions: Boolean;
begin
  Result := False;
end;

{**
  Can a schema name be used in a privilege definition statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsSchemasInPrivilegeDefinitions: Boolean;
begin
  Result := False;
end;

{**
  Can a catalog name be used in a data manipulation statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsCatalogsInDataManipulation: Boolean;
begin
  Result := False;
end;

{**
  Can a catalog name be used in a procedure call statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsCatalogsInProcedureCalls: Boolean;
begin
  Result := False;
end;

{**
  Can a catalog name be used in a table definition statement?
  @return <code>true</code> if so; <code>false</code> otherwise
}
function TZASADatabaseInfo.SupportsCatalogsInTableDefinitions: Boolean;