mysqlconn.inc 20 KB

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