DBF

Top  Previous  Next

unit Dbf;

 

interface

 

Uses SysUtils,Classes,Dialogs,Szoveg,DB,DBTables,DBIPROCS,DBITYPES,DBIErrs;

 

Type DbfHeader = record

     azonosito   : byte;

     ev,ho,nap   : byte;

     rekordszam  : Longint;

     adatoffset  : word;

     rekordhossz : word;

     ures        : array[1..16] of byte;

     Delphi1     : Word;     {Delphi indexelt dbf esetén <>0}

     Delphi2     : Word;     {Delphi indexelt dbf esetén <>0}

   end;

 

   DbfMezoRecord = record

     mezonev     : array[0..9] of char;

     nemhasznalt1: byte;

     tipus       : char;

     nemhasznalt2: array[0..3] of char;

 

     hossz       : byte;       { Karakteres mezoknél a 2 byte

                                 hossz és tizedesek összetartozik }

     tizedesek   : byte;

     nemhasznalt3: array[1..14] of byte;

   end;

 

   DbfMezoLeiroRecord  = record

     mezonev   : string[10];

     tipus     : char;

     hossz     : word;

     tizedesek : word;

     required  : boolean;

   end;

 

   DbfTableInfo = record

     TableName    : string;

     DatabaseName : string;

     exclusive    : boolean;

     ReadOnly     : boolean;

     Active       : boolean;

     Indexek      : TIndexDefs;

   end;

 

   TFieldStru  = record

     fNo       : word;

     fName     : string[40];

     fType     : TFieldType;

     fLength   : word;

     fDesimals : word;

     fRequired : boolean;

   end;

 

DbfError = (DBF_Ok,           {Minden Oke}

          DBF_NotExist,     {Nem létező dbf file}

          DBF_OpenError,    {Filenyitási hiba}

          DBF_Corrupt,      {Nem DBase file}

          DBF_ReadError,    {Olvasási hiba}

          DBF_WriteError    {Írási hiba}

         );

 

DbfMezok = array[0..1024] of DbfMezoRecord;

 

const dtype: Array[0..16] of String =

    ('ftUnknown','ftString','ftSmallint','ftInteger','ftWord',

    'ftBoolean','ftFloat','ftCurrency','ftBCD','ftDate','ftTime',

    'ftDateTime','ftBytes','ftVarBytes','ftBlob','ftMemo','ftGraphic');

 

const dtypeString: Array[0..16] of String =

    ('ftUnknown','ftString','ftSmallint','ftInteger','ftWord',

    'ftBoolean','ftFloat','ftCurrency','ftBCD','ftDate','ftTime',

    'ftDateTime','ftBytes','ftVarBytes','ftBlob','ftMemo','ftGraphic');

 

{ DÁTUM }

 

Function Isdate(d:TDateTime):boolean;

Function IsdateEHN(E,H,N: Word):boolean;

Function Year(d:TDateTime):Word;

Function Month(d:TDateTime):Word;

Function Day(d:TDateTime):Word;

 

{ Adatbázisok }

 

function  DBFNyitas(fnev: String): boolean;

Procedure DBFZaras;

function  DBFFejOlvas(fnev: String; var dh: DbfHeader): boolean;

function  DBFMezoszam(fnev: String): integer;

function  DBFMezoOlvas(fnev: String; var dbm: array of DBFMezoRecord): word;

function  DBFMezoLeiro(fnev: String; var dbm: array of DbfMezoLeiroRecord): word;

Function  DbfDelphi(fnev: String): boolean;

Function  DbfDelphiToDBase(fnev: String): boolean;

 

procedure DbfTableInfoSave(t:TTable; var dbfi: DbfTableInfo);

procedure DbfTableInfoLoad(t:TTable; var dbfi: DbfTableInfo);

Function  DbfPack(t: TTable ): boolean;

Function  DbfZap(t: TTable): boolean;

Function  DbfCopyStru(t: TTable; dbfnev: string): boolean;

Function  DbfRecallAll(t: TTable): boolean;

function  RecNo(tab1 :Ttable) : longint;

function  DbfReindex(t: TTable): boolean;

procedure NewRec(tab1 :Ttable);

function  KodControl(tab1 :Ttable;indexstr,mezostr,ertek : string) : boolean;

 

Function  DbfTableLock(t:TTable): boolean;

