Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Утечка памяти - TStrings.AddObject()


Автор: Siton 17.7.2006, 16:19
Программа работает в круглосуточном режиме. 
Возникает утечка памяти при работе с компонентом TStrings при добавлении объекта к строке. Где то я вычитал что делфи сам не очищет объекты добавленные таким способом. При вызове метода TStrings.Clear - память не очищается, я проверял с помощью memproof и DMM. При добавлении кода 

Код

for I:=1 to slPr.Count-1 do begin
    slPr.Objects[I].Free;
    end;
 

возникает ошибка обращения к памяти. Помогите мне пожалуйста. Код программы чужой. 
Может быть нужно сделать переменную slPr - глобальной.

Привожу пример кода:
Код

Procedure FindAllFiles(Const sFN:String;
    Var aFSR:TASearchRec;slO,slPr:TStrings;
    Const aPrList:TaPriorityFile;Work_dat_Od:TDateTime;
    Const PathIn:String; Var tMess:String;
    Const aIgnList:TaIgnoreFile);
  Var
    FSR:TSearchRec;
    I,iA,iR,iPr,J,ipr1,nPos,iIgn:Integer;
    sFN_m:String;
    sDat_od:String[8];
    Filename,Filenew: String;
  Begin
    aFSR:=Nil;
    for I:=1 to slPr.Count-1 do begin
    slPr.Objects[I].Free; //--ошибка обращения к памяти
    end;
    slPr.Clear;
    FillChar(FSR,SizeOf(FSR),0);
    iA:=0;
    iR:=0;
    I:=FindFirst(sFN,0,FSR);
    Try
      If I=0 Then
        Repeat
          If iA<=iR Then Begin
            iA:=iR*2+1;
            SetLength(aFSR,iA);
          End;
          aFSR[iR]:=FSR;
          If slO.Values[FSR.Name]='' Then
            iPr:=100
          Else
            iPr:=0;
          ipr1:=0;
          For J:=Low(aPrList) To High(aPrList) Do Begin
            If IsMaskValid(FSR.Name,aPrList[J].sFileMask) Then
              If ipr1<aPrList[J].iLevel Then
                ipr1:=aPrList[J].iLevel;
          End;
          iPr:=iPr+ipr1;
          iIgn:=0;
          For J:=Low(aIgnList) To High(aIgnList) Do Begin
            If IsMaskValid(FSR.Name,aIgnList[J].sFileMask) Then
               iIgn:=1;
          End;
          if iIgn=0 Then
                 //Здесь происходит утечка 
            if Assigned(Pointer(iPr)) then slPr.AddObject(IntToStr(iR),Pointer(iPr));
          Inc(iR);
          I:= FindNext(FSR);
        Until I<>0;
    Finally
      SysUtils.FindClose(FSR);
    End;
    nPos:=Pos( '.', sFN );
    tMess:='';
    If UpperCase(Copy(sFN,nPos-4,3))='MPF' Then Begin
// ----------------
      sDat_od:=FormatDateTime('yyyymmdd',Work_dat_Od);
      SysUtils.FindClose(FSR);
      FillChar(FSR,SizeOf(FSR),0);
      iA:=0;
      sFN_m:=PathIn+'\'+'MP11F?'+Copy(sDat_od,5,2)+'.txt';
      I:=FindFirst(sFN_m,0,FSR);
      Try
        If I=0 Then
          Repeat
            Filename:=PathIn+'\'+FSR.Name;
            Filenew:=PathIn+'\'+'MPF'+Copy(FSR.Name,6,1)+
            Copy(sDat_od,5,4)+'.txt';
            If Not FileExists (Filenew) Then Begin
              If Not CopyFile(PChar(Filename),PChar(Filenew),False) Then
                tMess:=tMess+'!!! cant copy file '+ Filename
              Else Begin
                tMess:=tMess+'Copy file '+Filename+'->'+Filenew;
                If iA<=iR Then Begin
                  iA:=iR*2+1;
                  SetLength(aFSR,iA);
                End;
                FSR.Name:='MPF'+Copy(FSR.Name,6,1)+
                Copy(sDat_od,5,4)+'.txt';
                aFSR[iR]:=FSR;

                If slO.Values[FSR.Name]='' Then
                  iPr:=100
                Else
                  iPr:=0;
                ipr1:=0;
                For J:=Low(aPrList) To High(aPrList) Do Begin
                  If IsMaskValid(FSR.Name,aPrList[J].sFileMask) Then
                    If ipr1<aPrList[J].iLevel Then
                      ipr1:=aPrList[J].iLevel;
                End;
                iPr:=iPr+ipr1;
                 //Здесь происходит утечка 
                if Assigned(Pointer(iPr)) then slPr.AddObject(IntToStr(iR),Pointer(iPr));
              End;
            End;
            Inc(iR);
            I:= FindNext(FSR);
          Until I<>0;
      Finally
        SysUtils.FindClose(FSR);
      End;
    End;
// -----------------
    SetLength(aFSR,iR);
    (slPr As TStringList).CustomSort(CompareObjVal);
  End;
 

Автор: Alexeis 17.7.2006, 16:49
Цитата(Siton @  17.7.2006,  16:19 Найти цитируемый пост)
Возникает утечка памяти при работе с компонентом TStrings 

Интересно как же вам удалось создать экземпляр класса TStrings, учитывая что он абстрактный. Если утечка и возникает, то только по вине наследника, TStrings, который не правельно работает с памятю. Сам же TStrings c ней непосредственно не работает. Ищите главного виновника, - кто скрывается под личиной TStrings - кто у нас сегодня самое слабое звено smile  smile  

Автор: Siton 17.7.2006, 16:59
Переменная slPr берется из другой процедуры где имеет тип TStringList

Вот код :
Код

Procedure TRPLThread.Execute;
  Var
    FSR:TSearchRec;
    aFSR:TASearchRec;
    S:String;
    sstm:_Systemtime;
    lcftm: _filetime;
    I,J:Integer;
    ObrFilename:String;
    slO,slPr,slToDo:TStringList;
    OldT:String;
    dirdat_odname:String;
    FoundAnyFile:Boolean;
    Work_dat_Od:TDateTime;
    FilePathCo:String;
    tm:Integer;
    tt:ttypetime;
    ttKey:TTypeKey;
    slBadFiles:TStrings;
    bSkipFile:Boolean;
    sPrevFN:String;
    stmpFileMask:String;
    tMess:String;

  Begin

    I:=lsKeys.IndexOf(AnsiUpperCase(Fskey));
    If I<0 Then ttKey:=ttUnknown Else ttKey:=TTypeKey(Integer(lsKeys.Objects[I]));
    sPrevFN:='';


    FoundAnyFile:=True;
    If bScanDirection Then
      Work_dat_Od:=DateBegin
    Else
      Work_dat_Od:=Dat_Od;
    slO:=Nil;
    slPr:=Nil;// Переменная которая передается
    slToDo:=Nil;
    slBadFiles:=Nil;
    Try
      slO:=TStringList.Create;
      slPr:=TStringList.Create;
      slToDo:=TStringList.Create;
      slBadFiles:=TStringList.Create;
      While Not Terminated Do Begin
        If bAutoDate And (Date()>Dat_Od) Then Begin
          WriteOutput('Change date to '+DateToStr(Date()));
          Dat_Od:=Date();
        End;
        osi.CalcNextTime(tt,tm);
        WriteOutput('Whait for  '+TimeToStr(Now+tm/(1000*60*60*24)));
        If WaitForSingleObject(StopEvent,tm)=WAIT_OBJECT_0 Then Begin
          WriteOutput('I am stopped !!! ');
          Break;
        End;

//
        If DateBegin=0 Then Begin
          Work_dat_Od:=Dat_Od;
          slBadFiles.Clear;
        End
        Else
          If Not FoundAnyFile Then Begin
            If bScanDirection Then Begin
              Case Date_interval Of
                0:Work_dat_Od:=Work_dat_Od+1;
                1:Work_dat_Od:=IncMonth(Work_dat_Od,1);
                2:Work_dat_Od:=IncMonth(Work_dat_Od,3);
                3:Work_dat_Od:=IncMonth(Work_dat_Od,12);
              End;
              If Work_dat_Od>Dat_Od Then Begin
                Work_dat_Od:=DateBegin;
                sPrevFN:='';
              End;
            End Else Begin
              Case Date_interval Of
                0:Work_dat_Od:=Work_dat_Od-1;
                1:Work_dat_Od:=IncMonth(Work_dat_Od,-1);
                2:Work_dat_Od:=IncMonth(Work_dat_Od,-3);
                3:Work_dat_Od:=IncMonth(Work_dat_Od,-12);
              End;
              If Work_dat_Od<DateBegin Then Begin
                Work_dat_Od:=Dat_Od;
                sPrevFN:='';
              End;
            End;
            slBadFiles.Clear;
          End;



        LoadObrFile(slO,Work_dat_Od,ObrFilename);
