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

[Vodnik]

Использую классический пример из 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 нарушает какое-то из требований?
Понимаю, что задачка со многими неизвестными...
Подскажите хотя бы, чем и в какую сторону копать?

[pupsik]

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

подсказка:

Код: Выделить всё

Var TheStream : TFileStream;
begin
  TheStream:=TFileStream.Create(FileName,fmCreate); ....


п.с.

Понимаю, что задачка со многими неизвестными...

угу.

[fedan]

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

Примерно в эту:

Код: Выделить всё

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.

[Vodnik]

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

Добавлено спустя 5 минут 57 секунд:

Примерно в эту:

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

[fedan]

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

Посмотри внутренности 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 для держания в нём название файла пока поток работает.

[Vodnik]

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

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

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

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

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

Спасибо, попробую. Это такой общепринятый порядок одновременной записи в один файл, да?

[mig-31]

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

[fedan]

TStringList.Free ведь закрывает файл?

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

[Deimos]

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

[serbod]

Есть разные режимы доступа к файлу, в том числе и одновременная запись в разные участки файла - так работают многие базы данных. Но стандартные компоненты при простой записи в файл (где указывается только имя файла) открывают файл монопольно. Как вариант - открыть файл в нужном режиме через THandleStream или TFileStream и писать в него через TStringList.SaveToStream().

[Vodnik]

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

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

Добавлено спустя 26 минут 21 секунду:

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

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

Добавлено спустя 1 час 35 минут 51 секунду:

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

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

Добавлено спустя 3 минуты 50 секунд:

Как вариант - открыть файл в нужном режиме через THandleStream или TFileStream и писать в него через TStringList.SaveToStream().

serdbod, предложенное fedan решение как раз и использует этот подход. Сейчас его тестирую.

[fedan]

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

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

[Vodnik]

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

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

[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... туплю безбожно...