gk.powersuche.org

Siehe auch:

ASP
Dieser VBScript Code konvertiert Access Datenbanken zu SQL Server Datenbanken via versa

Bitte kontaktieren Sie uns, falls Sie spezielle praktische Scripts brauchen, um Ihre Arbeit zu erleichtern.


<%@LANGUAGE="VBScript" %>
<%
''*********************************
'' Speichern Sie diese Datei als: convertdb.asp
''*********************************
Option Explicit
Server.ScriptTimeout = 3600
Response.Buffer = True
Response.Expires = 0
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdText = &H0001
Const adUseClient = 3
Const Jet4x = 5
Dim Browser
Dim BrowserType
Dim TextBoxSize
Dim TextAreaCols
Dim strError
Dim objFSO
Dim Catalog
Dim DbPathTo
Dim DBPathFrom
Dim TheColumn
Dim TxtArea
Dim Conn_1
Dim Conn_2
Dim Table
Dim TblName
Dim SQL
Dim strSQL
Dim RS_0
Dim FldName
Dim cType
Dim cSize
Dim RS_2
Dim strSQL1
Dim RS_1
Dim tbCount
Dim flCount
Dim rcCount
Dim FieldStr
Dim ValueStr
Dim varTemp
Dim RS_1FldNameName
Browser = Request.ServerVariables("HTTP_USER_AGENT")
If InStr(Browser, "MSIE") Then
     BrowserType = "Microsoft"
     TextBoxSize = 20
     TextAreaCols = 120
Else
     BrowserType = "Other"
     TextBoxSize = 14
     TextAreaCols = 65
