← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fcl/db/sqldb/mysql/mysqlconn.inc

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/sqldb/mysql/mysqlconn.inc
 
1
 
 
2
{$mode objfpc}{$H+}
 
3
{$MACRO on}
 
4
 
 
5
interface
 
6
 
 
7
uses
 
8
  Classes, SysUtils,sqldb,db,dynlibs,
 
9
{$IfDef mysql50}
 
10
  mysql50dyn;
 
11
  {$DEFINE TConnectionName:=TMySQL50Connection}
 
12
  {$DEFINE TTransactionName:=TMySQL50Transaction}
 
13
  {$DEFINE TCursorName:=TMySQL50Cursor}
 
14
{$ELSE}
 
15
  {$IfDef mysql41}
 
16
    mysql41dyn;
 
17
    {$DEFINE TConnectionName:=TMySQL41Connection}
 
18
    {$DEFINE TTransactionName:=TMySQL41Transaction}
 
19
    {$DEFINE TCursorName:=TMySQL41Cursor}
 
20
  {$ELSE}
 
21
    {$IFDEF mysql4} // temporary backwards compatibility for Lazarus
 
22
      mysql40dyn;
 
23
      {$DEFINE TConnectionName:=TMySQLConnection}
 
24
      {$DEFINE TTransactionName:=TMySQLTransaction}
 
25
      {$DEFINE TCursorName:=TMySQLCursor}
 
26
    {$ELSE}
 
27
      mysql40dyn;
 
28
      {$DEFINE TConnectionName:=TMySQL40Connection}
 
29
      {$DEFINE TTransactionName:=TMySQL40Transaction}
 
30
      {$DEFINE TCursorName:=TMySQL40Cursor}
 
31
    {$EndIf}
 
32
  {$EndIf}
 
33
{$EndIf}
 
34
 
 
35
Type
 
36
  TTransactionName = Class(TSQLHandle)
 
37
  protected
 
38
  end;
 
39
 
 
40
  TCursorName = Class(TSQLCursor)
 
41
  protected
 
42
    FQMySQL : PMySQL;
 
43
    FRes: PMYSQL_RES;                   { Record pointer }
 
44
    FNeedData : Boolean;
 
45
    FStatement : String;
 
46
    Row : MYSQL_ROW;
 
47
    RowsAffected : QWord;
 
48
    LastInsertID : QWord;
 
49
    ParamBinding : TParamBinding;
 
50
    ParamReplaceString : String;
 
51
    MapDSRowToMSQLRow  : array of integer;
 
52
  end;
 
53
 
 
54
  TConnectionName = class (TSQLConnection)
 
55
  private
 
56
    FDialect: integer;
 
57
    FHostInfo: String;
 
58
    FServerInfo: String;
 
59
    FMySQL : PMySQL;
 
60
    FDidConnect : Boolean;
 
61
    function GetClientInfo: string;
 
62
    function GetServerStatus: String;
 
63
    procedure ConnectMySQL(var HMySQL : PMySQL;H,U,P : pchar);
 
64
  protected
 
65
    function StrToStatementType(s : string) : TStatementType; override;
 
66
    Procedure ConnectToServer; virtual;
 
67
    Procedure SelectDatabase; virtual;
 
68
    function MySQLDataType(AType: enum_field_types; ASize, ADecimals: Integer; var NewType: TFieldType; var NewSize: Integer): Boolean;
 
69
    function MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType;Source, Dest: PChar): Boolean;
 
70
    // SQLConnection methods
 
71
    procedure DoInternalConnect; override;
 
72
    procedure DoInternalDisconnect; override;
 
73
    function GetHandle : pointer; override;
 
74
 
 
75
    function GetAsSQLText(Field : TField) : string; overload; virtual;
 
76
    function GetAsSQLText(Param : TParam) : string; overload; virtual;
 
77
 
 
78
    Function AllocateCursorHandle : TSQLCursor; override;
 
79
    Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
 
80
    Function AllocateTransactionHandle : TSQLHandle; override;
 
81
 
 
82
    procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); override;
 
83
    procedure UnPrepareStatement(cursor:TSQLCursor); override;
 
84
    procedure FreeFldBuffers(cursor : TSQLCursor); override;
 
85
    procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;AParams : TParams); override;
 
86
    procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); override;
 
87
    function Fetch(cursor : TSQLCursor) : boolean; override;
 
88
    function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer) : boolean; override;
 
89
    function GetTransactionHandle(trans : TSQLHandle): pointer; override;
 
90
    function Commit(trans : TSQLHandle) : boolean; override;
 
91
    function RollBack(trans : TSQLHandle) : boolean; override;
 
92
    function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
 
93
    procedure CommitRetaining(trans : TSQLHandle); override;
 
94
    procedure RollBackRetaining(trans : TSQLHandle); override;
 
95
    procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
 
96
 
 
97
  Public
 
98
    Property ServerInfo : String Read FServerInfo;
 
99
    Property HostInfo : String Read FHostInfo;
 
100
    property ClientInfo: string read GetClientInfo;
 
101
    property ServerStatus : String read GetServerStatus;
 
102
  published
 
103
    property Dialect  : integer read FDialect write FDialect;
 
104
    property DatabaseName;
 
105
    property HostName;
 
106
    property KeepConnection;
 
107
    property LoginPrompt;
 
108
    property Params;
 
109
    property OnLogin;
 
110
  end;
 
111
 
 
112
  EMySQLError = Class(Exception);
 
113
 
 
114
implementation
 
115
 
 
116
uses dbconst;
 
117
 
 
118
{ TConnectionName }
 
119
 
 
120
Resourcestring
 
121
  SErrServerConnectFailed = 'Server connect failed.';
 
122
  SErrDatabaseSelectFailed = 'failed to select database: %s';
 
123
  SErrDatabaseCreate = 'Failed to create database: %s';
 
124
  SErrDatabaseDrop = 'Failed to drop database: %s';
 
125
  SErrNoData = 'No data for record';
 
126
  SErrExecuting = 'Error executing query: %s';
 
127
  SErrFetchingdata = 'Error fetching row data: %s';
 
128
  SErrGettingResult = 'Error getting result set: %s';
 
129
  SErrNoQueryResult = 'No result from query.';
 
130
  SErrNotversion50 = 'TMySQL50Connection can not work with the installed MySQL client version (%s).';
 
131
  SErrNotversion41 = 'TMySQL41Connection can not work with the installed MySQL client version (%s).';
 
132
  SErrNotversion40 = 'TMySQL40Connection can not work with the installed MySQL client version (%s).';
 
133
 
 
134
Procedure MySQlError(R : PMySQL;Msg: String;Comp : TComponent);
 
135
 
 
136
Var
 
137
  MySQLMsg : String;
 
138
 
 
139
begin
 
140
 If (R<>Nil) then
 
141
   begin
 
142
   MySQLMsg:=Strpas(mysql_error(R));
 
143
   DatabaseErrorFmt(Msg,[MySQLMsg],Comp);
 
144
   end
 
145
 else
 
146
   DatabaseError(Msg,Comp);
 
147
end;
 
148
 
 
149
function TConnectionName.StrToStatementType(s : string) : TStatementType;
 
150
 
 
151
begin
 
152
  S:=Lowercase(s);
 
153
  if s = 'show' then exit(stSelect);
 
154
  result := inherited StrToStatementType(s);
 
155
end;
 
156
 
 
157
 
 
158
function TConnectionName.GetClientInfo: string;
 
159
 
 
160
Var
 
161
  B : Boolean;
 
162
 
 
163
begin
 
164
  // To make it possible to call this if there's no connection yet
 
165
  B:=(MysqlLibraryHandle=Nilhandle);
 
166
  If B then
 
167
    InitialiseMysql;
 
168
  Try  
 
169
    Result:=strpas(mysql_get_client_info());
 
170
  Finally  
 
171
    if B then
 
172
      ReleaseMysql;
 
173
  end;  
 
174
end;
 
175
 
 
176
function TConnectionName.GetServerStatus: String;
 
177
begin
 
178
  CheckConnected;
 
179
  Result := mysql_stat(FMYSQL);
 
180
end;
 
181
 
 
182
procedure TConnectionName.ConnectMySQL(var HMySQL : PMySQL;H,U,P : pchar);
 
183
 
 
184
begin
 
185
  HMySQL := mysql_init(HMySQL);
 
186
  HMySQL:=mysql_real_connect(HMySQL,PChar(H),PChar(U),Pchar(P),Nil,0,Nil,0);
 
187
  If (HMySQL=Nil) then
 
188
    MySQlError(Nil,SErrServerConnectFailed,Self);
 
189
end;
 
190
 
 
191
function TConnectionName.GetAsSQLText(Field : TField) : string;
 
192
 
 
193
var esc_str : pchar;
 
194
 
 
195
begin
 
196
  if (not assigned(field)) or field.IsNull then Result := 'Null'
 
197
  else if field.DataType = ftString then
 
198
    begin
 
199
    Getmem(esc_str,sizeof(field.asstring)*2+1);
 
200
    mysql_real_escape_string(FMySQL,esc_str,pchar(field.asstring),length(field.asstring));
 
201
    Result := '''' + esc_str + '''';
 
202
    Freemem(esc_str);
 
203
    end
 
204
  else Result := inherited GetAsSqlText(field);
 
205
end;
 
206
 
 
207
function TConnectionName.GetAsSQLText(Param: TParam) : string;
 
208
 
 
209
var esc_str : pchar;
 
210
 
 
211
begin
 
212
  if (not assigned(param)) or param.IsNull then Result := 'Null'
 
213
  else if param.DataType =  ftString then
 
214
    begin
 
215
    Getmem(esc_str,sizeof(param.asstring)*2+1);
 
216
    mysql_real_escape_string(FMySQL,esc_str,pchar(param.asstring),length(param.asstring));
 
217
    Result := '''' + esc_str + '''';
 
218
    Freemem(esc_str);
 
219
    end
 
220
  else Result := inherited GetAsSqlText(Param);
 
221
end;
 
222
 
 
223
 
 
224
procedure TConnectionName.ConnectToServer;
 
225
 
 
226
Var
 
227
  H,U,P : String;
 
228
 
 
229
begin
 
230
  H:=HostName;
 
231
  U:=UserName;
 
232
  P:=Password;
 
233
  ConnectMySQL(FMySQL,pchar(H),pchar(U),pchar(P));
 
234
  FServerInfo := strpas(mysql_get_server_info(FMYSQL));
 
235
  FHostInfo := strpas(mysql_get_host_info(FMYSQL));
 
236
end;
 
237
 
 
238
procedure TConnectionName.SelectDatabase;
 
239
begin
 
240
  if mysql_select_db(FMySQL,pchar(DatabaseName))<>0 then
 
241
    MySQLError(FMySQL,SErrDatabaseSelectFailed,Self);
 
242
end;
 
243
 
 
244
procedure TConnectionName.DoInternalConnect;
 
245
begin
 
246
  FDidConnect:=(MySQLLibraryHandle=NilHandle);
 
247
  if FDidConnect then
 
248
    InitialiseMysql;
 
249
{$IFDEF mysql50}
 
250
  if copy(strpas(mysql_get_client_info()),1,3)<>'5.0' then
 
251
    Raise EInOutError.CreateFmt(SErrNotversion50,[strpas(mysql_get_client_info())]);
 
252
{$ELSE}
 
253
  {$IFDEF mysql41}
 
254
  if copy(strpas(mysql_get_client_info()),1,3)<>'4.1' then
 
255
    Raise EInOutError.CreateFmt(SErrNotversion41,[strpas(mysql_get_client_info())]);
 
256
  {$ELSE}
 
257
  if copy(strpas(mysql_get_client_info()),1,3)<>'4.0' then
 
258
    Raise EInOutError.CreateFmt(SErrNotversion40,[strpas(mysql_get_client_info())]);
 
259
  {$ENDIF}
 
260
{$ENDIF}
 
261
  inherited DoInternalConnect;
 