Function  DbfTableUnLock(t:TTable): boolean;

Function  Gather(t: TTable):TStringList;

Function  EmptyRec(t: TTable):TStringList;

Function  Scatter(t: TTable; l:TStrings):boolean;

Function  UjraIndexel(t: TTable): boolean;

Function  Indexeles(t:TTable):boolean;

Function  Ujkod(Table:TTable; mezonev,indexnev:String):LongInt;

Function  Empty(var a):boolean;

Function  GetDatasourceState(ds:TDatasource):string;

Function  GetDatabasePath(dbas:TDatabase):string;

Function  SetNewDatabasePath(dbas:TDatabase;ujpath:string):string;

Function  DbfCopyTable(t: TTable; tablenev: string): boolean;

Function  DbfGetFiledsStructures(t: TTable;var pfDesc: pFLDDesc): boolean;

Function  DbfInsertField(var t: TTable; mezo: TFieldStru; poz:word): boolean;

function  DBFCharToFieldType(c:char):TFieldType;

function  DBFFieldTypeToChar(F:TFieldType):Char;

 

var f: file;

  dbh: DbfHeader;

 

const napperho: array[1..12] of word = (31,29,31,30,31,30,31,31,30,31,30,31);

 

implementation

 

var hiba: word;

  dbnev: array[0..80] of char;

  Error: DbfError;

  dbi    : DbfTableInfo;

 

Function Isdate(d:TDateTime):boolean;

var E,H,N: word;

  szokoev: boolean;

begin

Try

  Result:=False;

  DecodeDate(d,E,H,N);

  if d>0 then

  begin

    szokoev := (E mod 4)=0;

    Case H of

        1..12: Result:=True;

    end;

    If (N>=1) AND (N<=napperho[H]) THEN

      If (H=2) and not szokoev and (N=29) then Result:=False

      else Result := True;

  end;

except

  Result:=False;

end;

end;

 

Function IsdateEHN(E,H,N: Word):boolean;

var  szokoev: boolean;

   d: TDateTime;

begin

  Result := True;

  if E<3000 then

  begin

    szokoev := (E mod 4)=0;

    If (H<1) or (H>12) then Result:=False;

    If (N>=1) AND (N<=napperho[H]) THEN

    begin

      If (H=2) and not szokoev and (N=29) then Result:=False;

    end else Result := False;

  end else Result := False;

end;

 

Function Year(d:TDateTime):Word;

var E,H,N: Word;

begin

 DecodeDate(d,E,H,N);

 Result:=E;

end;

 

Function Month(d:TDateTime):Word;

var E,H,N: Word;

begin

 DecodeDate(d,E,H,N);

 Result:=H;

end;

 

Function Day(d:TDateTime):Word;

var E,H,N: Word;

begin

 DecodeDate(d,E,H,N);

 Result:=N;

end;

 

 

{

UJKOD( Táblanév, mezonev, indexnév )

------------------------------------

       Uj kódot képez, a legnagyobbtól 1-el nagyobbat.

Out  : Result=-1 , ha EOF vagy nem megfelelő mezőtipus,

               0 , ha nincs ilyen mezőnév,

              >0 , uj kód

}

Function Ujkod(Table:TTable; mezonev,indexnev:String):LongInt;

Var oldIndex: String;

  bm: TBookmark;

begin

With Table do begin

     Active:=True;

  If RecordCount<>0 then

  begin

     oldIndex:=IndexName;

     IndexName:=indexnev;

     bm:=GetBookmark;

     DisableControls;

     Try

        Last;

     except

        Result := -1;

        exit;

     end;

     if FindField(mezonev)=nil then Result:=0

     else

     Case FieldByName(mezonev).DataType of

        ftString : Result:=StrToInt(FieldByname(mezonev).AsString)+1;

        ftSmallint:Result:=FieldByname(mezonev).AsInteger+1;

        ftInteger: Result:=FieldByname(mezonev).AsInteger+1;

        ftFloat  : Result:=Trunc(FieldByname(mezonev).AsFloat)+1;

     else Result:=-1;

     end;

     GotoBookmark(bm);

     FreeBookmark(bm);

     EnableControls;

     IndexName:=oldIndex;

end else

  Result:=1

end;

end;

 

 

{ DBFNyittas( filenév ) = True, sikeres megnyitás }

 

function DBFNyitas(fnev: String): boolean;

