| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Сохранение файла в Thread? [D7, WinXP]

Страницы:   < 1 2 >

Alex_C ©   (2011-09-29 12:22:00) 

Посоветуйте как правильно сделать:
есть локальная БД VolgaTable.
После каждого изменения в базе, фаил базы я записываю на диск.
Есть проблема: если в качестве диска использутся флешка, то сохранение происходит порядка 3 сек - что долго. Хочется этот процесс от пользователя "скрыть". Как идея - записывать на диск базе в отдельном Thread.
Вопрос: можно ли это делать? И если да, то как лучше это сделать?

---

Alex_C   (2011-10-18 17:16:00) [1]

Большое спасибо!

---

jack128_   (2011-10-18 16:57:00) [2]

Примерно так код должен выглядить:

unit Unit4;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, AppEvnts;

type
 TForm4 = class(TForm)
   Button1: TButton;
   ApplicationEvents1: TApplicationEvents;
   procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
   procedure FormCreate(Sender: TObject);
   procedure Button1Click(Sender: TObject);
 public
   { Public declarations }
 end;

var
 Form4: TForm4;

implementation

{$R *.dfm}

type
 PAsyncSaveStreamData = ^TAsyncSaveStreamData;
 TAsyncSaveStreamData = record
   FileHandle: THandle;
   Overlapped: TOverlapped;
   AfterSaveAction: TProc;
 end;

procedure SaveStreamToFileAsyncCallback(
 dwErrorCode: DWORD;
 dwNumberOfBytesTransfered: DWORD;
 lpOverlapped: POverlapped); stdcall;
var
 Data: PAsyncSaveStreamData;
begin
 Data := Pointer(lpOverlapped.hEvent);
 try
   // тут нужно обработать ошибки..
   Data.AfterSaveAction();
 finally
   Win32Check(CloseHandle(Data.FileHandle));
   Dispose(Data);
 end;
end;

function WriteFileEx(hFile: THandle; lpBuffer: Pointer; nNumberOfBytesToWrite: DWORD;
 lpOverlapped: POverlapped; lpCompletionRoutine: FARPROC): BOOL; stdcall; external kernel32 name 'WriteFileEx';

procedure SaveStreamToFileAsync(AStream: TMemoryStream; AFilename: string; AfterSaveAction: TProc);
var
 Handle: THandle;
 Data: PAsyncSaveStreamData;
begin
 Handle := CreateFile(PChar(AFilename), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0);
 Win32Check(Handle <> INVALID_HANDLE_VALUE);
 New(Data);
 try
   ZeroMemory(Data, SizeOf(TAsyncSaveStreamData));
   Data.FileHandle := Handle;
   Data.Overlapped.hEvent := Cardinal(Data);
   Data.AfterSaveAction := AfterSaveAction;
   Win32Check(WriteFileEx(Handle, AStream.Memory, AStream.Size, @Data.Overlapped, @SaveStreamToFileAsyncCallback));
 except
   Win32Check(CloseHandle(Handle));
   Dispose(Data);
   raise;
 end;
end;

procedure TForm4.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
 MsgWaitForMultipleObjectsEx(0, PInteger(nil)^, 0, QS_ALLEVENTS, MWMO_ALERTABLE);
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
 ReportMemoryLeaksOnShutdown := True;
end;

procedure TForm4.Button1Click(Sender: TObject);
var
 Stream: TMemoryStream;
begin
 Stream := TMemoryStream.Create;
 try
   Stream.SetSize(10* 1024 * 1024);
   SaveStreamToFileAsync(Stream, 'X:\1.dat', procedure
     begin
       Stream.Free;
       ShowMessage('Ура');
     end);
 except
   Stream.Free;
   raise;
 end;
end;

end.

object Form4: TForm4
 Left = 0
 Top = 0
 Caption = 'Form4'
 ClientHeight = 337
 ClientWidth = 635
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'Tahoma'
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 PixelsPerInch = 96
 TextHeight = 13
 object Button1: TButton
   Left = 280
   Top = 216
   Width = 75
   Height = 25
   Caption = 'Button1'
   TabOrder = 0
   OnClick = Button1Click
 end
 object ApplicationEvents1: TApplicationEvents
   OnIdle = ApplicationEvents1Idle
   Left = 312
   Top = 176
 end
