admin_field.asp

个人网站比较简短

    Else
        Response.Write " <TEXTAREA Name='DefaultValue' ROWS='10' COLS='50' >" & Server.HTMLEncode(rsField("DefaultValue")) & "</TEXTAREA>"
    End If
    Response.Write "</td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg' id='trOptions'"
    If rsField("FieldType") <> 3 Then Response.Write " style='display:none'"
    Response.Write ">"
    Response.Write "      <td width='300'><strong>列表项目：</strong><br>每一行为一个列表项目</td>"
    Response.Write "      <td><textarea name='Options' cols='40' rows='3' id='Options'>" & rsField("Options") & "</textarea></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='300'><strong>是否必填：</strong></td>"
    Response.Write "      <td><input name='EnableNull' type='radio' value='No'"
    If rsField("EnableNull") = False Then Response.Write " checked"
    Response.Write ">是&nbsp;&nbsp;&nbsp;&nbsp;<input name='EnableNull' type='radio' value='Yes'"
    If rsField("EnableNull") = True Then Response.Write " checked"
    Response.Write ">否</td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='300'><strong>是否在前台显示：</strong></td>"
    Response.Write "      <td><input name='ShowOnForm' type='radio' value='Yes'"
    If rsField("ShowOnForm") = True Then Response.Write " checked"
    Response.Write ">是&nbsp;&nbsp;&nbsp;&nbsp;<input name='ShowOnForm' type='radio' value='No'"
    If rsField("ShowOnForm") = False Then Response.Write " checked"
    Response.Write ">否</td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='40' colspan='2' align='center'><input name='ChannelID' type='hidden' id='Action' value='" & ChannelID & "'>"
    Response.Write "      <input name='Action' type='hidden' id='Action' value='SaveModify'><input name='FieldID' type='hidden' id='FieldID' value='" & FieldID & "'>"
    Response.Write "        <input name='Submit' type='submit' id='Submit' value=' 保存修改结果 '>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "</form>"
    
    rsField.Close
    Set rsField = Nothing
End Sub

Sub SaveAdd()
    Dim FieldName, Title, Tips, LabelName, FieldType, DefaultValue, Options, EnableNull,ShowOnForm
    Dim rsField, sqlField, trs, i
    FieldName = Replace(ReplaceBadChar(Trim(Request("FieldName"))), " ", "")
    Title = Trim(Request("Title"))
    Tips = Trim(Request("Tips"))
    FieldType = PE_CLng(Trim(Request("FieldType")))
    DefaultValue = Trim(Request("DefaultValue"))
    Options = Trim(Request("Options"))
    EnableNull = Trim(Request("EnableNull"))
    ShowOnForm = Trim(Request("ShowOnForm"))
    If FieldName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>字段名称不能为空！</li>"
    Else
		If IsValidStr(FieldName) = False Then
			FoundErr = True
			ErrMsg = ErrMsg & "<li>请输入有效的字段名称！</li>"
			Exit Sub
		End If
        FieldName = "MY_" & FieldName
        Set trs = Conn.Execute("select top 1 * from " & SheetName & "")
        For i = 0 To trs.Fields.Count - 1
            If trs.Fields(i).name = FieldName Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>指定的字段名称已经存在！</li>"
                Exit For
            End If
        Next
        Set trs = Nothing
    End If
    If Title = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>字段标题不能为空！</li>"
    End If
    
    If FieldType <> 2 And Len(DefaultValue) > 29 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>默认值不能大于30个字符！</li>"
    End If
    LabelName = "{$" & FieldName & "}"
    
    If FieldType = 3 And Options = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入项目列表！</li>"
    End If
    If EnableNull = "Yes" Then
        EnableNull = True
    Else
        EnableNull = False
    End If
    If ShowOnForm = "Yes" Then
        ShowOnForm = True
    Else
        ShowOnForm = False
	End If
    If FoundErr = True Then Exit Sub
    
    If SystemDatabaseType = "SQL" Then
        If FieldType = 2 Then
            sqlField = "alter table " & SheetName & " add " & FieldName & " ntext null"
        Else
            sqlField = "alter table " & SheetName & " add " & FieldName & " nvarchar(255) null"
        End If
    Else
        If FieldType = 2 Then
            sqlField = "alter table " & SheetName & " add " & FieldName & " text null"
        Else
            sqlField = "alter table " & SheetName & " add " & FieldName & " varchar(255) null"
        End If
    End If
    If Table_AddField(sqlField) = True Then
        sqlField = "select top 1 * from PE_Field"
        Set rsField = Server.CreateObject("ADODB.Recordset")
        rsField.Open sqlField, Conn, 1, 3
        rsField.addnew
        rsField("FieldName") = FieldName
        rsField("Title") = Title
        rsField("Tips") = Tips
        rsField("LabelName") = LabelName
        rsField("FieldType") = FieldType
        rsField("DefaultValue") = DefaultValue
        rsField("Options") = Options
        rsField("EnableNull") = EnableNull
        rsField("ShowOnForm") = ShowOnForm
        If PE_CLng(Trim(Request("AreaType"))) = 0 Then
            rsField("ChannelID") = tempModuleType
        Else
            rsField("ChannelID") = ChannelID
        End If
        rsField.Update
        rsField.Close
        Set rsField = Nothing
        Call CloseConn
        Response.Redirect "Admin_Field.asp?ChannelID=" & ChannelID
    End If
