api.asp

access管理系统API文件 把API文件上传到网站数据库目录下 再到ACCESS2008.CN 上

end if

sql="Alter Table "&TableName&" Alter Column "

select case ColumnType
case  "AutoIncrement" 
sql=sql&ColumnName&" AutoIncrement "&ColumnNullable

case "varchar"
 if ColumnLength="" then
 sql=sql&ColumnName&" varchar(50) "&ColumnNullable
 else
 sql=sql&ColumnName&" varchar("&cint(ColumnLength)&") "&ColumnNullable
 end if 
 if ColumnDefault<>"" then 
 sql=sql&"  default "&ColumnDefault
 else
 sql=sql
 end if

case "memo"
  if ColumnDefault<>"" then 
  sql=sql&ColumnName&" memo "&"  default "&ColumnDefault
  else
  sql=sql&ColumnName&" memo "&ColumnNullable
  end if
  
case "integer"
  if ColumnLength="" then
  sql=sql&ColumnName&" integer "&ColumnNullable
  else
  sql=sql&ColumnName&" integer("&ColumnLength&") "&ColumnNullable
  end if 
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if
  
case "number"
  if ColumnLength="" then
  sql=sql&ColumnName&" number "&ColumnNullable
  else
  sql=sql&ColumnName&" number("&ColumnLength&") "&ColumnNullable
  end if 
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if
  
case "short"
  if ColumnLength="" then
  sql=sql&ColumnName&" short "&ColumnNullable
  else
  sql=sql&ColumnName&" short("&ColumnLength&") "&ColumnNullable
  end if 
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if
case "long"
  if ColumnLength="" then
  sql=sql&ColumnName&" long "&ColumnNullable
  else
  sql=sql&ColumnName&" long("&ColumnLength&") "&ColumnNullable
  end if 
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if 
  
case "double"
  if ColumnLength="" then
  sql=sql&ColumnName&" double "&ColumnNullable
  else
  sql=sql&ColumnName&" double("&ColumnLength&") "&ColumnNullable
  end if 
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if
  
case "real"
  if ColumnLength="" then
  sql=sql&ColumnName&" real "&ColumnNullable
  else
  sql=sql&ColumnName&" real("&ColumnLength&") "&ColumnNullable
  end if 
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if
  
case "numeric"
  if ColumnLength="" then
  sql=sql&ColumnName&" numeric "&ColumnNullable
  else
  sql=sql&ColumnName&" numeric("&ColumnLength&") "&ColumnNullable
  end if 
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if
  
case "byte"
  if ColumnLength="" then
  sql=sql&ColumnName&" byte "&ColumnNullable
  else
  sql=sql&ColumnName&" byte("&ColumnLength&") "&ColumnNullable
  end if 
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if
   
case "datetime"
 if ColumnDefault="" then
 sql=sql&ColumnName&" datetime "&ColumnNullable
 else
 sql=sql&ColumnName&" datetime "&ColumnNullable&"  default "&ColumnDefault
 end if 
 
case "date"
  if ColumnDefault="" then
  sql=sql&ColumnName&" date "&ColumnNullable
  else
  sql=sql&ColumnName&" date  "&ColumnNullable&" default "&ColumnDefault
  end if 
  
case "time"
  if ColumnDefault="" then
  sql=sql&ColumnName&" time "&ColumnNullable
  else
  sql=sql&ColumnName&" time  "&ColumnNullable&" default "&ColumnDefault
  end if 
case "yesno"
  if ColumnDefault="" then
  sql=sql&ColumnName&" yesno "&ColumnNullable
  else
  sql=sql&ColumnName&" yesno "&ColumnNullable&"  default "&ColumnDefault
  end if
  
case "currency"
  if ColumnLength="" then
  sql=sql&ColumnName&" currency "&ColumnNullable
  else
  sql=sql&ColumnName&" currency("&ColumnLength&") "&ColumnNullable
  end if 
  
  if ColumnDefault<>"" then 
  sql=sql&"  default "&ColumnDefault
  else
  sql=sql
  end if

case "hyperlink"
  if ColumnDefault="" then
  sql=sql&ColumnName&" OleObject "&ColumnNullable
  else
  sql=sql&ColumnName&" OleObject "&ColumnNullable&"  default "&ColumnDefault
  end if
case "OleObject"
  if ColumnDefault="" then
  sql=sql&ColumnName&" OleObject "&ColumnNullable
  else
  sql=sql&ColumnName&" OleObject "&ColumnNullable&"  default "&ColumnDefault
  end if  
case else
	text.ReInfoOrErr 21,"","outerr",array(ColumnType)
end select
conn.execute(sql)
if ColumnName<>newname and len(newname)>0 then
	MyField.name=newname
end if

	conn.close
	set Conn=nothing
	text.ReInfoOrErr 22,4,"infoshow",array(tablename,ColumnName)
	text.start
	text.categoties "editfieldend"
	text.Completed
   if err.number<>0 then
		text.outerr err.Description&","&err.number&","&err.line
    end if
End Sub

