Работа с текстовым файлом

MSD · #46 01.08.2008, 16:45

Цитата:

Сообщение от The Shadow

Вот, но здесь уже без стоимости рейса

Код:

procedure TForm1.Button1Click(Sender: TObject);
type
  TStringMatrix = Array of Array of String;
function NumPos(S: String; C: Char; Num: Integer): Integer;
var
  i, CurPos: Integer;
begin
  CurPos:=0;
  Result:=0;
  for i:=1 to Length(S) do
  begin
    if S[i] = C then
    Inc(CurPos);
    if CurPos = Num then
    begin
      Result:=i;
      Break;
    end;
  end;
end;
function CopyFromTo(S: String; C: Char; BeginPos, EndPos: Integer): String;
begin
  Result:=Copy(S, NumPos(S, C, BeginPos) + 1, NumPos(S, ',', EndPos) - NumPos(S, ',', BeginPos) - 1);
end;
function IndexInArray(S: String; Ar: TStringMatrix): Integer;
var
  i: Integer;
begin
  Result:=-1;
  if Length(Ar) = 0 then
  Exit;
  for i:=Low(Ar) to High(Ar) do
  begin
    if Length(Ar[i]) > 0 then
    if Ar[i][0] = S then
    begin
      Result:=i;
      Exit;
    end;
  end;
end;
var
  TmpStr: String;
  Cheks: TStringMatrix;
  i, j: Integer;
begin
  AssignFile(Input, 'f.txt');
  Reset(Input);
  AssignFile(Output, 'num.txt');
  Rewrite(Output);
  //AssignFile(ErrOutput, 'price.txt');
  //Rewrite(ErrOutput);
  while not Eof(Input) do
  begin
    Readln(Input, TmpStr);
    if IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks) > -1 then
    begin
      SetLength(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)], Length(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)]) + 1);
      Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)][High(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)])]:=CopyFromTo(TmpStr, ',', 2, 3);
    end
    else
    begin
      SetLength(Cheks, Length(Cheks) + 1);
      SetLength(Cheks[High(Cheks)], 2);
      Cheks[High(Cheks)][0]:=Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1);
      Cheks[High(Cheks)][1]:=CopyFromTo(TmpStr, ',', 2, 3);
    end;
  end;
  for i:=Low(Cheks) to High(Cheks) do
  begin
    Writeln(Output, Cheks[i][0]);
    for j:=Low(Cheks[i]) + 1 to High(Cheks[i]) do
    Writeln(Output, Cheks[i][j] + ',');
  end;
  CloseFile(Input);
  CloseFile(Output);
end;

Слушай а вот ты вставил //AssignFile(ErrOutput, 'price.txt');
//Rewrite(ErrOutput);
здесь можно просто вставить код из предыдущего примера и будет работать как один?

The Shadow · #47 01.08.2008, 16:46

Да, просто я убрал несколько строчек чтобы код не стал еще больше.

MSD · #48 01.08.2008, 17:05

Цитата:

Сообщение от The Shadow

Да, просто я убрал несколько строчек чтобы код не стал еще больше.

Блин мне конечно стыдно, но у меня что то не получается...... Подскажи...

The Shadow · #49 01.08.2008, 17:13

Код:

procedure TForm1.Button1Click(Sender: TObject);
type
  TStringMatrix = Array of Array of String;
function NumPos(S: String; C: Char; Num: Integer): Integer;
var
  i, CurPos: Integer;
begin
  CurPos:=0;
  Result:=0;
  for i:=1 to Length(S) do
  begin
    if S[i] = C then
    Inc(CurPos);
    if CurPos = Num then
    begin
      Result:=i;
      Break;
    end;
  end;
end;
function CopyFromTo(S: String; C: Char; BeginPos, EndPos: Integer): String;
begin
  Result:=Copy(S, NumPos(S, C, BeginPos) + 1, NumPos(S, ',', EndPos) - NumPos(S, ',', BeginPos) - 1);
end;
function IndexInArray(S: String; Ar: TStringMatrix): Integer;
var
  i: Integer;
begin
  Result:=-1;
  if Length(Ar) = 0 then
  Exit;
  for i:=Low(Ar) to High(Ar) do
  begin
    if Length(Ar[i]) > 0 then
    if Ar[i][0] = S then
    begin
      Result:=i;
      Exit;
    end;
  end;
end;
var
  TmpStr: String;
  Cheks: TStringMatrix;
  i, j: Integer;
begin
  AssignFile(Input, 'f.txt');
  Reset(Input);
  AssignFile(Output, 'num.txt');
  Rewrite(Output);
  AssignFile(ErrOutput, 'price.txt');
  Rewrite(ErrOutput);
  while not Eof(Input) do
  begin
    Readln(Input, TmpStr);
    Writeln(ErrOutput, Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1));
    Writeln(ErrOutput, Copy(TmpStr, Pos(': ', TmpStr) + 2, NumPos(TmpStr, ',', 9) - Pos(': ', TmpStr) - 2));
    if IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks) > -1 then
    begin
      SetLength(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)], Length(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)]) + 1);
      Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)][High(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)])]:=CopyFromTo(TmpStr, ',', 2, 3);
    end
    else
    begin
      SetLength(Cheks, Length(Cheks) + 1);
      SetLength(Cheks[High(Cheks)], 2);
      Cheks[High(Cheks)][0]:=Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1);
      Cheks[High(Cheks)][1]:=CopyFromTo(TmpStr, ',', 2, 3);
    end;
  end;
  for i:=Low(Cheks) to High(Cheks) do
  begin
    Writeln(Output, Cheks[i][0]);
    for j:=Low(Cheks[i]) + 1 to High(Cheks[i]) do
    Writeln(Output, Cheks[i][j] + ',');
  end;
  CloseFile(Input);
  CloseFile(Output);
  CloseFile(ErrOutput);
