Проблема с TStringList.SaveToFile

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

Проблема с TStringList.SaveToFile

Сообщение Vodnik » 22.03.2017 01:27:15

Использую классический пример из http://wiki.freepascal.org:
Код: Выделить всё
program StrListFile;
{$mode objfpc}
uses
Classes, SysUtils;

var
  Str: TStringList;
begin
  Str := TStringList.Create;
  try
    Str.LoadFromFile('SomeFile.txt');
    Str.Add('Hello');
    Str.SaveToFile('SomeFile.txt');
  finally
    Str.Free;
  end;
end.

Сам по себе он работает без вопросов. Но мне нужно его засунуть в функцию библиотеки DLL, которая вызывается неким ПО (Колцентр), работу которого я не контролирую. К моей функции оно предъявляет требования: processor safe, memory safe, thread safe.
В процессе работы Колцентра моя функция вызывается многократно (при поступлении телефонных вызовов), иногда успешно отрабатывает, иногда вызывает сбой (пока не научился как отловить) - спорадически. Теоретически, функция может быть вызвана одновременно из нескольких тредов, попытается писать в один и тот же файл... не знаю, как Windows Server 2012 это разрулит. Но на практике траффик небольшой, вызовы следуют один за другим с интервалом в несколько секунд, и всё равно спорадически происходят сбои.
Заметил, что если вместо SaveToFile использовать старый добрый AssignFile, Append и Writeln - функция отрабатывает 100% успешно. Неужели SaveToFile нарушает какое-то из требований?
Понимаю, что задачка со многими неизвестными...
Подскажите хотя бы, чем и в какую сторону копать?
Vodnik
новенький
 
Сообщения: 10
Зарегистрирован: 24.12.2016 01:14:23

Re: Проблема с TStringList.SaveToFile

Сообщение pupsik » 22.03.2017 05:54:08

а вы смотрели: как сохраняется TStringList?

подсказка:
Код: Выделить всё
Var TheStream : TFileStream;
begin
  TheStream:=TFileStream.Create(FileName,fmCreate); ....


п.с.
Понимаю, что задачка со многими неизвестными...
угу. :mrgreen:
pupsik
энтузиаст
 
Сообщения: 996
Зарегистрирован: 20.08.2014 16:20:13

Re: Проблема с TStringList.SaveToFile

Сообщение fedan » 22.03.2017 07:35:42

Vodnik писал(а):Подскажите хотя бы, чем и в какую сторону копать?

Примерно в эту:
Код: Выделить всё
program filesafe;

{$mode objfpc}{$H+}
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}

uses
{$IFDEF UNIX}
  cthreads,
{$ENDIF}
  syncobjs,
  Classes,
  SysUtils;

const
  threadcount = 5;

var
  cs: TCriticalSection;
  finished: LongInt;
  fname: string;

function f(p: pointer): ptrint;
var
  fs: TFileStream;
  fsparams: Word;
  sl: TStringList;
begin
  cs.Enter;
  try
    Writeln('thread ', PtrUint(p), ' started');
    if FileExists(fname) then
      fsparams := fmOpenReadWrite
    else
      fsparams := fmCreate;


    fs := TFileStream.Create(fname, fsparams);
    try
      sl := TStringList.Create;
      try

//        if fs.Size > 0 then
//          sl.LoadFromStream(fs);

{********************* Work area ************************}

        sl.Add('call thread ' + IntToStr(PtrUint(p)));

{********************************************************}
        fs.Seek(0, soEnd);

        sl.SaveToStream(fs);

      finally
        sl.Free;
      end;
    finally
      fs.Free;
    end;
  finally
    Writeln('thread ', PtrUint(p), ' finished');
    InterLockedIncrement(finished);
    cs.Leave;
  end;
  Result := 0;
end;

var
  I: Integer;
begin
  cs := TCriticalSection.Create;
  try
    finished := 0;
    fname := GetTempDir(True) + 'workarea.txt';

    for i := 1 to threadcount do
      BeginThread(@f, Pointer(PtrUint(i)));

    while finished < threadcount do ;

    Writeln(finished);

  finally
    cs.Free;
  end;
end.
fedan
новенький
 
Сообщения: 26
Зарегистрирован: 15.09.2016 21:18:48

Re: Проблема с TStringList.SaveToFile

Сообщение Vodnik » 22.03.2017 10:36:17

