mysqlconn.inc 21 KB

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