end;

Вроде так, не проверял

MSD · #50 01.08.2008, 18:51

И еще подскажите пожалуйста как убрать из файла повторяющиеся строки длинна которых не более 3 символов.. Например есть строки
3
54555454
54545454
3
545454
878778
4
545545
5454554 и.т.д
нудно чтоб осталось
3
54555454
54545454
545454
878778
4
545545
5454554
Спасибо

lmikle · #51 01.08.2008, 21:18

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  SList : TStringList;
  I, J : Integer;
begin
  SList := TStringList.Create;
  Try
    SList.LoadFromFile(Edit1.Text);
    For I := 0 To SList.Count-1 Do
      If Lenght(SList[i]) <= 3 Then // Длинна строки <= 3
        For J := SList.Count DownTo I + 1 Do
          If Slist[i] = SList[J] Then
            SList.Delete(J); // Удаляем такие-же, что ниже I
    SList.SaveToFile(Edit1.Text);
  Finally
    SList.Free;
  End;
end;

MSD · #52 04.08.2008, 08:44

Спасибо. Есть еще один вопрос. Можно организавать чтобы обработка Мemo1.lines..SavetoFile (C:\1.txt) не переписыва файл заново а добавляла записи в конец

?

The Shadow · #53 04.08.2008, 08:47

Код:

procedure AppendFile(Memo: TMemo; FN: String);
var
  i: Integer;
  f: TextFile;
begin
  AssignFile(f, FN);
  Append(f);
  for i:=0 to Memo.Lines.Count - 1 do
  Writeln(f, Memo.Lines[i]);
  CloseFile(f);
end;

oleg87 · #54 23.08.2008, 15:56

Мне дан текстовый файл с описанием переменной f, количество переменных в файле заранее не известно.

>view f=0784
07/24/08_10:24:22 rty
### view subd start ###
# basic information #
f=0784
et=8974
sub_typ=analog lcls=indv chrg_cls=ama chrg_an=0 an=0
bnw=com tpad=0.0 rpad=-6.0 rc_org=1 rc_trm=0
chrg_ccls=nctl lctl=nctl
st=trmv
# service information #
sc=clip clip_typ=p
//total=1

>view f=3698

07/24/08_09:36:41 rty
### view subd start ###
# basic information #
f=0047
et=3698
sub_typ=analog lcls=indv chrg_cls=ama chrg_an=0 an=0
bnw=com tpad=0.0 rpad=-6.0 rc_org=1 rc_trm=0
chrg_ccls=nctl lctl=nctl
st=trmv
//total=1

В общем виде
>view f=.... параметры......... //total=1

Нужно в зависимости от параметров f вывести в новый файл инструкции последовательно для каждой переменной содержащие ее значение.

В общем виде для первой записи т.к sc=clip Нужно вывести в новый файл
can f=0784 sc=clip
reg f=0784 st_ope=trmv
can f=3698 sc=cw

где f=0784 значение функции
can sc=clip действия

и так для каждой f

Пожалуйста, помогите!

DSL88 · #55 08.09.2008, 09:57

Ничего не понял из твоего объяснения

MSD · #56 21.03.2009, 11:29

Здравствуйте мастера. Подсткажите пожалуйста возможно ли скопировать файлы по дате? К примеру на форме есть компонента DateTimePicker и кнопка копировать. Выбираем дату в DateTimePicker, нажимаем копировать и файлы к примеру из папки C:\1\*.cm копируются (при этом у файлов меняется расширение) в папку D:\2\*.txt. Возможно ли это? Спасибо большое за ответы.

MSD · #57 21.03.2009, 11:29

Здравствуйте мастера. Подсткажите пожалуйста возможно ли скопировать файлы по дате? К примеру на форме есть компонента DateTimePicker и кнопка копировать. Выбираем дату в DateTimePicker, нажимаем копировать и файлы к примеру из папки C:\1\*.cm копируются (при этом у файлов меняется расширение) в папку D:\2\*.txt. Возможно ли это? Спасибо большое за ответы.

MSD · #58 24.03.2009, 08:59

Цитата:

Сообщение от MSD

Здравствуйте мастера. Подсткажите пожалуйста возможно ли скопировать файлы по дате? К примеру на форме есть компонента DateTimePicker и кнопка копировать. Выбираем дату в DateTimePicker, нажимаем копировать и файлы к примеру из папки C:\1\*.cm копируются (при этом у файлов меняется расширение) в папку D:\2\*.txt. Возможно ли это? Спасибо большое за ответы.

Что никто не знает как это сделать??

MSD · #59 29.04.2009, 09:29

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

Код:

var
sl: TStringList;
begin
sl := TStringList.Create;
if fileexists ('C:\1.txt')then sl.LoadFromFile('C:\1.txt');
for i := 0 to sl.Count - 1 do
  sl[i] := StringReplace(sl[i], 'г:', '', [rfReplaceAll]);
sl.SaveToFile('C:\1.txt');
sl.Free;

Admin: Пользуемся тегами, иначе последуют санкции!

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты