Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.01.2018, 03:21   #1
Алексей0001
Пользователь
 
Регистрация: 25.11.2017
Сообщений: 39
По умолчанию Код приводящий к утечке памяти

При тестирование программы на утечку памяти, возникли ошибки, подскажите как исправить 1.PNG

2.PNG

3.PNG

4.PNG

Код:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, StrUtils, Math;

type
  TForm2 = class(TForm)
    StringGrid1: TStringGrid;
    Button_Open: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button_Process: TButton;
    procedure Button_OpenClick(Sender: TObject);
    procedure Button_ProcessClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    slFile: TStringList;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
  f: TextFile; // обяъвляем переменные
  iTmp, i, k, p: Integer;
  strTemp: String;
begin
  AssignFile(f, FileName); // Связь между файловой переменной и файлом
  Reset(f); // открываем файл для чтения
  with StringGrid do // используем   with   do для упрощения записи
  begin
    i := 0; // переменной i присваиваем 0
    While Not Eof(f) do // используем цикл покуда не будет достигнут конец файла
    begin
      Readln(f, strTemp); // получаем количество
      Inc(i); // увеличиавем I На 1
      RowCount := i; //

      strTemp := strTemp + #9; //
      p := 1;
      k := 0;
      While True do
      begin
        iTmp := PosEx(#9, strTemp, p);
        if iTmp = 0 then
          Break;
        Inc(k);
        If (i = 1) Or (ColCount < k) Then
          ColCount := k;

        Cells[k - 1, i - 1] := Copy(strTemp, p, iTmp - p);
        p := iTmp + 1;
        While (p <= Length(strTemp)) And (strTemp[p] = #9) Do
          Inc(p);
      end;
    end;
  end;
  CloseFile(f);
end;

procedure TForm2.Button_OpenClick(Sender: TObject);
var
  SlSort, SlRow: TStringList;
  i, j, aCol: Integer;
begin
  begin
    OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName);
    If OpenDialog1.Execute Then
      LoadStringGrid(StringGrid1, OpenDialog1.FileName);
  end;
  begin
    aCol := StringGrid1.FixedCols;

    SlSort := TStringList.Create;
    for i := StringGrid1.FixedRows to StringGrid1.RowCount - 1 do
    begin
      SlRow := TStringList.Create;
      SlRow.Assign(StringGrid1.Rows[i]);
      SlSort.AddObject(StringGrid1.Cells[aCol, i], SlRow);
    end;
    SlSort.Sort;
    j := 0;
    for i := StringGrid1.FixedRows to StringGrid1.RowCount - 1 do
    begin
      SlRow := Pointer(SlSort.Objects[j]);
      StringGrid1.Rows[i].Assign(SlRow);
      SlRow.Free;
      Inc(j);
    end;
    SlSort.Free;
  end;
end;

function DigitSort(L: TStringList; index1, index2: Integer): Integer;
var
  i1, i2: Integer;
begin
  i1 := StrToInt(Copy(L.Strings[index1], 1, Pos(#9, L.Strings[index1]) - 1));
  i2 := StrToInt(Copy(L.Strings[index2], 1, Pos(#9, L.Strings[index2]) - 1));
  result := CompareValue(i1, i2);
end;

procedure TForm2.Button_ProcessClick(Sender: TObject);
var
  fName: String;
  dL, sL: TStringList;
  i, tmp: Integer;
begin
  if not OpenDialog1.Execute then // открываем файл
    Exit;
  slFile.LoadFromFile(OpenDialog1.FileName);
  StringGrid1.RowCount := slFile.Count;
  dL := TStringList.Create;
  for i := 0 to slFile.Count - 1 do
  begin
    dL.Delimiter := #9;
    dL.DelimitedText := slFile.Strings[i];
    if dL.Count > StringGrid1.ColCount then
      StringGrid1.ColCount := dL.Count;
    StringGrid1.Rows[i].DelimitedText := slFile.Strings[i];
  end;
  dL.Clear;
  fName := ChangeFileExt(OpenDialog1.FileName, '.result');
  // изминяем расширение файла
  sL := TStringList.Create;
  for i := 0 to StringGrid1.RowCount - 1 do // пробегаем по всем строкам таблицы
  begin
    StringGrid1.Rows[i].Delimiter := #9; // разделяем  каждый элемент строки символом табуляции
    if TryStrToInt(StringGrid1.Cells[0, i], tmp) then
      dL.Add(StringGrid1.Rows[i].DelimitedText)
    else
      sL.Add(StringGrid1.Rows[i].DelimitedText);
  end;
  if sL.Count > 1 then
    sL.Sort;
  if dL.Count > 1 then
    dL.CustomSort(DigitSort);  // производим сортировку
  slFile.Text := dL.Text;
  for i := 0 to sL.Count - 1 do
    slFile.Add(sL.Strings[i]);
  if not FileExists(fName) then
    slFile.SaveToFile(fName)     //проверяем есть ли файл с таким именем
  else if (MessageBox(Handle,
      'Обработанный файл с таким именем уже существует.'#13'Вы хотите сохранить файл под другим именем?', 'Запрос.', mb_YesNo or mb_IconQuestion) = idNo) or (not SaveDialog1.Execute) then
  begin
    ShowMessage('Операция отменена. Файл не сохранен!');
    Exit;
  end
  else
    slFile.SaveToFile(SaveDialog1.FileName);
  ShowMessage('Готово!');           //сохраняем файл
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  slFile := TStringList.Create; // создаем   StringList
end;

end.
Алексей0001 вне форума Ответить с цитированием
Старый 21.01.2018, 07:18   #2
Filka
Форумчанин
 
Регистрация: 29.10.2015
Сообщений: 272
По умолчанию

dL := TStringList.Create есть, а где dL.Free?
sL := TStringList.Create есть, а где sL.Free?
slFile := TStringList.Create есть, а где slFile.Free?
Filka вне форума Ответить с цитированием
Старый 21.01.2018, 11:08   #3
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Дичь какая-то. И всё это полотенце для того, чтобы заполнить грид из файла?
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 21.01.2018, 12:47   #4
Алексей0001
Пользователь
 
Регистрация: 25.11.2017
Сообщений: 39
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
Дичь какая-то. И всё это полотенце для того, чтобы заполнить грид из файла?
Заполняет грид, сортирует его. У вас есть по проще вариант?
Алексей0001 вне форума Ответить с цитированием
Старый 21.01.2018, 12:48   #5
Алексей0001
Пользователь
 
Регистрация: 25.11.2017
Сообщений: 39
По умолчанию

Цитата:
Сообщение от Filka Посмотреть сообщение
dL := TStringList.Create есть, а где dL.Free?
Free освобождает память?
Алексей0001 вне форума Ответить с цитированием
Старый 21.01.2018, 12:49   #6
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
Сообщение от Алексей0001 Посмотреть сообщение
Заполняет грид, сортирует его. У вас есть по проще вариант?
Ясен пень.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 21.01.2018, 13:13   #7
Алексей0001
Пользователь
 
Регистрация: 25.11.2017
Сообщений: 39
По умолчанию

Проблема решена вот код, работает без сбоев
Код:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, StrUtils, Math;

type
  TForm2 = class(TForm)
    StringGrid1: TStringGrid;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button3: TButton;
    Button1: TButton;
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    slFile: TStringList;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
  f: TextFile; // обяъвляем переменные
  iTmp, i, k, p: Integer;
  strTemp: String;
begin
  AssignFile(f, FileName); // Связь между файловой переменной и файлом
  Reset(f); // открываем файл для чтения
  with StringGrid do // используем   with   do для упрощения записи
  begin
    i := 0; // переменной i присваиваем 0
    While Not Eof(f) do // используем цикл покуда не будет достигнут конец файла
    begin
      Readln(f, strTemp); // получаем количество
      Inc(i); // увеличиавем I На 1
      RowCount := i; //

      strTemp := strTemp + #9; //
      p := 1;
      k := 0;
      While True do
      begin
        iTmp := PosEx(#9, strTemp, p);
        if iTmp = 0 then
          Break;
        Inc(k);
        If (i = 1) Or (ColCount < k) Then
          ColCount := k;

        Cells[k - 1, i - 1] := Copy(strTemp, p, iTmp - p);
        p := iTmp + 1;
        While (p <= Length(strTemp)) And (strTemp[p] = #9) Do
          Inc(p);
      end;
    end;
  end;
  CloseFile(f);
end;

function DigitSort(L: TStringList; index1, index2: Integer): Integer;
var
  i1, i2: Integer;
begin
  i1 := StrToInt(Copy(L.Strings[index1], 1, Pos(#9, L.Strings[index1]) - 1));
  i2 := StrToInt(Copy(L.Strings[index2], 1, Pos(#9, L.Strings[index2]) - 1));
  result := CompareValue(i1, i2);
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  SlSort, SlRow: TStringList;
  i, j, aCol: Integer;
begin
  begin
    OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName);
    If OpenDialog1.Execute Then
      LoadStringGrid(StringGrid1, OpenDialog1.FileName);
  end;
  begin
    aCol := StringGrid1.FixedCols;

    SlSort := TStringList.Create;
    for i := StringGrid1.FixedRows to StringGrid1.RowCount - 1 do
    begin
      SlRow := TStringList.Create;
      SlRow.Assign(StringGrid1.Rows[i]);
      SlSort.AddObject(StringGrid1.Cells[aCol, i], SlRow);
    end;
    SlSort.Sort;
    j := 0;
    for i := StringGrid1.FixedRows to StringGrid1.RowCount - 1 do
    begin
      SlRow := Pointer(SlSort.Objects[j]);
      StringGrid1.Rows[i].Assign(SlRow);
      SlRow.Free;
      Inc(j);
    end;
    SlSort.Free;
  end;
end;


procedure TForm2.Button3Click(Sender: TObject);
var
  fName: String;
  dL, sL: TStringList;
  i, tmp: Integer;
begin
  if not OpenDialog1.Execute then Exit;
  slFile.LoadFromFile(OpenDialog1.FileName);
  StringGrid1.RowCount := slFile.Count;
  dL := TStringList.Create;
  for i := 0 to slFile.Count - 1 do
  begin
    dL.Delimiter := #9;
    dL.DelimitedText := slFile.Strings[i];
    if dL.Count > StringGrid1.ColCount then
      StringGrid1.ColCount := dL.Count;
    StringGrid1.Rows[i].DelimitedText := slFile.Strings[i];
  end;
  dL.Clear;
  fName := ChangeFileExt(OpenDialog1.FileName, '.result');
  sL := TStringList.Create;
  for i := 0 to StringGrid1.RowCount - 1 do
    begin
      StringGrid1.Rows[i].Delimiter := #9;
      if TryStrToInt(StringGrid1.Cells[0, i], tmp) then
        dL.Add(StringGrid1.Rows[i].DelimitedText)
      else
        sL.Add(StringGrid1.Rows[i].DelimitedText);
    end;
  if sL.Count > 1 then sL.Sort;
  if dL.Count > 1 then dL.CustomSort(DigitSort);
  slFile.Text := dL.Text;
  for i := 0 to sL.Count - 1 do
    slFile.Add(sL.Strings[i]);
  if not FileExists(fName)
   then slFile.SaveToFile(fName)
   else if (MessageBox(Handle, 'Обработанный файл с таким именем уже существует.'#13'Вы хотите сохранить файл под другим именем?', 'Запрос.', mb_YesNo or mb_IconQuestion) = idNo) or (not SaveDialog1.Execute)
          then begin
                 ShowMessage('Операция отменена. Файл не сохранен!');
                 Exit;
               end
          else slFile.SaveToFile(SaveDialog1.FileName);
  ShowMessage('Done!');
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  slFile := TStringList.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
 slFile.Free;
end;

end.
Алексей0001 вне форума Ответить с цитированием
Старый 21.01.2018, 15:51   #8
Алексей0001
Пользователь
 
Регистрация: 25.11.2017
Сообщений: 39
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
Ясен пень.
можете написать его тут?
Алексей0001 вне форума Ответить с цитированием
Старый 21.01.2018, 15:55   #9
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
Сообщение от Алексей0001 Посмотреть сообщение
можете написать его тут?
Способов много. Когда я был маленький, деревья - большими, трава и девки - дешёвыми, то юзал XML. Но пришла пора серьёзной работы и я пересел на это: TVirtualTreeView.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 21.01.2018, 16:02   #10
Алексей0001
Пользователь
 
Регистрация: 25.11.2017
Сообщений: 39
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
Способов много. Когда я был маленький, деревья - большими, трава и девки - дешёвыми, то юзал XML. Но пришла пора серьёзной работы и я пересел на это: TVirtualTreeView.
спасибо
Алексей0001 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Определите и запишите в протокол шестнадцатеричный объектный код для следующих директив резервирования памяти nelo_001 Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 6 28.06.2014 00:30
Программа для тестирования памяти, тестирование ячеек памяти Hunter557 Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 0 30.01.2011 19:20
Кольцевая очередь на массиве в статической памяти с элементами в динамической памяти ]tach[ Общие вопросы C/C++ 1 19.01.2011 13:16
Почему такой код возможен и сколько выделится памяти? Gtx541 Общие вопросы C/C++ 5 16.06.2010 19:38