262
  ConnectToServer;
 
263
  SelectDatabase;
 
264
end;
 
265
 
 
266
procedure TConnectionName.DoInternalDisconnect;
 
267
begin
 
268
  inherited DoInternalDisconnect;
 
269
  mysql_close(FMySQL);
 
270
  FMySQL:=Nil;
 
271
  if FDidConnect then
 
272
    ReleaseMysql;
 
273
end;
 
274
 
 
275
function TConnectionName.GetHandle: pointer;
 
276
begin
 
277
  Result:=FMySQL;
 
278
end;
 
279
 
 
280
function TConnectionName.AllocateCursorHandle: TSQLCursor;
 
281
begin
 
282
  Result:=TCursorName.Create;
 
283
end;
 
284
 
 
285
Procedure TConnectionName.DeAllocateCursorHandle(var cursor : TSQLCursor);
 
286
 
 
287
begin
 
288
  FreeAndNil(cursor);
 
289
end;
 
290
 
 
291
function TConnectionName.AllocateTransactionHandle: TSQLHandle;
 
292
begin
 
293
//  Result:=TTransactionName.Create;
 
294
  Result := nil;
 
295
end;
 
296
 
 
297
procedure TConnectionName.PrepareStatement(cursor: TSQLCursor;
 
298
  ATransaction: TSQLTransaction; buf: string;AParams : TParams);
 
299
begin
 
300
//  if assigned(AParams) and (AParams.count > 0) then
 
301
//    DatabaseError('Parameters (not) yet supported for the MySQL SqlDB connection.',self);
 
302
  With Cursor as TCursorName do
 
303
    begin
 
304
    FStatement:=Buf;
 
305
    if assigned(AParams) and (AParams.count > 0) then
 
306
      FStatement := AParams.ParseSQL(FStatement,false,psSimulated,paramBinding,ParamReplaceString);
 
307
    if FStatementType=stSelect then
 
308
      FNeedData:=True;
 
309
    ConnectMySQL(FQMySQL,FMySQL^.host,FMySQL^.user,FMySQL^.passwd);
 
310
    if mysql_select_db(FQMySQL,pchar(DatabaseName))<>0 then
 
311
      MySQLError(FQMySQL,SErrDatabaseSelectFailed,Self);
 
312
    end
 
313
end;
 
314
 
 
315
procedure TConnectionName.UnPrepareStatement(cursor: TSQLCursor);
 
316
begin
 
317
  With Cursor as TCursorName do
 
318
    begin
 
319
    mysql_close(FQMySQL);
 
320
    FQMysql := nil;
 
321
    end;
 
322
end;
 
323
 
 
324
procedure TConnectionName.FreeFldBuffers(cursor: TSQLCursor);
 
325
 
 
326
Var
 
327
  C : TCursorName;
 
328
 
 
329
begin
 
330
  C:=Cursor as TCursorName;
 
331
  if c.FStatementType=stSelect then
 
332
    c.FNeedData:=False;
 
333
  if (c.FQMySQL <> Nil) then
 
334
    begin
 
335
    mysql_close(c.FQMySQL);
 
336
    c.FQMySQL:=Nil;
 
337
    end;
 
338
  If (C.FRes<>Nil) then
 
339
    begin
 
340
    Mysql_free_result(C.FRes);
 
341
    C.FRes:=Nil;
 
342
    end;
 
343
  SetLength(c.MapDSRowToMSQLRow,0);
 
344
end;
 
345
 
 
346
procedure TConnectionName.Execute(cursor: TSQLCursor;
 
347
  atransaction: tSQLtransaction;AParams : TParams);
 
348
 
 
349
Var
 
350
  C : TCursorName;
 
351
  i : integer;
 
352
 
 
353
begin
 
354
  C:=Cursor as TCursorName;
 
355
  If (C.FRes=Nil) then
 
356
    begin
 
357
    if Assigned(AParams) and (AParams.count > 0) then
 
358
      for i := 0 to AParams.count -1 do
 
