STDATW

Top  Previous  Next

{

 StellaMap komponens család

 

 TSDFDataAccess :

     Struktúra leíró alapján szekvanciális fileok szerkezetét és rekordjait

     teszi hozzáférhetővé hasonlóan az adatbázisokéhoz.

 

     INI file-ban is megadhatjuk a struktúra leíró paramétereket, de

     a hozzáférést közvetlenül a DataFileName,FieldStructure propertik

     biztosítják.

 

     FieldStructure szerkezete: a rekord szerkezet...

 

     Pl.   reteg  = byte

           No     = Longint

           x           = real

           y           = real

 

 TSDFDataGrid :

     Táblázatos formában jeleníti meg a szekvenciális adatfileokat.

     Ha kapcsolatot teremtünk a TCustomDataAccess komponenssel, akkor

     az adattáblázat előfeldolgozását az elvégzi.

}

 

unit Stdatw;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Inifiles, Graphics, Controls,

Forms, Dialogs, stdctrls, Grids, Szoveg, Streamfn, DBF, Gauges;

 

type

TDataTypes = (dtNil,dtByte,dtShortInt,dtSmallInt,dtInteger,dtLongint,dtWord,

              dtSingle,dtReal,dtDouble,dtExtended,dtComp,

              dtChar,dtString,dtBoolean,dtVarChar,

              dtCharacter,dtNumeric,dtLogical,dtDate,dtMemo);

 

TDataStru = record

   FieldNo        : integer;         {mező sorszáma}

   FieldName      : string[10];      {mező neve}

   FieldType      : TDataTypes;      {mező tipusa}

   FieldLength    : integer;         {mező fizikai hossza byte-okban}

   DisplayName    : string[20];      {mező alias neve}

   DisplayWidth   : integer;         {mező szélessége a képernyőn}

   Justify        : TAlignMent;      {mező kiírás igazítása:(taLeftJustify, taRightJustify, taCenter)}

   Enabled        : boolean;         {módosítható}

   Visible        : boolean;         {Látható}

end;

 

TDataStruArray = array[1..100] of TDataStru;

TPRecBuffer  = ^TRecBuffer;

TRecBuffer   = PChar;

 

TModifyEvent = procedure(Sender: TObject) of object;

TRecordCountModifyEvent = procedure(Sender: TObject;Recno,RecCount:integer) of object;

{  TRecordNoModifyEvent = procedure(Sender: TObject;Recno,RecCount:integer) of object;}

TBofEvent = procedure(Sender: TObject; BOF: boolean) of object;

TEofEvent = procedure(Sender: TObject; EOF: boolean) of object;

TFileLoadEvent = procedure(Sender: TObject; FileName : string) of object;

 

TSDFDataGrid = class;

TSDFStructureGrid = class;

 

TCustomDataAccess = class(TComponent)

private

  FDataGrid        : TSDFDataGrid;

  FStructureGrid   : TSDFStructureGrid;

  FStruFileName    : TFileName;

  FDataFileName    : TFileName;

  FHeaderOffset    : word;        {A datafile header mérete byte-ban}

  FRecordStructure : TStrings;

  FFSTRU           : TStrings;    {Struktúra átmeneti tárplója}

  FDataStruCount   : integer;

  FSections        : TStrings;    {INI file sekció név}

  FSelectedSection : String;      {INI file kiválasztott szekciója}

  FStruModified    : TModifyEvent;{Ha a struktúra vagy az adatbázis módosított}

  FRecordLength    : integer;     {egy adatrekord hossza byte-ban}

  FRecordCount     : longint;     {Adatfile rekordok száma}

  FRecNo           : longint;     {Rekordmutató}

  FRecStrings      : TStrings;    {Rekord mezők string alakban}

  FIniFileLoad     : TFileLoadEvent; {Új inifile betöltésekor}

  FDataFileLoad    : TFileLoadEvent; {Új inifile betöltésekor}

  FRecCountModified: TRecordCountModifyEvent; {Ha változik a rekordszám}

  FRecNoModified   : TRecordCountModifyEvent; {Ha változik a rekordsorszám}

  FBOF,FEOF        : boolean;     {File eleje,vége jelző}

  FOnBOF           : TBofEvent;

  FOnEOF           : TBofEvent;

  FTest            : boolean;

  FOEMConversion   : boolean;

  procedure SetStruFileName(Value:TFileName);

  procedure SetDataFileName(Value:TFileName);

  procedure SeTRecordStructure(Value:TStrings);

  function  GetDataStruCount:integer;

  function  GetRecordCount:longint;

  function  GetRecNo:longint;

  procedure SetRecNo(Value:longint);

  function  GetRecordLength:integer;

  procedure SetRecStrings(Value:TStrings);

  procedure SetSections(Value:TStrings);

  procedure SetSelectedSection(Value:String);

  procedure SetDataGrid(Value:TSDFDataGrid);

  procedure SetStructureGrid(Value:TSDFStructureGrid);

protected

  ppByte    : byte;

  ppShortInt: ShortInt;

  ppSmallInt: SmallInt;

  ppInteger : Integer;

  ppLongint : Longint;

  ppWord    : Word;

  ppSingle  : Single;

  ppReal    : real;

  ppDouble  : double;

  ppExtended: extended;

  ppComp    : Comp;

  ppChar    : Char;

  ppString  : string;

  function SectionToIndex(sec:string):integer; virtual;

{    procedure StruFeltolt(iFile:TInifile;Section:String); virtual;}

