📄 api.asp
字号:
text.xmladd rs.fields(i).type,"type1"
text.xmladd cat.Tables(b).Columns(rs.fields(i).name).Properties("Description").Value,"Description"
if d=0 then
text.xmladd rs(i),"data"
end if
text.add "</datashow>"
end if
next
text.Completed
rs.close
conn.close
end sub
sub editdata(ByVal a,ByVal b,ByVal c,ByVal d,ByVal e,ByVal f,ByVal g,ByVal pass)
On Error resume next
dim conn,cat,rs,sql,i,type1,fieldtxt
set cat = server.CreateObject(COArray(2))
call connaccess(conn,b,a)
set rs=server.createobject(COArray(1))
sql="select * from ["&b&"]"
rs.open sql,conn,3,3
if g=1 then
rs.addnew
else
rs.AbsolutePosition = cint(e)
end if
set cat.ActiveConnection = conn
Set objXML = Server.CreateObject(COArray(7))
objXML.async = False
loadResult = objXML.loadXML(f)
Set objNodes = objXML.getElementsByTagName("challs")
for i=0 to rs.fields.count-1
type1=rs.fields(i).type
fieldtxt=objNodes(0).selectSingleNode(rs.fields(i).name).Text
if type1<>205 and type1<>128 and type1<>204 and cat.Tables(b).Columns(rs.fields(i).name).Properties("Autoincrement")=false and len(fieldtxt)>0 then
if type1=11 then
if lcase(fieldtxt)="false" then
rs(i)=0
else
rs(i)=1
end if
else
rs(i)=fieldtxt
end if
end if
next
rs.update
rs.close
conn.close
text.start
text.categoties "editdataend"
text.Completed
if err.number<>0 and err.number<>424 then
text.outerr err.Description&","&err.number
end if
end sub
sub getfield(ByVal a,ByVal b,ByVal c,ByVal d,ByVal pass)
On Error resume next
dim conn,cat,rs,sql,i
set cat = server.CreateObject(COArray(2))
call connaccess(conn,b,a)
set rs=server.createobject(COArray(1))
sql="select top 1 * from ["&b&"]"
set cat.ActiveConnection = conn
rs.open sql,conn,3,3
text.start
text.categoties "getfield"
text.xmladd d,"bs"
text.add "<datashow>"
text.xmladd rs.fields(c).name,"name"
text.xmladd rs.fields(c).type,"type"
text.xmladd fieldtype(rs.fields(c).type,cat.Tables(b).Columns(c).Properties("Autoincrement")),"type1"
text.xmladd cat.Tables(b).Columns(c).DefinedSize,"DefinedSize"
text.xmladd cat.Tables(b).Columns(c).Properties("default").Value,"default"
text.xmladd cat.Tables(b).Columns(c).Properties("Jet OLEDB:Allow Zero Length").Value,"AllowZeroLength"
text.xmladd cat.Tables(b).Columns(c).Properties("Jet OLEDB:Column Validation Rule").Value,"ColumnValidationRule"
text.xmladd cat.Tables(b).Columns(c).Properties("Jet OLEDB:Column Validation Text").Value,"ColumnValidationText"
text.xmladd cat.Tables(b).Columns(c).Properties("Nullable").Value,"Nullable"
text.xmladd cat.Tables(b).Columns(c).Properties("Jet OLEDB:Compressed UNICODE Strings").Value,"CompressedUNICODEStrings"
text.xmladd cat.Tables(b).Columns(c).Properties("Autoincrement").Value,"Autoincrement"
text.xmladd cat.Tables(b).Columns(c).Properties("Description").Value,"Description"
text.add "</datashow>"
text.Completed
rs.close
conn.close
if err.number<>0 then
text.outerr err.Description&","&err.number
end if
end sub
sub deletefield(ByVal a,ByVal b,ByVal c,ByVal pass)
On Error resume next
dim conn,cat
call connaccess(conn,b,a)
set cat =server.createobject(COArray(2))
Set cat.ActiveConnection = conn
cat.tables(b).columns.delete c
text.start
text.categoties "editfieldend"
text.Completed
if err.number<>0 then
text.outerr err.Description&","&err.number
end if
end sub
sub getfieldslist(ByVal a,ByVal b,ByVal pass)
On Error resume next
dim conn,cat,rs,sql,i,zjname,sybs,u,j,ui
dim syjh(),jj,sythtype()
dim strSQL,TempSQL,PrimaryKey,PrKey
dim keySQL
set cat = server.CreateObject(COArray(2))
set ckey1 = server.CreateObject(COArray(6))
set ckey = server.CreateObject(COArray(5))
call connaccess(conn,b,a)
set rs=server.createobject(COArray(1))
sql="select top 1 * from ["&b&"]"
strSQL="CREATE TABLE [" & b & "]"
set cat.ActiveConnection = conn
jj=0
redim Preserve sythtype(1)
for each tim in cat.Tables(b).keys
if tim.type=1 then
keySQL=keySQL&VBCrlf&"CREATE "
set ckey1 = tim
PrKey=tim.Name
keySQL=keySQL&"INDEX [" & PrKey & "] ON [" & b & "]("
for j=0 to ckey1.Columns.count-1
zjname=ckey1.Columns(j).Name
keySQL=keySQL&"[" & ckey1.Columns(j).Name & "],"
next
keySQL=Left(KeySQL,len(KeySQL)-1)
keySQL=keySQL& ") WITH PRIMARY;"
elseif tim.type=3 then
keySQL=keySQL&VBCrlf&"CREATE "
set ckey1 = tim
keySQL=keySQL&"UNIQUE INDEX [" & tim.Name & "] ON [" & b & "]("
redim Preserve sythtype(ckey1.Columns.count)
for j=0 to ckey1.Columns.count-1
sythtype(jj)=ckey1.Columns(j).Name
keySQL=keySQL&"[" & ckey1.Columns(j).Name & "],"
jj=jj+1
next
keySQL=Left(KeySQL,len(KeySQL)-1)
keySQL=keySQL& ");"
end if
next
jj=0
dim TempKey
if cat.Tables(b).Indexes.count<>0 then
redim Preserve syjh(cat.Tables(b).Indexes.count)
for u=0 to cat.Tables(b).Indexes.count-1
TempKey="CREATE INDEX [" & cat.Tables(b).indexes(u).Name & "] ON [" & b & "]("
set ckey = cat.Tables(b).indexes(u)
for j=0 to ckey.Columns.count-1
syjh(jj)=ckey.Columns(j).Name
TempKey=TempKey&"[" & ckey.Columns(j).Name & "],"
jj=jj+1
next
TempKey=Left(TempKey,len(TempKey)-1)
TempKey=TempKey& ");"
if cat.Tables(b).indexes(u).Name<>PrKey then
keySQL=keySQL&VBcrlf&TempKey
end if
next
else
redim syjh(0)
end if
rs.open sql,conn,3,3
text.start
text.categoties "getfieldslist"
text.xmladd a,"dataaccess"
text.xmladd b,"tablename"
text.xmladd pass,"dataaccesspass"
text.xmladd keySQL,"keySQL"
for i=0 to rs.fields.count-1
sybs=0
PrimaryKey=False
text.add "<datashow>"
if rs.fields(i).name=zjname and len(zjname)>0 then
text.xmladd "√","PrimaryKey"
PrimaryKey=True
else
text.add "<PrimaryKey/>"
end if
sybs=""
for u=0 to ubound(syjh)
if rs.fields(i).name=syjh(u) then
sybs=text.gettxt(17)
for ui=0 to ubound(sythtype)
if rs.fields(i).name=sythtype(ui) then
sybs=text.gettxt(18)
exit for
end if
next
end if
next
dim Temp,DefinedSize_,IsNullable_,Default_
DefinedSize_=cat.Tables(b).Columns(rs.fields(i).name).DefinedSize
IsNullable_=cat.Tables(b).Columns(rs.fields(i).name).Properties("Nullable").Value
Default_=cat.Tables(b).Columns(rs.fields(i).name).Properties("default").Value
Temp=GetSQLTypeName(rs.fields(i).Type,PrimaryKey,DefinedSize_)
TempSQL=TempSQL& "[" & rs.fields(i).name & "] " & Temp
If Temp="TEXT" Then TempSQL=TempSQL & "(" & DefinedSize_ & ")"
If Not IsNullable_ or PrimaryKey Then TempSQL=TempSQL & " NOT NULL"
If Len(Default_)>0 Then TempSQL=TempSQL & " DEFAULT " & Default_
TempSQL=TempSQL & ","
text.xmladd sybs,"index"
text.xmladd rs.fields(i).name,"name"
text.xmladd rs.fields(i).type,"type"
text.xmladd fieldtype(rs.fields(i).type,cat.Tables(b).Columns(rs.fields(i).name).Properties("Autoincrement")),"type1"
text.xmladd DefinedSize_,"DefinedSize"
text.xmladd Default_,"default"
text.xmladd cat.Tables(b).Columns(rs.fields(i).name).Properties("Jet OLEDB:Allow Zero Length").Value,"AllowZeroLength"
text.xmladd cat.Tables(b).Columns(rs.fields(i).name).Properties("Jet OLEDB:Column Validation Rule").Value,"ColumnValidationRule"
text.xmladd cat.Tables(b).Columns(rs.fields(i).name).Properties("Jet OLEDB:Column Validation Text").Value,"ColumnValidationText"
text.xmladd not IsNullable_,"Nullable"
text.xmladd cat.Tables(b).Columns(rs.fields(i).name).Properties("Jet OLEDB:Compressed UNICODE Strings").Value,"CompressedUNICODEStrings"
text.xmladd cat.Tables(b).Columns(rs.fields(i).name).Properties("Autoincrement").Value,"Autoincrement"
text.xmladd cat.Tables(b).Columns(rs.fields(i).name).Properties("Description").Value,"Description"
text.add "</datashow>"
next
strSQL=strSQL & "("&Left(TempSQL,Len(TempSQL)-1)&");"
text.xmladd strSQL,"strSQL"
text.Completed
rs.close
conn.close
if err.number<>0 then
text.outerr err.Description&","&err.number
end if
end sub
Function GetSQLTypeName(FieldType_,IsAutonumber,MaxLength_)
Select Case FieldType_
Case 3 if IsAutonumber then GetSQLTypeName = "COUNTER" else GetSQLTypeName = "LONG"
Case 7 GetSQLTypeName = "DATETIME"
Case 11 GetSQLTypeName = "BIT"
Case 6 GetSQLTypeName = "MONEY"
Case 128 GetSQLTypeName = "BINARY"
Case 17 GetSQLTypeName = "TINYINT"
Case 131 GetSQLTypeName = "DECIMAL"
Case 5 GetSQLTypeName = "FLOAT"
Case 2 GetSQLTypeName = "INTEGER"
Case 4 GetSQLTypeName = "REAL"
Case 72 GetSQLTypeName = "UNIQUEIDENTIFIER"
Case 130 if MaxLength_ = 0 then GetSQLTypeName = "MEMO" else GetSQLTypeName = "TEXT"
Case 202 GetSQLTypeName = "TEXT"
Case 203 GetSQLTypeName = "MEMO"
Case Else GetSQLTypeName = ""
End Select
End Function
sub editPRIMARY(ByVal a,ByVal b,ByVal c,ByVal d)
dim conn,cat,ckey1,zjname,IndexName,tim
set cat = server.CreateObject(COArray(2))
set ckey1 = server.CreateObject(COArray(6))
call connaccess(conn,b,a)
set cat.ActiveConnection = conn
for each tim in cat.Tables(b).keys
if tim.type=1 then
IndexName = tim.Columns(0).name
cat.Tables(b).keys.delete tim.name
end if
next
if IndexName<>c and len(c)>0 then
conn.execute("CREATE INDEX [PrimaryKey] ON [" & b & "]([" & c & "]) WITH PRIMARY")
end if
call getfieldslist(a,b,d)
end sub
sub editIndex(ByVal a,ByVal b,ByVal c,ByVal d,ByVal e)
dim conn,cat,ckey1,zjname,IndexName,tim,syjh(),u,j,bool,uu,typecf
bool=true
typecf=" "
set cat = server.CreateObject(COArray(2))
set ckey = server.CreateObject(COArray(5))
call connaccess(conn,b,a)
set cat.ActiveConnection = conn
if cat.Tables(b).Indexes.count<>0 then
redim syjh(cat.Tables(b).Indexes.count-1)
for u=0 to cat.Tables(b).Indexes.count-1
set ckey = cat.Tables(b).indexes(u)
for j=0 to ckey.Columns.count-1
syjh(j)=ckey.Columns(j).Name
if syjh(j)=c then
IndexName=cat.Tables(b).indexes(u).name
uu=u
bool=false
exit for
end if
next
next
end if
if bool then
if e="1" then
typecf=" UNIQUE "
end if
conn.execute("CREATE"&typecf&"INDEX [] ON [" & b & "]([" & c & "])")
else
cat.Tables(b).indexes.delete IndexName
end if
call getfieldslist(a,b,d)
end sub
sub editfield(ByVal a,ByVal b,ByVal c,ByVal d,ByVal e,ByVal pass)
On Error resume next
dim ColumnName,ColumnType,ColumnLength,ColumnDefault,ColumnDescription,ColumnNullable,ColumnValidRule,ColumnValidText,ColumnZeroLength,ColumnUnicode,newname
dim typestring
Set objXML = Server.CreateObject(COArray(7))
objXML.async = False
loadResult = objXML.loadXML(d)
Set objNodes = objXML.getElementsByTagName("challs")
if e="0" then
Select Case objNodes(0).selectSingleNode("type").Text
case 2
typestring="short"
case 3
typestring="long"
case 4
typestring="real"
case 5
typestring="double"
case 6
typestring="currency"
case 7
typestring="datetime"
case 11
typestring="yesno"
case 17
typestring="byte"
case 128
typestring="hyperlink"
case 133
typestring="date"
case 134
typestring="time"
case 135
typestring="datetime"
case 202
typestring="varchar"
case 203
typestring="memo"
case 204
typestring="OleObject"
case 205
typestring="OleObject"
case 8888
typestring="AutoIncrement"
case else
typestring=objNodes(0).selectSingleNode("type").Text
end Select
ColumnType=typestring
newname = objNodes(0).selectSingleNode("name").Text
ColumnName = objNodes(0).selectSingleNode("oldname").Text
ColumnLength = objNodes(0).selectSingleNode("DefinedSize").Text
if ColumnLength="" then ColumnLength=0
if int(ColumnLength)<=0 then ColumnLength=""
ColumnDefault = objNodes(0).selectSingleNode("default").Text
ColumnDescription = objNodes(0).selectSingleNode("Description").Text
ColumnNullable = objNodes(0).selectSingleNode("Nullable").Text
ColumnValidRule =""
ColumnValidText =""
ColumnZeroLength = objNodes(0).selectSingleNode("AllowZeroLength").Text
ColumnUnicode = objNodes(0).selectSingleNode("CompressedUNICODEStrings").Text
call AlterTableColumn(a,b,pass,ColumnName,ColumnType,ColumnLength,ColumnDefault,ColumnDescription,ColumnNullable,ColumnValidRule,ColumnValidText,ColumnZeroLength,ColumnUnicode,newname)
else
call addfield(a,b,c,d,e,pass)
end if
end sub
Sub addfield(ByVal a,ByVal b,ByVal c,ByVal d,ByVal e,ByVal pass)
On Error resume next
dim conn,cat,rs,sql,i,zjname,sybs,u,j
set cat = server.CreateObject(COArray(2))
set mytable=server.createobject(COArray(3))
set myfield =server.createobject(COArray(4))
call connaccess(conn,b,a)
Set objXML1 = Server.CreateObject(COArray(7))
objXML1.async = False
loadResult = objXML1.loadXML(d)
Set objNodes1 = objXML1.getElementsByTagName("challs")
if objNodes1(0).selectSingleNode("type").Text = "11" then
if (objNodes1(0).selectSingleNode("DefinedSize").Text<>"" and isNumeric(objNodes1(0).selectSingleNode("DefinedSize").Text)) or objNodes1(0).selectSingleNode("DefinedSize").Text="0" then
mrz = 0
else
mrz = 1
end if
conn.execute("ALTER TABLE ["&b&"] ADD COLUMN ["&objNodes1(0).selectSingleNode("name").Text&"] yesno default "&mrz)
PropertiesEdit Conn,b,objNodes1(0).selectSingleNode("name").Text,"",objNodes1(0).selectSingleNode("Description").Text,objNodes1(0).selectSingleNode("AllowZeroLength").Text
elseif objNodes1(0).selectSingleNode("type").Text = "7" then
conn.execute("ALTER TABLE ["&b&"] ADD COLUMN ["&objNodes1(0).selectSingleNode("name").Text&"] datetime")
PropertiesEdit Conn,b,objNodes1(0).selectSingleNode("name").Text,objNodes1(0).selectSingleNode("default").Text,objNodes1(0).selectSingleNode("Description").Text,objNodes1(0).selectSingleNode("AllowZeroLength").Text
elseif objNodes1(0).selectSingleNode("type").Text = "133" then
conn.execute("ALTER TABLE ["&b&"] ADD COLUMN ["&objNodes1(0).selectSingleNode("name").Text&"] date")
PropertiesEdit Conn,b,objNodes1(0).selectSingleNode("name").Text,objNodes1(0).selectSingleNode("default").Text,objNodes1(0).selectSingleNode("Description").Text,objNodes1(0).selectSingleNode("AllowZeroLength").Text
else
set cat.ActiveConnection = conn
set myfield.ParentCatalog=cat
myfield.Name = objNodes1(0).selectSingleNode("name").Text
if objNodes1(0).selectSingleNode("type").Text = "8888" then
myfield.Type = 3
myfield.Properties("AutoIncrement") = true
else
myfield.Type = int(objNodes1(0).selectSingleNode("type").Text)
end if
myfield.Properties("Nullable").Value=not CBool(objNodes1(0).selectSingleNode("Nullable").Text)
if objNodes1(0).selectSingleNode("DefinedSize").Text<>"" and isNumeric(objNodes1(0).selectSingleNode("DefinedSize").Text) then
myfield.DefinedSize = int(objNodes1(0).selectSingleNode("DefinedSize").Text)
end if
set mytable=cat.Tables(b)
mytable.Columns.Append myfield
set myfield=mytable.Columns(objNodes1(0).selectSingleNode("name").Text)
with myfield
.Properties("Description").Value= objNodes1(0).selectSingleNode("Description").Text
.Properties("Jet OLEDB:Allow Zero Length").Value= CBool(objNodes1(0).selectSingleNode("AllowZeroLength").Text)
.Properties("Jet OLEDB:Compressed UNICODE Strings").Value=CBool(objNodes1(0).selectSingleNode("CompressedUNICODEStrings").Text)
end with
set mytable=nothing
set myfield=nothing
set cat=nothing
if len(objNodes1(0).selectSingleNode("default").Text)>0 then
conn.Execute("ALTER TABLE [" & b & "] ALTER COLUMN [" & objNodes1(0).selectSingleNode("name").Text & "] SET DEFAULT " & objNodes1(0).selectSingleNode("default").Text)
end if
end if
if err.number<>0 and err.number<>-2147217887 then
text.outerr err.Description&","&err.number
end if
text.ReInfoOrErr 20,4,"infoshow",array(b,objNodes1(0).selectSingleNode("name").Text)
text.start
text.categoties "editfieldend"
text.Completed
end Sub
sub PropertiesEdit(Conn,TableName,ColumnName,ColumnDefault,ColumnDescription,ColumnZeroLength)
dim mydb,mytable,myfield
set mydb=server.createobject(COArray(2))
set mytable=server.createobject(COArray(3))
set myfield =server.createobject(COArray(4))
MyDB.ActiveConnection =Conn
For Each MyTable In MyDB.Tables
if MyTable.Name=TableName then
For Each MyField In MyTable.Columns
if MyField.Name=ColumnName Then
Res=1
if MyField.Properties("Default").Value<>ColumnDefault and len(ColumnDefault)>0 then
MyField.Properties("Default").Value=ColumnDefault
end if
if MyField.Properties("Description").Value<>ColumnDescription and len(ColumnDescription)>0 then
MyField.Properties("Description").Value=ColumnDescription
end if
if MyField.Properties("Jet OLEDB:Allow Zero Length").Value<>ColumnZeroLength and len(ColumnZeroLength)>0 then
MyField.Properties("Jet OLEDB:Allow Zero Length").Value=ColumnZeroLength
end if
exit for
end if
Next
if Res=1 then exit for
end if
if Res=1 then exit for
Next
end sub
Sub AlterTableColumn(PathName,TableName,pass,ColumnName,ColumnType,ColumnLength,ColumnDefault,ColumnDescription,ColumnNullable,ColumnValidRule,ColumnValidText,ColumnZeroLength,ColumnUnicode,newname)
On Error resume next
dim Conn
call connaccess(Conn,pass,PathName)
PropertiesEdit Conn,TableName,ColumnName,ColumnDefault,ColumnDescription,ColumnZeroLength
if ColumnNullable=True then
ColumnNullable=" Null "
else
ColumnNullable=" Not Null "
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -