← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to fcl/db/mysql/mysqldb4.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/mysql/mysqldb4.pp
 
1
unit MySQLDB4;
 
2
 
 
3
{$H+}
 
4
 
 
5
interface
 
6
 
 
7
uses
 
8
  SysUtils, Classes, db, mysql4,mysql4_com;
 
9
 
 
10
type
 
11
  PMySQLDatasetBookmark = ^TMySQLDatasetBookmark;
 
12
  TMySQLDatasetBookmark = record
 
13
                          BookmarkData: Integer;
 
14
                          BookmarkFlag: TBookmarkFlag;
 
15
                          end;
 
16
 
 
17
  Pinteger = ^Integer;
 
18
 
 
19
  TMySQLDatabase = class(TDatabase)
 
20
  Private
 
21
    FMYSQL: PMYSQL;
 
22
    FServerInfo: string;
 
23
    FHostInfo: string;
 
24
    function GetHostName: String;
 
25
    Function GetUserName : String;
 
26
    procedure SetHostName(const AValue: String);
 
27
    Procedure SetUserName (Value : String);
 
28
    Procedure SetPassword (Value : String);
 
29
    Function GetPassword : String;
 
30
    Function GetClientInfo : String;
 
31
  Protected
 
32
    Procedure ConnectToServer;
 
33
    Procedure SelectDatabase;
 
34
    Procedure DoInternalConnect; override;
 
35
    Procedure DoInternalDisConnect; override;
 
36
    procedure StartTransaction; override;
 
37
    procedure EndTransaction; override;
 
38
    function  GetServerStatus: string;
 
39
  Public
 
40
    Procedure CreateDatabase;
 
41
    Procedure DropDatabase;
 
42
    Property ServerInfo : String Read FServerInfo;
 
43
    Property HostInfo : String Read FHostInfo;
 
44
    property ClientInfo: string read GetClientInfo;
 
45
    property ServerStatus : String read GetServerStatus;
 
46
  Published
 
47
    Property UserName : String Read GetUserName Write SetUserName;
 
48
    Property HostName : String Read GetHostName Write SetHostName;
 
49
    Property Password : String Read GetPassword Write SetPassword;
 
50
  end;
 
51
 
 
52
  TMySQLDataset = class(TDBDataSet)
 
53
  private
 
54
    FSQL: TStrings;
 
55
    FRecordSize: Integer;
 
56
    FBufferSize: Integer;
 
57
    // MySQL data
 
58
    FMYSQLRES: PMYSQL_RES;
 
59
    FCurrentRecord: Integer;              { Record pointer }
 
60
    FAffectedRows: QWord;
 
61
    FLastInsertID: Integer;
 
62
    FLoadingFieldDefs: Boolean;
 
63
 
 
64
    procedure DoClose;
 
65
    procedure DoQuery;
 
66
    procedure DoGetResult;
 
67
 
 
68
    procedure CalculateSizes;
 
69
    procedure LoadBufferFromData(Buffer: PChar);
 
70
  protected
 
71
    Function FMySQL : PMySQL;
 
72
    procedure SetSQL(const Value: TStrings);
 
73
    function InternalStrToFloat(S: string): Extended;
 
74
    function InternalStrToDate(S: string): TDateTime;
 
75
    function InternalStrToTime(S: string): TDateTime;
 
76
    function InternalStrToDateTime(S: string): TDateTime;
 
77
    function InternalStrToTimeStamp(S: string): TDateTime;
 
78
 
 
79
    function MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
 
80
         var NewType: TFieldType; var NewSize: Integer): Boolean;
 
81
    function MySQLDataSize(AType: enum_field_types; ASize: Integer): Integer;
 
82
    function MySQLWriteFieldData(AType: enum_field_types; ASize: Integer; Source: PChar;
 
83
       Dest: PChar): Integer;
 
84
 
 
85
 
 
86
    function GetCanModify: Boolean; override;
 
87
    { Mandatory overrides }
 
88
    // Record buffer methods:
 
89
    function AllocRecordBuffer: PChar; override;
 
90
    procedure FreeRecordBuffer(var Buffer: PChar); override;
 
91
    procedure InternalInitRecord(Buffer: PChar); override;
 
92
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
 
93
    function GetRecordSize: Word; override;
 
94
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
 
95
    // Bookmark methods:
 
96
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
 