public

  iFile : TInifile;

  StruStream : TMemoryStream;      {Struktúra leíró stream}

  DataStream  : TFileStream;        {Adatfile stream}

  DataStruRec: TDataStru;          {struktóra leíró rekord}

  DataStru   : TDataStruArray;

  RecBuffer  : TRecBuffer;

  PRecBuffer : TPRecBuffer;

  new        : boolean;            {True:=Uj file}

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  function  GetSelectedSection(List:TStrings):string;

  procedure DataStruFeltolt;

  function  GetRecStrings:TStrings;

  procedure GoRecord(Value:longint);  {Adott sorszámú rekord elejére áll}

  procedure Skip(Value:longint);      {Ennyi rekordot lép +előre/-vissza}

  procedure GoTop;                    {Adatfile elejére}

  procedure GoBottom;                 {Adatfile végére}

  Function  ColSearch(fejlec:string):integer;

  procedure LoadFromDATAFile(fn:string);

  procedure LoadDBF(fn:string);

  procedure SaveToListFile(fn:string;delimeiter:string;tablo:boolean);

 

  Property StruFileName : TFileName read FStruFileName write SetStruFileName ;

  Property DataFileName : TFileName read FDataFileName write SetDataFileName ;

  property HeaderOffset : word read FHeaderOffset write FHeaderOffset;

  Property RecordStructure : TStrings read FRecordStructure write SetRecordStructure ;

  Property RecordLength : integer read GetRecordLength write FRecordLength;

  Property DataStruCount: integer read GetDataStruCount write FDataStruCount;

           {ennyi mező van a rekordban}

  Property RecordCount: longint read GetRecordCount write FRecordCount;

  property RecNo: longint read Getrecno write SetRecno;

  property BOF: boolean read FBOF write FBOF;

  property EOF: boolean read FEOF write FEOF;

  property RecStrings: TStrings read FRecStrings write FRecStrings;

  Property Sections : TStrings read FSections write SetSections;

  Property SelectedSection : string read FSelectedSection write SetSelectedSection;

  property OnIniFileLoad : TFileLoadEvent read FIniFileLoad write FIniFileLoad;

  property OnDataFileLoad : TFileLoadEvent read FDataFileLoad write FDataFileLoad;

  property OnStruModified : TModifyEvent read FStruModified write FStruModified;

  property OnRecCountModified : TRecordCountModifyEvent read FRecCountModified

                              write FRecCountModified;

  property OnRecNoModified : TRecordCountModifyEvent read FRecNoModified

                              write FRecNoModified;

  property OnBOF : TBofEvent read FOnBof write FOnBof;

  property OnEOF : TBofEvent read FOnEof write FOnEof;

  property Test: boolean read FTest write FTest;

  {Ha Test=True, akkor csak az elso 10 adatrekordot elvassa be}

  property DataGrid: TSDFDataGrid read FDataGrid write SetDataGrid;

  property StructureGrid: TSDFStructureGrid read FStructureGrid write SetStructureGrid;

  property OEMConversion : boolean read FOEMConversion write FOEMConversion;

end;

 

TSDFDataGrid = class(TStringGrid)

private

  FCustomDataAccess: TCustomDataAccess;

  FCopyAboweRow    : boolean;     {Uj sornál a flötte lévőt másolja}

  FGauge           : TGauge;      {Jelzőcsík komponens a kijelzésekhez}

  FOEMConversion   : boolean;

  procedure SetCustomDataAccess(Value:TCustomDataAccess);

  procedure SetOEMConversion(Value:boolean);

protected

  procedure KeyDown(var Key: Word; Shift: TShiftState);override;

  procedure Notification(AComponent: TComponent;

    Operation: TOperation); override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure GridStruFeltolt(DSA:TDataStruArray;count:integer);

  procedure SaveToFile(fn:string);

  procedure ColClear;

  procedure RowClear;

  procedure RowClearTo;

  procedure RowClearFrom;

  procedure Clear;

  procedure NewRec;

  procedure InsertRec;

  procedure DeleteRec;

  procedure FillsCol(Value:string);

  procedure SaveToListFile(fn:string;delimeiter:string;tablo:boolean);

  procedure OnStruModified(Sender: TObject);

  procedure Recall;

  procedure GaugeProgress(Value,Total:longint);

published

  property CustomDataAccess:TCustomDataAccess read FCustomDataAccess

                                              write SetCustomDataAccess;

  property CopyAboweRow:boolean read FCopyAboweRow write FCopyAboweRow;

  property Gauge : TGauge read FGauge write FGauge;

  property OEMConversion : boolean read FOEMConversion write SetOEMConversion;

end;

 

TSDFStructureGrid = class(TStringGrid)

private

  FCustomDataAccess:TCustomDataAccess;

  procedure SetCustomDataAccess(Value:TCustomDataAccess);

protected

  procedure KeyDown(var Key: Word; Shift: TShiftState);override;

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

  procedure Notification(AComponent: TComponent;

    Operation: TOperation); override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure GridStruFeltolt(DSA:TDataStruArray;count:integer);

  procedure Clear;

  procedure NewRec;

  procedure InsertRec;

  procedure DeleteRec;

  procedure Recall;

  procedure Execute;  {A struktúrát kielemezve feltölti a TSDFAccess

                       RecordStructure-t}

published

  property CustomDataAccess:TCustomDataAccess read FCustomDataAccess

                                              write SetCustomDataAccess;

end;

 

 

TSDFAccess = class(TCustomDataAccess)

published

  property DataGrid;

  property StructureGrid;

  Property StruFileName;

  Property DataFileName;

  Property RecordStructure;

  Property RecordLength;

  property RecNo;

  Property DataStruCount;

  Property Sections;

  Property SelectedSection;

  property HeaderOffset;

  property OnDataFileLoad;

  property OnIniFileLoad;

  property OnStruModified;

  property OnRecCountModified;

  property OnRecNoModified;

  property OnBOF;

  property OnEOF;

end;

 

 

Const DTypes : array[0..20] of string[15] =

            ('nil','Byte','ShortInt','SmallInt','Integer','Longint','Word',

             'Single','Real','Double','Extended','Comp',

             'Char','String','Boolean','VarChar',

             'Character','Numeric','Logical','Date','Memo');

 

  procedure Register;

  Function  UresStrings(t:TStrings): TStrings;

  function  TypeStringToType(s:string):TDataTypes;

  function  GetTypeLength(s:string):integer;

  function  GetDisplayWidth(s:string):integer;

  function  StrToBool(strVal: string): boolean;

  function  BoolToStr(b:boolean;igaz,hamis: string): string;

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TSDFAccess,TSDFDataGrid,TSDFStructureGrid]);

end;

 

function StrToBool(strVal: string): boolean;

var Bool1,Bool2: boolean;

begin

