Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.09.02;
Скачать: CL | DM;

Вниз

SaveDialog, сохранение в DBF   Найти похожие ветки 

 
alex_tonk   (2007-08-10 11:18) [0]

Доброго здоровья! Помогите разобраться со следующей проблемой. Есть фаербердовская база, нужно сохранить результаты запроса в DBF файл.
Что я делаю:

Вызываю процедуру:

procedure TFrmMainVwPL.BitBtn2Click(Sender: TObject);
begin
 if SaveDlg.Execute then
   DBUtil.CopyDataSetToDbf(QryPlat,SaveDlg.FileName,ttDBase);
end;

но тут она ругается на ttDBase...

А вот собственно и сама рабочая утилитка:

procedure CopyDataSetToDbf(Source: TDataSet; DestDbf: string; TblType: TTableType = ttDBase; ACodePage: cardinal = 866);
var
 TblDbf: TDbf;
 i, l: integer;
 tft: TFieldType;
 S: string;
begin
 TblDbf:=TDbf.Create(nil);
 try
   TblDbf.TableName:=DestDbf;
   TblDbf.Exclusive:=true;
   TblDbf.FieldDefs.Clear;
   TblDbf.TableLevel:=3;
   try
     for i:=0 to Source.FieldCount-1 do begin
       case Source.Fields[i].DataType of
           ftBCD: begin tft:=ftFloat; l:=0; end;
           ftTime: begin tft:=ftString; l:=8; end;
         else begin tft:=Source.Fields[i].DataType; l:=Source.Fields[i].Size; end;
       end;
       TblDbf.FieldDefs.Add(Source.Fields[i].FieldName,
                            tft,
                            l);
     end;
   except
     ShowMessage(Source.Fields[i].FieldName);
   end;
   TblDbf.CreateTable;
   TblDbf.Open;

   S:=Source.Bookmark;
   Source.DisableControls;
   Source.First;
   while not Source.Eof do begin
     TblDbf.Append;
     for i:=0 to Source.FieldDefs.Count-1 do
       if (TblDbf.Fields[i].DataType=ftString) and (ACodePage=866) then
         TblDbf.Fields[i].Value:=RxStrUtils.StrToOem(Source.Fields[i].Value)
       else TblDbf.Fields[i].Value:=Source.Fields[i].Value;
     TblDbf.Post;
     Source.Next;
   end;
 finally
   Source.Bookmark:=S;
   Source.EnableControls;
   TblDbf.Close;
   TblDbf.Free;
 end;
end;

Надеюсь на вашу помощь.


 
Lacmus ©   (2007-08-10 11:33) [1]

>но тут она ругается на ttDBase...

Как ругается ?


 
Mishell ©   (2007-08-10 15:42) [2]

DBTables в uses поместили?



Страницы: 1 вся ветка

Текущий архив: 2007.09.02;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.023 c
3-1178801337
DeadMeat
2007-05-10 16:48
2007.09.02
Транзакции


2-1186737234
Новичек
2007-08-10 13:13
2007.09.02
Массив объектов.


15-1186484853
ooserg
2007-08-07 15:07
2007.09.02
перехват сообщений


1-1178203465
kirajax
2007-05-03 18:44
2007.09.02
Объекты в RTF


1-1182862301
mif99
2007-06-26 16:51
2007.09.02
Ошибка в приложение клиент сервер (CANNOT ALLOCATE SOCKET)