Quick.Data.Redis.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742
  1. { ***************************************************************************
  2. Copyright (c) 2015-2021 Kike Pérez
  3. Unit : Quick.Data.Redis
  4. Description : Redis client
  5. Author : Kike Pérez
  6. Version : 1.0
  7. Created : 22/02/2020
  8. Modified : 15/10/2021
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.Data.Redis;
  22. {$i QuickLib.inc}
  23. interface
  24. uses
  25. {$IFDEF DEBUG_REDIS}
  26. Quick.Debug.Utils,
  27. {$ENDIF}
  28. System.SysUtils,
  29. System.DateUtils,
  30. IdTCPClient,
  31. IdGlobal,
  32. Quick.Commons;
  33. type
  34. IRedisResponse = interface
  35. ['{21EF7ABF-E678-4F18-AE56-8A7C6B817AE3}']
  36. function GetIsDone: Boolean;
  37. function GetResponse: string;
  38. procedure SetIsDone(const Value: Boolean);
  39. procedure SetResponse(const Value: string);
  40. property IsDone : Boolean read GetIsDone write SetIsDone;
  41. property Response : string read GetResponse write SetResponse;
  42. end;
  43. TRedisResponse = class(TInterfacedObject,IRedisResponse)
  44. private
  45. fIsDone : Boolean;
  46. fResponse : string;
  47. function GetIsDone: Boolean;
  48. function GetResponse: string;
  49. procedure SetIsDone(const Value: Boolean);
  50. procedure SetResponse(const Value: string);
  51. public
  52. constructor Create;
  53. property IsDone : Boolean read GetIsDone write SetIsDone;
  54. property Response : string read GetResponse write SetResponse;
  55. end;
  56. TRedisSortedItem = record
  57. Value : string;
  58. Score : Int64;
  59. end;
  60. IRedisCommand = interface
  61. ['{13A978D1-C689-403F-8623-3489E4DEE060}']
  62. function AddArgument(const aValue : string) : IRedisCommand; overload;
  63. function AddArgument(const aValue : Int64) : IRedisCommand; overload;
  64. function AddArgument(const aValue : Extended) : IRedisCommand; overload;
  65. function ToCommand : string;
  66. end;
  67. TRedisCommand = class(TInterfacedObject,IRedisCommand)
  68. private
  69. fCommand : string;
  70. fArguments : array of string;
  71. public
  72. constructor Create(const aCommand : string);
  73. function AddArgument(const aValue : string) : IRedisCommand; overload;
  74. function AddArgument(const aValue : Int64) : IRedisCommand; overload;
  75. function AddArgument(const aValue : Extended) : IRedisCommand; overload;
  76. function ToCommand : string;
  77. end;
  78. TRedisClient = class
  79. private
  80. fTCPClient : TIdTCPClient;
  81. fHost : string;
  82. fPort : Integer;
  83. fDataBaseNumber : Integer;
  84. fMaxSize : Int64;
  85. fPassword : string;
  86. fConnectionTimeout : Integer;
  87. fReadTimeout : Integer;
  88. fConnected : Boolean;
  89. fRaiseErrorIfCommandFails : Boolean;
  90. procedure SetConnectionTimeout(const Value: Integer);
  91. procedure SetReadTimeout(const Value: Integer);
  92. function Command(const aCommand : string; const aArguments : string) : IRedisResponse; overload;
  93. function Command(const aCommand, aArgumentsFormat : string; aValues : array of const) : IRedisResponse; overload;
  94. function Command(const aCommand : string) : IRedisResponse; overload;
  95. function EscapeString(const json: string) : string;
  96. //function BulkString(const aValue : string) : string;
  97. public
  98. constructor Create;
  99. destructor Destroy; override;
  100. property Host : string read fHost write fHost;
  101. property Port : Integer read fPort write fPort;
  102. property DataBaseNumber : Integer read fDataBaseNumber write fDataBaseNumber;
  103. property MaxSize : Int64 read fMaxSize write fMaxSize;
  104. property Password : string read fPassword write fPassword;
  105. property ConnectionTimeout : Integer read fConnectionTimeout write SetConnectionTimeout;
  106. property ReadTimeout : Integer read fReadTimeout write SetReadTimeout;
  107. property RaiseErrorIfCommandFails : Boolean read fRaiseErrorIfCommandFails write fRaiseErrorIfCommandFails;
  108. property Connected : Boolean read fConnected;
  109. function RedisSELECT(dbIndex : Integer) : Boolean;
  110. function RedisSET(const aKey, aValue : string; aTTLMs : Integer = -1) : Boolean;
  111. function RedisGET(const aKey : string; out oValue : string) : Boolean;
  112. function RedisDEL(const aKey : string) : Boolean;
  113. function RedisRPUSH(const aKey, aValue : string) : Boolean;
  114. function RedisLPUSH(const aKey, aValue : string) : Boolean;
  115. function RedisRPOP(const aKey : string; out oValue : string) : Boolean;
  116. function RedisBRPOP(const aKey: string; out oValue: string; aWaitTimeoutSecs : Integer): Boolean;
  117. function RedisLPOP(const aKey : string; out oValue : string) : Boolean;
  118. function RedisBLPOP(const aKey: string; out oValue: string; aWaitTimeoutSecs : Integer): Boolean;
  119. function RedisBRPOPLPUSH(const aKey, aKeyToMove: string; out oValue: string; aWaitTimeoutSecs : Integer): Boolean;
  120. function RedisLTRIM(const aKey : string; aFirstElement, aMaxSize : Int64) : Boolean;
  121. function RedisEXPIRE(const aKey : string; aTTLMs : Integer) : Boolean; overload;
  122. function RedisEXPIRE(const aKey : string; aExpireDate : TDateTime) : Boolean; overload;
  123. function RedisLINDEX(const aKey: string; aIndex: Integer; out oValue : string): Boolean;
  124. function RedisLREM(const aKey, aValue: string; aNumOccurrences: Integer): Boolean;
  125. function RedisZADD(const aKey, aValue : string; aScore : Int64) : Boolean;
  126. function RedisZREM(const aKey, aValue : string) : Boolean;
  127. function RedisZRANGE(const aKey : string; aStartPosition, aEndPosition : Int64) : TArray<string>;
  128. function RedisZRANGEBYSCORE(const aKey : string; aMinScore, aMaxScore : Int64) : TArray<TRedisSortedItem>;
  129. function RedisLLEN(const aKey : string): Integer;
  130. function RedisTTL(const aKey, aValue : string): Integer;
  131. function RedisAUTH(const aPassword : string) : Boolean;
  132. function RedisPING : Boolean;
  133. function RedisQUIT : Boolean;
  134. procedure Connect;
  135. procedure Disconnect;
  136. end;
  137. ERedisConnectionError = class(Exception);
  138. ERedisAuthError = class(Exception);
  139. ERedisCommandError = class(Exception);
  140. implementation
  141. const
  142. DEF_REDIS_PORT = 6379;
  143. CRLF = #13#10;
  144. DEF_CONNECTIONTIMEOUT = 30000;
  145. DEF_READTIMETOUT = 10000;
  146. { TRedisResponse }
  147. constructor TRedisResponse.Create;
  148. begin
  149. fIsDone := False;
  150. fResponse := '';
  151. end;
  152. function TRedisResponse.GetIsDone: Boolean;
  153. begin
  154. Result := fIsDone;
  155. end;
  156. function TRedisResponse.GetResponse: string;
  157. begin
  158. Result := fResponse;
  159. end;
  160. procedure TRedisResponse.SetIsDone(const Value: Boolean);
  161. begin
  162. fIsDone := Value;
  163. end;
  164. procedure TRedisResponse.SetResponse(const Value: string);
  165. begin
  166. fResponse := Value;
  167. end;
  168. { TRedisClient }
  169. constructor TRedisClient.Create;
  170. begin
  171. inherited;
  172. fConnected := False;
  173. fHost := 'localhost';
  174. fPort := DEF_REDIS_PORT;
  175. fDataBaseNumber := 0;
  176. fMaxSize := 0;
  177. fPassword := '';
  178. fConnectionTimeout := DEF_CONNECTIONTIMEOUT;
  179. fReadTimeout := DEF_READTIMETOUT;
  180. fRaiseErrorIfCommandFails := False;
  181. fTCPClient := TIdTCPClient.Create;
  182. end;
  183. destructor TRedisClient.Destroy;
  184. begin
  185. try
  186. try
  187. Disconnect;
  188. finally
  189. fTCPClient.Free;
  190. end;
  191. except
  192. //avoid closing errors
  193. end;
  194. inherited;
  195. end;
  196. procedure TRedisClient.Disconnect;
  197. begin
  198. if fTCPClient.Connected then
  199. begin
  200. RedisQUIT;
  201. fTCPClient.IOHandler.InputBuffer.Clear;
  202. fTCPClient.IOHandler.WriteBufferFlush;
  203. if fTCPClient.Connected then fTCPClient.Disconnect(False);
  204. end;
  205. fConnected := False;
  206. end;
  207. procedure TRedisClient.Connect;
  208. begin
  209. try
  210. //connect password and database
  211. if not fTCPClient.Connected then
  212. begin
  213. fTCPClient.Host := fHost;
  214. fTCPClient.Port := fPort;
  215. fTCPClient.ConnectTimeout := fConnectionTimeout;
  216. fTCPClient.ReadTimeout := fConnectionTimeout;
  217. fTCPClient.Connect;
  218. if not fTCPClient.Connected then raise ERedisConnectionError.Create('Can''t connect to Redis Server!');
  219. end;
  220. fTCPClient.Socket.Binding.SetKeepAliveValues(True,5000,1000);
  221. if fPassword <> '' then
  222. begin
  223. if not RedisAUTH(fPassword) then raise ERedisAuthError.Create('Redis authentication error!');
  224. end;
  225. if fDataBaseNumber > 0 then
  226. begin
  227. if not RedisSELECT(fDataBaseNumber) then raise ERedisConnectionError.CreateFmt('Can''t select Redis Database "%d"',[fDataBaseNumber]);
  228. end;
  229. fTCPClient.IOHandler.MaxLineLength := MaxInt;
  230. fConnected := True;
  231. except
  232. on E : Exception do raise ERedisConnectionError.CreateFmt('Can''t connect to Redis service %s:%d (%s)',[Self.Host,Self.Port,e.Message]);
  233. end;
  234. end;
  235. function TRedisClient.EscapeString(const json: string): string;
  236. begin
  237. Result := StringReplace(json,'\','\\',[rfReplaceAll]);
  238. Result := StringReplace(Result,'"','\"',[rfReplaceAll]);
  239. Result := StringReplace(Result,#13,'\r',[rfReplaceAll]);
  240. Result := StringReplace(Result,#10,'\n',[rfReplaceAll]);
  241. //Result := StringReplace(Result,'/','\/"',[rfReplaceAll]);
  242. end;
  243. //function TRedisClient.BulkString(const aValue : string) : string;
  244. //begin
  245. // Result := Format('$%d%s%s%s',[aValue.Length,CRLF,aValue,CRLF]);
  246. //end;
  247. procedure TRedisClient.SetConnectionTimeout(const Value: Integer);
  248. begin
  249. if fConnectionTimeout <> Value then
  250. begin
  251. fConnectionTimeout := Value;
  252. if Assigned(fTCPClient) then fTCPClient.ConnectTimeout := fConnectionTimeout;
  253. end;
  254. end;
  255. procedure TRedisClient.SetReadTimeout(const Value: Integer);
  256. begin
  257. if fReadTimeout <> Value then
  258. begin
  259. fReadTimeout := Value;
  260. if Assigned(fTCPClient) then fTCPClient.ConnectTimeout := fReadTimeout;
  261. end;
  262. end;
  263. function TRedisClient.Command(const aCommand, aArgumentsFormat : string; aValues : array of const) : IRedisResponse;
  264. begin
  265. Result := Command(aCommand,Format(aArgumentsFormat,aValues));
  266. end;
  267. function TRedisclient.Command(const aCommand : string; const aArguments : string) : IRedisResponse;
  268. begin
  269. Result := Command(aCommand + ' ' + aArguments + CRLF);
  270. end;
  271. function TRedisClient.Command(const aCommand : string) : IRedisResponse;
  272. function TrimResponse(const aResponse : string) : string;
  273. begin
  274. Result := Copy(aResponse,Low(aResponse) + 1, aResponse.Length);
  275. end;
  276. var
  277. res : string;
  278. begin
  279. Result := TRedisResponse.Create;
  280. try
  281. if not fTCPClient.Connected then Connect;
  282. //Writeln('*'+ (aArguments.CountChar('$') + 1).ToString + CRLF + BulkString(aCommand) + aArguments);
  283. fTCPClient.IOHandler.Write(aCommand);
  284. if fTCPClient.IOHandler.CheckForDataOnSource(fReadTimeout) then
  285. begin
  286. res := fTCPClient.IOHandler.ReadLn;
  287. {$IFDEF DEBUG_REDIS}
  288. TDebugger.Trace(Self,Format('Command "%s"',[res]));
  289. {$ENDIF}
  290. if not res.IsEmpty then
  291. case res[Low(res)] of
  292. '+' :
  293. begin
  294. if res.Contains('+OK') then
  295. begin
  296. Result.IsDone := True;
  297. end
  298. else Result.Response := TrimResponse(res);
  299. end;
  300. '-' : Result.Response := TrimResponse(res);
  301. ':' :
  302. begin
  303. Result.Response := TrimResponse(res);
  304. Result.IsDone := Result.Response.ToInteger > -1;
  305. end;
  306. '$' :
  307. begin
  308. Result.Response := TrimResponse(res);
  309. if IsInteger(Result.Response) then
  310. begin
  311. if Result.Response.ToInteger > -1 then Result.IsDone := True;
  312. end
  313. else Result.IsDone := True;
  314. end;
  315. '*' :
  316. begin
  317. Result.Response := TrimResponse(res);
  318. Result.IsDone := True;
  319. end;
  320. else Result.Response := TrimResponse(res);
  321. end;
  322. end;
  323. if (fRaiseErrorIfCommandFails) and (not Result.IsDone) then raise ERedisCommandError.CreateFmt('command fail (%s)',[Result.Response]);
  324. except
  325. on E : Exception do raise ERedisCommandError.CreateFmt('Redis error: %s [%s...]',[e.message,aCommand.Substring(0,20)]);
  326. end;
  327. end;
  328. function TRedisClient.RedisRPUSH(const aKey, aValue : string) : Boolean;
  329. begin
  330. Result := Command('RPUSH','%s "%s"',[aKey,EscapeString(aValue)]).IsDone;
  331. end;
  332. function TRedisClient.RedisSELECT(dbIndex: Integer): Boolean;
  333. begin
  334. Result := Command('SELECT',dbIndex.ToString).IsDone;
  335. end;
  336. function TRedisClient.RedisSET(const aKey, aValue: string; aTTLMs: Integer = -1): Boolean;
  337. var
  338. rediscmd : IRedisCommand;
  339. begin
  340. rediscmd := TRedisCommand.Create('SET')
  341. .AddArgument(aKey)
  342. .AddArgument(aValue)
  343. .AddArgument('PX')
  344. .AddArgument(aTTLMs);
  345. Result := Command(rediscmd.ToCommand).IsDone;
  346. end;
  347. function TRedisClient.RedisRPOP(const aKey: string; out oValue: string): Boolean;
  348. var
  349. rediscmd : IRedisCommand;
  350. begin
  351. rediscmd := TRedisCommand.Create('RPOP')
  352. .AddArgument(aKey);
  353. if Command(rediscmd.ToCommand).IsDone then
  354. begin
  355. oValue := fTCPClient.IOHandler.ReadLn;
  356. Result := True;
  357. end
  358. else Result := False;
  359. end;
  360. function TRedisClient.RedisBRPOP(const aKey: string; out oValue: string; aWaitTimeoutSecs : Integer): Boolean;
  361. var
  362. rediscmd : IRedisCommand;
  363. response : IRedisResponse;
  364. begin
  365. Result := False;
  366. rediscmd := TRedisCommand.Create('BRPOP')
  367. .AddArgument(aKey)
  368. .AddArgument(aWaitTimeoutSecs);
  369. response := Command(rediscmd.ToCommand);
  370. if response.IsDone then
  371. begin
  372. //if response.Response = '-1' then Exit;
  373. fTCPClient.IOHandler.ReadLn; //$int
  374. fTCPClient.IOHandler.ReadLn; //key
  375. fTCPClient.IOHandler.ReadLn; //$int
  376. oValue := fTCPClient.IOHandler.ReadLn; //value
  377. if not oValue.IsEmpty then Result := True;
  378. end
  379. else
  380. begin
  381. if not response.Response.IsEmpty then ERedisCommandError.CreateFmt('BRPOP Error: %s',[response.Response]);
  382. end;
  383. end;
  384. function TRedisClient.RedisBRPOPLPUSH(const aKey, aKeyToMove: string; out oValue: string; aWaitTimeoutSecs: Integer): Boolean;
  385. var
  386. rediscmd : IRedisCommand;
  387. response : IRedisResponse;
  388. begin
  389. Result := False;
  390. rediscmd := TRedisCommand.Create('BRPOPLPUSH')
  391. .AddArgument(aKey)
  392. .AddArgument(aKeyToMove)
  393. .AddArgument(aWaitTimeoutSecs);
  394. response := Command(rediscmd.ToCommand);
  395. if response.IsDone then
  396. begin
  397. oValue := fTCPClient.IOHandler.ReadLn; //value
  398. if not oValue.IsEmpty then Result := True;
  399. end
  400. else raise ERedisCommandError.CreateFmt('BRPOPLPUSH Error: %s',[response.Response]);
  401. end;
  402. function TRedisClient.RedisDEL(const aKey: string): Boolean;
  403. var
  404. rediscmd : IRedisCommand;
  405. begin
  406. rediscmd := TRedisCommand.Create('DEL')
  407. .AddArgument(aKey);
  408. Result := Command(rediscmd.ToCommand).IsDone;
  409. end;
  410. function TRedisClient.RedisLLEN(const aKey : string): Integer;
  411. var
  412. rediscmd : IRedisCommand;
  413. response : IRedisResponse;
  414. begin
  415. Result := 0;
  416. rediscmd := TRedisCommand.Create('LLEN')
  417. .AddArgument(aKey);
  418. response := Command(rediscmd.ToCommand);
  419. if response.IsDone then
  420. begin
  421. Result := response.Response.ToInteger;
  422. end;
  423. end;
  424. function TRedisClient.RedisTTL(const aKey, aValue : string): Integer;
  425. var
  426. rediscmd : IRedisCommand;
  427. response : IRedisResponse;
  428. begin
  429. Result := 0;
  430. rediscmd := TRedisCommand.Create('TTL')
  431. .AddArgument(aKey)
  432. .AddArgument(aValue);
  433. response := Command(rediscmd.ToCommand);
  434. if response.IsDone then
  435. begin
  436. Result := response.Response.ToInteger;
  437. end;
  438. end;
  439. function TRedisClient.RedisZADD(const aKey, aValue: string; aScore: Int64): Boolean;
  440. var
  441. rediscmd : IRedisCommand;
  442. response : IRedisResponse;
  443. begin
  444. rediscmd := TRedisCommand.Create('ZADD')
  445. .AddArgument(aKey)
  446. .AddArgument(aScore)
  447. .AddArgument(aValue);
  448. response := Command(rediscmd.ToCommand);
  449. if response.IsDone then
  450. begin
  451. Result := response.Response.ToInteger = 1;
  452. end
  453. else raise ERedisCommandError.CreateFmt('ZADD %s',[response.Response]);
  454. end;
  455. function TRedisClient.RedisZRANGE(const aKey: string; aStartPosition, aEndPosition: Int64): TArray<string>;
  456. var
  457. rediscmd : IRedisCommand;
  458. response : IRedisResponse;
  459. value : string;
  460. i : Integer;
  461. begin
  462. Result := [];
  463. rediscmd := TRedisCommand.Create('ZRANGE')
  464. .AddArgument(aKey)
  465. .AddArgument(aStartPosition)
  466. .AddArgument(aEndPosition);
  467. response := Command(rediscmd.ToCommand);
  468. if response.IsDone then
  469. begin
  470. for i := 1 to (response.Response.ToInteger) do
  471. begin
  472. fTCPClient.IOHandler.ReadLn; //$int
  473. value := fTCPClient.IOHandler.ReadLn; //value
  474. Result := Result + [value];
  475. end;
  476. end
  477. else raise ERedisCommandError.CreateFmt('ZRANGE Error: %s',[response.Response]);
  478. end;
  479. function TRedisClient.RedisZRANGEBYSCORE(const aKey: string; aMinScore, aMaxScore: Int64): TArray<TRedisSortedItem>;
  480. var
  481. rediscmd : IRedisCommand;
  482. response : IRedisResponse;
  483. item : TRedisSortedItem;
  484. i : Integer;
  485. value : string;
  486. score : string;
  487. begin
  488. Result := [];
  489. rediscmd := TRedisCommand.Create('ZRANGEBYSCORE')
  490. .AddArgument(aKey)
  491. .AddArgument(aMinScore)
  492. .AddArgument(aMaxScore)
  493. .AddArgument('WITHSCORES');
  494. response := Command(rediscmd.ToCommand);
  495. if response.IsDone then
  496. begin
  497. for i := 1 to (response.Response.ToInteger Div 2) do
  498. begin
  499. fTCPClient.IOHandler.ReadLn; //$int
  500. value := fTCPClient.IOHandler.ReadLn; //value
  501. fTCPClient.IOHandler.ReadLn; //$int
  502. score := fTCPClient.IOHandler.ReadLn; //score
  503. item.Value := value;
  504. item.Score := score.ToInt64;
  505. Result := Result + [item];
  506. end;
  507. end
  508. else raise ERedisCommandError.CreateFmt('ZRANGE Error: %s',[response.Response]);
  509. end;
  510. function TRedisClient.RedisZREM(const aKey, aValue: string): Boolean;
  511. var
  512. rediscmd : IRedisCommand;
  513. response : IRedisResponse;
  514. begin
  515. Result := False;
  516. rediscmd := TRedisCommand.Create('ZREM')
  517. .AddArgument(aKey)
  518. .AddArgument(aValue);
  519. response := Command(rediscmd.ToCommand);
  520. if response.IsDone then
  521. begin
  522. Result := response.Response.ToInteger = 1;
  523. end;
  524. end;
  525. function TRedisClient.RedisLPOP(const aKey: string; out oValue: string): Boolean;
  526. var
  527. rediscmd : IRedisCommand;
  528. begin
  529. Result := False;
  530. rediscmd := TRedisCommand.Create('LPOP')
  531. .AddArgument(aKey);
  532. if Command(rediscmd.ToCommand).IsDone then
  533. begin
  534. oValue := fTCPClient.IOHandler.ReadLn;
  535. Result := True;
  536. end;
  537. end;
  538. function TRedisClient.RedisBLPOP(const aKey: string; out oValue: string; aWaitTimeoutSecs : Integer): Boolean;
  539. var
  540. rediscmd : IRedisCommand;
  541. response : IRedisResponse;
  542. begin
  543. rediscmd := TRedisCommand.Create('BLPOP')
  544. .AddArgument(aKey)
  545. .AddArgument(aWaitTimeoutSecs);
  546. response := Command(rediscmd.ToCommand);
  547. if response.IsDone then
  548. begin
  549. fTCPClient.IOHandler.ReadLn; //$int
  550. fTCPClient.IOHandler.ReadLn; //key
  551. fTCPClient.IOHandler.ReadLn; //$int
  552. oValue := fTCPClient.IOHandler.ReadLn; //value
  553. Result := True;
  554. end
  555. else raise ERedisCommandError.CreateFmt('BLPOP Error: %s',[response.Response]);
  556. end;
  557. function TRedisClient.RedisLPUSH(const aKey, aValue : string) : Boolean;
  558. var
  559. rediscmd : IRedisCommand;
  560. begin
  561. rediscmd := TRedisCommand.Create('LPUSH')
  562. .AddArgument(aKey)
  563. .AddArgument(aValue);
  564. Result := Command(rediscmd.ToCommand).IsDone;
  565. end;
  566. function TRedisClient.RedisLREM(const aKey, aValue: string; aNumOccurrences: Integer): Boolean;
  567. var
  568. rediscmd : IRedisCommand;
  569. begin
  570. rediscmd := TRedisCommand.Create('LREM')
  571. .AddArgument(aKey)
  572. .AddArgument(aNumOccurrences * -1)
  573. .AddArgument(aValue);
  574. Result := Command(rediscmd.ToCommand).IsDone;
  575. end;
  576. function TRedisClient.RedisLTRIM(const aKey : string; aFirstElement, aMaxSize : Int64) : Boolean;
  577. var
  578. rediscmd : IRedisCommand;
  579. begin
  580. rediscmd := TRedisCommand.Create('LTRIM')
  581. .AddArgument(aKey)
  582. .AddArgument(aFirstElement)
  583. .AddArgument(aMaxSize);
  584. Result := Command(rediscmd.ToCommand).IsDone;
  585. end;
  586. function TRedisClient.RedisAUTH(const aPassword : string) : Boolean;
  587. begin
  588. Result := Command('AUTH',fPassword).IsDone;
  589. end;
  590. function TRedisClient.RedisEXPIRE(const aKey: string; aExpireDate: TDateTime): Boolean;
  591. begin
  592. Result := RedisEXPIRE(aKey,MilliSecondsBetween(Now(),aExpireDate));
  593. end;
  594. function TRedisClient.RedisEXPIRE(const aKey: string; aTTLMs: Integer): Boolean;
  595. begin
  596. Result := Command('PEXPIRE','%s %d',[aKey,aTTLMs]).IsDone;
  597. end;
  598. function TRedisClient.RedisLINDEX(const aKey: string; aIndex: Integer; out oValue : string): Boolean;
  599. var
  600. response : IRedisResponse;
  601. begin
  602. Result := False;
  603. response := Command('LINDEX','%s %d',[aKey,aIndex]);
  604. if response.IsDone then
  605. begin
  606. oValue := response.response;
  607. Result := True;
  608. end;
  609. end;
  610. function TRedisClient.RedisGET(const aKey: string; out oValue: string): Boolean;
  611. var
  612. rediscmd : IRedisCommand;
  613. begin
  614. Result := False;
  615. rediscmd := TRedisCommand.Create('GET')
  616. .AddArgument(aKey);
  617. if Command(rediscmd.ToCommand).IsDone then
  618. begin
  619. oValue := fTCPClient.IOHandler.ReadLn;
  620. Result := True;
  621. end;
  622. end;
  623. function TRedisClient.RedisPING : Boolean;
  624. begin
  625. Result := False;
  626. if Command('PING'+ CRLF).IsDone then
  627. begin
  628. Result := fTCPClient.IOHandler.ReadLn = 'PONG';
  629. end;
  630. end;
  631. function TRedisClient.RedisQUIT : Boolean;
  632. begin
  633. try
  634. Result := Command('QUIT' + CRLF).IsDone;
  635. except
  636. Result := False;
  637. end;
  638. end;
  639. { TRedisCommand }
  640. constructor TRedisCommand.Create(const aCommand: string);
  641. begin
  642. fCommand := aCommand;
  643. fArguments := fArguments + [fCommand];
  644. end;
  645. function TRedisCommand.AddArgument(const aValue: string) : IRedisCommand;
  646. begin
  647. Result := Self;
  648. fArguments := fArguments + [aValue];
  649. end;
  650. function TRedisCommand.AddArgument(const aValue: Extended): IRedisCommand;
  651. begin
  652. Result := Self;
  653. fArguments := fArguments + [aValue.ToString];
  654. end;
  655. function TRedisCommand.AddArgument(const aValue: Int64): IRedisCommand;
  656. begin
  657. Result := Self;
  658. fArguments := fArguments + [aValue.ToString];
  659. end;
  660. function TRedisCommand.ToCommand: string;
  661. var
  662. arg : string;
  663. begin
  664. Result := '*' + (High(fArguments) + 1).ToString + CRLF;
  665. for arg in fArguments do
  666. begin
  667. Result := Result + '$' + arg.Length.ToString + CRLF + arg + CRLF;
  668. end;
  669. end;
  670. end.