Bool1:=(Pos(UpperCase(strVal),'TTRUEYYESON')>0) or (strVal = '1');

Bool2:=(Pos(UpperCase(strVal),'FFALSENNOOFF')>0) or (strVal <> '1');

Result := Bool1;

end;

 

function BoolToStr(b:boolean;igaz,hamis: string): string;

begin

If b then Result:=igaz else Result := hamis;

end;

 

constructor TCustomDataAccess.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   FRecordStructure:= TStringList.Create;

   FSections       := TStringList.Create;

   RecStrings      := TStringList.Create;

   FFSTRU          := TStringList.Create;

   FStruFileName   := '';

   FDataFileName   := '';

   FHeaderOffset   := 0;

   FRecordLength   := 0;

   FRecordCount    := 0;

   FRecNo          := 0;

end;

 

destructor TCustomDataAccess.Destroy;

begin

   FRecordStructure.Free;

   FSections.Free;

   RecStrings.Free;

   FFSTRU.Free;

   iFile.Free;

   If DataStream<>nil then DataStream.Destroy;

   inherited Destroy;

end;

 

procedure TCustomDataAccess.SetDataGrid(Value:TSDFDataGrid);

begin

If FDataGrid<>Value then begin

   FDataGrid:=Value;

   FDataGrid.Recall;

end;

end;

 

procedure TCustomDataAccess.SetStructureGrid(Value:TSDFStructureGrid);

begin

If FStructureGrid<>Value then begin

   FStructureGrid:=Value;

   FStructureGrid.Recall;

end;

end;

 

procedure TCustomDataAccess.SetStruFileName(Value:TFileName);

var i: integer;

begin

Try

FStruFileName:=Value;

Sections.Clear;

If Value='' then begin

   If iFile<>nil then iFile.Free;

end else

   iFile:=TInifile.Create(Value);

   If iFile<>nil then Sections:=GetSectionNemes(iFile)

   else Sections.Clear;

   For i:=0 to Sections.count-1 do

       If UpperCase(Sections[i])='DATABASES' then

       begin

          Sections.Delete(i);

          break;

       end;

   If Assigned(FIniFileLoad) then FIniFileLoad(Self,Value);

except

   Application.MessageBox('INI file error!','Nem megfelelő INI file',mb_Ok);

   FStruFileName:='';

   Sections.Clear;

end;

end;

 

 

procedure TCustomDataAccess.SetDataFileName(Value:TFileName);

begin

Try

If DataStream<>nil then DataStream.Destroy;

If FileExists(Value) then begin

   DataStream:=TFileStream.Create(Value,fmOpenReadWrite);

end else begin

   If Value='' then Value:='NEW.DAT';

   DataStream:=TFileStream.Create(Value,fmCreate);

end;

finally

   FDataFileName:=Value;

   FRecordCount:=GetRecordCount;

   FRecNo := 0;

   new:=True;

   If Assigned(FDataFileLoad) then FDataFileLoad(Self,Value);

end;

end;

 

procedure TCustomDataAccess.SetRecordStructure(Value:TStrings);

var i: integer;

begin

FRecordStructure.Clear;

FRecordStructure.Assign(Value);

DataStruFeltolt;

If Assigned(FStructureGrid) then begin

   FStructureGrid.Recall;

end;

If Assigned(FDataGrid) then FDataGrid.Recall;

If Assigned(FStruModified) then FStruModified(Self);

end;

 

function  TCustomDataAccess.GetDataStruCount:integer;

begin

Result:=RecordStructure.Count;

end;

 

{A fejléc szöveg alapján megkeresi a struktúra indexet}

Function TCustomDataAccess.ColSearch(fejlec:string):integer;

var ii: integer;

begin

    Result:=-1;

    For ii:=1 to DataStruCount do

        If DataStru[ii].Displayname=fejlec

        then Result:=ii;

end;

 

function  TCustomDataAccess.GetRecordCount:longint;

begin

If DataStream<>nil then begin

   If RecordLength>0 then begin

   Result:=(DataStream.Size-HeaderOffset) div RecordLength;

   If Assigned(FRecCountModified) then FRecCountModified(Self,RecNo,Result);

   end;

end else Result:=0;

end;

 

function  TCustomDataAccess.GetRecNo:longint;

begin

If (DataStream<>nil) and (RecordLength<>0) then begin

   Result:=(DataStream.Position-HeaderOffset) div RecordLength;

   EOF := DataStream.Position=DataStream.Size;

end else begin

    Result := -1;

    EOF := True;

end;

end;

 

{Az n. rekordra ugrik}

procedure TCustomDataAccess.SetRecNo(Value:longint);

begin

If DataStream<>nil then begin

FBOF:=False; FEOF:=False;

If Value<0 then begin Value:=0; BOF:=True; end;

If Value<RecordCount then DataStream.Seek(HeaderOffset+Value*RecordLength,0);

If Value>=RecordCount then begin

   DataStream.Seek(0,2);

   EOF:=True;

end;

FRecNo:=Value;

If Assigned(FRecNoModified) then FRecNoModified(Self,FRecNo,RecordCount);

end;

end;

 

procedure TCustomDataAccess.GoRecord(Value:longint);  {Adott sorszámú rekord elejére áll}

begin

RecNo:=Value;

end;

 

procedure TCustomDataAccess.Skip(Value:longint);      {Ennyi rekordot lép +előre/-vissza}

begin

RecNo:=RecNo+Value;

end;

 

procedure TCustomDataAccess.GoTop;                    {Adatfile elejére}

begin

RecNo:=0;

end;

 

procedure TCustomDataAccess.GoBottom;                 {Adatfile végére}

begin

RecNo:=RecordCount;

end;

 

procedure TCustomDataAccess.LoadFromDATAFile(fn:string);

BEGIN

END;

 

procedure TCustomDataAccess.LoadDBF(fn:string);

Type TDataFType = (dfData,dfDBF);

var i,field_count  : longint;

  dfType         : TDataFType;

  dbh            : DbfHeader;

  dba            : DbfMezoRecord;

  ext            : string;

  tipus,sor      : string;