97
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
 
98
    procedure InternalGotoBookmark(ABookmark: Pointer); override;
 
99
    procedure InternalSetToRecord(Buffer: PChar); override;
 
100
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
 
101
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
 
102
    // Navigational methods:
 
103
    procedure InternalFirst; override;
 
104
    procedure InternalLast; override;
 
105
    // Editing methods:
 
106
    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
 
107
    procedure InternalDelete; override;
 
108
    procedure InternalPost; override;
 
109
    // Misc methods:
 
110
    procedure InternalClose; override;
 
111
    procedure InternalHandleException; override;
 
112
    procedure InternalInitFieldDefs; override;
 
113
    procedure InternalOpen; override;
 
114
    function IsCursorOpen: Boolean; override;
 
115
    { Optional overrides }
 
116
    function GetRecordCount: Integer; override;
 
117
    function GetRecNo: Integer; override;
 
118
    procedure SetRecNo(Value: Integer); override;
 
119
  public
 
120
    constructor Create(AOwner: TComponent); override;
 
121
    destructor Destroy; override;
 
122
 
 
123
    procedure ExecSQL;
 
124
 
 
125
    // TDataset method
 
126
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
 
127
 
 
128
    property AffectedRows: QWord read FAffectedRows;
 
129
    property LastInsertID: Integer read FLastInsertID;
 
130
  published
 
131
    property Active;
 
132
    property Database;
 
133
    property SQL: TStrings read FSQL write SetSQL;
 
134
    property BeforeOpen;
 
135
    property AfterOpen;
 
136
    property BeforeClose;
 
137
    property AfterClose;
 
138
    property BeforeInsert;
 
139
    property AfterInsert;
 
140
    property BeforeEdit;
 
141
    property AfterEdit;
 
142
    property BeforePost;
 
143
    property AfterPost;
 
144
    property BeforeCancel;
 
145
    property AfterCancel;
 
146
    property BeforeDelete;
 
147
    property AfterDelete;
 
148
    property BeforeScroll;
 
149
    property AfterScroll;
 
150
    property OnDeleteError;
 
151
    property OnEditError;
 
152
  end;
 
153
 
 
154
  EMySQLError = Class(Exception);
 
155
 
 
156
implementation
 
157
 
 
158
Resourcestring
 
159
  SErrServerConnectFailed = 'Server connect failed.';
 
160
  SErrDatabaseSelectFailed = 'failed to select database: %s';
 
161
  SErrDatabaseCreate = 'Failed to create database: %s';
 
162
  SErrDatabaseDrop = 'Failed to drop database: %s';
 
163
  SErrNoData = 'No data for record';
 
164
  SErrExecuting = 'Error executing query: %s';
 
165
  SErrFetchingdata = 'Error fetching row data: %s';
 
166
  SErrGettingResult = 'Error getting result set: %s';
 
167
 
 
168
Procedure MySQlError(R : PMySQL;Msg: String;Comp : TComponent);
 
169
 
 
170
Var
 
171
  MySQLMsg : String;
 
172
 
 
173
begin
 
174
 If (R<>Nil) then
 
175
   begin
 
176
   MySQLMsg:=Strpas(mysql_error(R));
 
177
   DatabaseErrorFmt(Msg,[MySQLMsg],Comp);
 
178
   end
 
179
 else
 
180
   DatabaseError(Msg,Comp);
 
181
end;
 
182
 
 
183
{ TMySQLDataset }
 
184
 
 
185
constructor TMySQLDataset.Create(AOwner: TComponent);
 
186
begin
 
187
  inherited Create(AOwner);
 
188
  FSQL := TStringList.Create;
 
189
  FBufferSize := 0;
 
190
  FRecordSize := 0;
 
191
  FCurrentRecord := -1;
 
192
  FLoadingFieldDefs := False;
 
193
  FAffectedRows := 0;
 
194
  FLastInsertID := -1;
 
195
  FMYSQLRES := nil;
 
196
end;
 
197
 
 
198
destructor TMySQLDataset.Destroy;
 
199
begin
 
200
  Close;
 
201
  FSQL.Free;
 
202
  inherited destroy;
 
203
end;
 
204
 
 
205
function TMySQLDataset.AllocRecordBuffer: PChar;
 
206
begin
 
207
  Result := AllocMem(FBufferSize);
 
208
end;
 
