主页 / 问题 / 1287651
Accepted
Татьяна
Asked:2022-05-30 01:28:13 +0000 UTC2022-05-30 01:28:13 +0000 UTC

在文本文件中查找重复行

  • 772

有一个视图基础（有重复线的地方）：

+Результат
+Ошибка
+Результат
+Результат
+Результат
+Ошибка
......

有必要计算位于文本文件中的所有重复行并在 Memo1 中显示报告。结果应该在 Memo1 中，如下所示：

+Результат - 4 раза
+Ошибка - 2 раза

也就是说，计算文本文件中所有相同的行并在 Memo1 中显示统计信息。

提供的代码运行迅速，但文件大小为 600 兆字节，它会显示内存不足消息。好吧，这是可以理解的，因为我们都加载到内存中。

procedure TForm1.Button1Click(Sender: TObject);
var
  TS: TStringList;
  s, OneWord: string;
  i, Cnt: integer;
begin
  TS := TStringList.Create;
  TS.Delimiter := '+';
  TS.LoadFromFile('baza.txt');
  s := TS.Text;
  TS.DelimitedText := s;

  if TS.Count = 0 then
  begin
    ShowMessage('Вообще ни одного слова нет!');
    Exit;
  end;

  TS.Sort;

  Memo1.Lines.Clear; // подготовим место для формирования отчёта

  // собственно подсчёт
  OneWord := TS.Strings[0];
  Cnt := 1;
  for i := 1 to TS.Count - 1 do
    if AnsiUpperCase(TS.Strings[i]) = AnsiUpperCase(OneWord) then
      inc(Cnt)
    else
    begin
      Memo1.Lines.Append(OneWord + '+' + InttoStr(Cnt));
      OneWord := TS.Strings[i];
      Cnt := 1;
    end;

  // для последнего слова в списке вывод результата
  Memo1.Lines.Append(OneWord + '+' + InttoStr(Cnt));

  FreeAndNil(TS); // освободим память
end;

我试图通过 AssignFile 发布代码 - 逐行阅读，但我在这里有错误。帮忙修？

var
  TS: TStringList;
  s,st: string;
  i, Cnt: integer;
  f1: TextFile;
begin
  Memo1.Lines.Clear; // подготовим место для формирования отчёта

  // Открываем диалог выбора файла
  if not OpenDialog1.Execute then
    exit
  else
    AssignFile(f1, OpenDialog1.FileName);
  reset(f1);

  TS := TStringList.Create;
  TS.Delimiter := '+';
  s := TS.Text;
  TS.DelimitedText := s;
  TS.Sort;

  if TS.Count = 0 then
  begin
    ShowMessage('Вообще ни одного слова нет!');
    exit;
  end;

  While not EOF(f1) do
  begin
    // Что бы программа не подвисала
    Application.ProcessMessages();
    readln(f1, st);
    TS.Add(st);

    // собственно подсчёт
    st := TS.Strings[0];
    Cnt := 1;
    for i := 1 to TS.Count - 1 do
      if AnsiUpperCase(TS.Strings[i]) = AnsiUpperCase(st) then
        inc(Cnt)
      else
      begin
        Memo1.Lines.Append(st + '-' + InttoStr(Cnt));
        st := TS.Strings[i];
        Cnt := 1;
      end;

    // для последнего слова в списке вывод результата
    Memo1.Lines.Append(st + '-' + InttoStr(Cnt));

    FreeAndNil(TS); // освободим память

  end;

  TS.Free;
  CloseFile(f1);

end;
delphi

1 个回答

  1. Best Answer
    var
  Dict: TDictionary<string, integer>;
  f: TextFile;
  s:string;
  cnt: Integer;
  A: TArray<TPair<string, integer>>;
  p: TPair<string, integer>;
begin
  Dict := TDictionary<string, integer>.Create;
  AssignFile(f, 'e:\s.txt');
  Reset(f);
  while not EOF(f) do begin
    Readln(f, s);
    Dict.TryGetValue(s, cnt);
    Dict.AddOrSetValue(s, cnt + 1);
  end;
  CloseFile(f);
//  for s in dict.Keys do
//    Memo1.Lines.Add(s + ': ' +Dict.Items[s].ToString);
  A:=  Dict.ToArray;
   TArray.Sort<TPair<string, Integer>>(A,
    TComparer<TPair<string, Integer>>.Construct(
      function (const L, R: TPair<string, Integer>): Integer
      begin
        Result := -CompareStr(L.Key, R.Key);
      end)
  );
  for p in A do
    Memo1.Lines.Add(p.Key + ': ' + p.Value.ToString);
  Dict.Free;
    • 2

相关问题