begin

  ext := UpperCase(ExtractFileExt(fn));

  dfType:=dfData;

  If ext='.DBF' then dfType:=dfDBF;

  Case dfType of

  dfDBF:

    begin

    Try

      DataFileName := fn;

      With DataStream do begin

           Seek(0,0);

           Read(dbh,SizeOf(DbfHeader));

           HeaderOffset := dbh.adatoffset;

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

      end;

{        DBFFejOlvas(fn,dbh);}

{        field_count := DBFMezoOlvas(fn,dba);}

      FFSTRU.clear;

      FFSTRU.Add('Del = VarChar[1]');

      For i:=0 to field_count-1 do begin

          DataStream.Read(dba,SizeOf(DbfMezoRecord));

          sor := '';

          If dba.tipus='C' then tipus:='Character'+'['+IntToStr(dba.Hossz)+']';

          If dba.tipus='D' then tipus:='Date'+'['+IntToStr(dba.Hossz)+']';

          If dba.tipus='N' then tipus:='Numeric'+'['+IntToStr(dba.Hossz)+']';

          If dba.tipus='L' then tipus:='Logical';

          If dba.tipus='M' then tipus:='Memo';

          sor := StrPas(dba.mezonev)+' = '+tipus;

          FFSTRU.Add(sor);

      end;

    finally

      RecordStructure:=FFSTRU;

    end;

    end;

  end;

end;

 

procedure TCustomDataAccess.SaveToListFile(fn:string;delimeiter:string;tablo:boolean);

var i: integer;

  f: TEXTFILE;

  s,sor : string;

begin

Try

Screen.Cursor:=crHourGlass;

AssignFile(f,fn);

Rewrite(f);

GoTop;

 

   If tablo then begin

      sor := '';

      WriteLn(f,'Filename : '+ UpperCase(DataFileName));

      WriteLn(f,'Date     : '+ FormatDateTime(ShortDateFormat,now));

      WriteLn(f,'Program  : StellaSoft Sequential File Explorer');

      WriteLn(f);

     For i:=0 to RecStrings.Count-1 do   {Fejléc kíírás}

             Sor := sor + PadL(DataStru[i+1].FieldName,' ',DataStru[i+1].DisplayWidth)+' ';

          WriteLn(f,sor);

          WriteLn(f,Replicate('_',Length(sor)));

   end;

 

While not Eof do begin

      RecStrings.Assign(GetRecStrings);

      sor := '';

      For i:=0 to RecStrings.Count-1 do begin

          If tablo then begin

             s:=Alltrim(RecStrings[i]);

             Case DataStru[i+1].FieldType of

             dtChar,dtCharacter,dtDate,dtLogical,dtString,dtBoolean :

                  s:= Padl(s,' ',DataStru[i+1].DisplayWidth);

             else

                  s:= PadR(s,' ',DataStru[i+1].DisplayWidth);

             end;

             sor := sor + s +' ';

          end else begin

             sor := sor + Alltrim(RecStrings[i]);

             If i<RecStrings.Count-1 then sor := sor + delimeiter;

          end;

      end;

      WriteLn(f,sor);

end;

finally

CloseFile(f);

Screen.Cursor:=crDefault;

end;

end;

 

{Kiolvassa az aktuális rekordot és a rekord mezőértékeket string listában adja vissza}

function  TCustomDataAccess.GetRecStrings:TStrings;

var s:string;

  i:integer;

begin

Result:=TStringList.Create;

If DataStream<>nil then begin

   For i:=1 to DataStruCount do begin

       With DataStru[i] do begin

       Case FieldType of

       dtByte    : begin ppByte    := GByte(DataStream); s:=IntToStr(ppByte);end;

       dtShortInt: begin ppShortInt:= GShortInt(DataStream);s:=IntToStr(ppShortInt);end;

       dtSmallInt: begin ppSmallInt:= GSmallInt(DataStream);s:=IntToStr(ppSmallInt);end;

       dtInteger : begin ppInteger := GInteger(DataStream);s:=IntToStr(ppInteger);end;

       dtLongint : begin ppLongint := GLongint(DataStream);s:=IntToStr(ppLongint);end;

       dtWord    : begin ppWord    := GWord(DataStream);s:=IntToStr(ppWord);end;

       dtSingle  : begin ppSingle  := GSingle(DataStream);s:=FloatToStr(ppSingle);end;

       dtReal    : begin ppReal    := GReal(DataStream);s:=Format('%10.3f',[ppReal]);end;

       dtDouble  : begin ppDouble  := GDouble(DataStream);s:=FloatToStr(ppDouble);end;

       dtExtended: begin ppExtended:= GExtended(DataStream);s:=FloatToStr(ppExtended);end;

       dtComp    : begin ppComp    := GComp(DataStream);s:=FloatToStr(ppComp);end;

       dtString  : begin

                        s := GString(DataStream,FieldLength);

                        If OEMConversion then s:=ASCIIToWIN(s);

                   end;

       dtVarChar,dtCharacter,dtNumeric,dtLogical,dtDate,dtMemo : begin

                        s := GVarChar(DataStream,FieldLength);

                        If OEMConversion then s:=ASCIIToWIN(s);

                   end;

       dtBoolean : begin

                         ppByte    := GByte(DataStream);

                         If Boolean(ppByte) then s:='True'

                         else s:='False';

                   end;

      end;

      end;

      Result.Add(s);

   end;

   RecStrings:=Result;

   If Assigned(FRecCountModified) then FRecCountModified(Self,RecNo,RecordCount);

end;

end;

 

procedure  TCustomDataAccess.SetRecStrings(Value:TStrings);

begin

If DataStream<>nil then begin

   FRecStrings.Assign(Value);

end else FRecStrings.Clear;

end;

 

function  TCustomDataAccess.GetRecordLength:integer;

var i:integer;

begin

Result:=0;

For i:=1 to DataStruCount do Result:=Result+DataStru[i].FieldLength;

end;

 

{ Az inifile adott Section értékeivel feltölti s struktúra TStrings-et }

procedure TCustomDataAccess.SetSections(Value:TStrings);

begin

If FSections<>Value then begin

FSections.Assign(Value);

end;

end;

 