209
 
 
210
procedure TMySQLDataset.FreeRecordBuffer(var Buffer: PChar);
 
211
begin
 
212
  If (@Buffer<>nil) then
 
213
    FreeMem(Buffer);
 
214
end;
 
215
 
 
216
procedure TMySQLDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
 
217
begin
 
218
  PInteger(Data)^ := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData;
 
219
end;
 
220
 
 
221
function TMySQLDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
 
222
begin
 
223
  Result:=PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag;
 
224
end;
 
225
 
 
226
function TMySQLDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
 
227
 
 
228
var
 
229
  I, FC: Integer;
 
230
  fld: PMYSQL_FIELD;
 
231
  CurBuf: PChar;
 
232
 
 
233
begin
 
234
  Result := False;
 
235
  CurBuf := ActiveBuffer;
 
236
  FC := mysql_num_fields(FMYSQLRES);
 
237
  for I := 0 to FC-1 do
 
238
    begin
 
239
    fld := mysql_fetch_field_direct(FMYSQLRES, I);
 
240
    if Field.FieldName = fld^.name then
 
241
      begin
 
242
      Move(CurBuf^, PChar(Buffer)^, MySQLDataSize(fld^.ftype, fld^.length));
 
243
      if Field.DataType in [ftString{, ftWideString}] then
 
244
        begin
 
245
        Result := PChar(buffer)^ <> #0;
 
246
        if Result then
 
247
          // Terminate string (necessary for enum fields)
 
248
          PChar(buffer)[fld^.length] := #0;
 
249
        end
 
250
      else
 
251
        Result := True;
 
252
      break;
 
253
      end
 
254
    else
 
255
      Inc(CurBuf, MySQLDataSize(fld^.ftype, fld^.length));
 
256
    end;
 
257
end;
 
258
 
 
259
function TMySQLDataset.GetRecNo: Integer;
 
260
begin
 
261
  UpdateCursorPos;
 
262
  if (FCurrentRecord=-1) and (RecordCount > 0) then
 
263
    Result:=1
 
264
  else
 
265
    Result:=FCurrentRecord+1;
 
266
end;
 
267
 
 
268
function TMySQLDataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
 
269
  DoCheck: Boolean): TGetResult;
 
270
begin
 
271
  if RecordCount < 1 then
 
272
    Result := grEOF
 
273
  else
 
274
    begin
 
275
    Result := grOk;
 
276
    case GetMode of
 
277
      gmPrior:
 
278
        if FCurrentRecord <= 0 then
 
279
          begin
 
280
          Result := grBOF;
 
281
          FCurrentRecord := -1;
 
282
          end
 
283
        else
 
284
          Dec(FCurrentRecord);
 
285
      gmCurrent:
 
286
        if (FCurrentRecord<0) or (FCurrentRecord>=RecordCount) then
 
287
          Result := grError;
 
288
      gmNext:
 
289
        if FCurrentRecord>=RecordCount-1 then
 
290
          Result := grEOF
 
291
        else
 
292
          Inc(FCurrentRecord);
 
293
     end;
 
294
     if (Result=grOK) then
 
295
       begin
 
296
       LoadBufferFromData(Buffer);
 
297
       with PMySQLDatasetBookmark(Buffer + FRecordSize)^ do
 
298
         begin
 
299
         BookmarkData := FCurrentRecord;
 
300
         BookmarkFlag := bfCurrent;
 
301
         end;
 
302
       end
 
303
     else
 
304
       if (Result=grError) and (DoCheck) then
 
305
         DatabaseError(SerrNoData,Self);
 
306
     end;
 
307
end;
 
308
 
 
309
function TMySQLDataset.GetRecordCount: Integer;
 
310
begin
 
311
  Result:=mysql_num_rows(FMYSQLRES);
 
312
end;
 
313
 
 
314
function TMySQLDataset.GetRecordSize: Word;
 
315
begin
 
316
  Result:=FRecordSize;
 
317
end;
 
318
 
 
319
procedure TMySQLDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
 
320
begin
 
321
 
 
322
end;
 
323
 
 
324
procedure TMySQLDataset.InternalClose;
 
325
begin
 
326
  FCurrentRecord := -1;
 
327
  DoClose;
 
328
  if DefaultFields then
 
329
    DestroyFields;
 
330
end;
 