pupsik писал(а):а вы смотрели: как сохраняется TStringList?
Да. Пробовал играться параметрами открытия файла, но смог добиться только худшего результата: функция 100% не работала...

Добавлено спустя 5 минут 57 секунд:
fedan писал(а):Примерно в эту:


Спасибо, для меня это незнакомая часть Вселенной. Идея понятна, пробую.
Но позвольте спросить: почему тогда работает классическая запись в файл?
Vodnik
новенький
 
Сообщения: 10
Зарегистрирован: 24.12.2016 01:14:23

Re: Проблема с TStringList.SaveToFile

Сообщение fedan » 22.03.2017 10:54:59

Vodnik писал(а):Но позвольте спросить: почему тогда работает классическая запись в файл?

Посмотри внутренности TStrings.SaveToFile и далее.

При AssignFile, Append и Writeln файл не перезаписывается, а добавляются к нему записи.

Код: Выделить всё
    Str.LoadFromFile('SomeFile.txt');
    Str.Add('Hello');
    Str.SaveToFile('SomeFile.txt');

Допустим, несколько потоков загрузили файл и начали его сохранять. Даже если одновременного доступа на запись к файлу не было, то всё равно там окажутся данные последнего завершившегося потока.

Добавлено спустя 17 минут 25 секунд:
Короче вот набросал пример.
Потокобезопасная библиотека:), т.е. доступ к файлу будет только у одного потока, остальные будут ждать на EnterCriticalSection(CriticalSection);
Общий юнит:
Код: Выделить всё
unit ufilesafe;

{$mode objfpc}{$H+}

interface

{$IFNDEF BUILD_LIB}
const
  libname = 'filesafe';

{$ENDIF}

procedure my_operation(const worklog: PChar); cdecl;{$IFNDEF BUILD_LIB} external libname;{$ENDIF}

implementation

{$IFDEF BUILD_LIB}// <== defined in Project Parameters->User Parameters.
uses
  Classes,
  SysUtils;

var
  CriticalSection: TRTLCriticalSection;

procedure my_operation(const worklog: PChar); cdecl;
var
  Stream: TFileStream;
  Mode: Word;
  List: TStringList;
//  temp: string;
begin
  EnterCriticalSection(CriticalSection);
  try
//    temp:=Utf8ToAnsi(worklog);
    if FileExists(worklog) then
      Mode := fmOpenReadWrite
    else
      Mode := fmCreate;

    Stream := TFileStream.Create(worklog, Mode);
    try
      List := TStringList.Create;
      try

//        if Stream.Size > 0 then
//          List.LoadFromStream(Stream);

{********************* Work area ************************}

        List.Add('growth ' + IntToStr(Stream.Size));

{********************************************************}
        Stream.Seek(0, soEnd);

        List.SaveToStream(Stream);
      finally
        List.Free;
      end;
    finally
      Stream.Free;
    end;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
end;

initialization
  InitCriticalSection(CriticalSection);

finalization
  DoneCriticalSection(CriticalSection);
{$ENDIF}
end.

библиотека:
Код: Выделить всё
library libfilesafe;

{$LIBPREFIX ''}
{$mode objfpc}{$H+}

uses
{$IFDEF UNIX}
  cthreads,
{$ENDIF}
  ufilesafe;

exports
  my_operation;

begin
end.

Программа:
Код: Выделить всё
program filesafe;

{$mode objfpc}{$H+}
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}

uses
{$IFDEF UNIX}
  cthreads,
  cwstring,
{$ENDIF}
  SysUtils,
  ufilesafe;

const
  threadcount = 10;

var
  finished: LongInt;

function f(p: pointer): PtrInt;
begin
  Writeln('thread ', threadId, ' started');
  my_operation(PChar(p));
  Writeln('thread ', threadId, ' finished');
  InterLockedIncrement(finished);
  Result := 0;
end;

procedure test(const FileName: string);
var
  I: Integer;
  Temp: string;
begin
  finished := 0;
  Temp := Utf8ToAnsi(FileName);

  for i := 1 to threadcount do
    BeginThread(@f, Pointer(Temp));

  while finished < threadcount do ;

  Writeln(finished);
  finished := 0;
end;

begin
  test(GetTempDir(True) + 'workarea.txt');
  test(GetTempDir(True) + 'звонки.txt');
end.

Тестировалось на Win7 x86_64 и Linux x86_64.
По хорошему надо еще одну CriticalSection и StringList для держания в нём название файла пока поток работает.
У вас нет необходимых прав для просмотра вложений в этом сообщении.
fedan
новенький
 