procedure TCustomDataAccess.SetSelectedSection(Value:String);

var sts: TStringList;

  i,j,n: integer;

  s: string;

begin

If iFile<>nil then begin

   FSelectedSection:=Value;

   RecordStructure.Clear;

   sts := TStringList.Create;

   iFile.ReadSection(FSelectedSection,sts);

   For i:=1 to sts.Count do begin

    s:=iFile.ReadString(FSelectedSection,sts.Strings[i-1],'');

    If s<>'' then begin

       RecordStructure.Add(sts[i-1]+' = '+s);

    end;

   end;

   {HederOffset kinyerése}

   sts.Assign(GetSectionNemes(iFile));

   For i:=0 to sts.count-1 do

       If UpperCase(sts[i])='DATABASES' then begin

          iFile.ReadSection('DATABASES',sts);

          HeaderOffset:=StrToInt(iFile.ReadString('DATABASES',Value+'.DataOffset','0'));

          Break;

       end;

   DataStruFeltolt;

   sts.free;

end;

end;

 

function TCustomDataAccess.GetSelectedSection(List:TStrings):string;

begin

List.BeginUpdate;

try

  List.Clear;

  List:=GetSectionNemes(iFile);

finally

  List.EndUpdate;

end;

end;

 

{Az ini section név alapján visszaadja annak sorszámát, vagy -1-et}

function TCustomDataAccess.SectionToIndex(sec:string):integer;

var i:integer;

begin

If Sections.Count>0 then begin

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

       If Sections[i]=sec then Result:=i;

end else Result:=-1;

end;

 

{

procedure TCustomDataAccess.StruFeltolt(sts:TString);

var sts: TStringList;

  i,j,n: integer;

  s: string;

begin

RecordStructure.Clear;

For i:=1 to sts.Count do begin

    If s<>'' then RecordStructure.Add(sts[i-1]+' = '+s);

end;

DataStruFeltolt;

sts.free;

end;}

 

{Feltölri a DataStru tömböt a RecordStructure leíró alapján}

procedure TCustomDataAccess.DataStruFeltolt;

var recszam,i,n,p:integer;

  sor,ty: string;

  Msg: TMessage;

begin

recszam:=RecordStructure.Count;

For i:=1 to recszam do begin

    With DataStru[i] do begin

         n := Pos('=',RecordStructure[i-1]);

         If n=0 then n := Pos(':',RecordStructure[i-1]);

         FieldName:=AllTrim(Copy(RecordStructure[i-1],1,n-1));

         sor := Alltrim(RightString(RecordStructure[i-1],n+1));

         FieldType   := TypeStringToType(sor);

         FieldLength := GetTypeLength(sor);

            DisplayName := FieldName;

         If new then begin

            DisplayWidth:= GetDisplayWidth(sor);

            Enabled     := True;

            Visible     := True;

         end;

         If FieldType in [dtChar,dtString,dtVarChar,dtCharacter,dtDate]

         then Justify := taLeftJustify else Justify := taRightJustify;

    end;

end;

If Assigned(FStruModified) then FStruModified(Self);

new := False;

end;

 

{a tipus nevéből a tipussal tér vissza}

function TypeStringToType(s:string):TDataTypes;

var i: integer;

begin

Result:=dtNil;

For i:=0 to High(DTypes) do begin

    If Pos(UpperCase(DTypes[i]),UpperCase(s))>0 then Result:=TDataTypes(i);

    If Pos('[',UpperCase(s))>0 then

       If Pos('STRING',UpperCase(s))>0 then Result:=dtString;

       If Pos('VARCHAR',UpperCase(s))>0 then Result:=dtVarChar;

end;

end;

 

{a tipus nevéből a hosszával tér vissza}

function GetTypeLength(s:string):integer;

var i: integer;

const DLength: array[0..High(DTypes)] of integer = (0,1,1,2,2,4,2,4,6,8,10,8,1,10,1,0,1,1,1,10,10);

begin

Result:=0;

For i:=0 to High(DTypes) do begin

    If UpperCase(DTypes[i])=UpperCase(s) then Result:=DLength[i];

end;

If Pos('[',s)>0 then

   Result:=StrToInt(Copy(s,Pos('[',s)+1,Pos(']',s)-Pos('[',s)-1));

   If Pos('STRING',UpperCase(s))>0 then Result:=Result+1;

end;

 

{a tipus nevéből a képernyőn megjelenített hosszával tér vissza = oszlopszélesség}

function GetDisplayWidth(s:string):integer;

var i: integer;

Const DLength: array[0..High(DTypes)] of integer = (1,3,4,6,6,12,5,12,12,14,16,16,1,25,5,0,1,1,1,10,10);

begin

Result:=0;

For i:=0 to High(DTypes) do begin

    If UpperCase(DTypes[i])=UpperCase(s) then Result:=DLength[i];

end;

If Pos('[',s)>0 then

   Result:=StrToInt(Copy(s,Pos('[',s)+1,Pos(']',s)-Pos('[',s)-1));

   If Pos('STRING',UpperCase(s))>0 then Result:=Result+1;

end;

 

{ ***************  TSDFDataGrid  ********************}

 

constructor TSDFDataGrid.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   DefaultRowHeight := 16;

   RowCount:=2;

   FixedRows:=1;

   ColCount:=2;

   FixedCols:=1;

end;

 

destructor TSDFDataGrid.Destroy;

begin

   inherited Destroy;

end;

 

procedure TSDFDataGrid.Recall;

begin

If FCustomDataAccess<>nil then

GridStruFeltolt(FCustomDataAccess.DataStru,FCustomDataAccess.DataStruCount);

invalidate;

end;

 

procedure TSDFDataGrid.SetCustomDataAccess(Value:TCustomDataAccess);

begin

If Value<>FCustomDataAccess then begin

    FCustomDataAccess:=Value;

end;

end;

 

procedure TSDFDataGrid.OnStruModified(Sender: TObject);

begin

If FCustomDataAccess<>nil then

GridStruFeltolt(FCustomDataAccess.DataStru,FCustomDataAccess.DataStruCount);

invalidate;

end;

 

{A struktúra leíró alapján a grid oszlopszámát és fejléc adatait beállítja

 DSA:      Rekord szerkezet leíró tömb;

 count:    mezők száma}

procedure TSDFDataGrid.GridStruFeltolt(DSA:TDataStruArray;count:integer);

var ii,i,n,h1,h2,k: longint;

  FColCount: integer;

  cur : TCursor;

  label ki;

begin

Try

Try

cur := Screen.Cursor;

Screen.Cursor := crHourGlass;

FColCount :=1;

For i:=1 to Count do If DSA[i].Visible then Inc(FColCount);

ColCount := FColCount;

If ColCount<2 then ColCount:=2;

If RowCount<2 then RowCount:=2;

FixedCols:=1;

FixedRows:=1;

k :=1;

For i:=1 to Count do

If DSA[i].Visible then begin

    Cells[k,0]   := DSA[i].FieldName;

    h1 := Canvas.TextWidth(DSA[i].FieldName)+4;

    h2 := DSA[i].DisplayWidth*Canvas.TextWidth('X')+4;

    If h2>h1 then ColWidths[k] := h2 else ColWidths[k] := h1;

    Inc(k);

end;

invalidate;

n:=FCustomDataAccess.RecordCount+1;

If n<2 then RowCount:=2 else

   If CustomDataAccess.Test then RowCount:=10 else RowCount:=n;

{Táblázat adatokkal való feltöltése}

If CustomDataAccess.DataFileName<>'' then begin

   CustomDataAccess.GoTop;

   For ii:=0 to CustomDataAccess.RecordCount do begin

      CustomDataAccess.Recno:=ii; n:=ii;

      GaugeProgress(n,CustomDataAccess.RecordCount);

      If (CustomDataAccess.Test and (n>10)) or CustomDataAccess.Eof then break;

      CustomDataAccess.RecStrings:=CustomDataAccess.GetRecStrings;

      FColCount :=1;

      For i:=1 to CustomDataAccess.DataStruCount do begin

      If DSA[i].Visible then begin

          k:=CustomDataAccess.ColSearch(Cells[FColCount,0]);

          If k>-1 then

          Cells[FColCount,n+1]:=CustomDataAccess.RecStrings[k-1];

          Inc(FColCount);

      end;

      end;

      If (ii mod 10)=0 then begin

         Application.ProcessMessages;

         If (GetKeyState(vk_escape) and 128)<>0 then

         begin

          RowCount:=ii+1;

          goto ki;

         end;

      end;

      Cells[0,n+1]:=IntToStr(n+1);

   end;

end;

ki: GaugeProgress(0,0);

invalidate;

except

ColCount := Count+1;

end;

finally

Screen.Cursor:=cur;

end;

end;

 

procedure TSDFDataGrid.GaugeProgress(Value,Total:longint);

var k: longint;

begin

 If FGauge<>nil then begin

    Gauge.Visible:=Value>0;

    If Gauge.Visible then begin

       k := Trunc(Gauge.MaxValue*Value/Total);

       If Abs(k-Gauge.Progress)>0 then begin

          Gauge.Progress:=k;

          Gauge.Update;

       end;

    end;

 end;

end;

 

{A struktúrának megfelelően szekvenciális fileba menti a táblázatot}

procedure TSDFDataGrid.SaveToFile(fn:string);

var

i,j,jj,recHossz,streamPos: longint;

s: string;

by : byte;

si : shortint;

wo : word;

sm : smallint;

ii : integer;

li : longint;

sg : single;

r  : real;

st : string;

bo : boolean;

k  : integer;

ch : Char;

 

begin

Try

tf:=TFileStream.create(fn,fmCreate);

{HEADER másolása a fileba}

If CustomDataAccess.HeaderOffset>0 then begin

   With CustomDataAccess.DataStream do begin

        Seek(0,0);

        For i:=1 to CustomDataAccess.HeaderOffset do begin

            Read(by,1);

            tf.Write(by,1);

        end;

   end;

end;

GaugeProgress(0,0);

For i:=1 to RowCount-1 do

    For j:=1 to CustomDataAccess.DataStruCount do begin

        s:=Cells[j,i];

        With CustomDataAccess do begin

              Case DataStru[j].FieldType of

              dtByte,dtShortInt : begin by := StrToInt(s);  tf.Write(by,1); end;

              dtSmallInt        : begin sm := StrToInt(s);  tf.Write(sm,Sizeof(SmallInt)); end;

              dtWord            : begin wo := StrToInt(s);  tf.Write(wo,Sizeof(Word)); end;

              dtInteger         : begin ii := StrToInt(s);  tf.Write(ii,Sizeof(integer)); end;

              dtLongint         : begin li := StrToInt(s);  tf.Write(li,Sizeof(Longint)); end;

              dtSingle          : begin sg := StrToFloat(s);tf.Write(sg,Sizeof(single)); end;

              dtReal            : begin r  := StrToFloat(s);tf.Write(r,Sizeof(real)); end;

              dtString          : begin k:=Length(s)+1;

                                           tf.Write(s,k);

                                           ch := #0;

                                           For jj:=k+1 to DataStru[j].FieldLength do

                                               tf.Write(ch,1);

                                  end;

              dtVarChar,dtCharacter,dtNumeric,dtLogical,dtDate,dtMemo :

                   begin

                        If OEMConversion then s:=WINToASCII(s);

                        If DataStru[j].FieldType=dtNumeric then

                           s:= PadR(s,' ',DataStru[j].DisplayWidth)

                        else

                           s:= Padl(s,' ',DataStru[j].DisplayWidth);

                        For jj:=1 to DataStru[j].FieldLength do

                        tf.Write(s[jj],1);

                   end;

              dtBoolean         : begin bo := StrToBool(s); tf.Write(bo,Sizeof(bo)); end;

              end;

              recHossz:=CustomDataAccess.RecordLength;

              streamPos := tf.Size;

        end;

        GaugeProgress(i,RowCount);

    end;

finally

by := $1A;

If UpperCase(ExtractFileExt(CustomDataAccess.DataFileName))='.DBF'

   then tf.Write(by,1);

GaugeProgress(0,0);

tf.Free;

end;

end;

 