331
 
 
332
procedure TMySQLDataset.InternalDelete;
 
333
begin
 
334
 
 
335
end;
 
336
 
 
337
procedure TMySQLDataset.InternalFirst;
 
338
begin
 
339
  FCurrentRecord := -1;
 
340
end;
 
341
 
 
342
procedure TMySQLDataset.InternalGotoBookmark(ABookmark: Pointer);
 
343
begin
 
344
  FCurrentRecord := PInteger(ABookmark)^;
 
345
end;
 
346
 
 
347
procedure TMySQLDataset.InternalHandleException;
 
348
begin
 
349
  //     Application.HandleException(self);
 
350
end;
 
351
 
 
352
procedure TMySQLDataset.InternalInitFieldDefs;
 
353
 
 
354
var
 
355
  I, FC: Integer;
 
356
  field: PMYSQL_FIELD;
 
357
  DFT: TFieldType;
 
358
  DFS: Integer;
 
359
  WasClosed: Boolean;
 
360
 
 
361
begin
 
362
  if FLoadingFieldDefs then Exit;
 
363
  FLoadingFieldDefs := True;
 
364
  try
 
365
    WasClosed := not IsCursorOpen;
 
366
    if WasClosed then
 
367
      begin
 
368
      DoQuery;
 
369
      DoGetResult;
 
370
      end;
 
371
    try
 
372
      FieldDefs.Clear;
 
373
      FC := mysql_num_fields(FMYSQLRES);
 
374
      for I := 0 to FC-1 do
 
375
        begin
 
376
        field := mysql_fetch_field_direct(FMYSQLRES, I);
 
377
        if MySQLFieldToFieldType(field^.ftype, field^.length, DFT, DFS) then
 
378
            TFieldDef.Create(FieldDefs, field^.name, DFT, DFS, False, I+1);
 
379
        end;
 
380
    finally
 
381
      if WasClosed then
 
382
        DoClose;
 
383
    end;
 
384
  finally
 
385
    FLoadingFieldDefs := False;
 
386
  end;
 
387
end;
 
388
 
 
389
procedure TMySQLDataset.InternalInitRecord(Buffer: PChar);
 
390
begin
 
391
  FillChar(Buffer^, FBufferSize, 0);
 
392
end;
 
393
 
 
394
procedure TMySQLDataset.InternalLast;
 
395
begin
 
396
  FCurrentRecord := RecordCount;
 
397
end;
 
398
 
 
399
procedure TMySQLDataset.InternalOpen;
 
400
begin
 
401
  CheckDatabase;
 
402
  FMYSQLRES := nil;
 
403
  try
 
404
    DoQuery;
 
405
    DoGetResult;
 
406
    FCurrentRecord := -1;
 
407
    InternalInitFieldDefs;
 
408
    if DefaultFields then
 
409
      CreateFields;
 
410
    CalculateSizes;
 
411
    BindFields(True);
 
412
  except
 
413
    DoClose;
 
414
    raise;
 
415
  end;
 
416
  BookMarkSize:=SizeOf(Longint);
 
417
end;
 
418
 
 
419
procedure TMySQLDataset.InternalSetToRecord(Buffer: PChar);
 
420
begin
 
421
  FCurrentRecord := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData;
 
422
end;
 
423
 
 
424
function TMySQLDataset.IsCursorOpen: Boolean;
 
425
begin
 
426
  Result:=(FMYSQLRES<>nil);
 
427
end;
 
428
 
 
429
procedure TMySQLDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
 
430
begin
 
431
  PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
 
432
end;
 
433
 
 
434
procedure TMySQLDataset.SetBookmarkFlag(Buffer: PChar;
 
435
  Value: TBookmarkFlag);
 
436
begin
 
437
  PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
 
438
end;
 
439
 
 
440
procedure TMySQLDataset.SetFieldData(Field: TField; Buffer: Pointer);
 
441
begin
 
442
 
 
443
end;
 
444
 
 
445
procedure TMySQLDataset.SetRecNo(Value: Integer);
 
446
begin
 
447
  if (Value >= 0) and (Value <= RecordCount-1) then
 
448
    begin
 
449
    FCurrentRecord := Value-1;
 
450
    Resync([]);
 
451
    end;
 
452
end;
 
453
 
 
454
procedure TMySQLDataset.SetSQL(const Value: TStrings);
 
