delphi 建表处理工具

unit UcreateTableTool;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
  cxContainer, cxEdit, dxSkinsCore, dxSkinsDefaultPainters, cxTextEdit, cxMemo,
  StdCtrls, cxSplitter, ExtCtrls, QRExport, TeEngine, TeeURL, TeeExcelSource,
  ExtDlgs, cxMaskEdit, cxButtonEdit, cxGraphics,ComObj;

type
  Tfrmcreatetabletool = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    right: TcxMemo;
    Button1: TButton;
    choosefile: TcxButtonEdit;
    OpenTextFileDialog1: TOpenTextFileDialog;
    SaveDialog1: TSaveDialog;
    edtdbname: TcxTextEdit;
    edttablename: TcxTextEdit;
    edtsheetcounts: TcxTextEdit;
    Label1: TLabel;
    Label2: TLabel;
    comboxtablenames: TComboBox;
    btnaddfield: TButton;
    edtfieldname: TcxTextEdit;
    edttype: TcxTextEdit;
    edtremark: TcxTextEdit;
    procedure Button1Click(Sender: TObject);
    procedure choosefilePropertiesButtonClick(Sender: TObject;
      AButtonIndex: Integer);
    procedure comboxtablenamesChange(Sender: TObject);
    procedure btnaddfieldClick(Sender: TObject);
  private
    { Private declarations }
    sqlstr1,sqlstr2,sqlstrs3,sqlstr4,sqlstr5,sqlstr6:string;
  public
    { Public declarations }
  end;

var
  frmcreatetabletool: Tfrmcreatetabletool;
const const1 =   'USE [dbname] '+#13#10
                +'GO ' +#13#10
                +#13#10
                +'SET ANSI_NULLS ON ' +#13#10
                +'GO ' +#13#10
                +#13#10
                +'SET QUOTED_IDENTIFIER ON ' +#13#10
                +'GO' +#13#10
                +#13#10
                +'SET ANSI_PADDING ON' +#13#10
                +'GO';
const const2 = 'CREATE TABLE [dbo].[tablename](';
const const3 = '[columname] type ';
const const4 =  ' CONSTRAINT [PK_tablename] PRIMARY KEY CLUSTERED'+#13#10
               +'('+#13#10
               +'[columname] ASC '+#13#10
               +')WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]'+#13#10
               +') ON [PRIMARY]'
               +#13#10
               +'GO'+#13#10
               +#13#10
               +'SET ANSI_PADDING OFF '+#13#10
               +'GO';

const const5 = 'CONSTRAINT [DF_tablename_columname]  DEFAULT (value)';

const const6 = 'EXEC sys.sp_addextendedproperty @name=N''MS_Description'', @value=N''decription_value'' , @level0type=N''SCHEMA'',@level0name=N''dbo'', @level1type=N''TABLE'',@level1name=N''tablename'', @level2type=N''COLUMN'',@level2name=N''columname'''
               +#13#10+'GO';

implementation

{$R *.dfm}

{添加字段}
procedure Tfrmcreatetabletool.btnaddfieldClick(Sender: TObject);
var
  str1:String;
  str2:string;
  str3:string;
begin

   str1 :=   'USE [dbname] '+#13#10
           +'GO ' +#13#10;
   str1 := StringReplace(str1,'[dbname]',trim(edtdbname.Text), [rfReplaceAll,rfIgnoreCase]);
   if Pos(str1,right.Lines.Text)<=0 then
   begin
     right.Lines.Add(str1);
   end;
   str2 := 'ALTER TABLE [tablename] add [fieldname] [fieldtype] ';
   str2 :=  StringReplace(str2,'[tablename]',trim(edttablename.Text), [rfReplaceAll,rfIgnoreCase]);
   str2 :=  StringReplace(str2,'[fieldname]',trim(edtfieldname.Text), [rfReplaceAll,rfIgnoreCase]);
   str2 :=  StringReplace(str2,'[fieldtype]',trim(edttype.Text), [rfReplaceAll,rfIgnoreCase]);
   if Pos(str2,right.Lines.Text)<=0 then
   begin
     right.Lines.Add(str2);
   end;
   str3 := 'EXEC sys.sp_addextendedproperty @name=N''MS_Description'', '
               +'@value=N''[decription_value]'' , @level0type=N''SCHEMA'','
               +'@level0name=N''dbo'', @level1type=N''TABLE'',@level1name=N''[tablename]'', '
               +'@level2type=N''COLUMN'',@level2name=N''[columname]'''
            +#13#10+'GO';
   str3 :=  StringReplace(str3,'[decription_value]',trim(edtremark.Text), [rfReplaceAll,rfIgnoreCase]);
   str3 :=  StringReplace(str3,'[tablename]',trim(edttablename.Text), [rfReplaceAll,rfIgnoreCase]);
   str3 :=  StringReplace(str3,'[columname]',trim(edtfieldname.Text), [rfReplaceAll,rfIgnoreCase]);

   if Pos(str3,right.Lines.Text)<=0 then
   begin
     right.Lines.Add(str3);
   end;

end;

procedure Tfrmcreatetabletool.Button1Click(Sender: TObject);
var
  iRow,iRowCnt:integer;
  myexcel:OleVariant;
  col1,col2,col3,col4,col5:string;
  strDM:string;
