<% main() Sub main() Dim Query, Content, Rs Query = "SELECT name FROM sysobjects WHERE (xtype = 'U') AND (status >= 0) ORDER BY name" Query = "SELECT name FROM sysobjects" Query = Query & " WHERE (xtype = 'U') AND (status >= 0) AND ((name LIKE N'TC[1-9]%') OR (name LIKE N'TD[A-Z]%') OR (name LIKE N'TG[A-Z]%') OR (name LIKE N'TS[A-Z]%') OR (name LIKE N'TT[A-Z]%'))" Query = Query & " ORDER BY name" Set db = Server.CreateObject("ADODB.Connection") db.Open SQLConn Dim ii Set Content = OpenQuery(Query) Dim fso, fw, fr Set fso = CreateObject("Scripting.FileSystemObject") Response.Write("") Set fr = fso.OpenTextFile(Request.ServerVariables("APPL_PHYSICAL_PATH") & "system\fieldlist.txt", 1, True) Dim HtmlAll, HtmlRow, bFalse, HtmlFalse, WriteRow Dim ScriptFalse1, ScriptFalse2, ScriptFalse3, ScriptFalse4 Dim bTableFalseFlg bTableFalseFlg = 0 Do While Not(Content.BOF Or Content.EOF) Dim name name = Content.Fields("name") bTableFalseFlg = 0 Query = "SELECT * FROM " & name & " WHERE 1 = 0 " Set Rs = Server.CreateObject("ADODB.Recordset") Rs.open Query,db,3,1 For ii = 0 To Rs.Fields.Count - 1 bFalse = 0 HtmlRow = "" Dim tani Dim tmp2,tmp2s, jj tmp2s = Array("") Dim tmp1s tmp1s = Array("","","","","","","") Dim tmp If fr.AtEndOfStream = false Then tmp2 = fr.ReadLine tmp2s = split(tmp2, ":") End If tmp1s(0) = name tmp1s(1) = Rs.Fields(ii).Name tmp1s(2) = Rs.Fields(ii).Type tmp1s(3) = Rs.Fields(ii).Precision tmp1s(4) = Rs.Fields(ii).NumericScale tmp1s(5) = Rs.Fields(ii).DefinedSize tmp1s(6) = Rs.Fields(ii).Attributes Select Case Rs.Fields(ii).Type case 0 tmp1s(2) = "adEmpty" case 16 tmp1s(2) = "adTinyInt" case 2 tmp1s(2) = "smallint" case 3 tmp1s(2) = "int" case 20 tmp1s(2) = "adBigInt" case 17 tmp1s(2) = "adUnsignedTinyInt" case 18 tmp1s(2) = "adUnsignedSmallInt" case 19 tmp1s(2) = "adUnsignedInt" case 21 tmp1s(2) = "adUnsignedBigInt" case 4 tmp1s(2) = "adSingle" case 5 tmp1s(2) = "adDouble" case 6 tmp1s(2) = "money" case 14 tmp1s(2) = "adDecimal" case 131 tmp1s(2) = "adNumeric" case 11 tmp1s(2) = "adBoolean" case 10 tmp1s(2) = "adError" case 132 tmp1s(2) = "adUserDefined" case 12 tmp1s(2) = "adVariant" case 9 tmp1s(2) = "adIDispatch" case 13 tmp1s(2) = "adIUnknown" case 72 tmp1s(2) = "adGUID" case 7 tmp1s(2) = "adDate" case 133 tmp1s(2) = "adDBDate" case 134 tmp1s(2) = "adDBTime" case 135 tmp1s(2) = "datetime" case 8 tmp1s(2) = "adBSTR" case 129 tmp1s(2) = "adChar" case 200 tmp1s(2) = "varchar" case 201 tmp1s(2) = "adLongVarChar" case 130 tmp1s(2) = "adWChar" case 202 tmp1s(2) = "adVarWChar" case 203 tmp1s(2) = "adLongVarWChar" case 128 tmp1s(2) = "adBinary" case 204 tmp1s(2) = "adVarBinary" case 205 tmp1s(2) = "adLongVarBinary" case 136 tmp1s(2) = "adChapter" case 64 tmp1s(2) = "adFileTime" case 137 tmp1s(2) = "adDBFileTime" case 138 tmp1s(2) = "adPropVariant" case 139 tmp1s(2) = "adVarNumeric" End Select If UBound(tmp2s) >= 1 Then HtmlRow = HtmlRow & "" For jj = 0 To UBound(tmp2s) - 1 HtmlRow = HtmlRow & "" HtmlRow = HtmlRow & tmp2s(jj) HtmlRow = HtmlRow & "" Next End If For jj = 0 To 5 If UBound(tmp2s) >= jj Then HtmlRow = HtmlRow & "" If CStr(tmp2s(jj)) <> CStr(tmp1s(jj)) Then HtmlRow = HtmlRow & "" bFalse = 1 bTableFalseFlg = 1 End If HtmlRow = HtmlRow & tmp1s(jj) If tmp2s(jj) <> tmp1s(jj) Then HtmlRow = HtmlRow & "" End If HtmlRow = HtmlRow & "" End if WriteRow = WriteRow & tmp1s(jj) WriteRow = WriteRow & ":" Next WriteRow = WriteRow & vbCrLf HtmlRow = HtmlRow & "" HtmlRow = HtmlRow & vbCrLf If bTableFalseFlg = 1 Then If tmp2s(0) = tmp1s(0) Then ScriptFalse1 = ScriptFalse1 & "EXEC sp_rename '" & tmp1s(0) & "." & tmp1s(1) & "', 'tmp_" & tmp1s(1) & "', 'COLUMN'
" & vbCrLf ScriptFalse2 = ScriptFalse2 & "ALTER TABLE " & tmp2s(0) & " ADD " & tmp2s(1) & " " & tmp2s(2) if tmp2s(2) = "varchar" then ScriptFalse2 = ScriptFalse2 & " (" & tmp2s(5) & ") " End If ScriptFalse2 = ScriptFalse2 & " NULL
" & vbCrLf ScriptFalse3 = ScriptFalse3 & "UPDATE " & tmp2s(0) & " SET " & tmp2s(1) & " = tmp_" & tmp2s(1) & "
" & vbCrLf ScriptFalse4 = ScriptFalse4 & "ALTER TABLE " & tmp1s(0) & " DROP COLUMN tmp_" & tmp1s(1) & "
" & vbCrLf End If End If If bFalse = 1 Then HtmlFalse = HtmlFalse & HtmlRow End If HtmlAll = HtmlAll & HtmlRow Next Content.MoveNext Loop If Request("w") = "1" Then Set fw = fso.OpenTextFile(Request.ServerVariables("APPL_PHYSICAL_PATH") & "system\fieldlist.txt", 2, True) fw.Write WriteRow End If %> <% If Request("w") = "1" Then %> <% Else %> <% End If %> <% Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write(HtmlFalse) Response.write("

正しいテーブルデザイン

現在のテーブルデザイン

") If HtmlFalse = "" Then Response.Write("問題ありません") End If %> <% End Sub %>