455
begin
 
456
  FSQL.Assign(Value);
 
457
  FieldDefs.Clear;
 
458
end;
 
459
 
 
460
procedure TMySQLDataset.ExecSQL;
 
461
begin
 
462
  try
 
463
    DoQuery;
 
464
  finally
 
465
    DoClose;
 
466
  end;
 
467
end;
 
468
 
 
469
 
 
470
procedure TMySQLDataset.InternalPost;
 
471
begin
 
472
 
 
473
end;
 
474
 
 
475
function TMySQLDataset.MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
 
476
   var NewType: TFieldType; var NewSize: Integer): Boolean;
 
477
begin
 
478
  Result := True;
 
479
  case AType of
 
480
    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
 
481
    FIELD_TYPE_INT24:
 
482
      begin
 
483
      NewType := ftInteger;
 
484
      NewSize := 0;
 
485
      end;
 
486
    FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
 
487
      begin
 
488
      NewType := ftFloat;
 
489
      NewSize := 0;
 
490
      end;
 
491
    FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATETIME:
 
492
      begin
 
493
      NewType := ftDateTime;
 
494
      NewSize := 0;
 
495
      end;
 
496
    FIELD_TYPE_DATE:
 
497
      begin
 
498
      NewType := ftDate;
 
499
      NewSize := 0;
 
500
      end;
 
501
    FIELD_TYPE_TIME:
 
502
      begin
 
503
      NewType := ftTime;
 
504
      NewSize := 0;
 
505
      end;
 
506
    FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
 
507
      begin
 
508
      NewType := ftString;
 
509
      NewSize := ASize;
 
510
      end;
 
511
  else
 
512
    Result := False;
 
513
  end;
 
514
end;
 
515
 
 
516
procedure TMySQLDataset.CalculateSizes;
 
517
var
 
518
  I, FC: Integer;
 
519
  field: PMYSQL_FIELD;
 
520
begin
 
521
  FRecordSize := 0;
 
522
  FC := mysql_num_fields(FMYSQLRES);
 
523
  for I := 0 to FC-1 do
 
524
    begin
 
525
    field := mysql_fetch_field_direct(FMYSQLRES, I);
 
526
    FRecordSize := FRecordSize + MySQLDataSize(field^.ftype, field^.length);
 
527
    end;
 
528
  FBufferSize := FRecordSize + SizeOf(TMySQLDatasetBookmark);
 
529
end;
 
530
 
 
531
procedure TMySQLDataset.LoadBufferFromData(Buffer: PChar);
 
532
 
 
533
var
 
534
  I, FC, CT: Integer;
 
535
  field: PMYSQL_FIELD;
 
536
  row: TMYSQL_ROW;
 
537
 
 
538
begin
 
539
  mysql_data_seek(FMYSQLRES, FCurrentRecord);
 
540
  row := mysql_fetch_row(FMYSQLRES);
 
541
  if row = nil then
 
542
     MySQLError(FMySQL,SErrFetchingData,Self);
 
543
  FC := mysql_num_fields(FMYSQLRES);
 
544
  for I := 0 to FC-1 do
 
545
    begin
 
546
    field := mysql_fetch_field_direct(FMYSQLRES, I);
 
547
    CT := MySQLWriteFieldData(field^.ftype, field^.length, row^, Buffer);
 
548
    Inc(Buffer, CT);
 
549
    Inc(row);
 
550
    end;
 
551
end;
 
552
 
 
553
 
 
554
function TMySQLDataset.MySQLDataSize(AType: enum_field_types;
 
555
  ASize: Integer): Integer;
 
556
begin
 
557
  Result := 0;
 
558
  case AType of
 
559
    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
 
560
    FIELD_TYPE_INT24:
 
561
      begin
 
562
      Result := SizeOf(Integer);
 
563
      end;
 
564
    FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
 
565
      begin
 
566
      Result := SizeOf(Double);
 
567
      end;
 
568
    FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATE, FIELD_TYPE_TIME, FIELD_TYPE_DATETIME:
 
569
      begin
 
570
      Result := SizeOf(TDateTime);
 
571
      end;
 
572
    FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
 
573
      begin
 
574
      Result := ASize;
 
575
      end;
 
576
  end;
 
577
end;
 
