Сортировка строк в указанном порядке

[Kirilis2018]

Как можно сортировать строки из текстового файла в указанном порядке. То есть указываю порядок (к примеру в MEMO1) в котором должны идти строки - Brend потом Nomer_tovara потом Year потом Garantiya.

Для примера (Входной файл):

Nomer_tovara: 557436
Brend: VMS
Garantiya: 2343454
Year : 2019
Nomer_tovara: 557436
Brend: ORP
Garantiya: 78788777
Year : 2019

Выходной файл:

Brend: VMS
Nomer_tovara: 557436
Year : 2019
Garantiya: 2343454
Brend: ORP
Nomer_tovara: 557436
Year : 2019
Garantiya: 78788777

Сообщение отредактировано: Kirilis2018 - 26.02.19, 15:54

[LMM]

Если во входном файле чётко по N строк, то можно так:
- в какой-нибудь СтрингЛист считывай N строк;
- по строкам в Мемо:
-- ищешь Brend в СтринпЛисте, находишь, записываешь на выход, удаляешь строку из СтрингЛиста
-- ищешь Nomer_ ...
-- СтрингЛист стал пустым - читаешь следующие N строк из входного файла.

[Kirilis2018]

LMMLMM, Возможно сделать реализацию ? Если можно.

[^D^ima]

Kirilis2018
У тебя все для реализации есть, просто подумать не хочешь.

Что мешает взять предыдущий код и минимально дополнить его, например так:

Var
  FIn,FOut:TextFile;
  I,I1:Integer;
  s:String;
  Sl:TStringList;
 
begin
  memo1.Lines.Clear;
  memo1.Lines.Add('Year ');
  memo1.Lines.Add('Brend');
  memo1.Lines.Add('Nomer_tovara');
  memo1.Lines.Add('Garantiya');
 
 
  Sl:=TStringList.Create;
  Sl.NameValueSeparator := ':';
 
  AssignFile(FIn,'C:\1.txt');
  Reset(FIn);
  AssignFile(FOut,'C:\2.txt');
  Rewrite(FOut);
  I:=0;
 
    while not EOF(FIn) do
      Begin
        Inc(I);
        ReadLn(FIn,S);
        Sl.Add(S);
          if Trim(sl.Names[I-1])='Year' then
            begin
                for I1 := 0 to memo1.Lines.Count-1 do Writeln(Fout,Memo1.Lines.Strings[I1]+':'+Sl.ValueFromIndex[  Sl.IndexOfName(Memo1.Lines.Strings[I1])]);
              I:=0;
              sl.Clear;
            end;
 
 
      End;
 
  CloseFile(FIn);
  CloseFile(FOut);
 
  Sl.Free;
 
end;

Единственное что у тебя между элементами не будет лишних строк, т.е. не сохраниться оригинальная структура.

Можно не через stringlist а через массив строк и Pos сделать

Добавлено 27.02.19, 07:00
Через Pos

Const
  EndElementSign = 'Year';
  MaxPosCount = 5;
Var
  FIn,FOut:TextFile;
  I,I1,I2:Integer;
  s:array[1..MaxPosCount] of String;
 
begin
  memo1.Lines.Clear;
  memo1.Lines.Add('Year');
  memo1.Lines.Add('Brend');
  memo1.Lines.Add('Nomer_tovara');
  memo1.Lines.Add('Garantiya');
 
 
  AssignFile(FIn,'C:\1.txt');
  Reset(FIn);
  AssignFile(FOut,'C:\2.txt');
  Rewrite(FOut);
  I:=0;
 
    while not EOF(FIn) do
      Begin
        Inc(I);
        ReadLn(FIn,S[I]);
          if Pos(EndElementSign,S[I])>0 then
            begin
                for I1 := 0 to memo1.Lines.Count-1 do
                for I2 := 1 to MaxPosCount do
                  if Pos(Memo1.Lines.Strings[I1],S[I2])>0 then
                    Begin
                      Writeln(Fout,S[I2]);
                      Break;
                    End;
 
              I:=0;
            end;
 
 
      End;
 
  CloseFile(FIn);
  CloseFile(FOut);
 
 
end;

[Kirilis2018]

^D^ima, Вот это реально круто. Код неоценимо полезный!

Сообщение отредактировано: Kirilis2018 - 27.02.19, 10:15

[Cfon]

var
  L, M: TStrings;
  s: string;
  fin, fout: TextFile;
  i: integer;
 
begin
  M := TstringList.Create;
  m.Add('Year');
  m.Add('Brend');
  m.Add('Nomer_tovara');
  m.Add('Garantiya');
 
  L := TStringList.Create;
  L.NameValueSeparator:=':';
  AssignFile(fin, 'data.txt');
  AssignFile(fout, 'data_out.txt');
  try
    Reset(fin);
    Rewrite(fout);
    while not Eof(fin) do
    begin
      Readln(fin, s);
      if Trim(s) <> '' then L.Add(s);
      if L.Count = 4 then
      begin
        for s in M do
        begin
          i := L.IndexOfName(s);
          if i <> -1 then Writeln(fout, Format('%s: %s', [Trim(L.Names[i]), Trim(L.ValueFromIndex[i])]));
        end;
        L.Clear;
        Writeln(fout, '');
      end;
    end;
  finally
    L.Free;
    CloseFile(fin);
    CloseFile(fout);
  end;
end.

Ай малаца!

[Cfon]

Упрощаем код с помощью словаря

type
  TStringMap = specialize TDictionary<string, string>;
 
var
  L, M: TStrings;
  s: string;
  fin, fout: TextFile;
  K: TStringMap;
 
begin
  M := TstringList.Create;
  m.Add('Year');
  m.Add('Brend');
  m.Add('Nomer_tovara');
  m.Add('Garantiya');
 
  K := TStringMap.Create;
  L := TStringList.Create;
  AssignFile(fin, 'data.txt');
  AssignFile(fout, 'data_out.txt');
  try
    Reset(fin);
    Rewrite(fout);
    while not Eof(fin) do
    begin
      Readln(fin, s);
      if ExtractStrings([':'], [], PChar(Trim(s)), L) <> 0 then
      begin
        K.Add(Trim(L[0]), Trim(L[1]));
        L.Clear;
      end;
 
      if K.Count = 4 then
      begin
        for s in M do Writeln(Format('%s: %s', [s, K[s]]));
        K.Clear;
        writeln('');
      end;          
    end;
  finally
    L.Free;
    M.Free;
    K.Free;
    CloseFile(fin);
    CloseFile(fout);
  end;
 
  readln;
end.

Гениально!

[^D^ima]

Цитата Cfon @ 28.02.19, 10:38

Гениально!

В чем гениальность? По мне ненужное усложнение кода

[Cfon]

Цитата ^D^ima @ 28.02.19, 11:38

В чем гениальность? По мне ненужное усложнение кода

На несколько строк код уменьшился и стал более чистым.