function fieldtype(ByVal a,ByVal b)
	 Select Case a
	  case 2            
	   fieldtype=text.gettxt(25)
	  case 3           
	   fieldtype=text.gettxt(26)
	  case 4            
	   fieldtype=text.gettxt(27)
	  case 5            
	   fieldtype=text.gettxt(28)
	  case 6           
		fieldtype=text.gettxt(29)
	  case 7            
	   fieldtype=text.gettxt(30)
	  case 11          
	   fieldtype=text.gettxt(31)
	  case 17          
	   fieldtype=text.gettxt(32)
	  case 128        
	   fieldtype=text.gettxt(33)
	  case 133        
	   fieldtype=text.gettxt(34)
	  case 134        
	   fieldtype=text.gettxt(35)
	  case 135        
	   fieldtype=text.gettxt(36)
	  case 202        
	   fieldtype=text.gettxt(37)
	  case 203        
	   fieldtype=text.gettxt(38)
	  case 204       
	   fieldtype=text.gettxt(39)
	  case 205     
	   fieldtype=text.gettxt(40)
	  case else
	   fieldtype=a
	 end Select
	 if b=true then
	   fieldtype=text.gettxt(41)
	 end if

end function 


sub edittablename(ByVal a,ByVal b,ByVal c,ByVal d)
	Dim oTbl,DBConn2
	Set DBConn2 = Server.CreateObject(COArray(2))
	DSN = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password='"&b&"';Data Source="&mululj&"/"&a
	DBConn2.ActiveConnection = DSN
	Set oTbl = Server.CreateObject(COArray(3))
	Set oTbl = DBConn2.Tables(c) 
	oTbl.Name = d  
	Set oTbl = Nothing
	Set DBConn2 = Nothing
	text.start
	text.categoties "edittablenameend"
	text.xmladd a,"access"
	text.xmladd b,"pass"
	text.Completed
end sub

sub AddTable(ByVal a,ByVal b,ByVal c)
	Dim oTbl,DBConn,myfield,DSN
	call connaccess(DBConn,b,a)
	DBConn.execute("CREATE TABLE "&c&" ([ID] counter, CONSTRAINT [Index1] PRIMARY KEY ([ID]))")
	text.start
	text.categoties "addtableend"
	text.xmladd a,"access"
	text.xmladd b,"pass"
	text.Completed
End sub 

sub deletetable(ByVal a,ByVal b,ByVal c)
	Dim DBConn2,DSN
	Set DBConn2 = Server.CreateObject(COArray(2))
	DSN = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password='"&b&"';Data Source="&mululj&"/"&a
	DBConn2.ActiveConnection = DSN
	DBConn2.Tables.Delete c
	text.start
	text.categoties "deletetableend"
	text.xmladd a,"access"
	text.xmladd b,"pass"
	text.Completed
end sub

Class TextData
	Private text()
	Private id
	Private max
	Private txt
	Private Sub Class_Initialize 
		redim text(12)
		id=0
		max=11
		txt=array("API文件密码错误,请重新输入密码！","API文件里设置的数据库目录不存在,请重新设置API文件!","服务器数据传输错误,请重新登入！","备份文件创建成功","信息提示","数据库已经还原为备份数据","密码修改失败！","数据库编码失败！","数据库修复压缩失败！","密码修改成功","数据库地区修改成功","数据库压缩成功","[OLE对象]","[超连接]","[二进制数据]","(密码)","ACCESS数据库密码不正确","(重复)","(唯一)","|TextData类文本索引错误|","数据表%1表中字段 %2 新建完成","数据类%1不可以识别或者暂时未完善此类别数据类型的建表功能","数据表%1表中字段 %2 修改常用属性完成"," (日期格式不规范)","(未知)","整形","长整形","单精度","双精度","货币","日期/时间","布尔","字节型","二进制","日期","时间","日期时间","文本","备注","二进制","OLE对象","自动编号")
	End Sub
	Public function xmldata(ByVal value)
		xmldata=replace(replace(replace(value&"","&","&amp;"),">","&gt;"),"<","&lt;")
	end function
	Public Default Sub Add(ByVal value)
		text(id) = value
		id = id+1
		If id>=max Then
			max = max + 12
			Redim Preserve text(max)
		End if
	End Sub
	Public Sub xmlAdd(ByVal value,ByVal bq)
		dim a
		if len(value)>0 then
			a=xmldata(value)
			add "<"&bq&">"
			add a
			add "</"&bq&">"
		else
			add "<"&bq&"/>"
		end if
	End Sub
	Public Sub outerr(ByVal value)
		dim a
		if VarType(value)=2 or VarType(value)=3 then
			a=GetTxt(value)
		else
			a=value
		end if
		add "<challs><categories>merr</categories><text>"&xmldata(a)&"</text></challs>"
	end Sub
	Public Sub infoshow(ByVal value,ByVal title)
		dim a,b
		if VarType(value)=2 or VarType(value)=3 then
			a=GetTxt(value)
		else
			a=value
		end if
		if VarType(title)=2 or VarType(title)=3 then
			b=GetTxt(title)
		else
			b=title
		end if
		add "<challs><categories>infoshow</categories><text>"&xmldata(a)&"</text><title>"&xmldata(b)&"</title></challs>"
	end Sub
	Public Sub ReInfoOrErr(ByVal value,ByVal title,ByVal type1,ByVal bs)
		dim i,a,b
		a=""
		b=""
		if VarType(bs)>8000 then
			if VarType(value)=2 or VarType(value)=3 then
				a=GetTxt(value)
			else
				a=value
			end if
			if type1="infoshow" then
				if VarType(title)=2 or VarType(title)=3 then
					b=GetTxt(title)
				else
					b=title
				end if	
			end if
			for i=0 to ubound(bs)
				if len(a)>0 then
					a=replace(a,"%"&(i+1),bs(i))
				end if
				if len(b)>0 then
					b=replace(b,"%"&(i+1),bs(i))
				end if
			next
			if type1="infoshow" then
				call infoshow(a,b)
			elseif type1="outerr" then
				call outerr(a)
			end if
		end if
	end sub
	Public Sub CDATA(ByVal value)
		add "<![CDATA["&value&"]]>"
	end Sub
	Public Sub categoties(ByVal value)
		add "<categories>"&xmldata(value)&"</categories>"
	end Sub
	Public Sub Start()
		add "<challs>"
	end Sub
	Public Sub Completed()
		add "</challs>"
	end Sub
	public Function GetTxt(ByVal t)
		if t>ubound(txt) then
			GetTxt=txt(19)
		else
			GetTxt=txt(t)
		end if
	end Function
	Public Function Output()
		Redim preserve text(id-1)
		Output = "<?xml version=""1.0"" encoding=""utf-8""?><date>"&join(text,"")&"</date>"
	end Function
	Public Sub Clase()'清空
		redim text(12)
		id=0
		max=11
	end Sub