procedure TSDFDataGrid.Clear;

begin

RowCount:=1;

Newrec;

FixedRows:=1;

end;

 

procedure TSDFDataGrid.ColClear;

begin

Cols[Col].Assign(UresStrings(Cols[Col]));

end;

 

procedure TSDFDataGrid.RowClear;

begin

Rows[Row].Assign(UresStrings(Rows[Row]));

Cells[0,row]:=IntToStr(row);

end;

 

procedure TSDFDataGrid.RowClearTo;

var i:longint;

begin

For i:=1 to Row-1 do begin

Rows[i].Assign(UresStrings(Rows[i]));

Cells[0,i]:=IntToStr(i);

end;

end;

 

procedure TSDFDataGrid.RowClearFrom;

var i:longint;

begin

For i:=Row to Rowcount do begin

Rows[i].Assign(UresStrings(Rows[i]));

Cells[0,i]:=IntToStr(i);

end;

end;

 

procedure TSDFDataGrid.FillsCol(Value:string);

var i:longint;

begin

For i:=1 to Rowcount do begin

Cells[Col,i]:=Value;

end;

end;

 

procedure TSDFDataGrid.SetOEMConversion(Value:boolean);

var i,j:longint;

begin

If FOEMConversion<>Value then begin

   FOEMConversion := Value;

For i:=1 to Rowcount do

For j:=1 to Colcount do begin

    If FOEMConversion then Cells[j,i]:=ASCIIToWin(Cells[j,i])

    else Cells[j,i]:=WinToASCII(Cells[j,i]);

end;

end;

end;

 

procedure TSDFDataGrid.NewRec;

begin

RowCount:=RowCount+1;

If CopyAboweRow and (Row>1) then

   Rows[RowCount-1].Assign(Rows[RowCount-2])

else

   Rows[RowCount-1].Assign(UresStrings(Rows[RowCount-1]));

  Cells[0,RowCount-1]:=IntToStr(RowCount-1)+'*';

If RowCount-Toprow>VisibleRowCount then TopRow:=RowCount-VisibleRowCount;

Row:=RowCount-1; Col:=1;

end;

 

procedure TSDFDataGrid.InsertRec;

var i:longint;

begin

If RowCount>1 then begin

RowCount := RowCount+1;

If RowCount>2 then begin

   For i:=RowCount-1 downto Row do begin

       Rows[i].Assign(Rows[i-1]);

       Rows[i][0]:=IntToStr(i);

   end;

end;

If CopyAboweRow and (Row>1) then

   Rows[Row].Assign(Rows[Row-1])

else

   Rows[Row].Assign(UresStrings(Rows[Row]));

Rows[Row][0]:=IntToStr(Row)+'*';

end else NewRec;

end;

 

procedure TSDFDataGrid.DeleteRec;

var i:longint;

begin

If (RowCount>2) then begin

   If (Row<RowCount-1) then

   For i:=Row to RowCount-2 do begin

       Rows[i+1][0]:=IntToStr(i);

       Rows[i].Assign(Rows[i+1]);

   end;

   RowCount:=RowCount-1

end else Rows[1].Assign(UresStrings(Rows[1]));

end;

 

procedure TSDFDataGrid.KeyDown(var Key: Word; Shift: TShiftState);

begin

Case Key of

VK_INSERT : InsertRec;

VK_DELETE : DeleteRec;

VK_DOWN   : If Row=RowCount-1 then NewRec;

end;

inherited KeyDown(Key,Shift);

end;

 

procedure TSDFDataGrid.SaveToListFile(fn:string;delimeiter:string;tablo:boolean);

var i,j,k: longint;

  f: TEXTFILE;

  s,sor : string;

 

begin

Try

Screen.Cursor:=crHourGlass;

AssignFile(f,fn);