End Sub

Function Table_AddField(sqlField)
    On Error Resume Next
    Conn.Execute (sqlField)
    If Err Then
        Err.Clear
        FoundErr = True
        ErrMsg = ErrMsg & "<li>向" & SheetName & "表中添加字段失败！如果是SQL数据库，请检查数据库用户是否拥有Owner权限。</li>"
        Table_AddField = False
    Else
        Table_AddField = True
    End If
End Function

Sub SaveModify()
    Dim FieldID, Title, Tips, FieldType, DefaultValue, Options, EnableNull,ShowOnForm
    Dim rsField, sqlField, trs, i
    FieldID = PE_CLng(Trim(Request("FieldID")))
    Title = Trim(Request("Title"))
    Tips = Trim(Request("Tips"))
    FieldType = PE_CLng(Trim(Request("FieldType")))
    DefaultValue = Trim(Request("DefaultValue"))
    Options = Trim(Request("Options"))
    EnableNull = Trim(Request("EnableNull"))
    ShowOnForm = Trim(Request("ShowOnForm"))
    
    If FieldID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定字段ID！</li>"
    End If
    If Title = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>字段标题不能为空！</li>"
    End If
    If FieldType = 3 And Options = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入项目列表！</li>"
    End If
    If EnableNull = "Yes" Then
        EnableNull = True
    Else
        EnableNull = False
    End If
    If ShowOnForm = "Yes" Then
        ShowOnForm = True
    Else
        ShowOnForm = False
    End If
    If FoundErr = True Then Exit Sub
    
    sqlField = "select top 1 * from PE_Field where FieldID=" & FieldID
    Set rsField = Server.CreateObject("ADODB.Recordset")
    rsField.Open sqlField, Conn, 1, 3
    If rsField.BOF And rsField.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的字段记录！</li>"
        rsField.Close
        Set rsField = Nothing
        Exit Sub
    End If
    rsField("Title") = Title
    rsField("Tips") = Tips
    rsField("DefaultValue") = DefaultValue
    rsField("Options") = Options
    rsField("EnableNull") = EnableNull
    rsField("ShowOnForm") = ShowOnForm
    If PE_CLng(Trim(Request("AreaType"))) = 0 Then
        rsField("ChannelID") = tempModuleType
    Else
        rsField("ChannelID") = ChannelID
    End If
    rsField.Update
    rsField.Close
    Set rsField = Nothing
    Call CloseConn
    Response.Redirect "Admin_Field.asp?ChannelID=" & ChannelID
End Sub

Sub DelField()
    Dim FieldID, sqlField, rsField
    FieldID = PE_CLng(Trim(Request("FieldID")))
    If FieldID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数丢失！</li>"
        Exit Sub
    End If
    sqlField = "select * from PE_Field where FieldID=" & FieldID
    Set rsField = Server.CreateObject("ADODB.Recordset")
    rsField.Open sqlField, Conn, 1, 3
    If rsField.BOF And rsField.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的字段！</li>"
        rsField.Close
        Set rsField = Nothing
        Exit Sub
    End If
    On Error Resume Next
    Conn.Execute ("alter table " & SheetName & " drop COLUMN " & rsField("FieldName") & "")
    If Err Then
        Err.Clear
        FoundErr = True
        ErrMsg = ErrMsg & "<li>无法从" & SheetName & "表中删除字段。如果是SQL数据库，请检查是否有足够权限。</li>"
    Else
        rsField.Delete
        rsField.Update
    End If
    rsField.Close
    Set rsField = Nothing
    Call CloseConn
    If FoundErr <> True Then
        Response.Redirect "Admin_Field.asp?ChannelID=" & ChannelID
    End If
End Sub

Function GetFieldType(FieldType)
    Dim strFieldType
    strFieldType = "<option value='1'"
    If FieldType = 1 Then strFieldType = strFieldType & " selected"
    strFieldType = strFieldType & ">单行文本</option>"
    strFieldType = strFieldType & "<option value='2'"
    If FieldType = 2 Then strFieldType = strFieldType & " selected"
    strFieldType = strFieldType & ">多行文本</option>"
    strFieldType = strFieldType & "<option value='3'"
    If FieldType = 3 Then strFieldType = strFieldType & " selected"
    strFieldType = strFieldType & ">下拉列表</option>"
    strFieldType = strFieldType & "<option value='4'"
    If FieldType = 4 Then strFieldType = strFieldType & " selected"
    strFieldType = strFieldType & ">图片</option>"
    strFieldType = strFieldType & "<option value='5'"
    If FieldType = 5 Then strFieldType = strFieldType & " selected"
    strFieldType = strFieldType & ">文件</option>"
    strFieldType = strFieldType & "<option value='6'"
    If FieldType = 6 Then strFieldType = strFieldType & " selected"
    strFieldType = strFieldType & ">日期</option>"
    GetFieldType = strFieldType
End Function
%>