db_createsqle.asp

一个简单的ASP和ACCESS连接的范例,实现简单的生日登记显示功能.

	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="""&_"
	else 
		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 n>0 then tmpStr1=tmpStr1& splitchar1 & vbcrlf
		TmpStr1=TmpStr1&remchar&"["&rs("TABLE_NAME")&"]:"& 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
			else 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
		tmp=tmp&"	"&splitchar&"FROM OPENDATASOURCE('Microsoft.Jet.OLEDB.4.0','Data Source="""&DB_Name&"""')...["&rs("TABLE_NAME")&"]"
		if exec=0 then 
			tmp=tmp&vbcrlf&" go "& vbcrlf
		else 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
			else tmp="CONN.execute("""&tmp&""")"&vbcrlf&vbcrlf
			end if
			TmpStr1=TmpStr1&tmp&vbcrlf
		end if

		RS.MoveNext
	wend
	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
		tmpstr=rs(0).name
		for i=1 to rs.fields.count-1
			tmpstr=tmpstr&","&rs(i).name
		next
		GetColumnStr=tmpstr
	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 getInxArr(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 isUnique(TableName,IndexName)
	dim cols
	set cols=CONN.openSchema(12)
	cols.filter="Table_Name='"&TableName&"' and Index_Name='"&IndexName&"' and UNIQUE=True"
	if not cols.eof then
		isUnique=true
	else
		isUnique=false
	end if
	cols.filter=0
	cols.close
	set cols=nothing
end function


function isPrimaryKey(TableName,IndexName) 
	dim cols
	set cols=CONN.openSchema(12)
	cols.filter="Table_Name='"&TableName&"' and Index_Name='"&IndexName&"' and PRIMARY_KEY=True"
	if not cols.eof then
		isPrimaryKey=true
	else
		isPrimaryKey=false
	end if
	cols.filter=0
	cols.close
	set cols=nothing
end function

function getPrimaryKey(tableName,columnName)
	dim cols
	Set cols=CONN.openSchema(12)
	cols.filter="Table_Name='"&tableName&"' and Column_Name='"&columnName&"' and PRIMARY_KEY=True"
	if not cols.eof then
		getPrimaryKey=cols("INDEX_NAME")
		'isPrimaryKey=true
	else
		getPrimaryKey=""
		'isPrimaryKey=false
	end if
	cols.filter=0
	cols.close
	set cols=nothing
end function

function existPrimaryKey(tableName)
	dim cols
	Set cols=CONN.openSchema(12)
	cols.filter="Table_Name='"&tableName&"' and PRIMARY_KEY=True"
	if not cols.eof then
		existPrimaryKey=true
	else
		existPrimaryKey=false
	end if
	cols.filter=0
	cols.close
	set cols=nothing
end function

Function GetIncrement(tableName,columnName)
	dim cat
	set cat=Server.CreateObject("ADOX.Catalog") 
	cat.ActiveCONNection =CONNstr
	GetIncrement=cat.Tables(""&TableName&"").Columns(""&columnName&"").Properties("Increment") 
	set cat=nothing
end function

Function GetSeed(tableName,columnName)
	dim cat
	set cat=Server.CreateObject("ADOX.Catalog") 
	cat.ActiveCONNection =CONNstr
	GetSeed=cat.Tables(""&TableName&"").Columns(""&columnName&"").Properties("Seed") 
	set cat=nothing
end function

'通用,内部属性取得自动编号，对SQLserver Access都可以
Function GetAutoincrementCoulmnT(TableName)
	dim i
	rs.open "select * from ["&TableName&"] where 1=0",CONN,0,1
	for i=0 to rs.fields.count-1
		'if rs(i).Properties("isAutoIncrement")=True then
		if rs(i).Properties("isAutoIncrement")=True then
			GetAutoincrementCoulmnT=rs(i).name
			rs.close
			exit function
		end if	
	next
	rs.close
End function

function datatypeStr(DATA_TYPE,CHARACTER_MAXIMUM_LENGTH)
	select case DATA_TYPE 
	case 130 
	  if CHARACTER_MAXIMUM_LENGTH=0 then
		     datatypeStr="Text"	'LongText
	  else   
			datatypeStr="varchar("&CHARACTER_MAXIMUM_LENGTH&")"
	  end if
	case 17  datatypeStr="tinyint"
	case 2   datatypeStr="Smallint"
	case 3   datatypeStr="integer" 
	case 4   datatypeStr="real" 'or  /同意词 float4
	case 5 	 datatypeStr="float" 'or  /同意词 float8 
	case 6	 datatypeStr="money" 'or  /同意词  CURRENCY
	case 7	 datatypeStr="datetime"
	case 11  datatypeStr="bit"
	case 72  datatypeStr="UNIQUEIDENTIFIER"  'or  /同意词  GUID
	case 131 datatypeStr="DECIMAL"  'or  /同意词  DEC
	case 128 datatypeStr="BINARY"  'or  /同意词  DEC
	end select 'AUTOINCREMENT
end function

function defaultStr(DATA_TYPE,COLUMN_DEFAULT,exec)
	if isNull(COLUMN_DEFAULT) then
		defaultStr=""
		exit function
	end if
	dim splitchar
	if exec=1 then 
		splitchar=""""""
	else 
		splitchar=""""
	end if
	select case DATA_TYPE 
	case 130 
			if left(COLUMN_DEFAULT,1)="""" and right(COLUMN_DEFAULT,1)="""" then
				COLUMN_DEFAULT=mid(COLUMN_DEFAULT,2,len(COLUMN_DEFAULT)-2)
			end if
				COLUMN_DEFAULT=replace(COLUMN_DEFAULT,"""",splitchar)
			 defaultStr=" Default ('"&COLUMN_DEFAULT&"')"
	case 128 
		 defaultStr=" Default (0x"&COLUMN_DEFAULT&")"  'or  /同意词  DEC
	case 7
		if COLUMN_DEFAULT="Now()" then COLUMN_DEFAULT="getdate()"
		if left(COLUMN_DEFAULT,1)="#" then COLUMN_DEFAULT=replace(COLUMN_DEFAULT,"#","'")
		 defaultStr=" Default ("&COLUMN_DEFAULT&")"  'or  /同意词  DEC
	case else
		 defaultStr=" Default ("&COLUMN_DEFAULT&")"
	end select 
end function

function nullStr(IS_NULLABLE)
	if IS_NULLABLE then
		nullStr=" null "
	else
		nullStr=" not null "
	end if
end function

'断点调试 num=0 中断
Sub rw(str,num)
	dim istr:istr=str
	dim inum:inum=num
	response.write str&"<br>"
	if inum=0 then response.end
end sub

SUB CreateMDB()
	'改配置表名和列名
	dim cat,NewDB_Name
	NewDB_Name=request("DB_Name")
	if NewDB_Name<>"" then
		if instr(NewDB_Name,":\")=0 and instr(NewDB_Name,":/")=0 then
			NewDB_Name=Server.MapPath(NewDB_Name)
		end if 
		set cat=Server.CreateObject("ADOX.Catalog") 
		cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&NewDB_Name
		set cat=nothing 
		CreateDB(NewDB_Name)
		response.write vbcrlf&"OK"
	else
		set cat=nothing 
		call main()
	end if
End SUB
'=============================编写access sql 脚本============//
Function questStr(Str)
		Str=request(Str)
		Str=replace(Str,"'","")
		Str=Replace(Str,Chr(0),"")
		Str=Replace(Str," ","")
		questStr=Str
End Function

Function Ados_Read(FileName,CharsetType)
		dim adosText
			Ados_Read=""
		if instr(FileName,":\")=0 and instr(FileName,":/")=0 then
			FileName=Server.mappath(FileName)
		end if
		set adosText=Server.CreateObject("ADODB.Stream")
		adosText.mode=3
		adosText.type=2 'textStream
		adosText.charset=""&CharsetType&""
		adosText.open
		adosText.loadFromFile FileName
		Ados_Read=adosText.ReadText()
		adosText.close
	set adosText=nothing
End Function

SUB Ados_Write(TextString,FileName,CharsetType)
		dim adosText
		if instr(FileName,":\")=0 and instr(FileName,":/")=0 then
			FileName=Server.mappath(FileName)
		end if
		set adosText=Server.CreateObject("ADODB.Stream")
		adosText.mode=3
		adosText.type=2 'textStream
		adosText.charset=""&CharsetType&""
		adosText.open
		adosText.setEos
		adosText.WriteText(TextString)
		adosText.SaveToFile FileName,2
		adosText.close
	set adosText=nothing
End SUB
%>
<hr size=1>
<center>Create by <a href="http://www.paintblue.net/">V37 PaintBlue.Net 极点视觉</a> 2004-11-12</center>
<hr size=1>
<br>
<br>
</BODY>
</HTML>