⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 db_createsqle.asp

📁 一个简单的ASP和ACCESS连接的范例,实现简单的生日登记显示功能.
💻 ASP
📖 第 1 页 / 共 2 页
字号:
🔍
12 
<% @ LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%Option Explicit
response.buffer=true
	Response.Expires = -1
	Response.AddHeader "Pragma","no-cache"
	Response.AddHeader "cache-ctrol","no-cache"
	'rw asc("	"),1
	'rw asc(" "),1
%><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<TITLE>MiniAcces Editor1.0part2S Access to SQLserver 数据库生迁脚本编写器(V37 PaintBlue.Net 2004 Acp Code)</TITLE>
<META NAME="Generator" CONTENT="EditPlus">
<META NAME="Author" CONTENT="V37">
<META NAME="Keywords" CONTENT="PaintBlue.Net,PaintBlue">
<META NAME="Description" CONTENT="PaintBlue.Net">
<style>
table{	color: #000000;
		font-size: 9pt;
		FONT-FAMILY: "Tahoma","MS Shell Dlg";
		}
td	{	color: #000000;
		font-size: 9pt;
		}table{	color: #000000;
		font-size: 9pt;
		FONT-FAMILY: "Tahoma","MS Shell Dlg";
		}
body	{	color: #000000;
		font-size: 9pt;
		}
</style>
</HEAD>
<body bgCOLOR=eeeeee text="#000000" leftmargin="0" marginwidth="100%" topmargin="0" bottommargin="20">
<%
dim enMode
dim DB_Name,ExtName,FileName
dim rs,CONN,CONNstr
	DB_Name="/coosel2.0/data/mydb.mdb"
	DB_Name=questStr("DB_Name")
	FileName=questStr("DB_Name")
	enMode=questStr("enMode")
	if not isnumeric(enMode) then enMode=0
	
	if DB_Name<>"" then 	
		enMode=clng(enMode)
		if enMode=0 then
			ExtName=".Sql"
		else
			ExtName=".Asp"
		end if
		Call openDB(DB_Name)
		Call CreateSQL(DB_Name,enMode)
	else
		if DB_Name="" then DB_Name="data/mydb.mdb"
		Call Main()
	end if