end

---

b z   (2011-10-16 15:52:00) [3]

если не инициализировали то и анализировать нечего

---

Alex_C   (2011-10-16 13:51:00) [4]

> если его инициализировали


Так собственно я об этом же и говорю - в выше приведенном примере я его не инициализирую - он и не должен вызываться.

Однако дело не в нем. Как вариант: может ли антивирус давать результат, при котором асинхронная запись не работает?

---

b z   (2011-10-15 11:19:00) [5]

> Вроде как идеологию тут я правильно понимаю.
Нет. Калбэк должен вызываться всегда, если его инициализировали. И в нем уже анализировать результат работы.

---

Alex_C   (2011-10-14 17:41:00) [6]

> Ну так ты же сразу после начала сохранения файла _ждешь_
> завершения записи данных.  А должен указать последним параметром
> WriteFileEx указатель на калбек(который будет вызван после
> того как все данные запишутся)
>


Спасибо за ответ!
Не катит.  Пробовал.
Поясню. Сначала пробовал просто WriteFile (он кстати закомментирован в примере). Ничего не меняется.
А калбек вызывается только если он ЕСТЬ! Это ведь всего лишь индикатор того, что ф-ция завершила свою работу. Вроде как идеологию тут я правильно понимаю.
Но не суть - и WriteFile дает тот же результат.

---

jack128_   (2011-10-14 17:07:00) [7]

Ну так ты же сразу после начала сохранения файла _ждешь_ завершения записи данных.  А должен указать последним параметром WriteFileEx указатель на калбек(который будет вызван после того как все данные запишутся)

---

Alex_C   (2011-10-14 15:03:00) [8]

да забыл исправить, в соответствии с [28] будет:


     if not WriteFileEx(FileHandle, @SaveStream.Memory^, SaveStream.Size, Overlap, nil) then



---

Alex_C   (2011-10-14 14:58:00) [9]

> ReadFile(FileHandle, MemoryStream.Memory^, MemoryStream.
> Size,WriteBytes, @Overlap);


Спасибо за подсказку! Действительно отпадает надобность в лишнем действии!

Однако по основному вопросу все равно остается вопрос: почему не действует асинхронная запись?
Сделал 4 варианта работы программы:
1. Вариант - запись на флешку Stream.SaveToFile из осносного потока - 3 сек "зависания" программы.
2. Тоже - из отдельного треда - около 1 сек "зависа".
3. При помощи WriteFileEx из основного потока - 3 сек.
4. Тоже из отдельного - 1 сек.
В итоге получается, что асинхронный вариант "не работает". Вопрос: почему?
Вот итоговый код для пункта 4:

type
TSaveFile = class(TThread)
  FFileName:    string;
protected
  procedure Execute; override;
public
  constructor Create(FileName: string);
end;

var
 SaveStream: TMemoryStream;
 SaveTableCS: TRTLCriticalSection;

constructor TSaveFile.Create(FileName: string);
begin
 FreeOnTerminate := True;
 FFileName := FileName;
 inherited Create(False);
end;

procedure TSaveFile.Execute;
var
 FileHandle: THandle;
 Overlap: TOverlapped;
 WriteBytes, LastError: DWORD;
 WriteArray: array of byte;
begin
 EnterCriticalSection(SaveTableCS);
 try
   SetLength(WriteArray, SaveStream.Size);
   SaveStream.Position := 0;
   SaveStream.ReadBuffer(WriteArray[0], SaveStream.Size);
   FileHandle := CreateFile(PChar(FFileName), GENERIC_WRITE , 0, Nil, CREATE_ALWAYS,
     FILE_FLAG_OVERLAPPED, 0);
   if FileHandle = INVALID_HANDLE_VALUE then
     Application.MessageBox(PChar('Can not write to file: ' + FFileName),
       'Error!', MB_OK)
   else
   begin
     FillChar(Overlap, SizeOf(Overlap), 0);
     Overlap.hEvent := CreateEvent(Nil, True, False, Nil);
     //res := WriteFile(FileHandle, WriteArray[0], Length(WriteArray), WriteBytes, @Overlap);
     if not WriteFileEx(FileHandle, @WriteArray[0], Length(WriteArray), Overlap, nil) then
     begin
       LastError := GetLastError;
       if LastError = ERROR_IO_PENDING then
       begin
         if not ((WaitForSingleObject(Overlap.hEvent, 100) = WAIT_OBJECT_0) and
           GetOverlappedResult(FileHandle, Overlap, WriteBytes, False)) then
           Application.MessageBox(PChar('Can not write to file: ' + FFileName),
             'Error!', MB_OK)
       end;
     end;
     CloseHandle(Overlap.hEvent);
     CloseHandle(FileHandle);
   end;
 finally
   SetLength(WriteArray, 0);
   LeaveCriticalSection(SaveTableCS);
 end;
