2
0

Quick.Data.Redis.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741
  1. { ***************************************************************************
  2. Copyright (c) 2015-2022 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 : 07/03/2022
  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. DEF_CONNECTIONTIMEOUT = 30000;
  144. DEF_READTIMETOUT = 10000;
  145. { TRedisResponse }
  146. constructor TRedisResponse.Create;
  147. begin
  148. fIsDone := False;
  149. fResponse := '';
  150. end;
  151. function TRedisResponse.GetIsDone: Boolean;
  152. begin
  153. Result := fIsDone;
  154. end;
  155. function TRedisResponse.GetResponse: string;
  156. begin
  157. Result := fResponse;
  158. end;
  159. procedure TRedisResponse.SetIsDone(const Value: Boolean);
  160. begin
  161. fIsDone := Value;
  162. end;
  163. procedure TRedisResponse.SetResponse(const Value: string);
  164. begin
  165. fResponse := Value;
  166. end;
  167. { TRedisClient }
  168. constructor TRedisClient.Create;
  169. begin
  170. inherited;
  171. fConnected := False;
  172. fHost := 'localhost';
  173. fPort := DEF_REDIS_PORT;
  174. fDataBaseNumber := 0;
  175. fMaxSize := 0;
  176. fPassword := '';
  177. fConnectionTimeout := DEF_CONNECTIONTIMEOUT;
  178. fReadTimeout := DEF_READTIMETOUT;
  179. fRaiseErrorIfCommandFails := False;
  180. fTCPClient := TIdTCPClient.Create;
  181. end;
  182. destructor TRedisClient.Destroy;
  183. begin
  184. try
  185. try
  186. Disconnect;
  187. finally
  188. fTCPClient.Free;
  189. end;
  190. except
  191. //avoid closing errors
  192. end;
  193. inherited;
  194. end;
  195. procedure TRedisClient.Disconnect;
  196. begin
  197. if fTCPClient.Connected then
  198. begin
  199. RedisQUIT;
  200. fTCPClient.IOHandler.InputBuffer.Clear;
  201. fTCPClient.IOHandler.WriteBufferFlush;
  202. if fTCPClient.Connected then fTCPClient.Disconnect(False);
  203. end;
  204. fConnected := False;
  205. end;
  206. procedure TRedisClient.Connect;
  207. begin
  208. try
  209. //connect password and database
  210. if not fTCPClient.Connected then
  211. begin
  212. fTCPClient.Host := fHost;
  213. fTCPClient.Port := fPort;
  214. fTCPClient.ConnectTimeout := fConnectionTimeout;
  215. fTCPClient.ReadTimeout := fConnectionTimeout;
  216. fTCPClient.Connect;
  217. if not fTCPClient.Connected then raise ERedisConnectionError.Create('Can''t connect to Redis Server!');
  218. end;
  219. fTCPClient.Socket.Binding.SetKeepAliveValues(True,5000,1000);
  220. if fPassword <> '' then
  221. begin
  222. if not RedisAUTH(fPassword) then raise ERedisAuthError.Create('Redis authentication error!');
  223. end;
  224. if fDataBaseNumber > 0 then
  225. begin
  226. if not RedisSELECT(fDataBaseNumber) then raise ERedisConnectionError.CreateFmt('Can''t select Redis Database "%d"',[fDataBaseNumber]);
  227. end;
  228. fTCPClient.IOHandler.MaxLineLength := MaxInt;
  229. fConnected := True;
  230. except
  231. on E : Exception do raise ERedisConnectionError.CreateFmt('Can''t connect to Redis service %s:%d (%s)',[Self.Host,Self.Port,e.Message]);
  232. end;
  233. end;
  234. function TRedisClient.EscapeString(const json: string): string;
  235. begin
  236. Result := StringReplace(json,'\','\\',[rfReplaceAll]);
  237. Result := StringReplace(Result,'"','\"',[rfReplaceAll]);
  238. Result := StringReplace(Result,#13,'\r',[rfReplaceAll]);
  239. Result := StringReplace(Result,#10,'\n',[rfReplaceAll]);
  240. //Result := StringReplace(Result,'/','\/"',[rfReplaceAll]);
  241. end;
  242. //function TRedisClient.BulkString(const aValue : string) : string;
  243. //begin
  244. // Result := Format('$%d%s%s%s',[aValue.Length,CRLF,aValue,CRLF]);
  245. //end;
  246. procedure TRedisClient.SetConnectionTimeout(const Value: Integer);
  247. begin
  248. if fConnectionTimeout <> Value then
  249. begin
  250. fConnectionTimeout := Value;
  251. if Assigned(fTCPClient) then fTCPClient.ConnectTimeout := fConnectionTimeout;
  252. end;
  253. end;
  254. procedure TRedisClient.SetReadTimeout(const Value: Integer);
  255. begin
  256. if fReadTimeout <> Value then
  257. begin
  258. fReadTimeout := Value;
  259. if Assigned(fTCPClient) then fTCPClient.ConnectTimeout := fReadTimeout;
  260. end;
  261. end;
  262. function TRedisClient.Command(const aCommand, aArgumentsFormat : string; aValues : array of const) : IRedisResponse;
  263. begin
  264. Result := Command(aCommand,Format(aArgumentsFormat,aValues));
  265. end;
  266. function TRedisclient.Command(const aCommand : string; const aArguments : string) : IRedisResponse;
  267. begin
  268. Result := Command(aCommand + ' ' + aArguments + CRLF);
  269. end;
  270. function TRedisClient.Command(const aCommand : string) : IRedisResponse;
  271. function TrimResponse(const aResponse : string) : string;
  272. begin
  273. Result := Copy(aResponse,Low(aResponse) + 1, aResponse.Length);
  274. end;
  275. var
  276. res : string;
  277. begin
  278. Result := TRedisResponse.Create;
  279. try
  280. if not fTCPClient.Connected then Connect;
  281. //Writeln('*'+ (aArguments.CountChar('$') + 1).ToString + CRLF + BulkString(aCommand) + aArguments);
  282. fTCPClient.IOHandler.Write(aCommand);
  283. if fTCPClient.IOHandler.CheckForDataOnSource(fReadTimeout) then
  284. begin
  285. res := fTCPClient.IOHandler.ReadLn;
  286. {$IFDEF DEBUG_REDIS}
  287. TDebugger.Trace(Self,Format('Command "%s"',[res]));
  288. {$ENDIF}
  289. if not res.IsEmpty then
  290. case res[Low(res)] of
  291. '+' :
  292. begin
  293. if res.Contains('+OK') then
  294. begin
  295. Result.IsDone := True;
  296. end
  297. else Result.Response := TrimResponse(res);
  298. end;
  299. '-' : Result.Response := TrimResponse(res);
  300. ':' :
  301. begin
  302. Result.Response := TrimResponse(res);
  303. Result.IsDone := Result.Response.ToInteger > -1;
  304. end;
  305. '$' :
  306. begin
  307. Result.Response := TrimResponse(res);
  308. if IsInteger(Result.Response) then
  309. begin
  310. if Result.Response.ToInteger > -1 then Result.IsDone := True;
  311. end
  312. else Result.IsDone := True;
  313. end;
  314. '*' :
  315. begin
  316. Result.Response := TrimResponse(res);
  317. Result.IsDone := True;
  318. end;
  319. else Result.Response := TrimResponse(res);
  320. end;
  321. end;
  322. if (fRaiseErrorIfCommandFails) and (not Result.IsDone) then raise ERedisCommandError.CreateFmt('command fail (%s)',[Result.Response]);
  323. except
  324. on E : Exception do raise ERedisCommandError.CreateFmt('Redis error: %s [%s...]',[e.message,aCommand.Substring(0,20)]);
  325. end;
  326. end;
  327. function TRedisClient.RedisRPUSH(const aKey, aValue : string) : Boolean;
  328. begin
  329. Result := Command('RPUSH','%s "%s"',[aKey,EscapeString(aValue)]).IsDone;
  330. end;
  331. function TRedisClient.RedisSELECT(dbIndex: Integer): Boolean;
  332. begin
  333. Result := Command('SELECT',dbIndex.ToString).IsDone;
  334. end;
  335. function TRedisClient.RedisSET(const aKey, aValue: string; aTTLMs: Integer = -1): Boolean;
  336. var
  337. rediscmd : IRedisCommand;
  338. begin
  339. rediscmd := TRedisCommand.Create('SET')
  340. .AddArgument(aKey)
  341. .AddArgument(aValue)
  342. .AddArgument('PX')
  343. .AddArgument(aTTLMs);
  344. Result := Command(rediscmd.ToCommand).IsDone;
  345. end;
  346. function TRedisClient.RedisRPOP(const aKey: string; out oValue: string): Boolean;
  347. var
  348. rediscmd : IRedisCommand;
  349. begin
  350. rediscmd := TRedisCommand.Create('RPOP')
  351. .AddArgument(aKey);
  352. if Command(rediscmd.ToCommand).IsDone then
  353. begin
  354. oValue := fTCPClient.IOHandler.ReadLn;
  355. Result := True;
  356. end
  357. else Result := False;
  358. end;
  359. function TRedisClient.RedisBRPOP(const aKey: string; out oValue: string; aWaitTimeoutSecs : Integer): Boolean;
  360. var
  361. rediscmd : IRedisCommand;
  362. response : IRedisResponse;
  363. begin
  364. Result := False;
  365. rediscmd := TRedisCommand.Create('BRPOP')
  366. .AddArgument(aKey)
  367. .AddArgument(aWaitTimeoutSecs);
  368. response := Command(rediscmd.ToCommand);
  369. if response.IsDone then
  370. begin
  371. //if response.Response = '-1' then Exit;
  372. fTCPClient.IOHandler.ReadLn; //$int
  373. fTCPClient.IOHandler.ReadLn; //key
  374. fTCPClient.IOHandler.ReadLn; //$int
  375. oValue := fTCPClient.IOHandler.ReadLn; //value
  376. if not oValue.IsEmpty then Result := True;
  377. end
  378. else
  379. begin
  380. if not response.Response.IsEmpty then ERedisCommandError.CreateFmt('BRPOP Error: %s',[response.Response]);
  381. end;
  382. end;
  383. function TRedisClient.RedisBRPOPLPUSH(const aKey, aKeyToMove: string; out oValue: string; aWaitTimeoutSecs: Integer): Boolean;
  384. var
  385. rediscmd : IRedisCommand;
  386. response : IRedisResponse;
  387. begin
  388. Result := False;
  389. rediscmd := TRedisCommand.Create('BRPOPLPUSH')
  390. .AddArgument(aKey)
  391. .AddArgument(aKeyToMove)
  392. .AddArgument(aWaitTimeoutSecs);
  393. response := Command(rediscmd.ToCommand);
  394. if response.IsDone then
  395. begin
  396. oValue := fTCPClient.IOHandler.ReadLn; //value
  397. if not oValue.IsEmpty then Result := True;
  398. end
  399. else raise ERedisCommandError.CreateFmt('BRPOPLPUSH Error: %s',[response.Response]);
  400. end;
  401. function TRedisClient.RedisDEL(const aKey: string): Boolean;
  402. var
  403. rediscmd : IRedisCommand;
  404. begin
  405. rediscmd := TRedisCommand.Create('DEL')
  406. .AddArgument(aKey);
  407. Result := Command(rediscmd.ToCommand).IsDone;
  408. end;
  409. function TRedisClient.RedisLLEN(const aKey : string): Integer;
  410. var
  411. rediscmd : IRedisCommand;
  412. response : IRedisResponse;
  413. begin
  414. Result := 0;
  415. rediscmd := TRedisCommand.Create('LLEN')
  416. .AddArgument(aKey);
  417. response := Command(rediscmd.ToCommand);
  418. if response.IsDone then
  419. begin
  420. Result := response.Response.ToInteger;
  421. end;
  422. end;
  423. function TRedisClient.RedisTTL(const aKey, aValue : string): Integer;
  424. var
  425. rediscmd : IRedisCommand;
  426. response : IRedisResponse;
  427. begin
  428. Result := 0;
  429. rediscmd := TRedisCommand.Create('TTL')
  430. .AddArgument(aKey)
  431. .AddArgument(aValue);
  432. response := Command(rediscmd.ToCommand);
  433. if response.IsDone then
  434. begin
  435. Result := response.Response.ToInteger;
  436. end;
  437. end;
  438. function TRedisClient.RedisZADD(const aKey, aValue: string; aScore: Int64): Boolean;
  439. var
  440. rediscmd : IRedisCommand;
  441. response : IRedisResponse;
  442. begin
  443. rediscmd := TRedisCommand.Create('ZADD')
  444. .AddArgument(aKey)
  445. .AddArgument(aScore)
  446. .AddArgument(aValue);
  447. response := Command(rediscmd.ToCommand);
  448. if response.IsDone then
  449. begin
  450. Result := response.Response.ToInteger = 1;
  451. end
  452. else raise ERedisCommandError.CreateFmt('ZADD %s',[response.Response]);
  453. end;
  454. function TRedisClient.RedisZRANGE(const aKey: string; aStartPosition, aEndPosition: Int64): TArray<string>;
  455. var
  456. rediscmd : IRedisCommand;
  457. response : IRedisResponse;
  458. value : string;
  459. i : Integer;
  460. begin
  461. Result := [];
  462. rediscmd := TRedisCommand.Create('ZRANGE')
  463. .AddArgument(aKey)
  464. .AddArgument(aStartPosition)
  465. .AddArgument(aEndPosition);
  466. response := Command(rediscmd.ToCommand);
  467. if response.IsDone then
  468. begin
  469. for i := 1 to (response.Response.ToInteger) do
  470. begin
  471. fTCPClient.IOHandler.ReadLn; //$int
  472. value := fTCPClient.IOHandler.ReadLn; //value
  473. Result := Result + [value];
  474. end;
  475. end
  476. else raise ERedisCommandError.CreateFmt('ZRANGE Error: %s',[response.Response]);
  477. end;
  478. function TRedisClient.RedisZRANGEBYSCORE(const aKey: string; aMinScore, aMaxScore: Int64): TArray<TRedisSortedItem>;
  479. var
  480. rediscmd : IRedisCommand;
  481. response : IRedisResponse;
  482. item : TRedisSortedItem;
  483. i : Integer;
  484. value : string;
  485. score : string;
  486. begin
  487. Result := [];
  488. rediscmd := TRedisCommand.Create('ZRANGEBYSCORE')
  489. .AddArgument(aKey)
  490. .AddArgument(aMinScore)
  491. .AddArgument(aMaxScore)
  492. .AddArgument('WITHSCORES');
  493. response := Command(rediscmd.ToCommand);
  494. if response.IsDone then
  495. begin
  496. for i := 1 to (response.Response.ToInteger Div 2) do
  497. begin
  498. fTCPClient.IOHandler.ReadLn; //$int
  499. value := fTCPClient.IOHandler.ReadLn; //value
  500. fTCPClient.IOHandler.ReadLn; //$int
  501. score := fTCPClient.IOHandler.ReadLn; //score
  502. item.Value := value;
  503. item.Score := score.ToInt64;
  504. Result := Result + [item];
  505. end;
  506. end
  507. else raise ERedisCommandError.CreateFmt('ZRANGE Error: %s',[response.Response]);
  508. end;
  509. function TRedisClient.RedisZREM(const aKey, aValue: string): Boolean;
  510. var
  511. rediscmd : IRedisCommand;
  512. response : IRedisResponse;
  513. begin
  514. Result := False;
  515. rediscmd := TRedisCommand.Create('ZREM')
  516. .AddArgument(aKey)
  517. .AddArgument(aValue);
  518. response := Command(rediscmd.ToCommand);
  519. if response.IsDone then
  520. begin
  521. Result := response.Response.ToInteger = 1;
  522. end;
  523. end;
  524. function TRedisClient.RedisLPOP(const aKey: string; out oValue: string): Boolean;
  525. var
  526. rediscmd : IRedisCommand;
  527. begin
  528. Result := False;
  529. rediscmd := TRedisCommand.Create('LPOP')
  530. .AddArgument(aKey);
  531. if Command(rediscmd.ToCommand).IsDone then
  532. begin
  533. oValue := fTCPClient.IOHandler.ReadLn;
  534. Result := True;
  535. end;
  536. end;
  537. function TRedisClient.RedisBLPOP(const aKey: string; out oValue: string; aWaitTimeoutSecs : Integer): Boolean;
  538. var
  539. rediscmd : IRedisCommand;
  540. response : IRedisResponse;
  541. begin
  542. rediscmd := TRedisCommand.Create('BLPOP')
  543. .AddArgument(aKey)
  544. .AddArgument(aWaitTimeoutSecs);
  545. response := Command(rediscmd.ToCommand);
  546. if response.IsDone then
  547. begin
  548. fTCPClient.IOHandler.ReadLn; //$int
  549. fTCPClient.IOHandler.ReadLn; //key
  550. fTCPClient.IOHandler.ReadLn; //$int
  551. oValue := fTCPClient.IOHandler.ReadLn; //value
  552. Result := True;
  553. end
  554. else raise ERedisCommandError.CreateFmt('BLPOP Error: %s',[response.Response]);
  555. end;
  556. function TRedisClient.RedisLPUSH(const aKey, aValue : string) : Boolean;
  557. var
  558. rediscmd : IRedisCommand;
  559. begin
  560. rediscmd := TRedisCommand.Create('LPUSH')
  561. .AddArgument(aKey)
  562. .AddArgument(aValue);
  563. Result := Command(rediscmd.ToCommand).IsDone;
  564. end;
  565. function TRedisClient.RedisLREM(const aKey, aValue: string; aNumOccurrences: Integer): Boolean;
  566. var
  567. rediscmd : IRedisCommand;
  568. begin
  569. rediscmd := TRedisCommand.Create('LREM')
  570. .AddArgument(aKey)
  571. .AddArgument(aNumOccurrences * -1)
  572. .AddArgument(aValue);
  573. Result := Command(rediscmd.ToCommand).IsDone;
  574. end;
  575. function TRedisClient.RedisLTRIM(const aKey : string; aFirstElement, aMaxSize : Int64) : Boolean;
  576. var
  577. rediscmd : IRedisCommand;
  578. begin
  579. rediscmd := TRedisCommand.Create('LTRIM')
  580. .AddArgument(aKey)
  581. .AddArgument(aFirstElement)
  582. .AddArgument(aMaxSize);
  583. Result := Command(rediscmd.ToCommand).IsDone;
  584. end;
  585. function TRedisClient.RedisAUTH(const aPassword : string) : Boolean;
  586. begin
  587. Result := Command('AUTH',fPassword).IsDone;
  588. end;
  589. function TRedisClient.RedisEXPIRE(const aKey: string; aExpireDate: TDateTime): Boolean;
  590. begin
  591. Result := RedisEXPIRE(aKey,MilliSecondsBetween(Now(),aExpireDate));
  592. end;
  593. function TRedisClient.RedisEXPIRE(const aKey: string; aTTLMs: Integer): Boolean;
  594. begin
  595. Result := Command('PEXPIRE','%s %d',[aKey,aTTLMs]).IsDone;
  596. end;
  597. function TRedisClient.RedisLINDEX(const aKey: string; aIndex: Integer; out oValue : string): Boolean;
  598. var
  599. response : IRedisResponse;
  600. begin
  601. Result := False;
  602. response := Command('LINDEX','%s %d',[aKey,aIndex]);
  603. if response.IsDone then
  604. begin
  605. oValue := response.response;
  606. Result := True;
  607. end;
  608. end;
  609. function TRedisClient.RedisGET(const aKey: string; out oValue: string): Boolean;
  610. var
  611. rediscmd : IRedisCommand;
  612. begin
  613. Result := False;
  614. rediscmd := TRedisCommand.Create('GET')
  615. .AddArgument(aKey);
  616. if Command(rediscmd.ToCommand).IsDone then
  617. begin
  618. oValue := fTCPClient.IOHandler.ReadLn;
  619. Result := True;
  620. end;
  621. end;
  622. function TRedisClient.RedisPING : Boolean;
  623. begin
  624. Result := False;
  625. if Command('PING'+ CRLF).IsDone then
  626. begin
  627. Result := fTCPClient.IOHandler.ReadLn = 'PONG';
  628. end;
  629. end;
  630. function TRedisClient.RedisQUIT : Boolean;
  631. begin
  632. try
  633. Result := Command('QUIT' + CRLF).IsDone;
  634. except
  635. Result := False;
  636. end;
  637. end;
  638. { TRedisCommand }
  639. constructor TRedisCommand.Create(const aCommand: string);
  640. begin
  641. fCommand := aCommand;
  642. fArguments := fArguments + [fCommand];
  643. end;
  644. function TRedisCommand.AddArgument(const aValue: string) : IRedisCommand;
  645. begin
  646. Result := Self;
  647. fArguments := fArguments + [aValue];
  648. end;
  649. function TRedisCommand.AddArgument(const aValue: Extended): IRedisCommand;
  650. begin
  651. Result := Self;
  652. fArguments := fArguments + [aValue.ToString];
  653. end;
  654. function TRedisCommand.AddArgument(const aValue: Int64): IRedisCommand;
  655. begin
  656. Result := Self;
  657. fArguments := fArguments + [aValue.ToString];
  658. end;
  659. function TRedisCommand.ToCommand: string;
  660. var
  661. arg : string;
  662. begin
  663. Result := '*' + (High(fArguments) + 1).ToString + CRLF;
  664. for arg in fArguments do
  665. begin
  666. Result := Result + '$' + arg.Length.ToString + CRLF + arg + CRLF;
  667. end;
  668. end;
  669. end.