begin

If FileExists(fnev) then

begin

  {$I-}

  AssignFile(f,fnev);

  Reset(f,1);

  {$I+}

  Result := IOResult = 0

end;

end;

 

Procedure DBFZaras;

begin

  CloseFile(f);

end;

 

{ DBFFejOlvas( filenév, var DbfHeader)                       }

{ DBF file fejblokkját olvassa ki és adja vissza a DbfHeader változóban }

 

function DBFFejOlvas(fnev: String; var dh: DbfHeader): boolean;

begin

If DBFNyitas(fnev) then

begin

  Try

    BlockRead(f,dh,SizeOf(dh),hiba);

  Finally

    Result := dh.azonosito in [$03,$83,$8B];

  end;

end;

end;

 

function DBFMezoszam(fnev: String): integer;

begin

DBFFejolvas(fnev,dbh);

Result:= Trunc(dbh.adatoffset div 32)-1;

DBFZaras;

end;

 

function DBFMezoOlvas(fnev: String; var dbm: array of DBFMezoRecord): word;

var mezoszam: word;

  i:  integer;

begin

IF DBFFejolvas(fnev,dbh)then

begin

  Result:= Trunc(dbh.adatoffset div 32)-1;

  For i:=0 to Result-1 do

    BlockRead(f,dbm[i],SizeOf(dbm[i]),hiba);

  DBFZaras;

end;

end;

 

function DBFMezoLeiro(fnev: String; var dbm: array of DbfMezoLeiroRecord): word;

var dh: DbfHeader;

  mezoszam: word;

  db      : DBFMezoRecord;

  dbl     : DBFMezoLeiroRecord;

  i       : integer;

  szo     : string;

begin

IF DBFNyitas(fnev)then