Сообщения: 26
Зарегистрирован: 15.09.2016 21:18:48

Re: Проблема с TStringList.SaveToFile

Сообщение Vodnik » 22.03.2017 11:56:09

fedan писал(а):При AssignFile, Append и Writeln ты не перезаписываешь файл, а добавляешь к нему записи.

А добавлять записи из нескольких потоков, получается, можно?

fedan писал(а):Прикинь, что несколько потоков загрузили файл и начали его сохранять. Даже если одновременного доступа на запись к файлу не было, то всё равно там окажутся данные последнего завершившегося потока.

TStringList.Free ведь закрывает файл? Но при последовательных вызовах с интервалом в минуту всё равно спорадически сбои возникают. Буферизация гадит?

fedan писал(а):Короче вот набросал пример.


Спасибо, попробую. Это такой общепринятый порядок одновременной записи в один файл, да?
Vodnik
новенький
 
Сообщения: 10
Зарегистрирован: 24.12.2016 01:14:23

Re: Проблема с TStringList.SaveToFile

Сообщение mig-31 » 22.03.2017 12:53:54

Всегда перед отрытием файла надо проверят если он доступен для записи. И как вам уже выше писали запись должна производиться только из одного потока. Несколько потоков получают инфу и передают в один поток,который пишет в файл.
mig-31
постоялец
 
Сообщения: 167
Зарегистрирован: 14.07.2011 13:46:48

Re: Проблема с TStringList.SaveToFile

Сообщение fedan » 22.03.2017 20:32:40

Vodnik писал(а):TStringList.Free ведь закрывает файл?

Нет. Научитесь пользоваться Lazarus или Delphi. Чтобы узнать что внутри интересующей вас функции происходит, поставь на неё курсор и зажми <Alt> + <Стрелка вверх>. Попадёшь на её объявление. Чтобы попасть в тело функции( её реализацию под текущую платформу), зажимай <Ctrl> + <Shift> + <Стрелка вверх или вниз>. Пока это не войдёт в мышечную память, то о дебаге и поиске ответов на (а как же оно работает) не стоит париться. Учись читать код. Тогда многие вопросы отпадут.
fedan
новенький
 
Сообщения: 26
Зарегистрирован: 15.09.2016 21:18:48

Re: Проблема с TStringList.SaveToFile

Сообщение Deimos » 22.03.2017 22:01:57

Не совсем (совсем НЕ) правильно пользовать запись в текстовый файл, для многозада(юзер)чного режима. Смотрите в сторону современных БД с их коммитами, ролбеками и кучей правильных нужных плюшек... ИМХО
Deimos
постоялец
 
Сообщения: 133
Зарегистрирован: 17.01.2010 00:31:30

Re: Проблема с TStringList.SaveToFile

Сообщение serbod » 23.03.2017 10:35:12

Есть разные режимы доступа к файлу, в том числе и одновременная запись в разные участки файла - так работают многие базы данных. Но стандартные компоненты при простой записи в файл (где указывается только имя файла) открывают файл монопольно. Как вариант - открыть файл в нужном режиме через THandleStream или TFileStream и писать в него через TStringList.SaveToStream().
Аватара пользователя
serbod
постоялец
 
Сообщения: 185
Зарегистрирован: 16.09.2016 11:03:02
Откуда: Минск

Re: Проблема с TStringList.SaveToFile

Сообщение Vodnik » 23.03.2017 11:14:05

mig-31 писал(а):Всегда перед отрытием файла надо проверят если он доступен для записи. И как вам уже выше писали запись должна производиться только из одного потока. Несколько потоков получают инфу и передают в один поток,который пишет в файл.

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

Добавлено спустя 26 минут 21 секунду:
fedan писал(а):Нет. Научитесь пользоваться Lazarus или Delphi. Чтобы узнать что внутри интересующей вас функции происходит, поставь на неё курсор и зажми <Alt> + <Стрелка вверх>. Попадёшь на её объявление. Чтобы попасть в тело функции( её реализацию под текущую платформу), зажимай <Ctrl> + <Shift> + <Стрелка вверх или вниз>. Пока это не войдёт в мышечную память, то о дебаге и поиске ответов на (а как же оно работает) не стоит париться. Учись читать код. Тогда многие вопросы отпадут.

