mysqldb4.pp 23 KB

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