578
 
 
579
function TMySQLDataset.MySQLWriteFieldData(AType: enum_field_types;
 
580
  ASize: Integer; Source, Dest: PChar): Integer;
 
581
 
 
582
var
 
583
  VI: Integer;
 
584
  VF: Double;
 
585
  VD: TDateTime;
 
586
 
 
587
begin
 
588
  Result := 0;
 
589
  case AType of
 
590
    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
 
591
    FIELD_TYPE_INT24:
 
592
      begin
 
593
      Result := SizeOf(Integer);
 
594
      if Source <> '' then
 
595
        VI := StrToInt(Source)
 
596
      else
 
597
        VI := 0;
 
598
      Move(VI, Dest^, Result);
 
599
      end;
 
600
    FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
 
601
      begin
 
602
      Result := SizeOf(Double);
 
603
      if Source <> '' then
 
604
        VF := InternalStrToFloat(Source)
 
605
      else
 
606
        VF := 0;
 
607
      Move(VF, Dest^, Result);
 
608
      end;
 
609
    FIELD_TYPE_TIMESTAMP:
 
610
      begin
 
611
      Result := SizeOf(TDateTime);
 
612
      if Source <> '' then
 
613
        VD := InternalStrToTimeStamp(Source)
 
614
      else
 
615
        VD := 0;
 
616
      Move(VD, Dest^, Result);
 
617
      end;
 
618
    FIELD_TYPE_DATETIME:
 
619
      begin
 
620
      Result := SizeOf(TDateTime);
 
621
      if Source <> '' then
 
622
        VD := InternalStrToDateTime(Source)
 
623
      else
 
624
        VD := 0;
 
625
      Move(VD, Dest^, Result);
 
626
      end;
 
627
    FIELD_TYPE_DATE:
 
628
      begin
 
629
      Result := SizeOf(TDateTime);
 
630
      if Source <> '' then
 
631
        VD := InternalStrToDate(Source)
 
632
      else
 
633
        VD := 0;
 
634
      Move(VD, Dest^, Result);
 
635
      end;
 
636
    FIELD_TYPE_TIME:
 
637
      begin
 
638
      Result := SizeOf(TDateTime);
 
639
      if Source <> '' then
 
640
        VD := InternalStrToTime(Source)
 
641
      else
 
642
        VD := 0;
 
643
      Move(VD, Dest^, Result);
 
644
      end;
 
645
    FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
 
646
      begin
 
647
      Result := ASize;
 
648
      if Source <> '' then
 
649
        Move(Source^, Dest^, Result)
 
650
      else
 
651
        Dest^ := #0;
 
652
      end;
 
653
  end;
 
654
end;
 
655
 
 
656
function TMySQLDataset.InternalStrToFloat(S: string): Extended;
 
657
 
 
658
var
 
659
  I: Integer;
 
660
  Tmp: string;
 
661
 
 
662
begin
 
663
  Tmp := '';
 
664
  for I := 1 to Length(S) do
 
665
    begin
 
666
    if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
 
667
      Tmp := Tmp + DecimalSeparator
 
668
    else
 
669
      Tmp := Tmp + S[I];
 
670
    end;
 
671
  Result := StrToFloat(Tmp);
 
672
end;
 
673
 
 
674
function TMySQLDataset.InternalStrToDate(S: string): TDateTime;
 
675
 
 
676
var
 
677
  EY, EM, ED: Word;
 
678
 
 
679
begin
 
680
  EY := StrToInt(Copy(S,1,4));
 
681
  EM := StrToInt(Copy(S,6,2));
 
682
  ED := StrToInt(Copy(S,9,2));
 
683
  if (EY = 0) or (EM = 0) or (ED = 0) then
 
684
    Result:=0
 
685
  else
 
686
    Result:=EncodeDate(EY, EM, ED);
 
687
end;
 
688
 
 
689
function TMySQLDataset.InternalStrToDateTime(S: string): TDateTime;
 
690
 
 
691
var
 
692
  EY, EM, ED: Word;
 
693
  EH, EN, ES: Word;
 
694
 
 
695
begin
 
696
  EY := StrToInt(Copy(S, 1, 4));
 
697
  EM := StrToInt(Copy(S, 6, 2));
 
698
  ED := StrToInt(Copy(S, 9, 2));
 
699
  EH := StrToInt(Copy(S, 11, 2));
 
700
  EN := StrToInt(Copy(S, 14, 2));
 