Учусь. Спасибо за ликбез по навигации, очень помогло. После 20-летнего перерыва с Турбо Паскалем пытаюсь привыкнуть к необходимости искать ответы в исходниках...

Добавлено спустя 1 час 35 минут 51 секунду:
Deimos писал(а):Не совсем (совсем НЕ) правильно пользовать запись в текстовый файл, для многозада(юзер)чного режима. Смотрите в сторону современных БД с их коммитами, ролбеками и кучей правильных нужных плюшек... ИМХО

Прихожу к этой мысли. Хотя жаль терять простоту - практически мне нужно реализовать обычный лог-файл...

Добавлено спустя 3 минуты 50 секунд:
serbod писал(а):Как вариант - открыть файл в нужном режиме через THandleStream или TFileStream и писать в него через TStringList.SaveToStream().

serdbod, предложенное fedan решение как раз и использует этот подход. Сейчас его тестирую.
Vodnik
новенький
 
Сообщения: 10
Зарегистрирован: 24.12.2016 01:14:23

Re: Проблема с TStringList.SaveToFile

Сообщение fedan » 23.03.2017 15:12:48

Vodnik писал(а): которая вызывается неким ПО (Колцентр), работу которого я не контролирую. К моей функции оно предъявляет требования: processor safe, memory safe, thread safe

с файлом, кроме вашей функции есчо какое-нибудь ПО работает. не в рамках одного процесса?
fedan
новенький
 
Сообщения: 26
Зарегистрирован: 15.09.2016 21:18:48

Re: Проблема с TStringList.SaveToFile

Сообщение Vodnik » 24.03.2017 17:20:24

fedan писал(а):с файлом, кроме вашей функции есчо какое-нибудь ПО работает. не в рамках одного процесса?

Нет, в данном конкретном случае только моя процедура создаёт и пишет данный файл.
Это мой собственный лог происходящих действий в Колцентре.
Vodnik
новенький
 
Сообщения: 10
Зарегистрирован: 24.12.2016 01:14:23

Re: Проблема с TStringList.SaveToFile

Сообщение Vodnik » 27.03.2017 19:07:26

fedan писал(а):
Vodnik писал(а):Подскажите хотя бы, чем и в какую сторону копать?

Примерно в эту:
Код: Выделить всё
program filesafe;

{$mode objfpc}{$H+}
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}

uses
{$IFDEF UNIX}
  cthreads,
{$ENDIF}
  syncobjs,
  Classes,
  SysUtils;

const
  threadcount = 5;

var
  cs: TCriticalSection;
  finished: LongInt;
  fname: string;

function f(p: pointer): ptrint;
var
  fs: TFileStream;
  fsparams: Word;
  sl: TStringList;
begin
  cs.Enter;
  try
    Writeln('thread ', PtrUint(p), ' started');
    if FileExists(fname) then
      fsparams := fmOpenReadWrite
    else
      fsparams := fmCreate;


    fs := TFileStream.Create(fname, fsparams);
    try
      sl := TStringList.Create;
      try

//        if fs.Size > 0 then
//          sl.LoadFromStream(fs);

{********************* Work area ************************}

        sl.Add('call thread ' + IntToStr(PtrUint(p)));

{********************************************************}
        fs.Seek(0, soEnd);

        sl.SaveToStream(fs);

      finally
        sl.Free;
      end;
    finally
      fs.Free;
    end;
  finally
    Writeln('thread ', PtrUint(p), ' finished');
    InterLockedIncrement(finished);
    cs.Leave;
  end;
  Result := 0;
end;

var
  I: Integer;
begin
  cs := TCriticalSection.Create;
  try
    finished := 0;
    fname := GetTempDir(True) + 'workarea.txt';

    for i := 1 to threadcount do
      BeginThread(@f, Pointer(PtrUint(i)));

    while finished < threadcount do ;

    Writeln(finished);

  finally
    cs.Free;
  end;
end.


Попробовал Ваш вариант. Сама эта программа под Win работает без вопросов. Подсунул в виде функции dll в Колцентр. Спорадические ошибки исчезли! Но почему-то каждое выполнение этой функции удваивает содержимое файла. По Вашему совету прошёлся по коду TStrings.SaveToFile, дошёл до TStream.WriteNotImplemented... туплю безбожно...
Vodnik
новенький
 
Сообщения: 10
Зарегистрирован: 24.12.2016 01:14:23


Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6

Рейтинг@Mail.ru