359
        C.FStatement := stringreplace(C.FStatement,C.ParamReplaceString+inttostr(AParams[i].Index+1),GetAsSQLText(AParams[i]),[rfReplaceAll,rfIgnoreCase]);
 
360
    if mysql_query(c.FQMySQL,Pchar(C.FStatement))<>0 then
 
361
      MySQLError(c.FQMYSQL,Format(SErrExecuting,[StrPas(mysql_error(c.FQMySQL))]),Self)
 
362
    else
 
363
      begin
 
364
      C.RowsAffected := mysql_affected_rows(c.FQMYSQL);
 
365
      C.LastInsertID := mysql_insert_id(c.FQMYSQL);
 
366
      if C.FNeedData then
 
367
        C.FRes:=mysql_use_result(c.FQMySQL);
 
368
      end;
 
369
    end;
 
370
end;
 
371
 
 
372
function TConnectionName.MySQLDataType(AType: enum_field_types; ASize, ADecimals: Integer;
 
373
   var NewType: TFieldType; var NewSize: Integer): Boolean;
 
374
begin
 
375
  Result := True;
 
376
  case AType of
 
377
    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
 
378
    FIELD_TYPE_INT24:
 
379
      begin
 
380
      NewType := ftInteger;
 
381
      NewSize := 0;
 
382
      end;
 
383
{$ifdef mysql50}
 
384
    FIELD_TYPE_NEWDECIMAL,
 
385
{$endif}
 
386
    FIELD_TYPE_DECIMAL: if ADecimals < 5 then
 
387
                          begin
 
388
                          NewType := ftBCD;
 
389
                          NewSize := 0;
 
390
                          end
 
391
                        else
 
392
                          begin
 
393
                          NewType := ftFloat;
 
394
                          NewSize := 0;
 
395
                          end;
 
396
    FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
 
397
      begin
 
398
      NewType := ftFloat;
 
399
      NewSize := 0;
 
400
      end;
 
401
    FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATETIME:
 
402
      begin
 
403
      NewType := ftDateTime;
 
404
      NewSize := 0;
 
405
      end;
 
406
    FIELD_TYPE_DATE:
 
407
      begin
 
408
      NewType := ftDate;
 
409
      NewSize := 0;
 
410
      end;
 
411
    FIELD_TYPE_TIME:
 
412
      begin
 
413
      NewType := ftTime;
 
414
      NewSize := 0;
 
415
      end;
 
416
    FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
 
417
      begin
 
418
      NewType := ftString;
 
419
      NewSize := ASize;
 
420
      end;
 
421
  else
 
422
    Result := False;
 
423
  end;
 
424
end;
 
425
 
 
426
procedure TConnectionName.AddFieldDefs(cursor: TSQLCursor;
 
427
  FieldDefs: TfieldDefs);
 
428
 
 
429
var
 
430
  C : TCursorName;
 
431
  I, TF, FC: Integer;
 
432
  field: PMYSQL_FIELD;
 
433
  DFT: TFieldType;
 
434
  DFS: Integer;
 
435
 
 
436
begin
 
437
//  Writeln('MySQL: Adding fielddefs');
 
438
  C:=(Cursor as TCursorName);
 
439
  If (C.FRes=Nil) then
 
440
    begin
 
441
//    Writeln('res is nil');
 
442
    MySQLError(c.FQMySQL,SErrNoQueryResult,Self);
 
443
    end;
 
444
//  Writeln('MySQL: have result');
 
445
  FC:=mysql_num_fields(C.FRes);
 
446
  SetLength(c.MapDSRowToMSQLRow,FC);
 
447
 
 
448
  TF := 1;
 
449
  For I:= 0 to FC-1 do
 
450
    begin
 
451
    field := mysql_fetch_field_direct(C.FRES, I);
 
452
//    Writeln('MySQL: creating fielddef ',I+1);
 
453
 
 
454
    if MySQLDataType(field^.ftype, field^.length, field^.decimals, DFT, DFS) then
 
455
      begin
 
456
      TFieldDef.Create(FieldDefs, field^.name, DFT, DFS, False, TF);
 
457
      c.MapDSRowToMSQLRow[TF-1] := I;
 