End If
If Request("ServerAddress") <> "" And Request("SqlDbName") <> "" And Request("AccessDbName") <> "" And Request("DbPort") <> "" And Request("DbPassword") <> "" And Request("DbUsername") <> "" Then
     On Error Resume Next
     If Request("DbType") = "" Then
          CreateNewMDB Server.MapPath(Request("AccessDbName") & ".mdb"), Jet4x
          DbPathTo = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath(Request("AccessDbName") & ".mdb") & ";"
          DBPathFrom = "DRIVER=SQL Server; SERVER=" & Request("ServerAddress") & "; DATABASE=" & Request("SqlDbName") & "; PORT=" & Request("DbPort") & "; UID=" & Request("DbUsername") & "; PASSWORD=" & Request("DbPassword") & ";"
          TheColumn = " COLUMN"
     Else
          DBPathFrom = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath(Request("AccessDbName") & ".mdb") & ";"
          DbPathTo = "DRIVER=SQL Server; SERVER=" & Request("ServerAddress") & "; DATABASE=" & Request("SqlDbName") & "; PORT=" & Request("DbPort") & "; UID=" & Request("DbUsername") & "; PASSWORD=" & Request("DbPassword") & ";"
          TheColumn = ""
     End If
     TxtArea = vbcrlf & vbcrlf
     Set Conn_1 = Server.CreateObject("ADODB.Connection")
     Conn_1.Open DBPathFrom
     TxtArea = TxtArea & "DBPathFrom = "" & DBPathFrom & """ & vbcrlf
     TxtArea = TxtArea & "Set Conn_1 = Server.CreateObject("ADODB.Connection")" & vbcrlf
     TxtArea = TxtArea & "Conn_1.Open DBPathFrom" & vbcrlf & vbcrlf
     Set Conn_2 = Server.CreateObject("ADODB.Connection")
     Conn_2.Open DbPathTo
     TxtArea = TxtArea & "DbPathTo = "" & DbPathTo & """ & vbcrlf
     TxtArea = TxtArea & "Set Conn_2 = Server.CreateObject("ADODB.Connection")" & vbcrlf
     TxtArea = TxtArea & "Conn_2.Open DbPathTo" & vbcrlf & vbcrlf
     If Err = 0 Then
          Set Table = Conn_1.OpenSchema(20)
          tbCount = 0
          While Not Table.EOF
               TblName = Table("Table_Name")
               If UCase(Left(TblName, 4)) <> "MSYS" And UCase(Left(TblName, 3)) <> "SYS" And UCase(Left(TblName, 4)) <> "RTBL" And UCase(Left(TblName, 3)) <> "DTP" Then
                    On Error Resume Next
                    tbCount = tbCount + 1
                    If Request("DbType") = "" Then
                         SQL = "CREATE TABLE " & TblName & " (" & TblName & "ID Counter NOT NULL CONSTRAINT [pk" & TblName & "ID] PRIMARY KEY)"
                    Else
                         SQL = "CREATE TABLE " & TblName & " (" & TblName & "ID integer IDENTITY (1, 1) NOT NULL CONSTRAINT [pk" & TblName & "ID] PRIMARY KEY)"
                    End If
                    Conn_2.Execute(SQL)
                    TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
                    TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
                    strSQL = "SELECT * FROM " & TblName
                    Set RS_0 = Conn_1.Execute(strSQL)
                    flCount = 0
                    For Each FldName In RS_0.Fields
                         flCount = flCount + 1
                         If FldName.attributes <> 16 Then
                              cType = GetTypeName(FldName.Type)
                              cSize = FldName.DefinedSize
                              If cType = "varchar" Or cType = "nvarchar" Then
                                   cSize = " (" & cSize & ")"
                              Else
                                   cSize = ""
                              End If
                              SQL = "ALTER TABLE " & TblName & " ADD" & TheColumn & " " & FldName.Name & " " & cType & cSize & " NULL"
                              Conn_2.Execute(SQL)
                              TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
                              TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
                              Set RS_2 = Conn_1.openSchema(12)
                              Do While Not RS_2.EOF
                                   If RS_2("Table_Name") = TblName Then
                                        If RS_2("Column_Name") = FldName.Name Then
                                             If (RS_2("Unique") = True) Then
                                                  SQL = "ALTER TABLE " & TblName & " ALTER COLUMN " & FldName.Name & " " & cType & cSize & " NULL CONSTRAINT [idx" & FldName.Name & "] UNIQUE"
                                                  Conn_2.Execute(SQL)
                                                  TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
                                                  TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
                                             End If
                                        End If
                                   End If
                                   RS_2.MoveNext
                              Loop
                              RS_2.Close
                              Set RS_2 = Nothing
                         End If
                    Next
                    RS_0.Close
                    Set RS_0 = Nothing
                    If Request("TheValues") <> "" Then
                         On Error Resume Next
                         strSQL1 = "SELECT * FROM " & TblName & " ORDER BY " & TblName & "ID ASC"
                         Set RS_1 = Server.CreateObject("ADODB.Recordset")
                         RS_1.CursorLocation = adUseClient
                         RS_1.Open (strSQL1), Conn_1, adOpenForwardOnly, adLockReadOnly, adCmdText
                         rcCount = 0
                         If Not RS_1.EOF Then
                              Do Until RS_1.EOF
                                   rcCount = rcCount + 1
                                   FieldStr = " ("
                                   ValueStr = " VALUES ("
                                   For Each FldName In RS_1.Fields
                                        If FldName.attributes <> 16 Then
                                             cType = GetTypeName(FldName.Type)
                                             If cType = "integer" Or cType = "smallint" Or cType = "double" Or cType = "bigint" Then
                                                  RS_1FldNameName = RS_1(FldName.Name)
                                                  If RS_1FldNameName <> "" Then
                                                       FieldStr = FieldStr & FldName.Name & ", "
                                                       ValueStr = ValueStr & RS_1FldNameName & ", "
                                                  Else
                                                       FieldStr = FieldStr & FldName.Name & ", "
                                                       ValueStr = ValueStr & "0, "
                                                  End If
                                             Else
                                                  RS_1FldNameName = CheckString(RS_1(FldName.Name))
                                                  If cType = "bit" Or cType = "yesno" Then
                                                       If RS_1FldNameName = "True" Then
                                                            RS_1FldNameName = "1"
                                                       Else
                                                            RS_1FldNameName = "0"
                                                       End If
                                                  End If
                                                  If RS_1FldNameName <> "" Then
                                                       FieldStr = FieldStr & FldName.Name & ", "
                                                       ValueStr = ValueStr & "''" & RS_1FldNameName & "'', "
                                                  End If
                                             End If
                                        End If
                                   Next
                                   If Len(FieldStr) > 3 And Len(ValueStr) > 12 Then
                                        FieldStr = Mid(FieldStr, 1, Len(FieldStr) - 2) & ")"
                                        ValueStr = Mid(ValueStr, 1, Len(ValueStr) - 2) & ")"
                                        strSQL = "INSERT INTO " & TblName & FieldStr & ValueStr
                                        Conn_2.Execute(strSQL)
                                   End If
                                   RS_1.MoveNext
                              Loop
                         End If
                         RS_1.Close
                         Set RS_1 = Nothing
                    End If
               End If
               Table.MoveNext
          Wend
          Response.Write "<DIV ALIGN=""center""><BR><B><FONT COLOR=""#0000CC"">The Database has been converted successfully!</FONT></B></DIV>"
     End If
     Sub CreateNewMDB(FileName, Format)
          Set objFSO = CreateObject("Scripting.FileSystemObject")
          If objFSO.FileExists(FileName) Then
               Response.Write "<DIV ALIGN=""center""><BR><B><FONT COLOR=""#CC0000"">Database Already Exists.</FONT></B></DIV>" &vbcrlf
               Set objFSO = Nothing
               Exit Sub
          End If
          Set objFSO = Nothing
          If Err Then
               Exit Sub
          Else
               Set Catalog = Server.CreateObject("ADOX.Catalog")
               Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & "Jet OLEDB:Engine Type=" & Format & ";Data Source=" & FileName
               Set Catalog = Nothing
          End If
     End Sub
     Function CheckString(varValue)
          varTemp = varValue
          On Error Resume Next
          varTemp = Replace(varTemp, "''", "''")
          varTemp = Replace(varTemp, """", """")
          varTemp = Replace(varTemp, "%", chr(37))
          varTemp = Trim(varTemp)
          CheckString = varTemp
     End Function
     Private Function GetTypeName(ByVal sFieldType)
          Select Case sFieldType
               Case 0
               GetTypeName = "Empty"
               Case 16
               GetTypeName = "tinyint"
               Case 2
               GetTypeName = "smallint"
               Case 3
               GetTypeName = "int"
               Case 20
               GetTypeName = "bigint"
               Case 17
               GetTypeName = "tinyint"
               Case 18
               GetTypeName = "smallint"
               Case 19
               GetTypeName = "int"
               Case 21
               GetTypeName = "bigint"
               Case 4
               GetTypeName = "real"
               Case 5
               GetTypeName = "float"
               Case 6
               GetTypeName = "money"
               Case 14
               GetTypeName = "decimal"
               Case 131
               GetTypeName = "numeric"
               Case 11
               GetTypeName = "bit"
               Case 10
               GetTypeName = "Error"
               Case 132
               GetTypeName = "UserDefined"
               Case 12
               GetTypeName = "variant"
               Case 9
               GetTypeName = "IDispatch"
               Case 13
               GetTypeName = "IUnknown"
               Case 72
               GetTypeName = "uniqueidentifier"
               Case 7, 133, 134, 135
               GetTypeName = "datetime"
               Case 8
               GetTypeName = "BSTR"
               Case 129
               GetTypeName = "char"
               Case 200
               GetTypeName = "varchar"
               Case 201
               GetTypeName = "text"
               Case 130
               GetTypeName = "nchar"
               Case 202
               GetTypeName = "nvarchar"
               Case 203
               GetTypeName = "ntext"
               Case 128
               GetTypeName = "binary"
               Case 204
               GetTypeName = "sql_variant"
               Case 205
               GetTypeName = "image"
               Case 136
               GetTypeName = "Chapter"
               Case 64
               GetTypeName = "FileTime"
               Case 138
               GetTypeName = "Propvariant"
               Case 139
               GetTypeName = "varnumeric"
               Case &H2000
               GetTypeName = "Array"
          Case Else
               GetTypeName = sFieldType
          End Select
     End Function
     Conn_1.Close
     Set Conn_1 = Nothing
     Conn_2.Close
     Set Conn_2 = Nothing
     TxtArea = TxtArea & vbcrlf
     TxtArea = TxtArea & "Conn_1.Close" & vbcrlf
     TxtArea = TxtArea & "Set Conn_1 = Nothing" & vbcrlf & vbcrlf
     TxtArea = TxtArea & "Conn_2.Close" & vbcrlf
     TxtArea = TxtArea & "Set Conn_2 = Nothing" & vbcrlf & vbcrlf
End If
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; Charset=windows-1254">
<TITLE>DATABASE CONVERTER</TITLE>
<META HTTP-EQUIV="DESCRIPTION" CONTENT="SQL To Access / Access To SQL - Database Converter">
<META HTTP-EQUIV="KEYWORDS" CONTENT="SQL, Access, Asp, Database Converter">
<META HTTP-EQUIV="Content-Language" CONTENT="EN">
<META HTTP-EQUIV="Expires" CONTENT="0">
<META NAME="Author" CONTENT="Cenk Yurtseven, www.yurtseven.org">
<STYLE TYPE="text/css">
BODY, TD, DIV, INPUT, TEXTAREA { font-family: MS Sans Serif, Arial, Verdana; font-size: 9pt }
</STYLE>
</HEAD>
<BODY BGCOLOR="#DFD9D0">
<%=strError %>
<FORM ACTION="convertdb.asp" METHOD="get">
<TABLE WIDTH="90%" BORDER="0" CELLSPACING="1" CELLPADDING="2" BGCOLOR="#FFF9F0" ALIGN="center">
<TR>
<TD WIDTH="100%" COLSPAN="4" BGCOLOR="#FFF9F0">
<BR>
<DIV ALIGN="center">
<B>Access To SQL / SQL To Access - DATABASE CONVERTER</B></DIV>
<BR>
</TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Database Name:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0">
<INPUT TYPE="text" NAME="SqlDbName" SIZE="<%=TextBoxSize %>"></TD>
<TD COLSPAN="2" ROWSPAN="5" BGCOLOR="#DFD9D0" WIDTH="50%" ALIGN="center" NOWRAP>Access Database Name:
<INPUT TYPE="text" NAME="AccessDbName" SIZE="<%=TextBoxSize %>"><B>.mdb</B> </TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Server Address:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="ServerAddress" VALUE="localhost" SIZE="<%=TextBoxSize %>"></TD>
</TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Username:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbUsername" VALUE="sa" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Password:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbPassword" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Port:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbPort" VALUE="1433" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>Convert:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0">
<INPUT TYPE="radio" NAME="DbType" VALUE="" CHECKED>SQL to Access</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%" NOWRAP>
<INPUT TYPE="radio" NAME="DbType" VALUE="1">Access to SQL</TD><TD ROWSPAN="2" BGCOLOR="#DFD9D0" WIDTH="25%" ALIGN="center"><INPUT TYPE="submit" VALUE="Convert Database"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>Converting Type:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>
<INPUT TYPE="radio" NAME="TheValues" VALUE="1" CHECKED>Structure and Data</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%" NOWRAP>
<INPUT TYPE="radio" NAME="TheValues" VALUE="">Structure only</TD></TR>
</TABLE></FORM>
<%
If Request("ServerAddress") <> "" And Request("SqlDbName") <> "" And Request("AccessDbName") <> "" And Request("DbPort") <> "" And Request("DbPassword") <> "" Then
%>
<DIV ALIGN="center"><FORM>
<B>SQL creating the database:</B>
<BR>
<TEXTAREA COLS="<%=TextAreaCols %>" ROWS="12" NAME="SQL"><%=TxtArea %></TEXTAREA>
</FORM></DIV>
<%
End If
%>
</BODY>
</HTML>



Haben Sie schon mal daran gedacht, eine eigene Suchmaschine zu besitzen, die Ihrem Unternehmen täglich hunderte von Besuchern schickt?
Eine Neue Epoche

Free Downloads




gk.powersuche.org

© 2024 GK Dienstleistungs UG

Cookies

Diese Website benutzt Cookies, um Ihnen ein besseres Weberlebnis zu garantieren.