Delphi 使用 TIdTCPClient 设置 memcashed 值后 readln() 变慢

Question

我制作了一个 class TmemcacheClass，我可以在其中设置和获取 memcached 的值。

它用于 Delphi Webbroker 应用程序，其中每个线程打开 TmemcacheClass 并在其生命周期中使用它。这意味着每个线程都打开 TIdTCPClient，并连接它并为每个请求重用。

获取值非常快，如 0 到 1 毫秒 set value 也很快像 1 ms ，但是设置后等待 readln 需要 47 ms.

想知道如何加快速度。

是等待很慢的过程store()
行：= tcp.Socket.ReadLn();

添加孔单元，也许我可以在保存后删除 readl 以加快速度？如果我放弃 readln，我想我需要清除套接字，因为我正在重用相同的套接字。

unit unitMemcache;

interface
uses
  system.sysutils,system.classes,system.JSON,idtcpclient,idGlobal;

type

   TmemcacheClass = Class ( Tobject )
    private

    tcp : TIdTCPClient;
    ConnectTimeout : integer;
    Fconnected: Boolean;
    Ferror: String;
    Fcontent: String;
    Flinecounter : Integer;
    procedure Setconnected(const Value: Boolean);
    procedure Seterror(const Value: String);
    procedure reportError(e:string);
    procedure Setcontent(const Value: String);

   public
      constructor create( ip : string ) ;
      destructor Destroy ( ) ; override  ;
      procedure store(Key, Value: string);
      function Lookup(Key: string ): String;
      procedure flush_all;

      procedure Delete(Key: string );

      procedure connect;

      property connected : Boolean read Fconnected write Setconnected;
      property error   : String read Ferror write Seterror;
      property content : String read Fcontent write Setcontent;
   End;

implementation

uses system.dateutils;


{ TmemcacheClass }


procedure TmemcacheClass.connect;
begin
  try
   if not tcp.Connected then
    begin
       tcp.Connect;
       Fconnected:=true;
    end;
  except
     on e: Exception do
    begin
       reportError(e.Message);
       Fconnected:=false;
    end;
  end;

end;

constructor TmemcacheClass.create(ip: string  );
begin
 //  FConnectTimeout := 4000;

  Fconnected:=false;
  tcp := TIdTCPClient.Create;
  tcp.ConnectTimeout :=    1000; // maybe to long  , specially if there is a issue...
  tcp.ReadTimeout    :=    2000;
  tcp.Host := ip;
  tcp.Port := 11211;
  tcp.ReuseSocket := rsTrue;

 end;

procedure TmemcacheClass.Delete(Key: string);
var
  command : String;
  stop    : Boolean;
  line : String;
begin
 connect;  // just in case
   if  Fconnected then
   begin
       command :='delete '+key;
       tcp.Socket.Writeln(command);
       stop:=false;
       repeat
        line:=  tcp.Socket.ReadLn();
        if Line = 'END' then Stop:=true;
        if Line = 'DELETED' then Stop:=true;
        if Line = 'NOT_FOUND' then Stop:=true;
        if (Line = '') and ( not tcp.Socket.ReadLnTimedOut)  then Stop:=true;
        until Stop;
   end;

end;

destructor TmemcacheClass.Destroy;
begin
  tcp.Free;
  inherited;
end;




procedure TmemcacheClass.flush_all;
var
  command : String;
  stop    : Boolean;
  line : String;
begin
 Ferror := '';
 connect;  // just in case
   if  Fconnected then
   begin
       command :='flush_all';
          try
           tcp.Socket.Writeln(command);
          except
             on e: Exception do
            begin
               reportError(e.Message);
               exit;
            end;
          end;

       stop:=false;
       repeat
          try
           line:=  tcp.Socket.ReadLn();
          except
             on e: Exception do
            begin
               reportError(e.Message);
               exit;
            end;
          end;

        if Line = 'OK' then Stop:=true;
        if Line = 'END' then Stop:=true;
        if Line = 'STORED' then Stop:=true;
        if (Line = '') and ( not tcp.Socket.ReadLnTimedOut)  then Stop:=true;
        until Stop;
         if line <> 'STORED' then   line:=  tcp.Socket.ReadLn();
   end;

end;

function TmemcacheClass.Lookup(Key : string): String;
var
   Top : Boolean;
   TopString : String;
   line : String;
   Data : String;
   Stop : Boolean;
   max_loops : Integer;
   topStringValues : Tstringlist;
   command : String;
   size : Integer;