458
      inc(TF);
 
459
      end
 
460
    end;
 
461
//  Writeln('MySQL: Finished adding fielddefs');
 
462
end;
 
463
 
 
464
function TConnectionName.Fetch(cursor: TSQLCursor): boolean;
 
465
 
 
466
Var
 
467
  C : TCursorName;
 
468
 
 
469
begin
 
470
  C:=Cursor as TCursorName;
 
471
  C.Row:=MySQL_Fetch_row(C.FRes);
 
472
  Result:=(C.Row<>Nil);
 
473
end;
 
474
 
 
475
function TConnectionName.LoadField(cursor : TSQLCursor;
 
476
  FieldDef : TfieldDef;buffer : pointer) : boolean;
 
477
 
 
478
var
 
479
  field: PMYSQL_FIELD;
 
480
  row : MYSQL_ROW;
 
481
  C : TCursorName;
 
482
 
 
483
begin
 
484
//  Writeln('LoadFieldsFromBuffer');
 
485
  C:=Cursor as TCursorName;
 
486
  if C.Row=nil then
 
487
     begin
 
488
  //   Writeln('LoadFieldsFromBuffer: row=nil');
 
489
     MySQLError(c.FQMySQL,SErrFetchingData,Self);
 
490
     end;
 
491
  Row:=C.Row;
 
