ufrmmain.pas

面向对象数据库开发时

unit UFrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, UFrmBase, ComCtrls, ToolWin, CheckLst, ExtCtrls,
  Buttons, DB, ADODB;

type
  TFrmMain = class(TFrmBase)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    Panel1: TPanel;
    cbxDBName: TComboBox;
    Label1: TLabel;
    clbTable: TCheckListBox;
    Label2: TLabel;
    ToolButton2: TToolButton;
    Panel2: TPanel;
    ToolButton4: TToolButton;
    SaveDialog1: TSaveDialog;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    Panel3: TPanel;
    cbNote: TCheckBox;
    rdgFileType: TRadioGroup;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    ProgressBar1: TProgressBar;
    mmFile: TRichEdit;
    Panel4: TPanel;
    edtBaseClass: TEdit;
    Label3: TLabel;
    cbInsert: TCheckBox;
    cbAmend: TCheckBox;
    cbDelete: TCheckBox;
    cbSetFieldValues: TCheckBox;
    cbAutoID: TCheckBox;
    procedure ToolButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cbxDBNameChange(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure mmFileKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure rdgFileTypeClick(Sender: TObject);
  private
    { Private declarations }
    ClassInfoList, DBList, TableList: TStringList;
    BaseClassName: string;

    procedure IniSystem;
    //刷新数据库
    procedure RefreshDB;
    //读取数据库名称列表
    function ReadDBNameList: TStringList;
    //读取数据表名称列表
    function ReadTableNameList: TStringList;
    function TableToClassInfo(ATableName: string): TStrings;
    //取得SQLServer字段的类型，返回相应Delphi变量类型
    function GetColumnType(AType: integer): string;
    //取得SQLServer字段的类型，返回相应字符串
    function GetDBColumnType(AType: integer): string;
    //仅生成类信息
    procedure GenerateClassInfo;

    //生成Unit文件
    procedure GenerateUnitFile;
    procedure TableToClassInfo1(ATableName: string; var AClassList1, AClassList2: TStringList);
    //取得保存的文件名，没有扩展名
    function GetFileName(AFileName: string): string;
    //保存文件
    procedure SaveToFile(AList: TStringList = nil);
    //取取选择数据表的数量
    function GetSelTableCount(AclbTable: TCheckListBox): integer;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

uses UDM, UFrmConDBServer, USysPublic;

{$R *.dfm}

function TFrmMain.ReadDBNameList: TStringList;
begin
  DBList.Clear;
  with DM do
  begin
    qryTemp.Close;
    qryTemp.SQL.Text := 'SELECT name AS DBName FROM master.dbo.sysdatabases';
    qryTemp.Open;

    qryTemp.First;
    while not qryTemp.Eof do
    begin
      DBList.Add(qryTemp.FieldByName('DBName').AsString);
      qryTemp.Next;
    end;
    DBList.Sorted := True;
    Result := DBList;
  end;
end;

function TFrmMain.ReadTableNameList: TStringList;
begin
  TableList.Clear;
  with DM do
  begin
    qryTemp.Close;
    qryTemp.SQL.Text := 'select name as TableName from sysobjects where xtype=''U'' '
      + 'AND (name<>''dtproperties'' AND name<>''LoanBank'') ';
    qryTemp.Open;

    qryTemp.First;
    while not qryTemp.Eof do
    begin
      TableList.Add(qryTemp.FieldByName('TableName').AsString);
      qryTemp.Next;
    end;
    TableList.Sorted := True;
    Result := TableList;
  end;
end;

procedure TFrmMain.RefreshDB;
begin

end;

procedure TFrmMain.ToolButton1Click(Sender: TObject);
begin
  inherited;
  if ConnectDBServer then
  begin
    cbxDBName.Items := ReadDBNameList;
    //MessageBox(0, '数据库连接成功！', '错误', MB_OK);
  end
  else
    MessageBox(0, '数据库连接失败！', '错误', MB_OK);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  inherited;
  DBList := TStringList.Create;
  TableList := TStringList.Create;
  ClassInfoList := TStringList.Create;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  inherited;
  DBList.Free;
  TableList.Free;
end;

procedure TFrmMain.cbxDBNameChange(Sender: TObject);
begin
  inherited;
  with DM do
  begin
    ADOCon.Close;
    ADOCon.ConnectionString := ADOCon.ConnectionString
      + ';Initial Catalog=' + cbxDBName.Text;
    ADOCon.Open;
  end;

  clbTable.Items := ReadTableNameList;
end;

function TFrmMain.TableToClassInfo(ATableName: string): TStrings;
var
  FieldList, PropertyList: TStringList;
  ColumnName, ColumnType: string;
begin
  //字段列表
  FieldList := TStringList.Create;
  FieldList.Clear;

  //保存属性声明
  PropertyList := TStringList.Create;
  PropertyList.Clear;

  with DM do
  begin
    qryTemp.Close;
    qryTemp.SQL.Text := 'SELECT C.name as ColumnName, C.xtype AS ColumnType '
      + 'FROM sysobjects T,syscolumns C WHERE T.id =C.id AND T.xtype=''U'' '
      + 'AND T.name=''' + ATableName + '''';
    qryTemp.Open;

    qryTemp.First;
    FieldList.Add('  T' + ATableName + ' = class(' + BaseClassName + ')');
    FieldList.Add('  private');
    PropertyList.Add('  public' );
    while not qryTemp.Eof do
    begin
      ColumnName := qryTemp.FieldByName('ColumnName').AsString;
      {if (not cbAutoID.Checked) and (qryTemp.FieldByName('ColumnType').AsInteger = 108) then //自动编号字段
      begin
        qryTemp.Next;
        continue;
      end;}

      ColumnType := GetColumnType(qryTemp.FieldByName('ColumnType').AsInteger);
      if cbNote.Checked = False then
        FieldList.Add('    F' + ColumnName + ': ' + ColumnType + ';')
      else
        FieldList.Add('    F' + ColumnName + ': ' + ColumnType + ';'
          + GetDBColumnType(qryTemp.FieldByName('ColumnType').AsInteger));  

      PropertyList.Add('    property ' + ColumnName + ': '  + ColumnType + ';');
      qryTemp.Next;
    end;
    PropertyList.Add('  end;' );
    FieldList.Text := FieldList.Text + PropertyList.Text ;
    Result := FieldList;
  end;


  PropertyList.Free;
  //SetmethodList.Free;
end;

procedure TFrmMain.IniSystem;
begin
  BlankCount := 2;
end;

procedure TFrmMain.ToolButton2Click(Sender: TObject);
var
  i, iCount: integer;
begin
  if DM.ADOCon.Connected = False then
  begin
    MessageBox(Handle, '请先连接SQLServer服务器!', '提示', MB_OK);
    Exit;
  end;

  if cbxDBName.Text = '' then
  begin
    MessageBox(Handle, '请选择数据库名称！', '提示', MB_OK);
    Exit;
  end;

  iCount := 0;
  for i := 0 to clbTable.Items.Count - 1 do
  begin
    if clbTable.Checked[i] then
      inc(iCount);
  end;

  if iCount = 0 then
  begin
    MessageBox(Handle, '没有要选择的表，请先选择表！', '提示', MB_OK);
    Exit;
  end;

  BaseClassName := Trim(edtBaseClass.Text);
  case rdgFileType.ItemIndex of
    0: GenerateUnitFile;
    1: GenerateClassInfo;
  end;
end;

function TFrmMain.GetColumnType(AType: integer): string;
begin
  case AType of
    34: Result := 'TStream'; //image
    35: Result := 'string'; //text
    36: Result := ''; //uniqueidentifier
    48: Result := 'integer'; //tinyint
    56: Result := 'integer'; //int
    52: Result := 'integer'; //smallint
    58: Result := 'TDateTime'; //smalldatetime
    59: Result := 'real'; //real
    60: Result := 'real'; //money
    61: Result := 'TDate'; //datetime
    62: Result := 'real'; //float
    98: Result := 'TStream'; //sql_variant
    99: Result := 'string'; //ntext
    104: Result := 'boolean'; //bit
    106: Result := 'real'; //decimal
    108: Result := 'integer'; //numeric
    122: Result := 'real'; //smallmoney
    127: Result := 'Longint'; //bigint
    165: Result := 'TStream'; //varbinary
    167: Result := 'string'; //varchar
    173: Result := 'TStream'; //binary 二进制数据
    175: Result := 'char'; //char
    189: Result := 'Tdatetime'; //timestamp
    231: Result := 'string'; //nvarchar
    239: Result := 'string'; //nchar
    else
      Result := '';
  end;
end;

procedure TFrmMain.mmFileKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if (ssCtrl in Shift) and (Key = 65) then
  begin
    if Sender is TMemo then
      TMemo(Sender).SelectAll;
  end;  
end;

function TFrmMain.GetDBColumnType(AType: integer): string;
begin
  case AType of
    34: Result := ' //image';
    35: Result := ' //text';
    36: Result := ' //uniqueidentifier';
    48: Result := ' //tinyint';
    56: Result := ' //int';
    52: Result := ' //smallint';
    58: Result := ' //smalldatetime';
    59: Result := ' //real';
    60: Result := ' //money';
    61: Result := ' //datetime';
    62: Result := ' //float';
    98: Result := ' //sql_variant';
    99: Result := ' //ntext';
    104: Result := ' //bit';
    106: Result := ' //decimal';
    108: Result := ' //numeric';
    122: Result := ' //smallmoney';
    127: Result := ' //bigint';
    165: Result := ' //varbinary';
    167: Result := ' //varchar';
    173: Result := ' //binary'; //二进制数据
    175: Result := ' //char';
    189: Result := ' //timestamp';
    231: Result := ' //nvarchar';
    239: Result := ' //nchar';
    else
      Result := '';
  end;
end;

procedure TFrmMain.GenerateClassInfo;
var
  i: integer;
begin
  inherited;
  ClassInfoList.Clear;

  ProgressBar1.Max := GetSelTableCount(clbTable);
  ProgressBar1.Position := 0;