Ошибка при выгрузке в DBF

[Alexan72]

Есть программа работающая с FB, суть работы её в следующем: загружаем DBF файл, исправляем данные, выгружаем. Обычно обрабатывается несколько файлов подряд, то есть загружаем первый фал, исправляем, выгружаем; загружаем второй файл, исправляем и вот тут облом- ошибка «Access violation» при запуске из Lazarus "External:SIGSEGV"
Создаю DBF так

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

procedure TForm1.CreateTable(AFileName: String);
begin
   With Dbf1 do
    begin
    Close;
    with FieldDefs do
      begin
      Clear;
      Add('ID',ftInteger,11);
      Add('NIB',ftString,16);
      Add('MARK',ftInteger,6);
      Add('FIOPAC',ftString,30);
      Add('DATAROGD',ftDate,8);
      Add('POLIS',ftString,25);
      Add('KODOTD',ftInteger,6);
      Add('DATAPOST',ftDate,8);
      Add('DATAVIPIS',ftDate,8);
      Add('KODWRN',ftString,4);
      Add('NAMEWRN',ftString,50);
      Add('KODUSLUGI',ftString,9);
      Add('NAMEUSLUGI',ftString,250);
      Add('CENAUSLUGI',ftFloat,20);
      Dbf1.FieldDefs[Dbf1.FieldDefs.Count-1].Precision := 4;
      Add('KOLUSLUG',ftInteger,6);
      Add('DATAOKAZAN',ftDate,8);
      Add('DIAGNOZ',ftString,4);
      Add('STOIMOST',ftFloat,20);
      Dbf1.FieldDefs[Dbf1.FieldDefs.Count-1].Precision := 4;
    end;
    TableName:=AFileName;
    CreateTable;
    Exclusive := true;
end;
end;             


Выгружаю так

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

procedure TForm1.Button3Click(Sender: TObject);
  var dbf : file of byte;
CP: byte;
  begin
    if SaveDialog1.Execute then
    CreateTable(Utf8ToSys(SaveDialog1.FileName));
    Dbf1.TableName:=Utf8ToSys(SaveDialog1.FileName);
    SQLQuery5.Open;
    Dbf1.Active:=true;
  Dbf1.First;
  Dbf1.Edit;
  while not Form1.SQLQuery5.EOF Do
  Begin
    Dbf1.FieldByName('ID').AsInteger:=SQLQuery5.FieldByName('ID').AsInteger;
    Dbf1.FieldByName('NIB').AsString:=Utf8ToConsole(SQLQuery5.FieldByName('NIB').AsString);
    Dbf1.FieldByName('MARK').AsInteger:=SQLQuery5.FieldByName('MARK').AsInteger;
    Dbf1.FieldByName('FIOPAC').AsString:=Utf8ToConsole(Form1.SQLQuery5.FieldByName('FIOPAC').AsString);
    Dbf1.FieldByName('DATAROGD').AsDateTime:=Form1.SQLQuery5.FieldByName('DATAROGD').AsDateTime;
    Dbf1.FieldByName('POLIS').AsString:=Utf8ToConsole(Form1.SQLQuery5.FieldByName('POLIS').AsString);
    Dbf1.FieldByName('KODOTD').AsInteger:=SQLQuery5.FieldByName('KODOT').AsInteger;
    Dbf1.FieldByName('DATAPOST').AsDateTime:=Form1.SQLQuery5.FieldByName('DATAPOST').AsDateTime;
    Dbf1.FieldByName('DATAVIPIS').AsDateTime:=Form1.SQLQuery5.FieldByName('DATAVIPIS').AsDateTime;
    Dbf1.FieldByName('KODWRN').AsString:=Utf8ToConsole(Form1.SQLQuery5.FieldByName('KODWRN').AsString);
    Dbf1.FieldByName('NAMEWRN').AsString:=Utf8ToConsole(Form1.SQLQuery5.FieldByName('NAMEWRN').AsString);
    Dbf1.FieldByName('KODUSLUGI').AsString:=Utf8ToConsole(SQLQuery5.FieldByName('KODUSLUGI').AsString);
    Dbf1.FieldByName('NAMEUSLUGI').AsString:=Utf8ToConsole(Form1.SQLQuery5.FieldByName('NAMEUSLUGI').AsString);
    Dbf1.FieldByName('CENAUSLUGI').AsFloat:=SQLQuery5.FieldByName('CENAUSLUGI').AsFloat;
    Dbf1.FieldByName('KOLUSLUG').AsInteger:=SQLQuery5.FieldByName('KOLUSLUG').AsInteger;
    Dbf1.FieldByName('DATAOKAZAN').AsDateTime:=SQLQuery5.FieldByName('DATAOKAZAN').AsDateTime;
    Dbf1.FieldByName('DIAGNOZ').AsString:=Utf8ToConsole(SQLQuery5.FieldByName('DIAGNOZ').AsString);
    Dbf1.FieldByName('STOIMOST').AsFloat:=SQLQuery5.FieldByName('STOIMOST').AsFloat;
    Dbf1.Post;
    Dbf1.Insert;
    Form1.SQLQuery5.Next;
  end;
  SQLQuery5.Close;
  Dbf1.Free;
  AssignFile(dbf, SysToUtf8(SaveDialog1.FileName));
  Reset(dbf);
  Seek(dbf, 29);
  CP := $26;
  Write(dbf, CP);
  CloseFile(dbf);
  DBF1.Free;
end;                 


Приходится перезапускать программу.
В общем вопрос прост В ЧЕМ ПРИЧИНА и КАК ИСПРАВИТЬ?

[Light13]