begin
   sqlstr1 := '';
   sqlstr2 := '';
   sqlstr4 := '';
   sqlstrs3 := '';
   sqlstr6 := '';
   sqlstr5 := '';
   if not FileExists(choosefile.Text)  then
    //未发Excel路径
    begin
      ShowMessage('未发现表');
      exit;
    end;

    try
      myexcel := Createoleobject('Excel.Application');
    except
      ShowMessage('无法创建Excel对象，请确认是否正确安装Excel');
      Exit;
    end;

    right.Lines.Clear;
    sqlstr1 := StringReplace(const1,'dbname',edtdbname.Text,[rfReplaceAll,rfIgnoreCase]);
    right.Lines.Add(sqlstr1);
    sqlstr2 := StringReplace(const2,'tablename',edttablename.Text,[rfReplaceAll,rfIgnoreCase]);
    right.Lines.Add(sqlstr2);
    try
      myexcel.Workbooks.Open(choosefile.Text);
      myexcel.WorkSheets[edttablename.Text].activate;
      iRowCnt := 744110;
      strDM :='' ;
      for iRow:=2 to iRowCnt do
      begin
        if (Trim(myexcel.Cells[iRow,1].Value) = '')
           and (Trim(myexcel.Cells[iRow,2].Value) = '')
           and (Trim(myexcel.Cells[iRow,3].Value) = '')
           and (Trim(myexcel.Cells[iRow,4].Value) = '')
           and (Trim(myexcel.Cells[iRow,4].Value) = '') then break;  //说明行已经到尽头

        col1 := Trim(widestring(myexcel.Cells[iRow,1].Value));
        col2 := Trim(widestring(myexcel.Cells[iRow,2].Value));
        col3 := Trim(widestring(myexcel.Cells[iRow,3].Value));
        col4 := Trim(widestring(myexcel.Cells[iRow,4].Value));
        col5 := Trim(widestring(myexcel.Cells[iRow,5].Value));

        if iRow = 2 then
        begin
           sqlstr4 :=  StringReplace(const4,'tablename',edttablename.Text,
                        [rfReplaceAll,rfIgnoreCase]);
           sqlstr4 := StringReplace(sqlstr4,'columname',col1,
                        [rfReplaceAll,rfIgnoreCase]);
        end;

         sqlstrs3 :=  StringReplace(const3,'columname',col1,
                        [rfReplaceAll,rfIgnoreCase]);
         sqlstrs3 :=  StringReplace(sqlstrs3,'type',col2,
                        [rfReplaceAll,rfIgnoreCase]);

         if col3<>'' then
         begin
            sqlstr5 :=
            StringReplace(const6,'tablename',edttablename.Text,
                        [rfReplaceAll,rfIgnoreCase]);
            sqlstr5 :=
            StringReplace(sqlstr5,'columname',col1,
                        [rfReplaceAll,rfIgnoreCase]);
            sqlstr5 := StringReplace(sqlstr5,'decription_value',col3,
                        [rfReplaceAll,rfIgnoreCase])+#13#10;

            sqlstr6 := sqlstr6 + sqlstr5;
         end;

         if (col4 ='*') or (col4 = '主键')  then
         begin
           sqlstrs3 := sqlstrs3 +' NOT NULL ';
         end
         else
         begin
           sqlstrs3 := sqlstrs3 +'  NULL ';
         end;
         if col5<>'' then
         begin
            sqlstrs3 := sqlstrs3 + const5;
            sqlstrs3 :=  StringReplace(sqlstrs3,'tablename',edttablename.Text,
                        [rfReplaceAll,rfIgnoreCase]);
            sqlstrs3 :=  StringReplace(sqlstrs3,'columname',col1,
                        [rfReplaceAll,rfIgnoreCase]);
            sqlstrs3 :=  StringReplace(sqlstrs3,'value',col5,
                        [rfReplaceAll,rfIgnoreCase]);
         end;
         sqlstrs3 := sqlstrs3 +', ';
         right.Lines.add(sqlstrs3);
      end;


    finally
      myexcel.Quit;
    end;
    right.Lines.Add(sqlstr4);
    right.Lines.Add(sqlstr6);
end;

procedure Tfrmcreatetabletool.choosefilePropertiesButtonClick(Sender: TObject;
  AButtonIndex: Integer);
var
  myexcel:OleVariant;
  I:integer;
begin
  if OpenTextFileDialog1.Execute()  then
  begin
     choosefile.Text := OpenTextFileDialog1.FileName;
  end;

  if not FileExists(choosefile.Text)  then
  //未发Excel路径
  begin
    ShowMessage('未发现表');
    exit;
  end;

  try
    myexcel := Createoleobject('Excel.Application');
  except
    ShowMessage('无法创建Excel对象，请确认是否正确安装Excel');
    Exit;
  end;

   try
     myexcel.Workbooks.Open(choosefile.Text);
     edtsheetcounts.Text := IntToStr(myexcel.worksheets.count);
     comboxtablenames.Items.Clear;
     for I := 1 to myexcel.worksheets.count  do
     begin
        comboxtablenames.Items.Add(WideString(myexcel.Sheets[i].Name));
     end;
     comboxtablenames.ItemIndex := 0;
     edttablename.Text := comboxtablenames.Text;
   finally
      myexcel.Quit;
   end;


end;



procedure Tfrmcreatetabletool.comboxtablenamesChange(Sender: TObject);
begin
    edttablename.Text := comboxtablenames.Text;
end;

end.

1.操作界面