701
  ES := StrToInt(Copy(S, 17, 2));
 
702
  if (EY = 0) or (EM = 0) or (ED = 0) then
 
703
    Result := 0
 
704
  else
 
705
    Result := EncodeDate(EY, EM, ED);
 
706
  Result := Result + EncodeTime(EH, EN, ES, 0);
 
707
end;
 
708
 
 
709
function TMySQLDataset.InternalStrToTime(S: string): TDateTime;
 
710
 
 
711
var
 
712
  EH, EM, ES: Word;
 
713
 
 
714
begin
 
715
  EH := StrToInt(Copy(S, 1, 2));
 
716
  EM := StrToInt(Copy(S, 4, 2));
 
717
  ES := StrToInt(Copy(S, 7, 2));
 
718
  Result := EncodeTime(EH, EM, ES, 0);
 
719
end;
 
720
 
 
721
function TMySQLDataset.InternalStrToTimeStamp(S: string): TDateTime;
 
722
 
 
723
var
 
724
  EY, EM, ED: Word;
 
725
  EH, EN, ES: Word;
 
726
 
 
727
begin
 
728
  EY := StrToInt(Copy(S, 1, 4));
 
729
  EM := StrToInt(Copy(S, 5, 2));
 
730
  ED := StrToInt(Copy(S, 7, 2));
 
731
  EH := StrToInt(Copy(S, 9, 2));
 
732
  EN := StrToInt(Copy(S, 11, 2));
 
733
  ES := StrToInt(Copy(S, 13, 2));
 
734
  if (EY = 0) or (EM = 0) or (ED = 0) then
 
735
    Result := 0
 
736
  else
 
737
    Result := EncodeDate(EY, EM, ED);
 
738
  Result := Result + EncodeTime(EH, EN, ES, 0);;
 
739
end;
 
740
 
 
741
procedure TMySQLDataset.DoClose;
 
742
begin
 
743
  try
 
744
    if FMYSQLRES <> nil then
 
745
       mysql_free_result(FMYSQLRES);
 
746
   finally
 
747
      FMYSQLRES := nil;
 
748
   end;
 
749
end;
 
750
 
 
751
procedure TMySQLDataset.DoQuery;
 
752
var
 
753
  Query: PChar;
 
754
 
 
755
begin
 
756
  Query := FSQL.GetText;
 
757
  try
 
758
    if mysql_query(FMySQL,Query) <> 0 then
 
759
      MySQLError(FMYSQL,SErrExecuting,Self);
 
760
  finally
 
761
    StrDispose(Query);
 
762
  end;
 
763
  FAffectedRows := mysql_affected_rows(FMYSQL);
 
764
  FLastInsertID := mysql_insert_id(FMYSQL);
 
765
end;
 
766
 
 
767
function TMySQLDataset.GetCanModify: Boolean;
 
768
begin
 
769
  Result := False;
 
770
end;
 
771
 
 
772
procedure TMySQLDataset.DoGetResult;
 
773
begin
 
774
  FMYSQLRES := mysql_store_result(FMYSQL);
 
775
  if (FMYSQLRES=nil) then
 
776
     MySQLError(FMYSQL,SErrGettingResult,Self);
 
777
  FAffectedRows := mysql_affected_rows(FMYSQL);
 
778
end;
 
779
 
 
780
function TMySQLDataset.FMySQL: PMySQL;
 
781
begin
 
782
  Result:=(Database as TMySQLDatabase).FMySQL;
 
783
end;
 
784
 
 
785
{ TMySQLDatabase }
 
786
 
 
787
function TMySQLDatabase.GetUserName: String;
 
788
begin
 
789
  result:=Params.values['UserName'];
 
790
end;
 
791
 
 
792
function TMySQLDatabase.GetHostName: String;
 
793
begin
 
794
  Result:=Params.Values['HostName'];
 
795
end;
 
796
 
 
797
procedure TMySQLDatabase.SetHostName(const AValue: String);
 
798
begin
 
799
  Params.Values['HostName']:=AValue;
 
800
end;
 
801
 
 
802
procedure TMySQLDatabase.SetUserName(Value: String);
 
803
begin
 
804
  Params.Values['UserName']:=Value;
 
805
end;
 
806
 
 
807
procedure TMySQLDatabase.SetPassword(Value: String);
 
