getfield.pas

特别方便的工具程序

unit GetField;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, DBTables, BDE, Grids, DBGrids;

type
  TGetFldForm = class(TForm)
    Button1: TButton;
    Table1: TTable;
    List1: TListBox;
    Comb1: TComboBox;
    Comb2: TComboBox;
    Comb3: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Comb1Change(Sender: TObject);
    procedure Comb3Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure ShowFields(T: TTable);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  GetFldForm: TGetFldForm;

implementation

{$R *.DFM}

procedure TGetFldForm.ShowFields(T: TTable);
var
  curProp: CURProps;
  pfldDes, pCurFld: pFLDDesc;
  i: Integer;
  MemSize: Integer;
  FieldList: string;
begin
  Check(DbiGetCursorProps(T.Handle, curProp));
  MemSize := curProp.iFields * SizeOf(FLDDesc);
  pfldDes := AllocMem(MemSize);
  List1.items.Clear;
  try
    pCurFld := pfldDes;
    DbiGetFieldDescs(T.Handle, pfldDes);
    I := 0;
    while (i < curProp.iFields) do
      with pCurFld^ do begin
        FieldList := szName +
          StringofChar(#32, 10 - Length(trim(szName))) +
          Format('(%4d,%4d)',
          [iUnits1, iUnits2]);
        List1.items.Add(Trim(FieldList));
        inc(pCurFld);
        inc(i);
      end;
  finally
    FreeMem(pfldDes, MemSize);
  end;
end;

procedure TGetFldForm.Button1Click(Sender: TObject);
begin
  Table1.Open;
  ShowFields(Table1);
  Table1.Close;
end;

procedure TGetFldForm.Comb1Change(Sender: TObject);
begin
  Table1.DatabaseName := Comb1.Text;
  Session.GetTableNames(Comb1.Text, '', true, false, Comb2.Items);
end;

procedure TGetFldForm.Comb3Change(Sender: TObject);
begin
  Table1.TableName := Comb2.Text;
  Table1.GetIndexNames(Comb3.Items);
end;


procedure TGetFldForm.FormCreate(Sender: TObject);
begin
//  Session.GetDriverNames(Comb1.Items);
  Session.GetDatabaseNames(Comb1.Items);
  Comb1.ItemIndex := -1;
end;

procedure TGetFldForm.Button2Click(Sender: TObject);
begin
  Close;
end;

end.