492
  
 
493
  inc(Row,c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
 
494
  field := mysql_fetch_field_direct(C.FRES, c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
 
495
 
 
496
  Result := MySQLWriteData(field^.ftype, field^.length, FieldDef.DataType, Row^, Buffer);
 
497
end;
 
498
 
 
499
function InternalStrToFloat(S: string): Extended;
 
500
 
 
501
var
 
502
  I: Integer;
 
503
  Tmp: string;
 
504
 
 
505
begin
 
506
  Tmp := '';
 
507
  for I := 1 to Length(S) do
 
508
    begin
 
509
    if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
 
510
      Tmp := Tmp + DecimalSeparator
 
511
    else
 
512
      Tmp := Tmp + S[I];
 
513
    end;
 
514
  Result := StrToFloat(Tmp);
 
515
end;
 
516
 
 
517
function InternalStrToCurrency(S: string): Extended;
 
518
 
 
519
var
 
520
  I: Integer;
 
521
  Tmp: string;
 
522
 
 
523
begin
 
524
  Tmp := '';
 
525
  for I := 1 to Length(S) do
 
526
    begin
 
527
    if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
 
528
      Tmp := Tmp + DecimalSeparator
 
529
    else
 
530
      Tmp := Tmp + S[I];
 
531
    end;
 
532
  Result := StrToCurr(Tmp);
 
533
end;
 
534
 
 
535
function InternalStrToDate(S: string): TDateTime;
 
536
 
 
537
var
 
538
  EY, EM, ED: Word;
 
539
 
 
540
begin
 
541
  EY := StrToInt(Copy(S,1,4));
 
542
  EM := StrToInt(Copy(S,6,2));
 
543
  ED := StrToInt(Copy(S,9,2));
 
544
  if (EY = 0) or (EM = 0) or (ED = 0) then
 
545
    Result:=0
 
546
  else
 
547
    Result:=EncodeDate(EY, EM, ED);
 
548
end;
 
549
 
 
550
function InternalStrToDateTime(S: string): TDateTime;
 
551
 
 
552
var
 
553
  EY, EM, ED: Word;
 
554
  EH, EN, ES: Word;
 
555
 
 
556
begin
 
557
  EY := StrToInt(Copy(S, 1, 4));
 
558
  EM := StrToInt(Copy(S, 6, 2));
 
559
  ED := StrToInt(Copy(S, 9, 2));
 
560
  EH := StrToInt(Copy(S, 12, 2));
 
561
  EN := StrToInt(Copy(S, 15, 2));
 
562
  ES := StrToInt(Copy(S, 18, 2));
 
563
  if (EY = 0) or (EM = 0) or (ED = 0) then
 
564
    Result := 0
 
565
  else
 
566
    Result := EncodeDate(EY, EM, ED);
 
567
  Result := Result + EncodeTime(EH, EN, ES, 0);
 
568
end;
 
569
 
 
570
function InternalStrToTime(S: string): TDateTime;
 
571
 
 
572
var
 
573
  EH, EM, ES: Word;
 
574
 
 
575
begin
 
576
  EH := StrToInt(Copy(S, 1, 2));
 
577
  EM := StrToInt(Copy(S, 4, 2));
 
578
  ES := StrToInt(Copy(S, 7, 2));
 
579
  Result := EncodeTime(EH, EM, ES, 0);
 
580
end;
 
581
 
 
582
function InternalStrToTimeStamp(S: string): TDateTime;
 
583
 
 
584
var
 
585
  EY, EM, ED: Word;
 
586
  EH, EN, ES: Word;
 
587
 
 
588
begin
 
589
{$IFNDEF mysql40}
 
590
  EY := StrToInt(Copy(S, 1, 4));
 
591
  EM := StrToInt(Copy(S, 6, 2));
 
592
  ED := StrToInt(Copy(S, 9, 2));
 
593
  EH := StrToInt(Copy(S, 12, 2));
 
594
  EN := StrToInt(Copy(S, 15, 2));
 
595
  ES := StrToInt(Copy(S, 18, 2));
 
596
{$ELSE}
 
597
  EY := StrToInt(Copy(S, 1, 4));
 
598
  EM := StrToInt(Copy(S, 5, 2));
 
599
  ED := StrToInt(Copy(S, 7, 2));
 
600
  EH := StrToInt(Copy(S, 9, 2));
 
601
  EN := StrToInt(Copy(S, 11, 2));
 
602
  ES := StrToInt(Copy(S, 13, 2));
 
603
{$ENDIF}
 
604
  if (EY = 0) or (EM = 0) or (ED = 0) then
 
605
    Result := 0
 
606
  else
 
607
    Result := EncodeDate(EY, EM, ED);
 
608
  Result := Result + EncodeTime(EH, EN, ES, 0);;
 
609
end;
 
610
 
 
611
function TConnectionName.MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType;Source, Dest: PChar): Boolean;
 
612
 
 
613
var
 
614
  VI: Integer;
 
615
  VF: Double;
 
616
  VC: Currency;
 
617
  VD: TDateTime;
 
618
  Src : String;
 
619
 
 
620
begin
 
621
  Result := False;
 
622
  if Source = Nil then
 
623
    exit;
 
624
  Src:=StrPas(Source);
 
625
  case AType of
 
626
    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG,
 
627
    FIELD_TYPE_INT24:
 
628
      begin
 
629
      if (Src<>'') then
 
630
        VI := StrToInt(Src)
 
631
      else
 
632
        VI := 0;
 
633
      Move(VI, Dest^, SizeOf(Integer));
 
634
      end;
 
635
    FIELD_TYPE_LONGLONG:
 
636
      begin
 
637
      if (Src<>'') then
 
638
        VI := StrToInt64(Src)
 
639
      else
 
640
        VI := 0;
 
641
      Move(VI, Dest^, SizeOf(LargeInt));
 
642
      end;
 
643
{$ifdef mysql50}
 
644
    FIELD_TYPE_NEWDECIMAL,
 
645
{$endif}      
 
646
    FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
 
647
      if AFieldType = ftBCD then
 
648
        begin
 
649
        VC := InternalStrToCurrency(Src);
 
650
        Move(VC, Dest^, SizeOf(Currency));
 
651
        end
 
652
      else
 
653
        begin
 
654
        if Src <> '' then
 
655
          VF := InternalStrToFloat(Src)
 
656
        else
 
657
          VF := 0;
 
658
        Move(VF, Dest^, SizeOf(Double));
 
659
        end;
 
660
    FIELD_TYPE_TIMESTAMP:
 
661
      begin
 
662
      if Src <> '' then
 
663
        VD := InternalStrToTimeStamp(Src)
 
664
      else
 
665
        VD := 0;
 
666
      Move(VD, Dest^, SizeOf(TDateTime));
 
667
      end;
 
668
    FIELD_TYPE_DATETIME:
 
669
      begin
 
670
      if Src <> '' then
 
671
        VD := InternalStrToDateTime(Src)
 
672
      else
 
673
        VD := 0;
 
674
      Move(VD, Dest^, SizeOf(TDateTime));
 
675
      end;
 
676
    FIELD_TYPE_DATE:
 
677
      begin
 
678
      if Src <> '' then
 
679
        VD := InternalStrToDate(Src)
 
680
      else
 
681
        VD := 0;
 
682
      Move(VD, Dest^, SizeOf(TDateTime));
 
683
      end;
 
684
    FIELD_TYPE_TIME:
 
685
      begin
 
686
      if Src <> '' then
 
687
        VD := InternalStrToTime(Src)
 
688
      else
 
689
        VD := 0;
 
690
      Move(VD, Dest^, SizeOf(TDateTime));
 
691
      end;
 
692
    FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
 
693
      begin
 
694
{      Write('Moving string of size ',asize,' : ');
 
695
      P:=Source;
 
696
      If (P<>nil) then
 
697
        While P[0]<>#0 do
 
698
          begin
 
699
          Write(p[0]);
 
700
          inc(p);
 
701
          end;
 
702
      Writeln;
 
703
}      if Src<> '' then
 
704
        Move(Source^, Dest^, ASize)
 
705
      else
 
706
        Dest^ := #0;
 
707
      end;
 
708
  end;
 
709
  Result := True;
 
710
end;
 
711
 
 
712
procedure TConnectionName.UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string);
 
