<% @ LANGUAGE="VBSCRIPT" CODEPAGE="936"%><%Option Explicitresponse.buffer=true Response.Expires = -1 Response.AddHeader "Pragma","no-cache" Response.AddHeader "cache-ctrol","no-cache"'build2004-11-20 V1.05%><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"><HTML><HEAD><TITLE>CooSel2.0 Access to SQLserver 数据库生迁脚本编写器 V1.05(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"><%'2004-11-18/'fix exec=0 =1 type'fix conv now() date() time() type'fix binary ole conv 不做导入'fix Asp代码生成dim enMode,UniCodeModedim DB_Name,ExtName,FileNamedim rs,CONN,CONNstr DB_Name=questStr("DB_Name") FileName=questStr("DB_Name") enMode=questStr("enMode") UniCodeMode=questStr("UniCodeMode") if not isnumeric(enMode) then enMode=0'2004-11-18 dim databaseName,darr,errinfo dim loginName dim loginPassword dim sapass errinfo="" databaseName=questStr("databaseName") loginName=questStr("loginName") loginPassword=questStr("loginPassword") sapass=questStr("sapass") if not checkchar(loginName) then errinfo=errinfo & "要生成的SQL数据库登陆名称含不合法字符\n" end if if not checkchar(databaseName) then errinfo=errinfo & "要生成的SQL数据库名称含不合法字符\n" end if if errinfo<>"" then GetAlert errinfo if databaseName="" and DB_Name<>"" then darr=split(DB_Name,"\") databaseName=split(darr(ubound(darr)),".")(0) end if'--------/ 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'2004-11-18Function CheckChar(testchar) CheckChar=true dim chars,i,j,charlen chars=testchar dim ichar ichar=array("=","\","(",")","/","%",chr(32),"?"," & ","$",";",",","'",chr(34),chr(9),chr(0),"*",">","<","|",":","#") charlen=len(chars) for i=0 to ubound(ichar) if instr(chars,ichar(i))>0 then CheckChar=false exit function end if nextEnd functionSUB GetAlert(errinfo) %> <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <HTML><HEAD><TITLE>CooSel GetAlert Error</TITLE> <META NAME="Generator" CONTENT="EditPlus"> <META NAME="Author" CONTENT="V37"></head> <body leftmargin="0" rightmargin="0" topmargin="0" bgcolor="#D4D0C8"> </BODY> </HTML> <SCRIPT LANGUAGE="JavaScript"> <!-- alert("<%=errinfo%>"); window.history.back(); //--> </SCRIPT><% if isObject(CONN) then closeDB response.endEnd SUBSub CloseDB CONN.close Set CONN=nothingEnd SubSub 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%> >Asp代码 <!-- <INPUT TYPE="radio" NAME="enMode" value="2" <%if enMode=2 then response.write "checked" end if%> >编写完后直接运行 --> <INPUT TYPE="checkbox" NAME="UniCodeMode" value="1" checked> 文本和备注按Unicode导入 </TD> </TR> <TR bgcolor=#D4D0C8> <TD align=right width=250>MDB数据库路径</TD> <TD><INPUT TYPE="text" NAME="DB_Name" value="<%=DB_Name%>" style="70%;"> </TD> </TR> <TR bgcolor=#D4D0C8> <TD align=right width=250>SQLserver登陆帐号(sa)</TD> <TD><INPUT TYPE="password" NAME="sapass" value="" style="30%;"> SQL数据库(sa)登陆密码,可以不用输入,生成完脚本再提供</TD> </TR> <TR bgcolor=#D4D0D8> <TD align=right width=250>导入SQL的后的数据库名</TD> <TD><INPUT TYPE="text" NAME="databasename" value="<%="myDatabase"%>" style="30%;"> </TD> </TR> <TR bgcolor=#D4D0D8> <TD align=right width=250>导入SQL的数据库登陆帐号</TD> <TD><INPUT TYPE="text" NAME="loginName" value="<%="my_login"%>" style="30%;"> </TD> </TR> <TR bgcolor=#D4D0D8> <TD align=right width=250>导入SQL的数据库登陆密码</TD> <TD><INPUT TYPE="password" NAME="loginPassword" value="<%="my_pass"%>" style="30%;"> </TD> </TR> <TR bgcolor=#667766><TD align=right height=10></TD><TD></TD></TR> <TR > <TD height=38></TD> <TD bgcolor=#D4D0C8> <INPUT TYPE="submit" value=" 确 定 " style="80;"></TD> </TR> <TR > <TD height=38></TD> <TD bgcolor=#D4D0C8> <li><<简介>> <li>For Access 数据库导入 SQLserver 的版本，生成的在SQL2000下执行的 SQL脚本，<br> 除了还原库结构，还同时将Access的数据导入 SQLserver <br> 由于SQLserver的视图不一样，Access能自动处理同名列，<br> 脚本生成对含Select *有同名列的联合查询作了自动转换，有可能需要对照重修改一下 <li>功能:可编写Access数据库的常用的主要对象,包括 <br> <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 ifEnd SUBSUB 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=TtempStr & "SUB CreateDB(DB_Name,NewDB_Name,loginName,loginPassword,sapass,DTS)" & vbcrlf TtempStr=TtempStr & "DIM CONN,CONNstr" & vbcrlf 'TtempStr=TtempStr & "CONNStr=""Provider=Microsoft.Jet.OLEDB.4.0;Data Source="" & DB_Name" & vbcrlf TtempStr=TtempStr & "CONNStr=""Provider=SQLOLEDB.1;Password='"" & sapass & ""';Persist Security InFso=true;User ID='sa';Initial Catalog='Master';Data Source='(local)';CONNect Timeout=30""" & vbcrlf TtempStr=TtempStr & "Set CONN=Server.CreateObject(""ADODB.Connection"")" & vbcrlf TtempStr=TtempStr & "CONN.open CONNStr" & vbcrlf & vbcrlf '2004-11-18 TtempStr=TtempStr & "CONN.execute(""Create Database ["" & NewDB_Name & ""]"")" & vbcrlf TtempStr=TtempStr & "CONN.close" & vbcrlf TtempStr=TtempStr & "CONNStr=""Provider=SQLOLEDB.1;Password='"" & sapass & ""';Persist Security InFso=true;User ID='sa';Initial Catalog='"" & NewDB_Name & ""';Data Source='(local)';CONNect Timeout=30""" & vbcrlf TtempStr=TtempStr & "CONN.open CONNStr" & vbcrlf & vbcrlf '2004-11-18 TtempStr=TtempStr & "CONN.execute(""exec sp_addlogin '"" & loginName & ""','"" & loginPassword & ""','"" & NewDB_Name & ""'"")" & vbcrlf TtempStr=TtempStr & "CONN.execute(""exec sp_adduser '"" & loginName & ""','"" & loginName & ""','db_owner'"")" & vbcrlf '-----/ elseif exec=0 then TtempStr=TtempStr & "Create Database [" & databaseName & "]" & vbcrlf & " go" & vbcrlf TtempStr=TtempStr & "use [" & databaseName & "]" & vbcrlf & " go" & vbcrlf & vbcrlf '2004-11-18 TtempStr=TtempStr & "exec sp_addlogin '" & loginName & "','" & loginPassword & "','" & databaseName & "'" & vbcrlf & " go" & vbcrlf TtempStr=TtempStr & "exec sp_adduser '" & loginName & "','" & loginName & "','db_owner'" & vbcrlf & " go" & 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="'" elseif exec=0 then 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 '编写数据导入 if exec=1 then TtempStr=TtempStr & "If DTS=1 then " & vbcrlf TtempStr=TtempStr & CreateOpenDataSource(TableStr,DB_Name,exec) if exec=1 then TtempStr=TtempStr & "End iF " & vbcrlf '编写表关系 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 & Add_aspExec() TtempStr=TtempStrHead & TtempStr & vbcrlf & "%" & ">" elseif exec=0 then TtempStr=TtempStr & "--=========================================================================" & vbcrlf & "--Access To SQL 数据库升迁脚本 by MiniAccess Edit V1.0 P2(V37 PaintBlue.Net 2004)" & vbcrlf & "--=========================================================================" & vbcrlf & vbcrlf TtempStr = TtempStr & vbCrLf & "--连接字串:CONNstr=""Provider=SQLOLEDB.1;Persist Security InFso=true;Data Source='(local)';Initial Catalog='" & databaseName & "';User ID='" & loginName & "';Password='" & loginPassword & "';CONNect Timeout=30""" & vbCrLf & 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=""70%;height:500px;"" wrap=""off"">" & server.Htmlencode(TtempStr) & "</textarea></center>",1End SUBfunction 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=tmpStrEnd FunctionFunction 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"),1End Functionfunction 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 ifend functionfunction 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=TmpStrEnd functionfunction CreatForeignSql(exec)dim colsdim FKtable,PK_cols,FK_cols,tmpStr,tmpStr1Set 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=tmpStrEnd FunctionFunction 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 ifSet 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=TmpStr1End Functionfunction 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 ifend functionSUB 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=nothingEnd 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 ifEnd 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=nothingend 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=arrend 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=arrend 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 If cols("index_name") <> tmpCol Then tmps = tmps & "," & cols("index_name") n = n + 1 End If tmpCol = cols("index_name") cols.movenext Wend cols.Filter = 0 cols.Close Set cols = Nothing getInxArr = Mid(tmps, 2)End Functionfunction 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=nothingend functionfunction 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=nothingend functionfunction 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=nothingend functionfunction 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=nothingend functionFunction GetIncrement(tableName,columnName) dim cat set cat=Server.CreateObject("ADOX.Catalog") cat.ActiveCONNection =CONNstr GetIncrement=cat.Tables("" & TableName & "").Columns("" & columnName & "").Properties("Increment") set cat=nothingend functionFunction GetSeed(tableName,columnName) dim cat set cat=Server.CreateObject("ADOX.Catalog") cat.ActiveCONNection =CONNstr GetSeed=cat.Tables("" & TableName & "").Columns("" & columnName & "").Properties("Seed") set cat=nothingend 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.closeEnd functionfunction datatypeStr(DATA_TYPE,CHARACTER_MAXIMUM_LENGTH) select case DATA_TYPE case 130 if CHARACTER_MAXIMUM_LENGTH=0 then if UniCodeMode="1" then datatypeStr="ntext" 'LongText else datatypeStr="text" 'LongText end if else if UniCodeMode="1" then datatypeStr="nvarchar(" & CHARACTER_MAXIMUM_LENGTH & ")" '双字节必须使用 bvarchar 否则导入后截断 else datatypeStr="varchar(" & CHARACTER_MAXIMUM_LENGTH & ")" '双字节必须使用 bvarchar 否则导入后截断 end if 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 'AUTOINCREMENTend functionfunction defaultStr(DATA_TYPE,COLUMN_DEFAULT,exec) if isNull(COLUMN_DEFAULT) then defaultStr="" exit function end if dim splitchar if exec=1 then splitchar="""""" elseif exec=0 then splitchar="""" end if COLUMN_DEFAULT = defaultStrfilter(COLUMN_DEFAULT) select case DATA_TYPE case 130 COLUMN_DEFAULT=replace(COLUMN_DEFAULT,"""",splitchar) defaultStr=" Default ('" & COLUMN_DEFAULT & "')" Case 11 If LCase(COLUMN_DEFAULT) = "true" Or LCase(COLUMN_DEFAULT) = "on" Or LCase(COLUMN_DEFAULT) = "yes" Then COLUMN_DEFAULT = 1 Else: COLUMN_DEFAULT = 0 End If defaultStr = " Default (" & COLUMN_DEFAULT & ")" case 128 defaultStr=" Default (0x" & COLUMN_DEFAULT & ")" 'or /同意词 DEC case 7 If LCase(COLUMN_DEFAULT) = "now()" Or _ LCase(COLUMN_DEFAULT) = "date()" Or _ LCase(COLUMN_DEFAULT) = "time()" 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 functionFunction defaultStrfilter(S) Do While Left(S, 1) = """" S = Mid(S, 2) Loop Do While Right(S, 1) = """" S = Left(S, Len(S) - 1) Loop Do While Left(S, 1) = "'" S = Mid(S, 2) Loop Do While Right(S, 1) = "'" S = Left(S, Len(S) - 1) Loop defaultStrfilter = SEnd FunctionFunction nullStr(IS_NULLABLE, tablename, columnName) If IS_NULLABLE Then If getPrimaryKey(tablename, columnName) = "" Then nullStr = " null " Else nullStr = " not null " End If Else nullStr = " not null " End IfEnd Function'断点调试 num=0 中断Sub rw(str,num) dim istr:istr=str dim inum:inum=num response.write str & "<br>" if inum=0 then response.endend subSUB 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 ifEnd SUB'=============================编写access sql 脚本============//Function questStr(Str) Str=request(Str) Str=replace(Str,"'","") Str=Replace(Str,Chr(0),"") Str=Replace(Str," ","") questStr=StrEnd FunctionFunction 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=nothingEnd FunctionSUB 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=nothingEnd SUBFunction Add_aspExec() dim S S = S & "call CreateSQLDB()" & vbCrlf S = S & vbCrlf S = S & "SUB Main()" & vbCrlf S = S & " Response.write(""<html><head></head><body topmargin=0><br><center><FORM METHOD=POST><table border=1><tr><td><table cellspacing=0 cellpadding=2 align=center border=0 width=""""600"""" style=""""font-size:9pt"""" bgcolor=#D4D0C8>"")" & vbCrlf S = S & " Response.write(""<tr bgcolor=#A4D0F8><td colspan=2 align=center style=""""font-size:9pt;color:#000000"""" height=30><b>Access To SQL server 导入</b>(CooSel2.0 CreateSQL脚本编写器创建 )</td></tr>"")" & vbCrlf S = S & " Response.write(""<tr bgcolor=#667766><td colspan=2 height=1></td></tr>"")" & vbCrlf S = S & " Response.write(""<tr><td align=right width=""""30%"""">Sa登陆密码:</td><td><input name=sapass type=password Value='" & sapass & "' style=""""70%;"""">(必须输入才能键库)</td></tr>"")" & vbCrlf S = S & " Response.write(""<tr bgcolor=#667766><td colspan=2 height=1></td></tr>"")" & vbCrlf S = S & " Response.write(""<tr><td align=right width=""""30%"""">要导入的Access数据库:</td><td><input name=DB_Name Value='" & DB_Name & "' style=""""70%;""""></td></tr>"")" & vbCrlf S = S & " " & vbCrlf S = S & " Response.write(""<tr><td align=right width=""""30%"""">新建SQL数据库名:</td><td><input name=NewDB_Name Value='" & databasename & "' style=""""70%;""""></td></tr>"")" & vbCrlf S = S & " Response.write(""<tr><td align=right>新建SQL数据库登陆名:</td><td><input name=loginName Value='" & loginName & "' style=""""70%;""""></td></tr>"")" & vbCrlf S = S & " Response.write(""<tr><td align=right>新建SQL数据库登陆密码:</td><td><input type=password name=loginPassword Value='" & loginPassword & "' style=""""70%;""""></td></tr>"")" & vbCrlf S = S & " " & vbCrlf S = S & " Response.write(""<tr><td align=right>是否导入MDB数据到SQL</td><td><input name=DTS type=radio Value='1' checked>是 <input name=DTS type=radio Value='0'>否 </td></tr>"")" & vbCrlf S = S & " Response.write(""<tr><td align=right></td><td><br><INPUT TYPE=submit name=CreateDB Value="""" 确 定 """"><br><br>注:如果有外键则只建库结构再导入数据可能会出错,要导入的数据库必须和原来的编写SQL脚本的数据库结构一致</td></tr>"")" & vbCrlf S = S & " Response.write(""</table></td></tr></table></FORM></center><body></html>"")" & vbCrlf S = S & "End SUB" & vbCrlf S = S & vbCrlf S = S & "SUB CreateSQLDB()" & vbCrlf S = S & " dim NewDB_Name,loginName,loginpassword,sapass,DB_Name,DTS,Tstr" & vbCrlf S = S & " NewDB_Name=questStr(""NewDB_Name"")" & vbCrlf S = S & " loginName=questStr(""loginName"")" & vbCrlf S = S & " loginpassword=questStr(""loginpassword"")" & vbCrlf S = S & " sapass=questStr(""sapass"")" & vbCrlf S = S & " DB_Name=questStr(""DB_Name"")" & vbCrlf S = S & " DTS=questStr(""DTS"")" & vbCrlf S = S & " if isNumeric(DTS) then " & vbCrlf S = S & " DTS=clng(DTS)" & vbCrlf S = S & " else DTS=0" & vbCrlf S = S & " end if" & vbCrlf S = S & " if DTS=0 then " & vbCrlf S = S & " Tstr=""创建完成"" " & vbCrlf S = S & " else Tstr=""创建完成,数据已经导入""" & vbCrlf S = S & " end if" & vbCrlf S = S & " if NewDB_Name<>"""" then" & vbCrlf S = S & " Call CreateDB(DB_Name,NewDB_Name,loginName,loginpassword,sapass,DTS)" & vbCrlf S = S & " response.write vbcrlf & Tstr & ""<br>连接字串:<br>CONNstr=""""Provider=SQLOLEDB.1;Persist Security InFso=true;Data Source='(local)';Initial Catalog='"" & NewDB_Name & ""';User ID='"" & loginName & ""';Password='"" & loginpassword & ""';CONNect Timeout=30""""<br>"" & vbcrlf" & vbCrlf S = S & " else" & vbCrlf S = S & " call main()" & vbCrlf S = S & " end if" & vbCrlf S = S & "End SUB" & vbCrlf S = S & vbCrlf S = S & "Function questStr(Str)" & vbCrlf S = S & " Str=request(Str)" & vbCrlf S = S & " Str=replace(Str,""'"","""")" & vbCrlf S = S & " Str=Replace(Str,Chr(0),"""")" & vbCrlf S = S & " Str=Replace(Str,"" "","""")" & vbCrlf S = S & " questStr=Str" & vbCrlf S = S & "End Function" & vbCrlf S = S & vbCrlf Add_aspExec=SEnd Function%><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>