传入数据集,生成对应表的sql脚本

delphi的,传入数据集,生成他的sql脚本。

//根据数据源结构创建ACCESS表1:生成脚本
Function CreateAccessTable(dSource:TDataSet;
    sTableName:String; sIgnoreFields:Array of String):String;
Var SQL:TStringList;
    oField:TField;
    i, n:Integer;
    sF:String;
Begin
    Result:='';
    SQL:=TStringList.Create;        
    With SQL do
    Try
        n:=0;
        //
        SQL.Text:='Create Table '+sTableName+' ';
        SQL.Add('( ');
        For i:=0 to dSource.FieldCount-1 do Begin
            oField:=dSource.Fields[i];
            if IndexOfStrArray(oField.FieldName,sIgnoreFields)>=0 then Continue;
            //
            if n>0 then sF:=',' else sF:='';
            sF:=sF+oField.FieldName+' '+GetFieldTypeString(oField)+' Null';
            SQL.Add('    '+sF);
            Inc(n);
        End;
        //添加主键
        //sql.add(', Primary Key(sStoreID, sItemID) ');
        //结束
        SQL.Add(') ');
        //完成
        Result:=SQL.Text;
        SQL.Free;
    Except
        On E:Exception do Begin
            Try SQL.Free; Except End;
            Raise Exception.Create('[CreateAccessTable-1]创建ACCESS表'+sTableName+'出错!'+#13+E.Message);
        End;
    End;
End;
//创建ACCESS表,执行2
Function CreateAccessTable(dSource:TDataSet; Qry_Access:TAdoQuery; sTableName:String;
    sIgnoreFields:Array of String; lTryDropExist:Boolean=True):Boolean;  OverLoad;
label lbl_iProcEnd;
Var Qry:TAdoQuery;                    s, s2, sScript, sError:String;
    i:integer;
    L, lTrans:Boolean;
Begin
    Result:=False;                    Qry:=Qry_Access;
    With Qry do
    Try
        sError:='';
        //检查是否存在此表
        L:=TableExists(connection, sTableName);
        //删除原表,检查有无此表
        If lTryDropExist then begin
            Close;
            If lTryDropExist And ((Qry.ConnectionString='') And (Not Qry.Connection.InTransaction)) then Begin
                Connection.BeginTrans;
                lTrans:=True;
            End;
            //找到了,删除
            if L then Try DoSQL(Qry,'Drop Table '+sTableName);  Except On E:Exception do ; End;
          end
        else if L then begin                        //不用删除,已经有表了,忽略
            goto lbl_iProcEnd;
        end;
        //创建表
        sScript:=CreateAccessTable(dSource,sTableName,sIgnoreFields);
        if sScript='' then Raise Exception.Create('[CreateAccessTable-1-2]生成脚本出错!');
        SQL.Text:=sScript;
        {$IFDef DebugClipBoard} clipBoard.asText:=sql.text;   {$EndIF}    //调试
        ExecSQL;
        //
    lbl_iProcEnd:
        if lTrans then Connection.CommitTrans;
        Result:=True;
    Except
        On E:Exception do Begin
            if lTrans then Connection.RollbackTrans;
            sError:='[CreateAccessTable-2]执行ACCESS表'+sTableName+'创建出错!'+#13+E.Message;
        End;
    End;
    if sError<>'' then Raise Exception.Create(sError);    
End;
//创建Access数据库
Function CreateAccessDB(sFileName:String; sPassWord:String=''): Boolean;
Const //默认语言标志Locale Identifier=2057
    sOleLink='Provider=Microsoft.Jet.OLEDB.4.0;Locale Identifier=2057;Data Source= %s ;Jet OLEDB:Database Password= %s';
Var
    CreateAccess: OleVariant;
Begin
    Result := False;
    Try
        CreateAccess := CreateOleObject('ADOX.Catalog');
        CreateAccess.Create(Format(sOleLink,[sFileName,sPassWord]));
        CreateAccess:=null;
        Result := True;
    Except
        On E:Exception do Raise Exception.Create('[CreateAccessDB]创建MDB数据库'+sFileName+'出错!'+#13+E.message);
    End;
End;
//创建一个新字段
function createNewField(oDB:TDataSet; sFieldName:String; oType:TFieldType; nSize:integer=-1):TField;
var d:TDataSet;
begin
    result:=nil;            d:=oDB;     
    case oType of
        ftString    : result:=TStringField.Create(d);
        ftInteger   : result:=TIntegerField.Create(d);
        ftFloat     : result:=TFloatField.Create(d);
        ftBoolean   : result:=TBooleanField.Create(d);
        ftDateTime  : result:=TDateTimeField.Create(d);
    end;
    result.FieldName:=sFieldName;
    if nSize>0 then result.Size:=nSize;
    //result.SetFieldType(oType);
    //result.DefaultExpression:='';     //默认值
    //必须设置其所在数据集,放在最后一行不易出错
    result.DataSet:=d;
end;
//返回字段的类型字符串
Function GetFieldTypeString(oField:TField):String;
Var n:Integer;    s:String;
Begin
    Result:='';
    Try
        n:=oField.Size;     s:='';
        //
        if oField is TStringField then Begin
            if n>nAccessStringMaxLength then
                s:='Memo'
            Else begin
                n:=nAccessStringMaxLength;
                s:='VarChar('+Inttostr(n)+')';
            End;
          End
        Else if oField is TLargeintField then
            s:='Int'
        Else if oField is TSmallIntField then
            s:='Int'
        Else if oField is TIntegerField then
            s:='Int'
        Else if oField is TNumericField then
            s:='Numeric(20,4)'
        Else if oField is TBooleanField then
            s:='Bit'
        Else if oField is TBlobField then
            s:='Image'
        Else if oField is TDateTimeField then
            s:='DateTime'
        Else if oField is TBinaryField then
            s:='Binary'
        Else if oField is TMemoField then
            s:='Memo'
        Else
            s:='VarChar(50)';
        //
        Result:=Trim(s);
    Except
        On E:Exception do Raise Exception.Create('[GetFieldTypeString]获取字段类型描述出错'+#13+E.Message);
    End;
End;

 

posted @ 2018-07-24 23:24  海宏软件  阅读(230)  评论(0编辑  收藏  举报