db_createsqle1.05.asp

一款开发人员少不了的工具.ACCESS 转MSSQL的小工具.很好用一般人多要请别人转有了这个工具就轻松多了....开发人员多可以收藏

	CreatViewSql=tmpStr
End Function

Function TransView(viewName,Str)
	dim S
	S=lcase(Str)
	S=replace(S,chr(9)," ")
	S=replace(S,chr(32)," ")
	S=replace(S,chr(10)," ")
	S=replace(S,chr(13),"")
	S=replace(S,";"," ")
	do while instr(S,"  ")>0
		S=replace(S,"  "," ")
	loop
	S=replace(S,"count(*)","count(*) as count_x")
	if instr(lcase(S),"* from")=0 then
		TransView=S
	else
		TransView=replace(S,"* from",GetviewColumnStr(viewName) & " from")
	end if
	'rw GetviewColumnStr(viewName),1
	'rw instr(lcase(S),"* from"),1
End Function

function GetviewColumnStr(viewName)
	dim rs,i,tmpstr,arr,j,chg
	chg=false
	'rw "[" & viewName & "]",0
	set rs=server.createobject("adodb.recordset")
	'rw "select * from [" & tablename & "] where 1=0",1
	rs.open "[" & viewName & "]",conn
	dim tmp
	if rs.fields.count>0 then
		tmpstr=rs(0).name
		for i=1 to rs.fields.count-1
			tmpstr=tmpstr & "," & rs(i).name
		next
			tmpstr=lcase(tmpstr)
		arr=split(tmpstr,",")
		for i=0 to ubound(arr)
			tmp=arr(i)
			arr(i)="[" & arr(i) & "]"
			if instr(arr(i),".")>0 then
				arr(i)=replace(arr(i),".","].[")
				arr(i)=arr(i) & " as " & replace(tmp,".","_")
				chg=true
			end if
		next
		if chg then
			GetviewColumnStr=join(arr,",")
		else
			GetviewColumnStr="*"
		end if
	else
		GetviewColumnStr=""
	end if
end function

function CreatTableSql(byval tableName,exec)
	dim cols
	dim TmpStr,TmpStr1
	Set cols=CONN.openSchema(4)
	dim splitchar,splitchar1
	if exec=1 then 
		splitchar=""""
		splitchar1=""" & _"
	elseif exec=0 then 
		splitchar=""
		splitchar1=""
	end if
	cols.filter="Table_name='" & tableName & "'"
	if cols.eof then
	   exit function
	end if
	dim cat,autoclumn,n,chkPrimaryKey
	n=0