end;

procedure SaveTableToFile(Table:TVolgaTable; FileName: string);
begin
 SaveStream.Clear;
 Table.SaveToStream(SaveStream);
 TSaveFile.Create(FileName);
end;

Для пункта 3 - он такой же, но в основном потоке.
Вопрос: что не так?
P.S. Очень бы хотелось получить ответы у авторов постов 19 и 20, которые по видимому что то знают, но не хотят говорить :)

---

Slym   (2011-10-14 13:40:00) [10]

Alex_C   (14.10.11 10:29) [25]
Table.SaveToStream(SaveStream);
SetLength(WriteArray, SaveStream.Size);
SaveStream.Position := 0;
SaveStream.ReadBuffer(WriteArray[0], SaveStream.Size);

ReadFile(FileHandle, MemoryStream.Memory^, MemoryStream.Size,WriteBytes, @Overlap);

---

Slym   (2011-10-14 13:39:00) [11]

похоже на запись асинхронка не действует :)
проверил сей код (заменой write на read +мелочи) на чтении - работает

---

Alex_C   (2011-10-14 10:33:00) [12]

Вернул сейчас поток назад - тормоза при записи на флешку пропали...

---

Alex_C   (2011-10-14 10:29:00) [13]

Может я чего не правильно делаю? Убрал поток. Сделал так:


procedure SaveTableToFile(Table:TVolgaTable; FileName: string);
var
 FileHandle: THandle;
 Overlap: TOverlapped;
 res: Boolean;
 WriteBytes, LastError: DWORD;
 WriteArray: array of byte;
begin
 SaveStream.Clear;
 Table.SaveToStream(SaveStream);
 SetLength(WriteArray, SaveStream.Size);
 SaveStream.Position := 0;
 SaveStream.ReadBuffer(WriteArray[0], SaveStream.Size);
 FillChar(Overlap, SizeOf(Overlap), 0);
 FileHandle := CreateFile(PChar(FileName), GENERIC_WRITE , 0, Nil, CREATE_ALWAYS,
   FILE_FLAG_OVERLAPPED, 0);
 if FileHandle = INVALID_HANDLE_VALUE then
   Application.MessageBox(PChar('Can not write to file: ' + FileName),
     'Error!', MB_OK)
 else
 begin
   Overlap.hEvent := CreateEvent(Nil, True, False, Nil);
   res := WriteFile(FileHandle, WriteArray[0], Length(WriteArray), WriteBytes, @Overlap);
   LastError := GetLastError;

   if not res then
   begin
     if LastError = ERROR_IO_PENDING then
       while  WaitForSingleObject(Overlap.hEvent, 100) = WAIT_TIMEOUT do
         Application.ProcessMessages
     else
       Application.MessageBox(PChar('Can not write to file: ' + FileName),
         'Error!', MB_OK)
   end;

   GetOverlappedResult(FileHandle, Overlap, WriteBytes, False);
   CloseHandle(Overlap.hEvent);
   CloseHandle(FileHandle);
 end;
 SetLength(WriteArray, 0);
end;


При записи на флешку появились 3-х секундные тормоза.
Может я асинхронную запись неправильно делаю?

---

Alex_C   (2011-10-14 10:21:00) [14]

> ОТДЕЛЬНОМ потоке асинхронный вывод?


отдельный поток остался от прошлых идей - я его конечно уберу. Теперь он не нужен. Но! Проблема то не в нем...

---

Slym   (2011-10-14 10:18:00) [15]