Ну на вскидку:
1. Убрать with и забыть про это зло.
2. Что более вероятно у вас дважды удаляется компонент Dbf1

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

  SQLQuery5.Close;
  [b]Dbf1.Free;[/b]
  AssignFile(dbf, SysToUtf8(SaveDialog1.FileName));
  Reset(dbf);
  Seek(dbf, 29);
  CP := $26;
  Write(dbf, CP);
  CloseFile(dbf);
  [b]DBF1.Free;[/b]


а в первом методе вы его используете - отсюда и AV.

Если этот объект нужен только для выгрузки данных dbf, то и создавайте его в этом месте, а после обработки уничтожайте.

[Vadim]

Alexan72
Не видно, где у Вас Dbf1 создаётся, зато видно, где делается Free. Теперь будем рассуждать логически: если Вы сделаете, после первого цикла Ваших манипуляций, Free компоненту, а потом заново к нему же и обращаетесь, то Ваши недоумение по поводу SIGSEGV выглядит, как минимум, очень странным, т.к. Вы уже тычете пальцем в небо.

[Alexan72]

Light13 и Vadim спасибо за ответы, избавился от Free и теперь всё работает как надо.
Код выгрузки изменил так

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

begin
    if SaveDialog1.Execute then
    CreateTable(Utf8ToSys(SaveDialog1.FileName));
    Dbf1.TableName:=Utf8ToSys(SaveDialog1.FileName);
    Dbf1.Open;
    SQLQuery5.Open;
    Dbf1.First;
  Dbf1.Edit;
  while not Form1.SQLQuery5.EOF Do
  Begin
............................................................
    Dbf1.Post;
    Dbf1.Insert;
    Form1.SQLQuery5.Next;
  end;
  SQLQuery5.Close;
  Dbf1.Close;
  AssignFile(dbf, SysToUtf8(SaveDialog1.FileName));
  Reset(dbf);
  Seek(dbf, 29);
  CP := $26;
  Write(dbf, CP);
  CloseFile(dbf);


[Light13]

В конструкции If then можно использовать только один оператор: простой, пустой или составной.

В вашем случае при вызове диалога

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

if SaveDialog1.Execute then

, если пользователь откажется от выбора файла все равно пройдет выгрузка с последним указанным именем файла. Или программа упадет с ошибкой, если это будет первый вызов. Также можно повысить скорость обработки, отключив визуальное отображение данных на время обработки DisableControls/EnableControls

Измените на:

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

  if SaveDialog1.Execute then
  begin
    CreateTable(Utf8ToSys(SaveDialog1.FileName));
    Dbf1.TableName := Utf8ToSys(SaveDialog1.FileName);
    Dbf1.Open;
    SQLQuery5.Open;
    Dbf1.DisableControls; //если есть метод, то вызвать для повышения скорости обработки
    Form1.SQLQuery5.DisableControls; //если есть метод, то вызвать для повышения скорости обработки
    //также если обработчик написан в форме Form1, тогда можно именование упростить: вместо Form1.SQLQuery5 указывать SQLQuery5
    try
      Dbf1.First;
      Dbf1.Edit;
      while not Form1.SQLQuery5.EOF Do
      Begin
    ............................................................
        Dbf1.Post;
        Dbf1.Insert;
        Form1.SQLQuery5.Next;
      end;
      SQLQuery5.Close;
      Dbf1.Close;
      AssignFile(dbf, SysToUtf8(SaveDialog1.FileName));
      Reset(dbf);
      Seek(dbf, 29);
      CP := $26;
      Write(dbf, CP);
      CloseFile(dbf);
    finally
      Dbf1.EnableControls; //если есть метод, то вызвать
      Form1.SQLQuery5.EnableControls; //если есть метод, то вызвать
    end;
  end;


Переделывал без среды, возможны ошибки.

[Alexan72]

Light13 спасибо за замечания, действительно при отказе от сохранения программа вылетает, исправил.
Программа писалась около года назад в страшной спешке, и несколько раз доделывалась, на некоторые ошибки и недоделки не было времени обращать внимания, главное чтоб файлы обрабатывались корректно, пользовался ей только я, в месяц обрабатывалось не более 30 файлов. Недавно появилась возможность от неё избавиться, то есть передать пользователю, вот и привожу в порядок.
Сразу ещё вопрос, хотя и не очень в тему:
Произвожу инкрементный поиск по таблице
Код в Edit.Change

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

…
SQLQuery2.SQL.Add('SELECT FIO FROM KONT where Upper(FIO) Like('+'''%'+Utf8UpperCase(Edit7.Text)+'%'''+')');
…



Всё работает, но я хочу чтоб поиск начинался с первой буквы, убираю первый %, получаю
‘Malformed String’, при этом раньше в Lazarus 0.9.31 всё работало. Лишних пробелов в таблице нет.
База на FB 2.5 UTF8

При этом если нажать ОК ,то есть продолжить выполнение программы, и ввести вторую букву – то поиск срабатывает. Странная ситуация нечетная буква – ошибка, четная – все ОК.

[Light13]

‘Malformed String’ - Данные передаются не в utf8. Можно настройки коннекта посмотреть. Странно это все.
Перед заполнением запроса делается SQLQuery2.SQL.Clear; ?

Поковырять нет возможности. Попробуйте передавать через параметры:

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

SQLQuery2.SQL.Add('SELECT FIO FROM KONT where Upper(FIO) Like(:Param)');
SQLQuery2.ParamByName('Param').AsString := Utf8UpperCase(Edit7.Text) + '%';


Опять же пишу без среды - требуется проверка.

[Alexan72]

Действительно строка IBConnection1.CharSet:='utf8'; была закомментирована, видимо ещё с 0.9.31, но там работало.
Спасибо за «наводку», а то взгляд совсем замылился.