//
        If Terminated Then Break;
        stmpFileMask:=FileMask;
        If bLoadByName And (sPrevFN<>'') Then
          Case ttKey Of
            ttCMP,ttCOMPS,ttNORM_MKPB,ttNORM_MKPB_BAL,ttMPF,ttMO_SCPF,ttSCPF_PI,ttRezerv_ND,ttRisk_KP,ttKRED_BAS,ttRKP_KRED_BAS,ttKRED_BAS_PI,ttMO..ttMO9,ttCYPR_MO,ttMJ_,ttMJ_PI,ttMJ_PA:
              stmpFileMask:=Copy(stmpFileMask,1,2)+Copy(sPrevFN,3,4)+Copy(stmpFileMask,7,Length(stmpFileMask)-6);
          End;
        MakeFileScanMaskByType(ttKey,Work_dat_Od,S,dirdat_odname,PathIn,stmpFileMask,Dat_OdInPathIn);
        FillChar(FSR,SizeOf(FSR),0);
        WriteOutput('сканируем '+S);
        FoundAnyFile:=False;
////////////////////////
/////-Здесь вызов процедуры из первого сообщения       
FindAllFiles(S,aFSR,slO,slPr,aPrList,Work_dat_Od,PathIn,tMess,aIgnList);
////////////////////////
        If tMess<>'' Then WriteOutput(tMess);
        slToDo.Clear;
        For I:=0 To slPr.Count-1 Do Begin
          J:=StrToInt(slPr[I]);
          FSR:=aFSR[J];
          FileTimeToLocalFileTime(FSR.FindData.ftLastWriteTime,lcftm);
          FileTimeToSystemTime(lcftm,sstm);
          S:=Format('%.4d%.2d%.2d%.2d%.2d%.2d %.10d',[sstm.wYear,sstm.wMonth,sstm.wDay,
              sstm.wHour,sstm.wMinute,sstm.wSecond,FSR.Size]);
          OldT:=slO.Values[FSR.Name];
          If Copy(OldT,14+1,1)<>' ' Then
            OldT:=Format('%s %.10d',[OldT,FSR.Size]);
          bSkipFile:=False;
          If ((OldT='') Or (OldT<>S)) And (slBadFiles.IndexOf(FSR.Name)>=0) Then Begin
            WriteOutput(GetFullFileInfoToStr('Skipping File = ',FSR.Name,sstm,FSR.Size));
            bSkipFile:=True;
          End;
          If ((OldT='') Or (OldT<>S)) And (Not bSkipFile) Then Begin
            WriteOutput(GetFullFileInfoToStr('queue ',FSR.Name,sstm,FSR.Size)
              +IIFStr((OldT='') Or ((Length(OldT)=11) And (Copy(OldT,1,1)=' ')),' new',''));
            slToDo.Add(IntToStr(J));
          End;
        End;
        
        If slToDo.Count>0 Then Begin
          J:=StrToInt(slToDo[0]);
          FSR:=aFSR[J];
          OldT:=slO.Values[FSR.Name];
          FoundAnyFile:=True;
          FileTimeToLocalFileTime(FSR.FindData.ftLastWriteTime,lcftm);
          FileTimeToSystemTime(lcftm,sstm);
          S:=Format('%.4d%.2d%.2d%.2d%.2d%.2d %.10d',[sstm.wYear,sstm.wMonth,sstm.wDay,
              sstm.wHour,sstm.wMinute,sstm.wSecond,FSR.Size]);
          If (OldT='') Or ((Length(OldT)=11) And (Copy(OldT,1,1)=' ')) Then Begin
            WriteOutput(GetFullFileInfoToStr('Найден новый файл ',FSR.Name,sstm,FSR.Size));
            bPovtor:=False;
          End
          Else Begin
            WriteOutput('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
            WriteOutput(GetFullFileInfoToStr('Повтор файла ',FSR.Name,sstm,FSR.Size));
            WriteOutput('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
            bPovtor:=True;
          End;
          
          If ttKey<>ttfiktiv Then Begin
            If Not CopyFileRO(FSR.Name,dirdat_odname,FilePathCo,FSR.Size) Then Continue;
          End;
          
//
          
          Case ttKey Of
            ttSCPF_PI: ProcessSCPF_PIFile(FilePathCo,Work_dat_Od);
            ttRezerv_ND: ProcessRezerv_NDFile(FilePathCo,Work_dat_Od);
            ttRisk_KP: ProcessRisk_KPFile(FilePathCo,Work_dat_Od);
            ttMO_SCPF: ProcessMO_SCPFFile(FilePathCo,Work_dat_Od);
            ttCMP: ProcessCMPFile(FilePathCo,Work_dat_Od);
            ttCOMPS: ProcessCOMPSFile(FilePathCo,Work_dat_Od);
            ttNORM_MKPB: ProcessNORM_MKPBFile(FilePathCo,Work_dat_Od);
            ttNORM_MKPB_BAL: ProcessNORM_MKPB_BALFile(FilePathCo,Work_dat_Od);
            ttMPF: ProcessMPFFile(FilePathCo, Work_dat_Od);
            ttKRED_BAS: ProcessKRED_BASFile(FilePathCo,Work_dat_Od);
            ttRKP_KRED_BAS: ProcessRKP_KRED_BASFile(FilePathCo,Work_dat_Od);
            ttKRED_BAS_PI: ProcessKRED_BAS_PIFile(FilePathCo,Work_dat_Od);
            ttMO..ttMO9,ttCYPR_MO: ProcessMOFile(FilePathCo,Work_dat_Od, Ord(ttKey)-Ord(ttMO)+1);
            ttSCPF_V2:ProcessScpf_v2File(FilePathCo,Work_dat_Od);
            ttGKF_: ProcessGKFile(FilePathCo,Work_dat_Od,'f',False);
            ttMB_: ProcessMBFile(FilePathCo,Work_dat_Od);
            ttMB_optirisk: ProcessMBFile(FilePathCo,Work_dat_Od);
            ttMBMB_1,ttMBMB_2: ProcessMBMBFile(FilePathCo,Work_dat_Od);
            ttMBMB_MP: ProcessMBMB_MPFile(FilePathCo,Work_dat_Od);
            ttMBMB_SCR: ProcessMBMBSCRFile(FilePathCo,Work_dat_Od);
            ttVZ01: ProcessVZ01File(FilePathCo,Work_dat_Od);
            ttvip_: ProcessSCPF_VIPFile(FilePathCo,Work_dat_Od);
            ttGKO_: ProcessGKFile(FilePathCo,Work_dat_Od,'o',False);
            ttGKM_: ProcessGKFile(FilePathCo,Work_dat_Od,'M',False);
            ttGKV_: ProcessGKFile(FilePathCo,Work_dat_Od,'V',False);
            ttGKG_: ProcessGKFile(FilePathCo,Work_dat_Od,'G',False);
            ttGKp_: ProcessGKFile(FilePathCo,Work_dat_Od,'p',False);
            ttGK_: ProcessGKFile(FilePathCo,Work_dat_Od,'',False);
            ttGZ_: ProcessGKFile(FilePathCo,Work_dat_Od,'',True);
            ttGZF_: ProcessGKFile(FilePathCo,Work_dat_Od,'f',True);
            ttGZO_: ProcessGKFile(FilePathCo,Work_dat_Od,'o',True);
            ttMJ_: ProcessMJFile(FilePathCo,Work_dat_Od);
            ttMJ_PI: ProcessMJFile(FilePathCo,Work_dat_Od);
            ttMJ_PA: ProcessMJFile(FilePathCo,Work_dat_Od);
            ttNBU01_: ProcessNbu01File(FilePathCo,Work_dat_Od);
            ttFS:ProcessFS(FilePathCo,Work_dat_Od);
            ttKP01_: ProcessNbu01_OtherFile(FilePathCo,'KP','03',Work_dat_Od);
            tt01_FO_03: ProcessNbu01_OtherFile(FilePathCo,'***','03',Work_dat_Od);
            tt01_FO_08: ProcessNbu01_OtherFile(FilePathCo,'***','08',Work_dat_Od);
            tt02_FO_08: ProcessNbu02_OtherFile(FilePathCo,Copy(FSR.Name,4,3),'08',Work_dat_Od);
            ttPI01_: ProcessNbu01_OtherFile(FilePathCo,'ПИ','08',Work_dat_Od);
            ttNBU26_: ProcessNbu26File(FilePathCo,Work_dat_Od);
            ttNBU26_DBF: ProcessNbu26FileDBF(FilePathCo,Work_dat_Od);
            ttNBUA7_: ProcessNbuA7File(FilePathCo,Work_dat_Od);
            ttNBUA7_DBF,ttNBUA7_CY_DBF: ProcessNbuA7File_DBF(FilePathCo,Work_dat_Od,ttKey=ttNBUA7_CY_DBF);
            ttFDPGR: ProcessFDPGRFile(FilePathCo,Work_dat_Od);
            ttfiktiv: DeleteFile(FilePathCo);
            ttCYBB_: ProcessCyBBFile(FilePathCo,Work_dat_Od);
            ttSams,ttSams_mkpb:ProcessSamsFile(FilePathCo,Work_dat_Od,OldT);
            ttZalog:ProcessZalogFile(FilePathCo,Work_dat_Od);
            ttLikvP48dp,ttEffP48dp:ProcessLikvP48dpFile(FilePathCo,Work_dat_Od);
            ttCySD:ProcessCySDFile(FilePathCo,Work_dat_Od);
            ttZals:ProcessZalsFile(FilePathCo,Work_dat_Od);
            ttNBU84_:ProcessNbu84File(FilePathCo,Work_dat_Od);
            ttNBUC5_:ProcessNbuC5File(FilePathCo,Work_dat_Od);
            ttPari:ProcessPariFile(FilePathCo,Work_dat_Od);
            ttPari_o:ProcessParioFile(FilePathCo,Work_dat_Od);
            ttRaru:ProcessRaruFile(FilePathCo,Work_dat_Od);
            ttPrim: ProcessPrimeFile(FilePathCo,Work_dat_Od);
            Else WriteOutput(Format('unknown type of key =%s [%s]',[Fskey,Integer(ttKey)]));
          End;
          
          
          If FileExists(FilePathCo) Then Begin
            slBadFiles.Add(FSR.Name);
            Continue;
          End;
          slO.Values[FSR.Name]:=S;
          SaveObrFile(slO,ObrFilename,FSR.Name,OldT,S);
          sPrevFN:=FSR.Name;
          If bLoadByName Then
            FoundAnyFile:=False;
//Break;
        End;
      End;
//   Until FindNext(FSR)<>0 ;
{
        Finally
          SysUtils.FindClose(FSR);
        End;
        }
//End;
    Finally
      slO.Free;
      slBadFiles.Free;
      slPr.Free;
      slToDo.Free;
    End;
  End;
 

Автор: Alexeis 17.7.2006, 17:39
Цитата(Siton @  17.7.2006,  16:19 Найти цитируемый пост)
    for I:=1 to slPr.Count-1 do begin    slPr.Objects[I].Free; //--ошибка обращения к памяти    end;

Да но ведь StringList не содержит объектов, только строки, поэтому и пытается обратится к несуществующему объекту

Добавлено @ 17:48 
Ух ты я и не знал, что туда можно еще и объекты пихать, такое ощущение, что они не присваивались.

Добавлено @ 17:52 
Я проверил
Код

   r : TRegistry;
   l : TStringList;

begin
  l := TStringList.Create;
  r := TRegistry.Create;
  l.AddObject(' ', r);
  l.Objects[0].Free;
  l.Clear;
  l.Free;


Все работает нормально! просто один из объектов не существует уже.  

Автор: Wing 17.7.2006, 19:43
Попробуй все таки переименовать все TString на TStringList.

Сделай проверку

Код

for I:=1 to slPr.Count-1 do begin
  if Assigned(slPr.Objects[I]) then FslPr.Objects[I].Free;
end;


Посмотри как работает FreeAndNil:
Код

procedure FreeAndNil(var Obj);
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;


Возможно нужно также поступить в твоем случае.
 

Автор: Mechanic 17.7.2006, 19:52
Solve code for lines 14..17 of 2nd code in post #1 smile
Код

    for I:=0 to slPr.Count-1 do   //ZERO BASED!!!
    begin
      if Assigned(slPr.Objects[I]) then  //Some protection
          slPr.Objects[I].Free;
    end;
    slPr.Clear;


Добавлено @ 19:54 
Опа, уже повтор. Лапы не шибко быстро сгинаются. smile 

Автор: Akella 18.7.2006, 09:03
Цитата

Procedure FindAllFiles(Const sFN:String;
    Var aFSR:TASearchRec;slO,slPr:TStrings;


Никогда в коде программы не используйте TStrings, это абстрактный класс, нужно использовать TStringList! 

Автор: Siton 18.7.2006, 09:17
Проверка (Assigned(slPr.Objects[i])) не помогает, все равно ошибка обращения. При использовании FreeAndNil компилятор пишет Constant object cannot be passed as var parameter. В чем ошибка. 

Автор: Alexeis 18.7.2006, 10:17
А если так
Код

var
 o : TObject;
..........
Begin
...............
o := slPr.Objects[i];
FreeAndNil(o);
 

Автор: Siton 18.7.2006, 10:36
Ошибка обращения (AV) на строке o := slPr.Objects[i];
 

Автор: Alexeis 18.7.2006, 10:49
Siton, У вас проблемы не с освобождением, а с самим объектом - где-то раньше. 
Я проверял почти весь код который приводился (из того что компилировался) работает. Вероятно имеюстся проблемы с объектами - напимер если использовались потоки, или в результате ошибки портится содержимое объекта. Похоже, что при вызове деструктора объекта возникает ошибка. 

Автор: Romikgy 18.7.2006, 11:08
Согласен с 
Akella, используй строку описания функции
Код

Procedure FindAllFiles(Const sFN:String;    
    Var aFSR:TASearchRec;slO,slPr:TStringList;    
    Const aPrList:TaPriorityFile;Work_dat_Od:TDateTime;    
    Const PathIn:String; Var tMess:String;    
    Const aIgnList:TaIgnoreFile);

Если ошибок в другом месте нет , значит код запустится сразу smile 

Автор: Mechanic 18.7.2006, 11:23
Цитата(Akella @  18.7.2006,  09:03 Найти цитируемый пост)
Никогда в коде программы не используйте TStrings, это абстрактный класс, нужно использовать TStringList!

Создавать такой экземпляр не надо, но вот как тип параметра - почему же не использовать? Мало-ли что понанаследуется, а строки есть строки.


Цитата(Siton @  17.7.2006,  16:19 Найти цитируемый пост)

Код

                iPr:=iPr+ipr1;   //Что здесь? Адрес + 100?
                 //Здесь происходит утечка 
                if Assigned(Pointer(iPr)) then slPr.AddObject(IntToStr(iR),Pointer(iPr));


Вот здесь идет адресная арифметика, а результат идет в объектный указатель. Может быть тут и пишется неверный указатель? 

Автор: Romikgy 18.7.2006, 11:35
Mechanic, из исходников 
Код


TStrings = class(TPersistent)
...
function AddObject(const S: string; AObject: TObject): Integer; [B]virtual;[/B]
...

function TStrings.AddObject(const S: string; AObject: TObject): Integer;
begin
  Result := Add(S);
  PutObject(Result, AObject);
end;

procedure TStrings.PutObject(Index: Integer; AObject: TObject);
begin
end;

куда объект в последней функции записыватся будет????? 

Автор: Siton 18.7.2006, 12:30
Переменная slPr обявляется не глобально. Может быть ее обявить как глобальную?
И еще, можноли передать в функцию не переменную а указатель?
 

Автор: Romikgy 18.7.2006, 12:43
Цитата(Siton @  18.7.2006,  11:30 Найти цитируемый пост)
можноли передать в функцию не переменную а указатель?

Можно , но имхо и так все объекты передаются только указателями в дельфи 

Автор: Siton 18.7.2006, 12:46
Объект добовляется к строке, что бы потом сделать сортировку. Строка хранит номер файла, а объект хранит уровень приоритета. С помощью метода TStringList.CustomSort(CompareObjVal);  и функции CompareObjVal сортируются номера файлов. После чего файлы обрабатываются в отсортированном виде.

Код

Function CompareObjVal(List: TStringList; Index1, Index2: Integer):Integer;
  Begin
    Result:=Integer(List.Objects[Index2])-Integer(List.Objects[Index1]);
  End;


Может быть есть возможность реализовать данный алгоритм по другому - без использования TStringList и AddObjects. 

Автор: Romikgy 18.7.2006, 12:55
Цитата(Siton @  18.7.2006,  11:46 Найти цитируемый пост)
Строка хранит номер файла, а объект хранит уровень приоритета.

где это хранится? 

Автор: Alexeis 18.7.2006, 13:00
Цитата(Siton @  18.7.2006,  12:46 Найти цитируемый пост)
Result:=Integer(List.Objects[Index2])-Integer(List.Objects[Index1]);
 - что должна была делать эта операция?

Добавлено @ 13:01 
Вычитание адресов объектов это круто! 

Автор: Siton 18.7.2006, 13:16
Номер найденного файла хранится в slPr.Strings[i], а его приоритет обработки в slPr.Objects[i]. Зачем такая сортировка я еще неразобрался, но после сортировки меняется порядок  slPr.Strings[i] и соответственно порядок обработки файлов. Но проблема в очистке.

Добавлено @ 13:20 
Есть такое предположение что у одного из найденных файлов приоритет равен нулю и при добавлении к номеру этого файла объекта указывающего на ноль то происходит утечка. 
Код


...
iR=3;//для примера
iPr=0;//для примера
//iR- добавится как '3' А как добавится объект????
slPr.AddObject(IntToStr(iR),Pointer(iPr)); 
 

Автор: Alexeis 18.7.2006, 13:33
Елки палки в адрес записали значение переменной, значит нет никакого объекта вообще! Вместо удаления - обращение к черт знает какому фрагменту памяти! Удалять ничего в этом случае не надо! smile

Добавлено @ 13:35 
Поэтому и вычитались адреса, поскольку это не адреса вовсе! А просто значения записанные вместо адресса в переменную типа Pointer 

Автор: Siton 18.7.2006, 14:01
Но потеря памяти остается. если закаментировать строку slPr.AddObject(IntToStr(iR),Pointer(iPr)); то утечка прекращается. Почему же тогда происходит утечка памяти 

Автор: Alexeis 18.7.2006, 16:49
Цитата(Siton @  18.7.2006,  14:01 Найти цитируемый пост)
Почему же тогда происходит утечка памяти 

Код

procedure TStringList.InsertItem(Index: Integer; const S: string; AObject: TObject);
begin
  Changing;
  if FCount = FCapacity then Grow;
  if Index < FCount then

 TStringList - это на самом деле не список а динамический масив
Код

if Index < FCount then
    System.Move(FList^[Index], FList^[Index + 1],
      (FCount - Index) * SizeOf(TStringItem));

, память , которого выделяется  "if FCount = FCapacity then Grow;"  порциями. Обычно, то что уже было выделено, не возвращается в кучу, поскольку велика вероятность повторного использования этого пространства.

Добавлено @ 16:52 
Вот как выглядит grow
Код

procedure TList.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 64 then
    Delta := FCapacity div 4
  else
    if FCapacity > 8 then
      Delta := 16
    else
      Delta := 4;
  SetCapacity(FCapacity + Delta);
end;


Добавлено @ 16:54 
А при удалении память не возвращается (не fremem ни чего подобного не наблюдается)
Код

procedure TList.Delete(Index: Integer);
var
  Temp: Pointer;
begin
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  Temp := Items[Index];
  Dec(FCount);
  if Index < FCount then
    System.Move(FList^[Index + 1], FList^[Index],
      (FCount - Index) * SizeOf(Pointer));
  if Temp <> nil then
    Notify(Temp, lnDeleted);
end;


Добавлено @ 16:56 
Так,  что для освобождения памяти в вашем случае годится только 
slPr.free; 

Автор: Mechanic 19.7.2006, 09:39
Цитата(Romikgy @  18.7.2006,  11:35 Найти цитируемый пост)
Mechanic, из исходников 
....
куда объект в последней функции записыватся будет?????


Цитата(Siton @  17.7.2006,  16:59 Найти цитируемый пост)
Переменная slPr берется из другой процедуры где имеет тип TStringList

Ясно куда? smile

Цитата(Mechanic @  18.7.2006,  11:23 Найти цитируемый пост)
Создавать такой экземпляр не надо, но вот как тип параметра - почему же не использовать?

Тут что-ли? Так ясно, что реально работают виртуальные методы наследников. Просто ХЗ, что будет унаследовано и передано, лучше уж в функу пущай базовый класс передается, раз ничего, кроме его методов там не используется.

А арифметика в "адресах" Objects[] мне сразу не понравилась.. 

Автор: Alexeis 19.7.2006, 09:45
Цитата(Mechanic @  19.7.2006,  09:39 Найти цитируемый пост)
Просто ХЗ, что будет унаследовано и передано, лучше уж в функу пущай базовый класс передается, раз ничего, кроме его методов там не используется.

И совсем не ХЗ - а будут вызываться одноименные функции, того класса, который был передан, правда только в том случае если в классе предка они определены были хотя бы абстрактно. 

Автор: Siton 19.7.2006, 17:00
Я решил вопрос с утечкой.  smile Проблема была не в TStringList - Memproff ошибся на пять сторчек. Бажная строка была ниже на пять строчек. smile 

Код

Procedure TRPLThread.Execute;
  Var
    FSR:TSearchRec;
    aFSR:TASearchRec;
    S:String;
    sstm:_Systemtime;
    lcftm: _filetime;
    I,J:Integer;
    ObrFilename:String;
    slO,slPr,slToDo:TStringList;
    OldT:String;
    dirdat_odname:String;
    FoundAnyFile:Boolean;
    Work_dat_Od:TDateTime;
    FilePathCo:String;
    tm:Integer;
    tt:ttypetime;
    ttKey:TTypeKey;
    slBadFiles:TStrings;
    bSkipFile:Boolean;
    sPrevFN:String;
    stmpFileMask:String;
    tMess:String;

  Begin
...

For I:=0 To slPr.Count-1 Do Begin
          J:=StrToInt(slPr[I]);
/////////////////////////////////
          FSR:=aFSR[J];// Вот эта строчка вызывала утечку
////////////////////////////////
          FileTimeToLocalFileTime(FSR.FindData.ftLastWriteTime,lcftm);
          FileTimeToSystemTime(lcftm,sstm);
          S:=Format('%.4d%.2d%.2d%.2d%.2d%.2d %.10d',[sstm.wYear,sstm.wMonth,sstm.wDay,
              sstm.wHour,sstm.wMinute,sstm.wSecond,FSR.Size]);
          OldT:=slO.Values[FSR.Name];
          If Copy(OldT,14+1,1)<>' ' Then
            OldT:=Format('%s %.10d',[OldT,FSR.Size]);
          bSkipFile:=False;
          If ((OldT='') Or (OldT<>S)) And (slBadFiles.IndexOf(FSR.Name)>=0) Then Begin
            WriteOutput(GetFullFileInfoToStr('Skipping File = ',FSR.Name,sstm,FSR.Size));
            bSkipFile:=True;
          End;
          If ((OldT='') Or (OldT<>S)) And (Not bSkipFile) Then Begin
            WriteOutput(GetFullFileInfoToStr('queue ',FSR.Name,sstm,FSR.Size)
              +IIFStr((OldT='') Or ((Length(OldT)=11) And (Copy(OldT,1,1)=' ')),' new',''));
            slToDo.Add(IntToStr(J));
          End;
        End;


Яубрал  эту строчку  FSR:=aFSR[J]; А везде где встречается 
FSR заменил на aFSR[J]. И утечка исчезла. smile 
Спасибо всем за советы. 

Автор: Mechanic 19.7.2006, 17:57
Цитата(alexeis1 @  19.7.2006,  09:45 Найти цитируемый пост)
И совсем не ХЗ - а будут вызываться одноименные функции, того класса, который был передан, правда только в том случае если в классе предка они определены были хотя бы абстрактно.

Имелось в виду, что неизвестно, что именно будет унаследовано от базового класса, и экземпляр какого именно типа будет передаваться на обработку. Вот поэтому всегда стараюсь принимать функами / процедурами минимально приемлемый класс. А с методами пущай уже сам экземпляр разбирается, зачем же ему VMT тогда? smile
Никому же не придет в голову писать, например, потоковый обработчик, на входе который получает TFileStream вместо TStream, если к файлам обработчик никакого отношения не имеет? 

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)