вот нафея в ОТДЕЛЬНОМ потоке асинхронный вывод? ты кроме сохранения что нибудь еще в этом потоке делаешь?

---

Alex_C   (2011-10-14 09:34:00) [16]

В продолжении темы: сделал асинхронное сохранение:


type
 TSaveFile = class(TThread)
   FFileName:    string;
 protected
   procedure Execute; override;
 public
   constructor Create(FileName: string);
 end;

var
 SaveStream: TMemoryStream;
 SaveTableCS: TRTLCriticalSection;

constructor TSaveFile.Create(FileName: string);
begin
 FreeOnTerminate := True;
 FFileName := FileName;
 inherited Create(False);
end;

procedure TSaveFile.Execute;
var
 FileHandle: THandle;
 Overlap: TOverlapped;
 res: Boolean;
 WriteBytes, LastError: DWORD;
 WriteArray: array of byte;
begin
 EnterCriticalSection(SaveTableCS);
 try
   try
     SetLength(WriteArray, SaveStream.Size);
     SaveStream.Position := 0;
     SaveStream.ReadBuffer(WriteArray[0], SaveStream.Size);
     FillChar(Overlap, SizeOf(Overlap), 0);
     FileHandle := CreateFile(PChar(FFileName), GENERIC_WRITE , 0, Nil, CREATE_ALWAYS,
       FILE_FLAG_OVERLAPPED, 0);
     if FileHandle = INVALID_HANDLE_VALUE then
       Application.MessageBox(PChar('Can not write to file: ' + FFileName),
         'Error!', MB_OK)
     else
     begin
       Overlap.hEvent := CreateEvent(Nil, True, False, Nil);
       res := WriteFile(FileHandle, WriteArray[0], Length(WriteArray), WriteBytes, @Overlap);
       LastError := GetLastError;

       if not res then
       begin
         if LastError = ERROR_IO_PENDING then
           while  WaitForSingleObject(Overlap.hEvent, 100) = WAIT_TIMEOUT do
             Application.ProcessMessages
         else
           Application.MessageBox(PChar('Can not write to file: ' + FFileName),
             'Error!', MB_OK)
       end;

       GetOverlappedResult(FileHandle, Overlap, WriteBytes, False);
       CloseHandle(Overlap.hEvent);
       CloseHandle(FileHandle);
     end;
   except
     Application.MessageBox(PChar('Can not create file ' + FFileName), 'Error', MB_OK);
   end;
 finally
   SetLength(WriteArray, 0);
   LeaveCriticalSection(SaveTableCS);
 end;
end;

procedure SaveTableToFile(Table:TVolgaTable; FileName: string);
begin
 SaveStream.Clear;
 Table.SaveToStream(SaveStream);
 TSaveFile.Create(FileName);
end;


У меня на нескольких компьютерах проверил: теперь что на флешку, что на диск тормозов при записи нет. Однако, у некоторых пользователей они остались. Вопрос: почему такое могло произойти?

---

Alex_C   (2011-10-07 15:58:00) [17]

> откройте для себя асинхронный ввод/вывод.


Большое спасибо за конструктивный совет! Сделано!
Для тех, кому интересно, очень хорошая статья по этому поводу тут:
http://pblog.ru/?p=74

---

Dennis I. Komarov   (2011-10-06 22:44:00) [18]

> зачем здесь поток нужен? 21 век, откройте для себя асинхронный
> ввод/вывод.

Не в этой серии...

---

jack128_   (2011-10-06 22:39:00) [19]

> ThreadSaveStream(MemoryStream);//в потоке не блокирую интерфейс
> сохраняем Stream

зачем здесь поток нужен? 21 век, откройте для себя асинхронный ввод/вывод.

---

Dennis I. Komarov   (2011-10-06 22:36:00) [20]

> Поясню - я использую локальную БД  VolgaTable - достаточно
> старенькая разработка 2000 года, но на мой взгляд ничего
> лучше для локальных БД так и не придумали.


> Немного не в тему: есть ли для SQLite надстройка, позволяющая
> использовать SQLite как и BDE (чтоб мого кода не перелапачивать)?
>

Достаточно что бы отправить в печку...

---

Страницы:   < 1 2 >

Наверх