begin

  BlockRead(f,dh,SizeOf(dh),hiba);

  Result:= Trunc(dh.adatoffset div 32)-1;

  i:=0;

  Repeat

    BlockRead(f,db,SizeOf(db),hiba);

    With dbl do

    begin

      mezonev:= PadL(StrPas(db.mezonev),' ',10);

      tipus  := db.tipus;

      hossz  := db.hossz;

      tizedesek := db.tizedesek;

    end;

    dbm[i] := dbl;

    Inc(i);

  Until (hiba<>SizeOf(db)) or (db.mezonev[0]=#13);

  DBFZaras;

end;

end;

 

Function DbfPack( t: TTable ): boolean;

Var dError: BYTE;

  sError: integer;

  nev   : string;

begin

Try

 With t as TTable do

 begin

   DbfTableInfoSave(t,dbi);

   Active:=False;

   exclusive:=True;

   StrPCopy(dbnev,TableName);

   DbiFormFullName(DBHandle,dbnev,szDBASE,dbnev);

   Result:=DBIPackTable(DBHandle,Handle,dbnev,szDBASE,True)=0;

   DbfTableInfoLoad(t,dbi);

   Active:=True;

 end;

except

   Result:=False;

   Raise;

end;

end;

 

Function DbfZap(t: TTable): boolean;

var dbnev: array[0..80] of char;

  sError: integer;

  nev   : string;

begin

 With t as TTable do

 begin

   Active:=False;

   StrPCopy(dbnev,TableName);

   Exclusive:=True; Open;

   DbiFormFullName(DBHandle,dbnev,szDBASE,dbnev);

   Result:=DbiEmptyTable(DBHandle,nil,dbnev,szDBASE)=0;

   DBIRegenIndexes(Handle);

   Active:=True;

 end;

end;

 

Function DbfCopyStru(t: TTable; dbfnev: string): boolean;

var tip,sn,dn: array[0..250] of Char;

begin

StrPCopy(sn,(t as TTable).TableName);

StrPCopy(dn,dbfnev);

Result := DbiCopyTable((t as TTable).DBHandle,False,sn,szDbase,dn)=0;

end;

 

 

procedure DbfTableInfoSave(t:TTable; var dbfi: DbfTableInfo);

begin

 With t as TTable do

 begin

     Dbfi.TableName    := TableName;

     Dbfi.DatabaseName := DatabaseName;

     Dbfi.exclusive    := exclusive;

     Dbfi.ReadOnly     := ReadOnly;

     Dbfi.Active       := Active;

 end;

end;

 

procedure DbfTableInfoLoad(t:TTable; var dbfi: DbfTableInfo);

begin

 With t as TTable do

 begin

     Active:=False;

     TableName    := Dbfi.TableName;

     DatabaseName := Dbfi.DatabaseName;

     exclusive    := Dbfi.exclusive;

     ReadOnly     := Dbfi.ReadOnly;

     Active       := Dbfi.Active;

 end;

end;

 

{ A fgv Igaz értéket ad, ha a dbf header rekord Delpi mezője <>0}

Function DbfDelphi(fnev: String): boolean;

begin

If DBFFejolvas(fnev,dbh) then

begin

    Result := dbh.Delphi1 <> 0;

    DBFZaras;

end;

end;

 

Function DbfDelphiToDBase(fnev: String): boolean;

begin

If DBFNyitas(fnev) then

begin

  Try

    BlockRead(f,dbh,SizeOf(dbh),hiba);

    Result := IOResult=0;

    dbh.Delphi1 := 0;

    dbh.Delphi2 := 0;

    Seek(f,0);

    BlockWrite(f,dbh,SizeOf(dbh),hiba);

    Result := IOResult=0;

  finally

    DBFZaras;

  end;

end;

end;

 

Function DbfRecallAll(t: TTable): boolean;

Var re: Longint;

  rp: PRecProps;

  torol: byte;

  poz: longint;

begin

 With t as TTable do

 begin

   DbfTableInfoSave(t,dbi);

   StrPCopy(dbnev,TableName);

   DbiFormFullName(DBHandle,dbnev,szDBASE,dbnev);

   Close;

 end;

 Try

  Try

   If dbfFejOlvas(dbnev,dbh) then

   begin

        Seek(f,dbh.adatoffset);

        While not Eof(f) do

        begin

          poz:=FilePos(f);

          BlockRead(f,torol,SizeOf(torol),hiba);

          Seek(f,poz);

          If chr(torol) = '*' then

          begin

             torol:=32;

             BlockWrite(f,torol,1,hiba);

          end;

          Seek(f,poz+dbh.rekordhossz);

        end;

   end;

  Finally

   DBFZaras;

   DBIRegenIndexes((t as Ttable).handle);

   DbfTableInfoLoad(t,dbi);

  end;

 except

   Result:=False;

   Raise;

 end;

end;

 

function RecNo(tab1 :Ttable) : longint;

Var

jel    : Tbookmark;

p      : ^longint;

vissza : longint;

begin

If not Tab1.EOF then

begin

    jel:=tab1.Getbookmark;

    p:=jel;

    if tab1.indexfieldcount=0 then Result:=round(p^/65536)

    else Result:=p^ ;

 tab1.freebookmark(jel);

end

else Result:=0;

end;

 

Function  DbfTableLock(t:TTable): boolean;

begin

 With t as TTable do

 begin

   DbfTableInfoSave(t,dbi);

   Active:=False;

   exclusive:=True;

   Active:=True;

   StrPCopy(dbnev,TableName);

   DbiFormFullName(DBHandle,dbnev,szDBASE,dbnev);

   Result:=DbiAcqPersistTableLock(DBHandle,dbnev,szDBASE) = 0;

   DbfTableInfoLoad(t,dbi);

 end;

end;

 

Function  DbfTableUnLock(t:TTable): boolean;

begin

Try

 With t as TTable do

 begin

   DbfTableInfoSave(t,dbi);

   Active:=False;

   exclusive:=True;

   Active:=True;

   StrPCopy(dbnev,TableName);

   DbiFormFullName(DBHandle,dbnev,szDBASE,dbnev);

   Result:=DbiRelPersistTableLock(DBHandle,dbnev,szDBASE) = 0;

   DbfTableInfoLoad(t,dbi);

 end;

except

   Result:=False;

   Raise;

end;

end;

 

 

function  DbfReindex(t: TTable): boolean;

begin

Try

 With t as TTable do

 begin

   Close;

   Result := DBIRegenIndexes(handle)=0;

   Open;

 end;

except

   Result:=False;

   Raise;

end;

end;

 

function KodControl(tab1 :Ttable;indexstr,mezostr,ertek : string) : boolean;

Var

Vissza : boolean;

kulcs  : string;

jel    : Tbookmark;

p      : ^Longint;

begin

with tab1 do

begin

  jel:=Getbookmark;

  p:=jel;

  indexname:=indexstr;

  setkey;

  fieldbyname(mezostr).asstring:=ertek;

  gotokey;

  kulcs:=fieldbyname(mezostr).asstring ;

  gotobookmark(jel);

  freebookmark(jel);

end;

  Result := kulcs=ertek;

end;

 

procedure NewRec(tab1 :Ttable);

var i     :integer;

  ronly :boolean;

begin

with tab1 do begin

If not Active then Active:=True;

Edit;

append;

for i:=1 to fieldcount do

begin

 ronly:=Fields[i-1].Readonly;

 Fields[i-1].Readonly:=False;

 case fields[i-1].datatype of

    ftString : fields[i-1].asstring:='';

    ftInteger: fields[i-1].asinteger:=0;

    ftFloat  : fields[i-1].asfloat:=0;

    ftBoolean: fields[i-1].asboolean:=False;

    ftDate   : fields[i-1].asDateTime := Now;

 end;

 Fields[i-1].Readonly:=ronly;

end;

end;

end;

 

Function Gather(t: TTable):TStringList;

var i  : integer;

  mez: string;

begin

Result:=TStringList.Create;

With t as TTable do

  For i:=0 to FieldCount-1 do

  begin

    mez:=Fields[i].AsString;

    Result.Add(mez);

  end;

end;

 

Function EmptyRec(t: TTable):TStringList;

var i  : integer;

  mez: string;

begin

  Result:=TStringList.Create;

  NewRec(t);

  Result:=Gather(t);

  t.cancel;

end;

 

Function Scatter(t: TTable; l:TStrings):boolean;

var

  i  : integer;

  mez: string;

begin

Try

Result := True;

With t as TTable do

begin

  If not Active then Active:=True;

  If not (State in [dsInsert,dsEdit]) then Edit;

  If State in [dsInsert] then Append;

  For i:=0 to FieldCount-1 do

  begin

   mez := l.Strings[i];

   if Fields[i].DataType=ftMemo then

      Fields[i].Text:=mez

   else

   Fields[i].AsString := mez;

  end;

  Post;

end;

except

Result := False;

Raise;

end;

end;

 

 

{   UJRAINDEXEL  = Az adatttábla indexeit felszedi, majd törli és

  -----------    ujra létrehozza.

}

Function  UjraIndexel(t: TTable): boolean;

var s: TStringList;

  i: integer;

begin

s:=TStringList.Create;

Try

With t as TTable do

begin

  Close;

  GetIndexNames(s);

  Exclusive:=True;

  For i:=0 to s.count-1 do begin

      DeleteIndex(s.strings[i]);

  end;

  For i:=0 to s.count-1 do begin

      AddIndex(s.Strings[i],s.Strings[i],[]);

  end;

  exclusive:=False;

end;

except

  (t as TTable).Exclusive:=False;

  MessageDlg('Nincs hozzáférés!',mtError,[mbYes],0);

end;

t.Open;

s.free;

end;

 

Function Indexeles(t:TTable):boolean;

var s: TStringList;

  i: integer;

begin

s:=TStringList.Create;

With t do

begin

Try

     GetIndexNames(s);

     Close;

     Exclusive := True;

     For i:=0 to s.Count-1 do

     begin

       DeleteIndex(s.Strings[i]);

       AddIndex(s.Strings[i],s.Strings[i],[]);

     end;

Finally

     Exclusive:=False;

     Active := True;

     s.Free;

end;

end;

end;

 

Function  Empty(var a):boolean;

var adat: longint;

  i,m: Longint;

  k: byte;

begin

adat := 0;

Move(adat,a,SizeOf(a));

Result := adat=0;

end;

 

{  GetDatasourceState( datasource )

 Szövegesen adja vissza az adatforrás állapotát

 Result = State 'ds' nélkül

}

Function GetDatasourceState(ds:TDatasource):string;

begin

Case ds.State of

dsInactive  : result := 'Inactive';

dsBrowse    : result := 'Browse';

dsEdit      : result := 'Edit';

dsInsert    : result := 'Insert';

dsSetKey    : result := 'SetKey';

dsCalcFields: result := 'CalcFields';

end;

end;

 

{A Tdatabase objectből kinyeri a path-t}

Function GetDatabasePath(dbas:TDatabase):string;

var celdir: array[0..127] of char;

begin

DBIGetdirectory(dbas.Handle,False,celdir);

Result := StrPas(celdir);

end;

 

{A Tdatabase objecthez rendelt uj könyvtár path-t állít be}

Function SetNewDatabasePath(dbas:TDatabase;ujpath:string):string;

var celdir: array[0..127] of char;

begin

StrPCopy(celdir,ujpath);

DBISetdirectory(dbas.Handle,celdir);

Result := StrPas(celdir);

end;

 

Function  DbfCopyTable(t: TTable; tablenev: string): boolean;

var dbnev,celtable: array[0..80] of char;

begin

 With t as TTable do

 begin

   Active:=False;

   StrPCopy(dbnev,TableName);

   StrPCopy(celtable,tablenev);

   DbiFormFullName(DBHandle,dbnev,nil,dbnev);

   Exclusive:=True;

   Active:=True;

   Result:=DbiCopyTable(DBHandle,True,dbnev,szDBASE,celtable)=0;

   Active:=True;

 end;

end;

 

Function  DbfGetFiledsStructures(t: TTable;var pfDesc: pFLDDesc): boolean;

var HCur : hDBICur;

  pfD  : pFLDDesc;

  fDescArray :FLDDesc;

begin

StrPCopy(dbnev,t.TableName);

Result := DbiGetCursorForTable(t.DBHandle,dbnev,szDBASE,HCur)=DBIERR_NONE;

If Result then begin

   t.Active := False;

   Result := DbiGetFieldDescs (hCur, @fDescArray)=DBIERR_NONE;

   pfDesc := pfD;

   t.Active := True;

end;

end;

 

Function  DbfInsertField(var t: TTable; mezo: TFieldStru; poz:word): boolean;

var BachMove : TBatchMove;

  Maps: TStringList;

  i: integer;

  ofn,fn,f1,f2 : string;

  srcTable : TTable;

  iDefs : TIndexdefs;

begin

Try

  StrPCopy(dbnev,t.TableName);

  DbiFormFullName(t.DBHandle,dbnev,szDBASE,dbnev);

  fn := StrPas(dbnev);

  f1 := ExtractFilePath(fn); f2:=ExtractFileName(fn);

  f2[1]:='_';

  fn := f1+f2;

{   DbfCopyTable(t,fn);}

  Maps := TStringList.Create;

  with Maps do

  begin

       Clear;

       For i:=0 to t.FieldCount-1 do

           Add(t.Fields[i].FieldName+'='+t.Fields[i].FieldName);

  end;

  srcTable := TTable.Create(Session);

  srcTable.TableName := fn;

  srcTable.DataBaseName := t.DataBaseName;

  BachMove := TBatchMove.Create(Session);

  With BachMove do begin

      Mappings := Maps;

      Source   := srcTable;

      Destination :=t;

      Mode     := batAppend;

  end;

  t.Close;

  t.DatabaseName := t.Databasename;

  t.TableName := t.Tablename;

  t.TableType := ttDbase;

  t.Exclusive := True;

  t.FieldDefs.Add(mezo.fName,mezo.fType,mezo.fLength,mezo.fRequired);

  t.CreateTable;

  f2 := ChangeFileExt(f2,'.MDX'); ofn:=f2;

  If FileExists(f1+f2) then begin

     f2[1]:=t.tablename[1];

     fn := f1+f2;

     RenameFile(f1+ofn,fn);

  end;

  BachMove.Execute;

finally

  BachMove.Free;

  Maps.Free;

  srcTable.DeleteTable;

  srcTable.Free;

  t.Open;

end;

end;

 

function  DBFCharToFieldType(c:char):TFieldType;

begin

Case c of

'C'     : Result:=ftString;

'N'     : Result:=ftFloat;

'L'     : Result:=ftBoolean;

'D'     : Result:=ftDate;

'M'     : Result:=ftMemo;

end;

end;

 

function  DBFFieldTypeToChar(F:TFieldType):Char;

begin

Case F of

ftString                 : Result:='C';

ftSmallint,ftWord,ftFloat,ftCurrency,ftBCD,ftBytes,ftVarBytes

                        : Result:='N';

ftBoolean                : Result:='L';

ftDate,ftTime,ftDateTime : Result:='D';

ftMemo,ftBlob,ftGraphic  : Result:='M';

end;

end;

 

end.