' 编写表脚本
	autoclumn=GetAutoincrementCoulmnT(tableName)
	
	tmpStr1="CREATE TABLE [dbo].[" & tableName & "] (" &  splitchar1 & vbcrlf
	dim autoclumnStr,columnStr
	if autoclumn<>"" then
		autoclumnStr=  "	" & splitchar & "[" &  autoclumn  & "] integer IDENTITY (1," & GetIncrement(tableName,autoclumn) & ") not null"
	end if
	
	n=0 
	do 
		n=n+1
		cols.filter="Table_name='" & tableName & "' and ORDINAL_POSITION=" & n
		if cols.eof  then exit do
		if n>1 then tmpStr1=tmpStr1 & "," & splitchar1 & vbcrlf
		if autoclumn=cols("Column_name") then
			tmpStr1=tmpStr1 & autoclumnStr 
		else
			tmpStr1=tmpStr1 & "	" & splitchar & "[" &  cols("Column_name")  & "] " &  lcase(datatypeStr(cols("DATA_TYPE"),cols("CHARACTER_MAXIMUM_LENGTH"))) &  defaultStr(cols("DATA_TYPE"),cols("COLUMN_DEFAULT"),exec) & nullStr(cols("IS_NULLABLE"), tablename, cols("Column_name")) 
		end if
		cols.movenext
	loop
		tmpStr1=tmpStr1 & splitchar1 & vbcrlf  & "	" & splitchar & ") ON [Primary]"
	cols.close
		if exec=0 then tmpStr1=tmpStr1 & splitchar1 & vbcrlf  & "" & splitchar & " go"
	if exec=1 then 
		TmpStr1="CONN.execute(""" & TmpStr1 & """)"
	end if
		tmpStr=tmpStr & vbcrlf & tmpStr1

' 编写索引脚本
	dim InxArr,i,kstr,j
	InxArr=split(getInxArr(tableName),",")
	Set cols=CONN.openSchema(12)

	for i=0 to ubound(InxArr)
		cols.filter="Table_name='" & tableName & "' and index_name='" & InxArr(i) & "'"
		kstr=""
		tmpStr1=""
		if Not isForeignIndex(tableName,InxArr(i)) then '外键索引不进行编写
			while not cols.eof
				kstr=kstr & ",[" & cols("column_name") & "] " & GetInxDesc(TableName,InxArr(i),cols("column_name"))
				cols.movenext
			wend
			if isPrimaryKey(TableName,InxArr(i)) then 
				tmpStr1=tmpStr1 & " Alter TABLE [dbo].[" & tableName & "] WITH NOCHECK ADD CONSTRAINT [PK_" & tableName & "] Primary Key Clustered (" & mid(kstr,2) & ")  ON [Primary] "
			else
				tmpStr1=tmpStr1 & "CREATE "
				if isUnique(TableName,InxArr(i)) then tmpStr1=tmpStr1 & "Unique "
				tmpStr1=tmpStr1 & "INDEX [" & InxArr(i) & "] on [dbo].[" & tableName & "](" & mid(kstr,2) & ") ON [Primary]"
			end if
			if exec=1 then tmpStr1="CONN.execute(""" & tmpStr1 & """)"
			if exec=0 then tmpStr1=tmpStr1 & vbcrlf & " go"
			tmpStr=tmpStr & vbcrlf & tmpStr1
		end if
	next
	cols.close
	cols.filter=0
	CreatTableSql=TmpStr
End function

function CreatForeignSql(exec)
dim cols
dim FKtable,PK_cols,FK_cols,tmpStr,tmpStr1
Set cols=CONN.openSchema(27)
cols.filter="PK_NAME<>Null"
	while not cols.eof
			tmpStr1=""
			tmpStr1="ALTER TABLE [" & cols("FK_TABLE_NAME") & "] " & _  
						"Add CONSTRAINT [" & cols("FK_NAME") & "] " & _  
						"FOREIGN KEY ([" & cols("FK_COLUMN_NAME") & "]) REFERENCES " & _
						"[" & cols("PK_TABLE_NAME") & "] ([" & cols("PK_COLUMN_NAME") & "]) "
			if cols("UPDATE_RULE")="CASCADE" then	tmpStr1=tmpStr1 & "ON UPDATE CASCADE "
			if cols("DELETE_RULE")="CASCADE" then	tmpStr1=tmpStr1 & "ON DELETE CASCADE "
			if exec=1 then tmpStr1="CONN.execute(""" & tmpStr1 & """)"
			tmpStr=tmpStr & vbcrlf & tmpStr1
			if exec=0 then tmpStr=tmpStr & vbcrlf & " go"
		cols.movenext
	wend
	cols.filter=0
	cols.close
	set cols=nothing
	CreatForeignSql=tmpStr
End Function

Function CreateOpenDataSource(TableStr,DB_Name,exec)
'SET IDENTITY_INSERT Co_admin ON
'go
'INSERT INTO dbo.Co_admin (id,username,password,MasterFlag,adduser)
'SELECT id,username,password,MasterFlag,adduser 
'FROM OPENDATASOURCE('Microsoft.Jet.OLEDB.4.0','Data Source="d:\www\lfgbox\coosel2.0\data\coosel.asa"')...[Co_admin]
'go
'SET IDENTITY_INSERT dbo.Co_admin OFF
'go
	dim splitchar,splitchar1,columnStr,rs,i,TmpStr1,tmp,remchar
	if exec=1 then
		remchar="'"
		splitchar=""""
		splitchar1=""" & _"
	elseif exec=0 then
		remchar="--"
		splitchar=""
		splitchar1=""
	end if
Set rs=CONN.openSchema(20)   
	rs.Filter ="TABLE_TYPE='TABLE'" 
	while not rs.EOF
		'rw server.htmlencode(rs("TABLE_NAME")),1
		columnStr=GetColumnStr(rs("TABLE_NAME"))
	  if columnStr<>"" then
		'if n>0 then tmpStr1=tmpStr1 &  splitchar1 & vbcrlf
		TmpStr1=TmpStr1 & remchar & "[" & rs("TABLE_NAME") & "]:" &  vbcrlf
		TmpStr1=TmpStr1 & "CONN.CommandTimeout = 600 " &  vbcrlf
		if GetAutoincrementCoulmnT(rs("TABLE_NAME"))<>"" then
			tmp="SET IDENTITY_INSERT [dbo].[" & rs("TABLE_NAME") & "] ON"
			if exec=0 then 
				tmp=tmp & vbcrlf & " go " &  vbcrlf
			elseif exec=1 then  
				tmp="CONN.execute(""" & tmp & """)" & vbcrlf
			end if
				TmpStr1=TmpStr1 & tmp & vbcrlf
		end if
		tmp="INSERT INTO [dbo].[" & rs("TABLE_NAME") & "] (" & columnStr & ") " &  splitchar1 & vbcrlf
		tmp=tmp & "	" & splitchar & "SELECT " & columnStr & " " &  splitchar1 & vbcrlf
		if exec=0 then 
			tmp=tmp & "	" & splitchar & "FROM OPENDATASOURCE('Microsoft.Jet.OLEDB.4.0','Data Source=" & splitchar & """" & DB_Name & """" & splitchar & "')...[" & rs("TABLE_NAME") & "]"
			tmp=tmp & vbcrlf & " go " &  vbcrlf
		elseif  exec=1 then
			tmp=tmp & "	" & splitchar & "FROM OPENDATASOURCE('Microsoft.Jet.OLEDB.4.0','Data Source=" & splitchar & """"" & DB_Name & """"" & splitchar & "')...[" & rs("TABLE_NAME") & "]"
			tmp="CONN.execute(""" & tmp & """)" & vbcrlf
		end if
		TmpStr1=TmpStr1 & tmp & vbcrlf
		if GetAutoincrementCoulmnT(rs("TABLE_NAME"))<>"" then
			tmp="SET IDENTITY_INSERT [dbo].[" & rs("TABLE_NAME") & "] Off"
			if exec=0 then 
				tmp=tmp & vbcrlf & " go " &  vbcrlf & vbcrlf
			elseif exec=1 then
				tmp="CONN.execute(""" & tmp & """)" & vbcrlf & vbcrlf
			end if
			TmpStr1=TmpStr1 & tmp & vbcrlf
	  	end if
       end if
		RS.MoveNext
	wend
	TmpStr1=TmpStr1 & "CONN.CommandTimeout = 30 " &  vbcrlf
	rs.filter=0
	rs.close
	set rs=nothing
	CreateOpenDataSource=TmpStr1
End Function

function GetColumnStr(tablename)
	dim rs,i,tmpstr
	set rs=server.createobject("adodb.recordset")
	'rw "select * from [" & tablename & "] where 1=0",1
	rs.open "select * from [" & tablename & "] where 1=0",conn
	if rs.fields.count>0 then
		for i=0 to rs.fields.count-1
			'rw rs(i).name & "_" & rs(i).type & "<br>",1
			if rs(i).type<>205 then tmpstr=tmpstr & "," & rs(i).name
		next
		if tmpstr<>"" then
			 GetColumnStr=mid(tmpstr,2)
		else GetColumnStr=""
		end if
	else
		GetColumnStr=""
	end if
end function

SUB Ac2SQLStr()
	dim rs
	TMPstr=""
Set rs=CONN.openSchema(20)   
	rs.Filter ="TABLE_TYPE='TABLE'" 
	while not rs.EOF
		TMPstr=TMPstr & "SELECT  * INTO [tmp_" & rs("TABLE_NAME") & "] FROM OPENDATASOURCE('Microsoft.Jet.OLEDB.4.0','Data Source=""d:\www\lfgbox\paintblue2.0f2\pbbs\database\paintbase#.asa""')...[" & rs("TABLE_NAME") & "]<br>"
		NN=NN+1
		RS.MoveNext
	wend
	rs.filter=0
	rs.close
	set rs=nothing
End SUB

'判断是否是外键索引
Function isForeignIndex(TableName,indexName)
	dim cols
	Set cols=CONN.openSchema(27)
	cols.filter="FK_TABLE_Name='" & TableName & "' and FK_NAME='" & indexName & "'"
	if Not cols.eof then
		isForeignIndex=true
	else
		isForeignIndex=false
	end if
End Function
'取得索引列的排序属性
function GetInxDesc(TableName,indexName,ColumnName)
	dim cat
	set cat=Server.CreateObject("ADOX.Catalog") 
	cat.ActiveCONNection =CONNstr
	if cat.Tables("" & TableName & "").Indexes("" & indexName & "").Columns("" & ColumnName & "").SortOrder=2 then
		GetInxDesc="Desc"
	else
		GetInxDesc=""
	end if
	set cat=nothing
end function
'取得列数组
function getColumArr(tableName)
	dim cols,arr(),n
	redim arr(-1)
	n=0
	redim arr(n)
	set cols=CONN.openSchema(4)
	cols.filter="Table_Name='" & tableName & "'"
	while not cols.eof
		redim Preserve arr(n)
		arr(n)=cols("column_name")
		cols.movenext
		n=n+1
	wend
	cols.filter=0
	cols.close
	set cols=nothing
	getColumArr=arr
end function
'取得索引数组
function getInxArr1(tableName)
	dim cols,arr(),n,tmpCol
	redim arr(-1)
	n=0
	set cols=CONN.openSchema(12)
	cols.filter="Table_Name='" & tableName & "'"
	while not cols.eof
		if cols("index_name")<>tmpCol then
			redim Preserve arr(n)
			arr(n)=cols("index_name")
			n=n+1
		end if
		tmpCol=cols("index_name")
		cols.movenext
	wend
	cols.filter=0
	cols.close
	set cols=nothing
	getInxArr=arr
end function

'取得索引数组
Function getInxArr(tablename)
    Dim cols
    Dim n
    Dim tmpCol
    Dim tmps
    n = 0
    Set cols = CONN.openSchema(12)
    cols.Filter = "Table_Name='" & tablename & "'"
    While Not cols.EOF