end Class
sub serverinfo()
	dim tnow,oknow
	text.start
	text.categoties "serverinfo"
	text.xmladd Request.ServerVariables("SERVER_NAME"),"name" 
	text.xmladd Request.ServerVariables("LOCAL_ADDR"),"ip" 
	text.xmladd Request.ServerVariables("SERVER_PORT"),"Port"
	tnow = now():oknow = cstr(tnow)
	  if oknow <> year(tnow) & "-" & month(tnow) & "-" & day(tnow) & " " & hour(tnow) & ":" & right(FormatNumber(minute(tnow)/100,2),2) & ":" & right(FormatNumber(second(tnow)/100,2),2) then oknow = oknow & text.gettxt(23)
	text.xmladd oknow,"time"
	text.xmladd Request.ServerVariables("SERVER_SOFTWARE"),"IISVersion" 
	text.xmladd Server.ScriptTimeout,"ScriptTimeout"
	text.xmladd Request.ServerVariables("PATH_TRANSLATED"),"FilePath"
	text.xmladd ScriptEngine & "/"& ScriptEngineMajorVersion &"."&ScriptEngineMinorVersion&"."& ScriptEngineBuildVersion,"ScriptEngine"
	call getsysinfo()
	text.Completed
end sub
sub getsysinfo()
  on error resume next
  dim okCPUS, okCPU, okOS
  Set WshShell = server.CreateObject("WScript.Shell")
  Set WshSysEnv = WshShell.Environment("SYSTEM")
  okOS = cstr(WshSysEnv("OS"))
  okCPUS = cstr(WshSysEnv("NUMBER_OF_PROCESSORS"))
  okCPU = cstr(WshSysEnv("PROCESSOR_IDENTIFIER"))
  if isempty(okCPUS) then
    okCPUS = Request.ServerVariables("NUMBER_OF_PROCESSORS")
  end if
  if okCPUS & "" = "" then
    okCPUS = text.gettxt(24)
  end if
  if okOS & "" = "" then
    okOS = text.gettxt(24)
  end if
  text.xmladd okOS,"OS"
  text.xmladd okCPUS,"CPUS"
  text.xmladd okCPU,"CPU"
end sub
sub comlist()
	text.start
	text.categoties "comlist"
	for i=0 to ubound(COArray)
		text.add "<data>"
		call ObjTest(COArray(i))
		text.add "</data>"
	next
	text.Completed
end sub
sub ObjTest(strObj)
  on error resume next
  dim IsObj,VerObj
  IsObj=false
  VerObj=""
  set TestObj=server.CreateObject (strObj)
  If -2147221005 <> Err then
    IsObj = True
    VerObj = TestObj.version
    if VerObj="" or isnull(VerObj) then VerObj=TestObj.about
  end if
  text.xmladd strObj,"strObj" 
  text.xmladd IsObj,"IsObj"
  text.xmladd VerObj,"VerObj"
  set TestObj=nothing
End sub
sub Bandwidth()
	dim a(1000)
	dim b,c
	text.start
	text.categoties "Bandwidth"
	for i=1 to 1000
		a(i)="|---567890#########0#########0#########0#########0#########0#########0#########0#########012345--|"
	next
	text.xmladd join(a,""),"a"
	text.Completed
end sub
%>