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

📄 db_createsqle1.05.asp

📁 一款开发人员少不了的工具.ACCESS 转MSSQL的小工具.很好用一般人多要请别人转有了这个工具就轻松多了....开发人员多可以收藏
💻 ASP
📖 第 1 页 / 共 3 页
字号:
🔍
123 
        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 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
		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 '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=""""""
	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 function

Function 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 = S
End Function

Function 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 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

Function 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=""""width: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=""""width: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=""""width:70%;""""></td></tr>"")" & vbCrlf
	S = S & "	Response.write(""<tr><td align=right>新建SQL数据库登陆名:</td><td><input name=loginName Value='" & loginName & "' style=""""width:70%;""""></td></tr>"")" & vbCrlf
	S = S & "	Response.write(""<tr><td align=right>新建SQL数据库登陆密码:</td><td><input type=password name=loginPassword Value='" & loginPassword & "' style=""""width: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=S
End 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>
123

⌨️ 快捷键说明

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