mysqlconn.inc 20 KB

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