Sub MAIN()
%>
	<style>
	.titlebar {
		FONT-WEIGHT: bold; FONT-SIZE: 12pt; FILTER: dropshadow(color=#333333, offx=1, offy=2); WIDTH: 100%; COLOR: #ffffff; FONT-FAMILY: Tahoma,Verdana, Arial, sans-serif; POSITION: relative; TOP: 1px
	}
	</style>
	<FORM METHOD=POST ACTION="?action=1" Name=DBform>
	<TABLE width="100%" cellspacing=0 border=0>
		<TR bgcolor=#D4D0C8>
			<TD  align=center height=32><a href=http://www.paintblue.net/ target=_blank><img src=http://www.paintblue.net/bbs/images/TitleLogo.gif border=0></a></td><td><span class=titlebar><font color=#ffffff><b>MiniAccess Editor V1.0 P3 (Access To SQLserver 数据升迁 脚本编写器)</b></font></span></TD>
		<td></td></TR>
	<TABLE align=center width="100%" cellspacing=1 cellpadding=3 border=0>
	</TABLE>
	<TABLE align=center width="100%" cellspacing=1 cellpadding=3 border=0>
	<TR  bgcolor=#667766><TD align=right  height=10></TD><TD></TD></TR>
	<TR bgcolor=#D4D0C8>
		<TD align=right><span id=a>编写模式</span></TD>
		<TD>
		<INPUT TYPE="radio" NAME="enMode" value="0" <%if enMode=0 then response.write "checked" end if%> >Sql文本
		<INPUT TYPE="radio" NAME="enMode" value="1" <%if enMode=1 then response.write "checked" end if%> disabled>Asp代码(暂时无效)
		</TD>
	</TR>
	<TR bgcolor=#D4D0C8>
		<TD align=right width=250>数据库路径</TD>
		<TD><INPUT TYPE="text" NAME="DB_Name" value="<%=DB_Name%>" style="width:70%;"> </TD>
	</TR>
	<TR  bgcolor=#667766><TD align=right  height=10></TD><TD></TD></TR>
	<TR >
		<TD height=38></TD>
		<TD bgcolor=#D4D0C8>&nbsp;&nbsp;<INPUT TYPE="submit" value=" 确 定 " style="width:80;"></TD>
	</TR>
	<TR >
		<TD height=38></TD>
		<TD bgcolor=#D4D0C8>&nbsp;&nbsp;
		<li><<简介>>
		<li>For Access 数据库导入 SQLserver 的版本，生成的在SQL2000下执行的 SQL脚本，<br>&nbsp;&nbsp;&nbsp;&nbsp;除了还原库结构，还同时将Access的数据导入 SQLserver
			<br>&nbsp;&nbsp;&nbsp;&nbsp;由于SQLserver的视图不一样，Access能自动处理同名列，<br>&nbsp;&nbsp;&nbsp;&nbsp;脚本生成对含Select *有同名列的联合查询作了自动转换，有可能需要对照重修改一下
		<li>功能:可编写Access数据库的常用的主要对象,包括 <br>&nbsp;&nbsp;&nbsp;&nbsp;<b>表,视图,索引,约束,包括 默认值,主键,自动编号,外键</b>(表关系)
		<li>编写完自动保存为原数据库名+相应扩展的文件
		<li>Asp模式可直接生成带表单输入的可执行的Asp文件,用生成的Asp文件即可生成新的数据库
		<li>Sql模式可直接生成纯Sql语句文本</li><br><br></TD>
	</TR>
	</Table>
	</FORM>
<%
End SUB
'====MiniAcces Editor1.0part2 Access SQL脚本编写器(V37 PaintBlue.Net 2004 Acp Code)=========

SUB openDB(DB_Name)
		if inStr(DB_Name,":/")=0 and inStr(DB_Name,":\")=0 then 
			DB_Name=server.mappath(DB_Name)
		end if
		Set CONN = Server.CreateObject("ADODB.CONNection")
	on error resume next	
		CONN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&DB_Name
		if err.number<>0 then
			rw "数据库打开失败,错误为:"&err.description,0
			err.clear
		else
			Set rs=Server.CreateObject("adodb.recordSet")
		end if
End SUB

SUB CreateSQL(DB_Name,exec)
	'创建模式
	'exec = 0 : 生成SQL语句
	'exec = 1 : 生成Asp程序
	dim tbls,tabsArr,ub,I,TtempStr,TtempStrHead,remchar
	dim TableStr
	if exec=1 then
		TtempStrHead="<"&"% @ LANGUAGE=""VBSCRIPT""%"&">"&vbcrlf
		TtempStrHead=TtempStrHead&"<"&"%Option Explicit"&vbcrlf
		TtempStrHead=TtempStrHead&"response.buffer=true"&vbcrlf&vbcrlf
		TtempStrHead=TtempStrHead&"'========================================================================="&vbcrlf&"'Access 数据库 SQL 脚本生成 by MiniAccess Edit V1.0 P2(V37 PaintBlue.Net 2004 Asp Code)"&vbcrlf&"'========================================================================="&vbcrlf&vbcrlf
	end if
	if instr(DB_Name,":\")=0 and instr(DB_Name,":/")=0 then
			DB_Name=Server.MapPath(DB_Name)
	end if 
			CONNstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DB_Name
		Set CONN = Server.CreateObject("ADODB.Connection")
			CONN.Open CONNstr	
	
	'rs.open "[查询3]",CONN
	'for i=0 to rs.fields.count-1
	'	rw rs(i).name,1
	'next
	'response.end
	
	
	'编写CONN对象
	if exec=1 then
		TtempStr="SUB CreateDB(DB_Name)"&vbcrlf
		TtempStr=TtempStr&"DIM CONN"&vbcrlf
		TtempStr=TtempStr&"Set CONN=Server.CreateObject(""ADODB.Connection"")"&vbcrlf
		TtempStr=TtempStr&"CONN.open ""Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""&DB_Name"&vbcrlf&vbcrlf
	else
		dim databaseName,darr
		darr=split(DB_Name,"\")
		databaseName=split(darr(ubound(darr)),".")(0)
		TtempStr=TtempStr&"Create Database ["&databaseName&"]"&vbcrlf&" go"&vbcrlf
		TtempStr=TtempStr&"use ["&databaseName&"]"&vbcrlf&" go"&vbcrlf&vbcrlf
	end if

	'编写表/索引对象
	Set tbls=CONN.openSchema(20) 'adSchemaPrimaryKeys  
		tbls.Filter =" TABLE_TYPE='TABLE' " '筛选出有默认值，但允许null的列
	while Not tbls.eof
		TableStr=TableStr&"|"&tbls("TABLE_Name")
		tbls.movenext
	wend
		tbls.filter=0
		tbls.close
		set tbls=nothing
		TableStr=mid(TableStr,2)
		if exec=1 then
			remchar="'"
		else remchar="--"
		end if
	if TableStr<>"" then
		tabsArr=split(TableStr,"|")
		ub=ubound(tabsArr)
		for I=0 to ub
			TtempStr=TtempStr&remchar&"["&tabsArr(I)&"]:"& vbcrlf
			TtempStr=TtempStr&CreatTableSql(tabsArr(I),exec)&vbcrlf&vbcrlf
		next
	end if
	'编写数据导入
	TtempStr=TtempStr&CreateOpenDataSource(TableStr,DB_Name,exec)
	'编写表关系
	if TableStr<>"" then TtempStr=TtempStr&CreatForeignSql(exec)
	'编写视图
	TtempStr=TtempStr&CreatViewSql(exec)&vbcrlf

	if exec=1 then 
		TtempStr=replace(TtempStr,">","""&chr(62)&""")
		TtempStr=replace(TtempStr,"<","""&chr(60)&""")
		TtempStr=TtempStr&"End SUB"& vbcrlf&vbcrlf
		TtempStr=TtempStr&"	call CreateMDB()"&vbcrlf
		TtempStr=TtempStr&"SUB Main()"&vbcrlf
		TtempStr=TtempStr&"	Response.write(""<center><FORM METHOD=POST><input name=DB_Name Value="""""&Server.Htmlencode(DB_Name)&""""" style=""""width:70%;""""><br><INPUT TYPE=submit name=CreateDB Value=创建数据库></FORM></center>"")"&vbcrlf
		TtempStr=TtempStr&"End SUB" & vbCrlf& vbCrlf
		TtempStr=TtempStr& "SUB CreateMDB()" & vbCrlf
		TtempStr=TtempStr& "	dim cat,NewDB_Name" & vbCrlf
		TtempStr=TtempStr& "	NewDB_Name=request(""DB_Name"")" & vbCrlf
		TtempStr=TtempStr& "	if NewDB_Name<>"""" then" & vbCrlf
		TtempStr=TtempStr& "		if instr(NewDB_Name,"":\"")=0 and instr(NewDB_Name,"":/"")=0 then" & vbCrlf
		TtempStr=TtempStr& "			NewDB_Name=Server.MapPath(NewDB_Name)" & vbCrlf
		TtempStr=TtempStr& "		end if " & vbCrlf
		TtempStr=TtempStr& "		set cat=Server.CreateObject(""ADOX.Catalog"") " & vbCrlf
		TtempStr=TtempStr& "		cat.Create ""Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""&NewDB_Name" & vbCrlf
		TtempStr=TtempStr& "		set cat=nothing " & vbCrlf
		TtempStr=TtempStr& "		CreateDB(NewDB_Name)" & vbCrlf
		TtempStr=TtempStr& "		response.write vbcrlf&""OK""" & vbCrlf
		TtempStr=TtempStr& "	else" & vbCrlf
		TtempStr=TtempStr& "		set cat=nothing " & vbCrlf
		TtempStr=TtempStr& "		call main()" & vbCrlf
		TtempStr=TtempStr& "	end if" & vbCrlf
		TtempStr=TtempStr& "End SUB"
		TtempStr=TtempStrHead&TtempStr&vbcrlf&"%"&">"
	end if
		call Ados_Write(TtempStr,DB_Name&ExtName,"gb2312")
		rw "<br><img width=100 height=0>"&DB_Name&"的SQL脚本编写完成",1
		rw "<img width=100 height=0>已经保存文件为<b><font color=blue>"&DB_Name&ExtName&"</font></b>[<a href=?>返回</a>]:",1
		rw "<center><textarea style=""width:70%;height:500px;"" wrap=""off"">"&server.Htmlencode(TtempStr)&"</textarea></center>",1
End SUB

function CreatViewSql(exec)
	dim cols
	dim FKtable,PK_cols,FK_cols,tmpStr,tmpStr1,VIEW_DEFINITION
	Set cols=CONN.openSchema(23)
	cols.filter=0
	while not cols.eof
			tmpStr1=""

			VIEW_DEFINITION=replace(cols("VIEW_DEFINITION"),chr(13),"")
			VIEW_DEFINITION=replace(VIEW_DEFINITION,chr(10)," ")
			VIEW_DEFINITION=left(VIEW_DEFINITION,len(VIEW_DEFINITION)-1)
			VIEW_DEFINITION=TransView(cols("TABLE_NAME"),VIEW_DEFINITION)
			tmpStr1="Create view [dbo].["&cols("TABLE_NAME")&"] As "&VIEW_DEFINITION&""
			if exec=1 then tmpStr1="CONN.execute("""&tmpStr1&""")"
			tmpStr=tmpStr&vbcrlf&tmpStr1
			if exec=0 then tmpStr=tmpStr&vbcrlf&" go"
		cols.movenext
	wend
	cols.close
	set cols=nothing
	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="""&_"
	else 
		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&"] ("& 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")) 
		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

'' 编写表脚本
'	autoclumn=GetAutoincrementCoulmnT(tableName)
'	if exec=1 then
'		TmpStr="CONN.execute(""CREATE TABLE ["&tableName&"] (""&_"& vbcrlf
'	else
'		TmpStr="CREATE TABLE ["&tableName&"] ("& vbcrlf
'	end if
'	if autoclumn<>"" then
'		TmpStr=TmpStr & "	"&splitchar&"["& autoclumn &"] integer IDENTITY (1,"&GetIncrement(tableName,autoclumn)&") not null"
'		n=n+1
'	end if
'	
'	cols.filter="Table_name='"&tableName&"' and column_name<>'"&autoclumn&"'"
'	while not cols.eof  
'		if n>0 then TmpStr=TmpStr&"," & splitchar1 & vbcrlf
'		TmpStr=TmpStr & "	"&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")) 
'		cols.movenext
'		n=n+1
'	wend
'		TmpStr=TmpStr & splitchar1 & vbcrlf &"	"&splitchar&")"
'	cols.close
'	if exec=1 then 
'		TmpStr=TmpStr&""")"
'	end if

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

'ALTER TABLE [dbo].[BestList] WITH NOCHECK ADD 
'	CONSTRAINT [PK_BestList] PRIMARY KEY  CLUSTERED 
'	(
'		[BestID]
'	)  ON [PRIMARY] 
'go
	
	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
12

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -