mysqldb.pp 21 KB

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