begin
 Ferror := '';
 connect;  // just in case
 result:='';
   if  Fconnected then
   begin

         command :='get '+key;


          try
            tcp.Socket.Writeln(command);
          except
             on e: Exception do
            begin
               reportError(e.Message);
               exit;
               result:='';
            end;
          end;



         Top:=true;
         stop := False;
         data :='';
         max_loops:=0;
         size :=0;
         repeat
           inc(max_loops);
           if top   then
           begin
            tcp.Socket.MaxLineLength:=1700; // default first line  :-)
            try
             TopString:= tcp.Socket.ReadLn();
            except
               on e: Exception do
              begin
                 reportError(e.Message);
                 exit;
                 result:='';
              end;
            end;

            top :=false;
            if TopString = 'END' then Stop:=true;
            if TopString = 'STORED' then Stop:=true;

            if TopString = 'SERVER_ERROR' then
            begin
             Stop:=true;
              reportError('SERVER_ERROR : '+key);
            end;
            if TopString = 'CLIENT_ERROR' then
            begin
             Stop:=true;
             reportError('CLIENT_ERROR : '+key);
            end;


            if (TopString = '') and ( not tcp.Socket.ReadLnTimedOut)  then Stop:=true;
            if stop=false then
            begin
             // Decode top string
             topStringValues := Tstringlist.Create;
             try
               TopString:= StringReplace(TopString,' ','*',[rfReplaceAll]);
               topStringValues.Delimiter:='*';
               topStringValues.DelimitedText:=TopString;
               if topStringValues.Count=4 then
               begin
                 size:=strtointdef( topStringValues[3],1700);
                 tcp.Socket.MaxLineLength:=size+10;  // meassure length add 10 in case  :-) for reading
                end
                 else
                  begin
                   // error with header
                   stop:=true;
                   result:='';
                   data :='';

                  end;
             finally
               topStringValues.Clear;
               topStringValues.Free;
             end
            end;
           end
            else
             begin
                try
                  Line :=  tcp.Socket.ReadLn(); // Can be to long need to check with a stream...
                except
                   on e: Exception do
                  begin
                     reportError(e.Message);
                     exit;
                     result:='';
                  end;
                end;

                if Line = 'END' then Stop:=true;
                if Line = 'STORED' then Stop:=true;
                if (Line = '') and ( not tcp.Socket.ReadLnTimedOut)  then Stop:=true;
                if not stop  then data := data+line;
             end;

             if max_loops > 5000 then
             begin
               stop :=true;
               reportError('max_loops > 500 getting : '+key);
               exit;
             end;
         until stop;

         result:=data;
   end;



end;

procedure TmemcacheClass.reportError(e: string);
begin
 Ferror:=e;
 tcp.Disconnect;
 Fconnected:=false;
 Fcontent:='';

end;

procedure TmemcacheClass.Setconnected(const Value: Boolean);
begin
  Fconnected := Value;
end;

procedure TmemcacheClass.Setcontent(const Value: String);
begin
  Fcontent := Value;
end;

procedure TmemcacheClass.Seterror(const Value: String);
begin
  Ferror := Value;
end;

procedure TmemcacheClass.store(Key, Value: string );
var
  command : String;
  stop    : Boolean;
  line : String;
  start_time         : Extended        ;
  startLabel         : String;


begin
 start_time:= now;
 Ferror := '';
 connect;  // just in case
   if  Fconnected then
   begin
       command :='set '+key+' 0 0 '+length(Value).ToString;
          try
           tcp.Socket.Writeln(command);
           tcp.Socket.Writeln(Value);
          except
             on e: Exception do
            begin
               reportError(e.Message);
               exit;
            end;
          end;

       stop:=false;
       repeat
          try
           line:=  tcp.Socket.ReadLn();
          except
             on e: Exception do
            begin
               reportError(e.Message);
               exit;
            end;
          end;



        if Line = 'END' then Stop:=true;
        if Line = 'STORED' then Stop:=true;
        if (Line = '') and ( not tcp.Socket.ReadLnTimedOut)  then Stop:=true;
        until Stop;
       startLabel:=(MilliSecondsBetween(Now, start_time) ).ToString;
        startLabel:=startLabel;

         if line <> 'STORED' then   line:=  tcp.Socket.ReadLn();
   end;


end;
end.

Answer 1

我更改了存储过程。在我的命令中添加了 "noreply"。并注释掉回复readln.

现在存储新数据只需要0到1毫秒。在 memcached 中使用 fluch_all 后速度大幅提升，需要重建。

procedure TmemcacheClass.store(Key, Value: string );
var
  command : String;
  stop    : Boolean;
  line : String;
  start_time         : Extended        ;
  startLabel         : String;


begin
 start_time:= now;
 Ferror := '';
 connect;  // just in case
   if  Fconnected then
   begin
       command :='set '+key+' 0 0 '+length(Value).ToString+' noreply';
          try
           tcp.Socket.Writeln(command);
           tcp.Socket.Writeln(Value);
          except
             on e: Exception do
            begin
               reportError(e.Message);
               exit;
            end;
          end;

//       stop:=false;
//       repeat
//          try
//           line:=  tcp.Socket.ReadLn();
//          except
//             on e: Exception do
//            begin
//               reportError(e.Message);
//               exit;
//            end;
//          end;
//
//
//
//        if Line = 'END' then Stop:=true;
//        if Line = 'STORED' then Stop:=true;
//        if (Line = '') and ( not tcp.Socket.ReadLnTimedOut)  then Stop:=true;
//        until Stop;
//       startLabel:=(MilliSecondsBetween(Now, start_time) ).ToString;
//        startLabel:=startLabel;
//
//         if line <> 'STORED' then   line:=  tcp.Socket.ReadLn();
   end;


end;

Delphi 使用 TIdTCPClient 设置 memcashed 值后 readln() 变慢

Delphi slow readln() after set memcashed value using TIdTCPClient

delphi

memcached