713
 
 
714
var qry : TSQLQuery;
 
715
 
 
716
begin
 
717
  if not assigned(Transaction) then
 
718
    DatabaseError(SErrConnTransactionnSet);
 
719
 
 
720
  qry := tsqlquery.Create(nil);
 
721
  qry.transaction := Transaction;
 
722
  qry.database := Self;
 
723
  with qry do
 
724
    begin
 
725
    ReadOnly := True;
 
726
    sql.clear;
 
727
    sql.add('show index from ' +  TableName);
 
728
    open;
 
729
    end;
 
730
 
 
731
  while not qry.eof do with IndexDefs.AddIndexDef do
 
732
    begin
 
733
    Name := trim(qry.fieldbyname('Key_name').asstring);
 
734
    Fields := trim(qry.fieldbyname('Column_name').asstring);
 
735
    If Name = 'PRIMARY' then options := options + [ixPrimary];
 
736
    If qry.fieldbyname('Non_unique').asinteger = 0 then options := options + [ixUnique];
 
737
    qry.next;
 
738
{    while (name = qry.fields[0].asstring) and (not qry.eof) do
 
739
      begin
 
740
      Fields := Fields + ';' + trim(qry.Fields[2].asstring);
 
741
      qry.next;
 
742
      end;}
 
743
    end;
 
744
  qry.close;
 
745
  qry.free;
 
746
end;
 
747
 
 
748
 
 
749
function TConnectionName.GetTransactionHandle(trans: TSQLHandle): pointer;
 
750
begin
 
751
  Result:=Nil;
 
752
end;
 
753
 
 
754
function TConnectionName.Commit(trans: TSQLHandle): boolean;
 
755
begin
 
756
  // Do nothing.
 
757
end;
 
758
 
 
759
function TConnectionName.RollBack(trans: TSQLHandle): boolean;
 
760
begin
 
761
  // Do nothing
 
762
end;
 
763
 
 
764
function TConnectionName.StartdbTransaction(trans: TSQLHandle; AParams : string): boolean;
 
765
begin
 
766
  // Do nothing
 
767
end;
 
768
 
 
769
procedure TConnectionName.CommitRetaining(trans: TSQLHandle);
 
770
begin
 
771
  // Do nothing
 
772
end;
 
773
 
 
774
procedure TConnectionName.RollBackRetaining(trans: TSQLHandle);
 
775
begin
 
776
  // Do nothing
 
777
end;
 
778
 
 
779
end.