说明
  硬盘内存4G
  delphi 7
  aSubmitItemList 为TThreadList  最大为100万,如果超长就不写入结构
  TaSubmitItem = Record
    LocalGwMessageId : Int64;
    Registered_Delivery : Byte;
    Data : String;
  end;
.....在TServerSocket的.OnClientRead中
var
    aSubmitItem : ^TaSubmitItem;
begin
   .......
    if GetaSubmitItemListCount < 1000000 then    //控制在100万
    begin
      New(aSubmitItem);
      aSubmitItem^.Data := '内容为接收短客户提交的(变长)';
      aSubmitItem^.LocalGwMessageId := GetMessageId;
      aSubmitItem^.Registered_Delivery := 1;    
      try
        aSubmitItemList.LockList.Add(aSubmitItem);
      finally
        aSubmitItemList.UnlockList;
      end;
    end;
end;
然后,一个线程负债把aSubmitItemList中的转存到数据库
var
  i,ListCount : Integer;
  aSubmitItem : TaSubmitItem;
begin
    ListCount := MainForm.GetaSubmitItemListCount;
    for i := 0 to ListCount - 1 do
    begin
      FillChar(aSubmitItem,SizeOf(aSubmitItem),0);
      try
        with MainForm.aSubmitItemList.LockList do
        begin
          if Items[0] <> nil then //保存数据库就删除
          begin
            aSubmitItem := TaSubmitItem(Items[0]^);
            Dispose(Items[0]);
          end;
          Delete(0);
        end;
      finally
        MainForm.aSubmitItemList.UnlockList;
      end;
      .....保存数据库
    end;
end;
问题: 为何长时间运行后,出现Out of memory ,是内存泄漏,还是我的程序不对,还是其它?请大家看看,

解决方案 »

  1.   

    en,如果我来做的话,我就会:
    A:将TaSubmitItem结构体中的Data定长,定长为一个最大字节。你那个是短信内容吧,好像最大160字节,则结构变为: 
      TaSubmitItem = packed Record 
        LocalGwMessageId : Int64; 
        Registered_Delivery : Byte; 
        Data : array [0..159] of Char; 
      end; B: 
    程序一启动,创建100W个TaSubmitItem指针到一个FMyIdlePtrs: TList中,作为缓存指针使用,如:
    var
      FBuffers: PChar;
      P: ^TaSubmitItem; 
    begin
      FBuffers := AllocMem(100W * SizeOf(TaSubmitItem));
      P := Pointer(FBuffers);
      for I := 0 to 100W - 1 do
      begin
        FMyIdlePtrs.Add(P);
        Inc(P);
      end;
    end;C:
    在ServerSocket.OnClientRead处理中,不使用New来分配,直接从FMyIdlePtrs取指针使用:
    如:
    >> New(aSubmitItem); 
    改成:
    aSubmitItem := FMyIdlePtrs.Last;
    FMyIdlePtrs.Delete(FMyIdlePtrs.Count - 1);
    ....D:
    删除时,不使用Dispose,而是将指针再返回FMyIdlePtrs中,循环使用。这样的话,根本不可能出现那错误。而且效率会更好,频繁New, Dispose操作,则效率的大敌,特别是SERVER端数据包的使用上。
      

  2.   

    哦,最后,那个FMyIdlePtrs里面的指针,只是由FBuffers转换而来,在应用程序退出时,写一行代码:FreeMem(FBuffers)就行了。不用管FMyIdlePtrs里面的东西。
      

  3.   

    这两句有问题:
        ListCount := MainForm.GetaSubmitItemListCount;
        for i := 0 to ListCount - 1 do
    它只取出第一次的ListCount,之后就退出了,除非这个线程会定时重启,否则肯定是要oom的。
      

  4.   

    ERR0RC0DE 兄弟,因为TaSubmitItem.Data是变长的,不是定长,所以用了string
      

  5.   

    既然那个线程会不断被执行,那就没问题了。
    String可能有问题。
    因为它是引用计数管理的,Dispose(Items[0]); 时可能不释放String,要看一下目标代码。
      

  6.   

    哦,明白了。
    原因可能是你这句:>>FillChar(aSubmitItem,SizeOf(aSubmitItem),0);aSubmitItem是结构体,不是指针,刚才没注意看。
    aSubmitItem在后面赋值是将LockList的指针指向的数据重新Copy了一份过去,然后进行数据,处理完成后,你是直接将FillChar,FillChar是不将Record.String进行清除的,而是简单的将String置空,但string指向的数据却还存在,这样积累一多,就会出现问题了。我搞不懂你为什么不直接使用指针?这样的话,直接Dispose就清楚掉内容了。var 
      i,ListCount : Integer; 
      //aSubmitItem : TaSubmitItem; 
      aSubmitItem : ^TaSubmitItem; 
    begin 
        ListCount := MainForm.GetaSubmitItemListCount; 
        for i := 0 to ListCount - 1 do 
        begin       
          //FillChar(aSubmitItem,SizeOf(aSubmitItem),0); 
          try 
            with MainForm.aSubmitItemList.LockList do 
            begin 
              aSubmitItem := Items[0];
              //if Items[0]  < > nil then //保存数据库就删除 
              //begin 
              //  aSubmitItem := TaSubmitItem(Items[0]^); 
              //  Dispose(Items[0]); 
              //end; 
              // 保存数据库
               Dispose(aSubmitItem); 
              Delete(0); 
            end; 
          finally 
            MainForm.aSubmitItemList.UnlockList; 
          end; 
          .....保存数据库 
        end; 
    end; 
      

  7.   

    纠正一下,刚发现
    aSubmitItem := TaSubmitItem(Items[0]^);
    这句是浅COPY,所以还不能在dispose时释放string,必须在保存数据库之后,如LS所示。不过LS的做法有个缺点就是会导致List被Lock得过久,并且最后那个保存数据库就不必了。
      

  8.   

    按ERR0RC0DE 这样的方法, 还是一样,cpu跟踪还是没有试放掉string
      

  9.   

    我觉得可以这样改试试:var
      i,ListCount : Integer;
      aSubmitItem : TaSubmitItem;
    begin
        ListCount := MainForm.GetaSubmitItemListCount;
        for i := 0 to ListCount - 1 do
        begin
          FillChar(aSubmitItem,SizeOf(aSubmitItem),0);
          try
            with MainForm.aSubmitItemList.LockList do
            begin
              if Items[0]  < > nil then //保存数据库就删除
              begin
                aSubmitItem := TaSubmitItem(Items[0]^);
                Dispose(Items[0]);
              end;
              Delete(0);
            end;
          finally
            MainForm.aSubmitItemList.UnlockList;
          end;
          .....保存数据库
          aSubmitItem.Data := Nil; // <==加这一句
        end;
    end; 
      

  10.   

    var  
      i,ListCount : Integer;  
      aSubmitItem : TaSubmitItem;   //我
      aSubmitItem : ^TaSubmitItem;  //你aSubmitItem在后面赋值是将LockList的指针指向的数据重新Copy了一份过去,然后进行数据,处理完成后,你是直接将FillChar,FillChar是不将Record.String进行清除的,而是简单的将String置空,但string指向的数据却还存在,这样积累一多,就会出现问题了。 我搞不懂你为什么不直接使用指针?这样的话,直接Dispose就清楚掉内容了
    兄弟,不用指针是为了效率啊, 因为aSubmitItem 下面要操作数据库,实threadlist.lock上, 其它线程就无法写入操作了.
      

  11.   

    type
      TRecordA = record
        aStr : string;
        aInt  : integer;
      end;
    var
      P : ^TRecordA;
      RecordA : TRecordA;
      Str : string;
    begin
      New ;
      TRecordA(P^).aStr := 'AAA';
      TRecordA(P^).aInt := 100;
      FillChar(RecordA,sizeof(RecordA),0);
      RecordA := TRecordA(P^);
      RecordA.aStr := 'CCC';
      Dispose( p)
      RecordA.aStr = ''
    end;那么这样的代码p^.aStr 有没有释放掉呢
      

  12.   

    以前好象也遇到过:
    试一下改成下面两种方式中的一个看可以不
    方式1:var 
      aSubmitItem : TaSubmitItem; 
    begin 
        while MainForm.GetaSubmitItemListCount>0 do 
        begin 
          FillChar(aSubmitItem,SizeOf(aSubmitItem),0); 
          try 
            with MainForm.aSubmitItemList.LockList do 
            begin 
              if Items[0]  < > nil then //保存数据库就删除 
              begin 
                aSubmitItem := TaSubmitItem(Items[0]^); 
                Dispose(Items[0]); 
              end; 
              Delete(0); 
            end; 
          finally 
            MainForm.aSubmitItemList.UnlockList; 
          end; 
          .....保存数据库 
        end; 
    end; 方式2:var 
      i,ListCount : Integer; 
      aSubmitItem : TaSubmitItem; 
    begin 
        ListCount := MainForm.GetaSubmitItemListCount; 
        for i :=ListCount - 1  downto 0 do 
        begin 
          FillChar(aSubmitItem,SizeOf(aSubmitItem),0); 
          try 
            with MainForm.aSubmitItemList.LockList do 
            begin 
              if Items[i]  < > nil then //保存数据库就删除 
              begin 
                aSubmitItem := TaSubmitItem(Items[i]^); 
                Dispose(Items[i]); 
              end; 
              Delete(i); 
            end; 
          finally 
            MainForm.aSubmitItemList.UnlockList; 
          end; 
          .....保存数据库 
        end; 
    end; 
      

  13.   

    还是不行. 测试如下:
    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls;type
      pTaSubmitItem = ^TaSubmitItem;
      TaSubmitItem = Record
        LocalGwMessageId : Int64;
        A1 : DWORD;
        A2 : Integer;
        A3 : Integer;
        A4 : Integer;
        Registered_Delivery : Byte;
        Data : String;
      end;  TForm1 = class(TForm)
        ButtonNew: TButton;
        ButtonDispose: TButton;
        Button3: TButton;
        Timer1: TTimer;
        procedure ButtonNewClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure ButtonDisposeClick(Sender: TObject);
        procedure Timer1Timer(Sender: TObject);
        procedure Button3Click(Sender: TObject);
      private
        { Private declarations }
        List : TThreadList;
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementation{$R *.dfm}procedure TForm1.ButtonNewClick(Sender: TObject);
      function GetRandomStr():String;
      var
        i,t : Integer;
      begin
        t := Random(100) + 200;
        for i := 1 to t do Result := Result + 'A';
      end;
    var
      i : Integer;
      S :String;
      aSubmitItem : ^TaSubmitItem;
    begin
      S := GetRandomStr;
      for i := 1 to 100000 do
      begin
        //Caption := IntToStr(i);
        New(aSubmitItem);
        aSubmitItem^.LocalGwMessageId := 10000;
        aSubmitItem^.A1 := 1000;
        aSubmitItem^.A2 := 2000;
        aSubmitItem^.A3 := 3000;
        aSubmitItem^.A4 := 4000;
        aSubmitItem^.Registered_Delivery := 1;
        aSubmitItem^.Data := S;    List.LockList.Add(aSubmitItem);
        List.UnlockList;
      end;
      List.UnlockList;
    end;procedure TForm1.FormCreate(Sender: TObject);
    begin
      List := TThreadList.Create;
    end;procedure TForm1.ButtonDisposeClick(Sender: TObject);
    var
      i,iCount : Integer;
      aSubmitItem : TaSubmitItem;
    begin
      iCount := List.LockList.Count - 1;
      with  List.LockList do
      begin
        for i := iCount downto 0 do
        begin
          aSubmitItem := TaSubmitItem(Items[i]^);      TaSubmitItem(Items[i]^).Data := '';
          Dispose(pTaSubmitItem(Items[i]));
          Delete(i);    end;
      end;
       List.UnlockList;
    end;procedure TForm1.Timer1Timer(Sender: TObject);
    begin
      ButtonNew.Click;
      
      ButtonDispose.Click;  ButtonNew.Click;
    end;procedure TForm1.Button3Click(Sender: TObject);
    begin
      Timer1.Enabled := not  Timer1.Enabled ;end;end.测试如下, 不断New , Dispose   内存任然飙涨.  大家在看看.
      

  14.   

    靠  ,你这样当然飙涨Timer.OnTimer并不是开辅线程,你的循环是运行在主线程中程序不断的申请空间当然会死掉;
    结帖了怎么不给分。
      

  15.   

    已经发现问题所在   问题在于 List : TThreadList;   
      

  16.   

    跟踪一下  居然是 iCount := List.LockList.Count - 1;这条语句执行不下去         ; 追查原因 终于发现原来  
         begin 
      S := GetRandomStr; 
      for i := 1 to 100000 do 
      begin 
        //Caption := IntToStr(i); 
        New(aSubmitItem); 
        aSubmitItem^.LocalGwMessageId := 10000; 
        aSubmitItem^.A1 := 1000; 
        aSubmitItem^.A2 := 2000; 
        aSubmitItem^.A3 := 3000; 
        aSubmitItem^.A4 := 4000; 
        aSubmitItem^.Registered_Delivery := 1; 
        aSubmitItem^.Data := S;     List.LockList.Add(aSubmitItem); 
        List.UnlockList; 
      end; 
      List.UnlockList; //(错在这里了兄弟):多余的,这里已经没有临界区可以释放了
    end; 
       
      

  17.   

    你改成如下:
    procedure TForm1.ButtonDisposeClick(Sender: TObject);
    var
      MyList: TList;
      P: pTaSubmitItem;
    begin
      MyList := List.LockList;
      while MyList.Count > 0 do
      begin
        P := MyList.Last;
        Dispose(P);
        MyList.Delete(MyList.Count - 1);
      end;
      List.UnlockList;
    end;
    则正常。如果是下面的代码,则内存则以4K的速度增长。原因就是FillChar
    procedure TForm1.ButtonDisposeClick(Sender: TObject);
    var
      MyList: TList;
      P: pTaSubmitItem;
      V: TaSubmitItem;
    begin
      MyList := List.LockList;
      while MyList.Count > 0 do
      begin
        P := MyList.Last;
        V := P^;
        FillChar(V, SizeOf(V), 0);
        Dispose(P);
        MyList.Delete(MyList.Count - 1);
      end;
      List.UnlockList;
    end;
    BTW:为了效率才是使用指针/引用。如上代码,P已经是指向结构内存了,再COPY到V结构变量中已经是多余了,直接使用P不好吗?
      

  18.   

    我那服务端内存不断增长还找不到原因啊, 内存碎片会不会?
    找的技术文章
    2、内存管理。
    不得不再次佩服一下某大牛说的话:“玩服务器就是玩内存”。
    内存管理不当就会造成内存泄漏和内存碎片。对于客户端而言,内存碎片几乎不算是问题。内存泄漏那么一点点也可以接受。但对于 24 * 7 的服务器而言,这却绝对致命,其重要性甚至超过了 IOCP 本身。
    关于内存泄漏,只要记得保证申请和释放动作的对称性即可,外加一系列的测试工具,基本就可以把这个问题解决。
    其次就是内存碎片。内存碎片问题的重要性绝不亚于内存泄漏。造成碎片的原因也是防不胜防。简单的如每次的 New 和 Dispose ,Create 和 Free ,隐晦一点的如 string 类型的操作。
    解决办法:
    首先对于Create和Free,尽量少用。换句话说,尽量少用封装。适当的封装是可以的,只要封装的层次不是太深。Delphi 提供了 VCL 源码,我们可以看看即使是直接继承 TObject 那也会多做多少工作!对于频繁调用的函数,不要采用虚拟函数。这些晚绑定的函数,想调用就得查找 VMT,很费时间。对于类的普通函数,由于进行了早绑定,这个和其他非类的常规一样,不会降低效率。其次,相应的,尽量使用结构和函数来代替类。对于结构,New 和 Dispose 也要尽量少用。要集中的使用来避免内存碎片。我们应该一次性把所预料的内存都申请完,服务器就得有服务器的样,放着那么多内存干什么。早晚都得申请,为什么在服务端启动的时候不一次性申请完,在服务端关闭的时候一次性释放掉?既避免了内存碎片又避免了以后的再申请操作,一举两得,何乐而不为?要知道内存分配和释放是非常昂贵的操作。不论是从时间上还是从稳定性上而言。再具体些,怎么保存这些申请到的内存?怎么保证在必要的时候可以很方便的再申请或及时的释放一些内存?我采用的是链表。在每次为一个数据结构申请内存的时候,先查看这个链表是否为空,如果不为空,就从这个链表中取出一个内存块,不需要真正调用函数申请。如果为空,再动态分配。使用完成后,把这个数据结构不释放,而是再把它插入到链表中去,以便下一次使用。再次,不用 string 用什么?用数组!用字符数组!就像C中的字符数组一样。就是这么简单~
      

  19.   

    现程序改为如下:
    说明 
      硬盘内存4G 
      delphi 7 
      aSubmitItemList 为TThreadList  最大为100万,如果超长就不写入 结构 
      TaSubmitItem = Record 
        LocalGwMessageId : Int64; 
        Registered_Delivery : Byte; 
        Data : String; 
      end; 
    ..... 在TServerSocket的.OnClientRead中 
    var 
        aSubmitItem : ^TaSubmitItem; 
    begin 
       ....... 
        if GetaSubmitItemListCount  < 1000000 then    //控制在100万 
        begin 
          New(aSubmitItem); 
          aSubmitItem^.Data :=  '内容为接收短客户提交的(变长) '; 
          aSubmitItem^.LocalGwMessageId := GetMessageId; 
          aSubmitItem^.Registered_Delivery := 1;     
          try 
            aSubmitItemList.LockList.Add(aSubmitItem); 
          finally 
            aSubmitItemList.UnlockList; 
          end; 
        end; 
    end; 
    然后,一个线程负债把aSubmitItemList中的转存到数据库 
    var 
      i,ListCount : Integer; 
      aSubmitItem : TaSubmitItem; 
    begin 
        {取得aSubmitItemList.LockList的Count,并UnLock}    ListCount := MainForm.GetaSubmitItemListCount;   
        for i := 0 to ListCount - 1 do 
        begin 
          FillChar(aSubmitItem,SizeOf(aSubmitItem),0); 
          try 
            with MainForm.aSubmitItemList.LockList do 
            begin  
              {
               保存这个结构的原来是以后要处理复杂的交易运算
                为了提高效率,不让原的写入线程等待时间过长,所以就..
                }
              aSubmitItem := TaSubmitItem(Items[0]^); 
              TaSubmitItem(Items[0]^).Data = '';
              Dispose(Items[0]); 
              Delete(0); 
            end; 
          finally 
            MainForm.aSubmitItemList.UnlockList; 
          end;       .....交易业务处理及保存数据库 
        end; 
    end; 
    问题是这样简单的一个aSubmitItemList写入 及读出删除操作, 内存会不断的涨, 这个问题我还没有解决啊,兄弟们.