808
begin
 
809
  Params.Values['Password']:=Value;
 
810
end;
 
811
 
 
812
function TMySQLDatabase.GetPassword: String;
 
813
begin
 
814
  Result:=Params.Values['Password'];
 
815
end;
 
816
 
 
817
function TMySQLDatabase.GetClientInfo: String;
 
818
begin
 
819
  Result:=strpas(mysql_get_client_info);
 
820
end;
 
821
 
 
822
procedure TMySQLDatabase.ConnectToServer;
 
823
Var
 
824
  H,U,P : String;
 
825
 
 
826
begin
 
827
  if (FMySQL=Nil) then
 
828
    New(FMySQL);
 
829
  H:=HostName;
 
830
  U:=UserName;
 
831
  P:=Password;
 
832
  mysql_init(FMySQL);
 
833
  FMySQL:=mysql_real_connect(FMySQL,PChar(H),PChar(U),Pchar(P),Nil,0,Nil,0);
 
834
  If (FMySQL=Nil) then
 
835
    MySQlError(Nil,SErrServerConnectFailed,Self);
 
836
  FServerInfo := strpas(mysql_get_server_info(FMYSQL));
 
837
  FHostInfo := strpas(mysql_get_host_info(FMYSQL));
 
838
 
 
839
end;
 
840
 
 
841
procedure TMySQLDatabase.SelectDatabase;
 
842
begin
 
843
  if mysql_select_db(FMySQL,pchar(DatabaseName))<>0 then
 
844
     MySQLError(FMySQL,SErrDatabaseSelectFailed,Self);
 
845
end;
 
846
 
 
847
procedure TMySQLDatabase.DoInternalConnect;
 
848
begin
 
849
  if (FMySQL<>nil) then
 
850
    DoInternalDisconnect;
 
851
  ConnectToServer;
 
852
  SelectDatabase;
 
853
end;
 
854
 
 
855
procedure TMySQLDatabase.DoInternalDisConnect;
 
856
begin
 
857
  mysql_close(FMySQL);
 
858
  FMySQL:=Nil;
 
859
  FServerInfo:='';
 
860
  FHostInfo:='';
 
861
end;
 
862
 
 
863
procedure TMySQLDatabase.StartTransaction;
 
864
begin
 
865
  // Nothing yet
 
866
end;
 
867
 
 
868
procedure TMySQLDatabase.EndTransaction;
 
869
begin
 
870
  // Nothing yet
 
871
end;
 
872
 
 
873
procedure TMySQLDatabase.CreateDatabase;
 
874
 
 
875
Var
 
876
  Disconnect : Boolean;
 
877
 
 
878
begin
 
879
  Disconnect:=(FMySQL=Nil);
 
880
  if Disconnect then
 
881
    ConnectToServer;
 
882
  try
 
883
    {if mysql_create_db(FMySQL,Pchar(DatabaseName))<>0 then
 
884
      MySQLError(FMySQL,SErrDatabaseCreate,Self);}
 
885
  Finally
 
886
    If Disconnect then
 
887
      DoInternalDisconnect;
 
888
  end;
 
889
end;
 
890
 
 
891
procedure TMySQLDatabase.DropDatabase;
 
892
 
 
893
Var
 
894
  Disconnect : Boolean;
 
895
 
 
896
begin
 
897
  Disconnect:=(FMySQL=Nil);
 
898
  if Disconnect then
 
899
    ConnectToServer;
 
900
  If (FMySQL=Nil) then
 
901
    ConnectToServer;
 
902
  try
 
903
{
 
904
    if mysql_drop_db(FMySQL,Pchar(DatabaseName))<>0 then
 
905
      MySQLError(FMySQL,SErrDatabaseDrop,Self);
 
906
}
 
907
  Finally
 
908
    If Disconnect then
 
909
      DoInternalDisconnect;
 
910
  end;
 
911
end;
 
912
 
 
913
function TMySQLDatabase.GetServerStatus: string;
 
914
begin
 
915
  CheckConnected;
 
916
  Result := mysql_stat(FMYSQL);
 
917
end;
 
918
 
 
919
end.
 
920
 
 
921
 
 
922
{
 
923
  $Log: mysqldb4.pp,v $
 
924
  Revision 1.2  2005/02/14 17:13:12  peter
 
925
    * truncate log
 
926
 
 
927
}