Rewrite(f);

 

   If tablo then begin

      WriteLn(f,';Filename : '+ UpperCase(CustomDataAccess.DataFileName));

      WriteLn(f,';Date     : '+ FormatDateTime(ShortDateFormat,now));

      WriteLn(f,';Program  : StellaSoft Sequential DataFile Explorer ');

      WriteLn(f,';');

      WriteLn(f,';Record structure:');

      For i:=1 to ColCount-1 do  begin {Fejléc kíírás}

          WriteLn(f,';'+Format('%3d',[i])+' '+PadL(Szo(CustomDataAccess.RecordStructure[i-1],1),' ',20)

                                     +' = '+Szo(CustomDataAccess.RecordStructure[i-1],3));

      end;

      WriteLn(f,';');

      sor := ';';

      For i:=1 to ColCount-1 do  begin {Fejléc kíírás}

          k:=CustomDataAccess.ColSearch(Cells[i,0]);

          Sor := sor + PadL(Cells[i,0],' ',CustomDataAccess.DataStru[k].DisplayWidth)+' ';

      end;

          WriteLn(f,sor);

          WriteLn(f,';'+Replicate('_',Length(sor)-1));

   end;

 

   For i:=1 to RowCount-1 do begin

      For j:=1 to ColCount-1 do begin

          k:=CustomDataAccess.ColSearch(Cells[j,0]);

          If tablo then begin

             s:=Alltrim(Cells[j,i]);

             If k>-1 then begin

             If CustomDataAccess.DataStru[k].Justify=taLeftJustify then

               begin

                  If Pos(#0,s)<>0 then s:=Copy(s,1,Pos(#0,s));

                  s:= Padl(s,' ',CustomDataAccess.DataStru[k].DisplayWidth);

               end

             else

                  s:= PadR(s,' ',CustomDataAccess.DataStru[k].DisplayWidth);

             Write(f,s+' ');

             end;

          end else begin

             s := Alltrim(Cells[j,i]);

             If j<ColCount-1 then s := s + delimeiter;

             Write(f,s);

          end;

      end;

      WriteLn(f,'');

   end;

finally

CloseFile(f);

Screen.Cursor:=crDefault;

end;

end;

 

procedure TSDFDataGrid.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (AComponent = CustomDataAccess)

then CustomDataAccess := nil;

end;

 

{ ------------------ TSDFStructureGrid ---------------- }

 

constructor TSDFStructureGrid.Create(AOwner:TComponent);

var i:integer;

begin

   inherited Create(AOwner);

   DefaultRowHeight := 16;

   RowCount:=2;

   FixedRows:=1;

   ColCount:=6;

   FixedCols:=1;

   Cells[1,0]:='Field name';

   Cells[2,0]:='Type';

   Cells[3,0]:='Length';

   Cells[4,0]:='Disp.Width';

   Cells[5,0]:='Visible';

end;

 

destructor TSDFStructureGrid.Destroy;

begin

   inherited Destroy;

end;

 

procedure TSDFStructureGrid.SetCustomDataAccess(Value:TCustomDataAccess);

begin

If Value<>FCustomDataAccess then begin

   FCustomDataAccess:=Value;

   If FCustomDataAccess<>nil then

   GridStruFeltolt(Value.DataStru,Value.DataStruCount);

end;

end;

 

procedure TSDFStructureGrid.Recall;

begin

If FCustomDataAccess<>nil then

GridStruFeltolt(CustomDataAccess.DataStru,CustomDataAccess.DataStruCount);

invalidate;

end;

 

{A truktúrát kielemezve feltölti a TSDFAccess RecordStructure-t}

procedure TSDFStructureGrid.Execute;

var i,k: Longint;

  sor,tipus : string;

  stl: TStringList;

begin

If FCustomDataAccess<>nil then

If Assigned(FCustomDataAccess) then begin

Try

stl:=TStringList.Create;

For i:=1 to RowCount-1 do begin

    tipus := Cells[2,i];

    sor   := Padl(Cells[1,i],' ',20)+' = '+tipus;

    If Pos(UpperCase(tipus),'STRING')>0 then

       sor := sor+'['+IntToStr(StrToInt(Cells[3,i])-1)+']'

    else

       sor := sor+'['+IntToStr(StrToInt(Cells[3,i]))+']';

    stl.Add(sor);

end;

finally

For i:=1 to RowCount-1 do begin

    k:=CustomDataAccess.ColSearch(Cells[1,i]);

    If k>-1 then begin

       CustomDataAccess.DataStru[k].DisplayWidth:=StrToInt(Cells[4,i]);

       CustomDataAccess.DataStru[k].Visible:=Cells[5,i]<>'';

    end;

end;

CustomDataAccess.RecordStructure:=stl;

Recall;

stl.Free;

end;

end;

end;

 

procedure TSDFStructureGrid.Clear;

begin

RowCount:=1;

ColCount:=5;

FixedCols:=1;

Newrec;

FixedRows:=1;

end;

 

{A struktúra leíró alapján a grid oszlopszámát és fejléc adatait beállítja

 count:    mezők száma}

procedure TSDFStructureGrid.GridStruFeltolt(DSA:TDataStruArray;count:integer);

var i,n,h1,h2: integer;

  cur : TCursor;

begin

Try

Try

cur := Screen.Cursor;

Screen.Cursor := crHourGlass;

If Count<2 then Count:=1;

RowCount := count+1;

FixedRows:=1;

For i:=1 to Count do begin

    Cells[1,i]   := DSA[i].FieldName;

    Cells[2,i]   := DTypes[Ord(DSA[i].FieldType)];

    Cells[3,i]   := IntToStr(DSA[i].FieldLength);

    Cells[4,i]   := IntToStr(DSA[i].DisplayWidth);

    Cells[5,i]   := BoolToStr(DSA[i].Visible,'*','');

    Cells[0,i]   := IntToStr(i);

end;

invalidate;

except

RowCount := RowCount+1;

end;

finally

Screen.Cursor:=cur;

end;

end;

 

procedure TSDFStructureGrid.NewRec;

begin

RowCount:=RowCount+1;

Rows[RowCount-1]:=UresStrings(Rows[RowCount-1]);

  Cells[3,RowCount-1]:='0';

  Cells[0,RowCount-1]:=IntToStr(RowCount-1);

{  If RowCount-Toprow>VisibleRowCount then TopRow:=RowCount-VisibleRowCount;}

Row:=RowCount-1; Col:=1;

end;

 

procedure TSDFStructureGrid.InsertRec;

var i:longint;

begin

If FCustomDataAccess<>nil then

If RowCount>1 then begin

RowCount := RowCount+1;

If RowCount>2 then begin

   For i:=RowCount-1 downto Row do begin

       Rows[i].Assign(Rows[i-1]);

       CustomDataAccess.Datastru[i]:=CustomDataAccess.Datastru[i-1];

       Rows[i][0]:=IntToStr(i);

   end;

end;

Rows[Row]:=UresStrings(Rows[Row]);

Rows[Row][0]:=IntToStr(Row);

Rows[Row][3]:='0';

end else NewRec;

end;

 

procedure TSDFStructureGrid.DeleteRec;

var i:longint;

begin

If (RowCount>2) then begin

   If (Row<RowCount-1) then

   For i:=Row to RowCount-2 do begin

       Rows[i+1][0]:=IntToStr(i);

       Rows[i].Assign(Rows[i+1]);

   end;

   RowCount:=RowCount-1

end else Rows[1].Assign(UresStrings(Rows[1]));

end;

 

procedure TSDFStructureGrid.KeyDown(var Key: Word; Shift: TShiftState);

begin

Case Key of

VK_INSERT : InsertRec;

VK_DELETE : DeleteRec;

VK_DOWN   : If Row=RowCount-1 then NewRec;

end;

inherited KeyDown(Key,Shift);

end;

 

procedure TSDFStructureGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

inherited MouseDown(Button, Shift, x, y);

end;

 

procedure TSDFStructureGrid.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (AComponent = CustomDataAccess)

then CustomDataAccess := nil;

end;

 

{

procedure TSDFStructureGrid.STRUMODIFY(var Message: TMessage);

begin

  GridStruFeltolt(FCustomDataAccess.DataStru,FCustomDataAccess.DataStruCount);

  inherited;

end;

}

Function UresStrings(t:TStrings): TStrings;

var i:longint;

begin

Result:=TStringList.create;

Result.Assign(t);

For i:=1 to Result.Count-1 do Result[i]:='';

end;

 

end.