这就是上面界面的源代码,还有一个辅助函数库,代码有点多,就不贴了。至于IHTTP组件,是我写的用来替代XMLHTTP的,俺不喜欢XMLHTTP,功能太弱,而且XML格式会浪费过多的带宽,当然,大家可以使用XMLHTTP,但实现的核心是熟悉HTML,此外,在后台俺还有一个通用的增加和替换多条记录的存储过程,这些都是俺现在手头的一个项目的一部分,回头俺打算贴在博客里,如果都贴出来,太多了。
<%@ Language=VBScript %>
<%Option Explicit%>
<%
Dim DB
Dim strHTBH,strData
strHTBH=Request("HTBH")
strData=Request("Data")
If Len(strData)>0 And Len(strHTBH) Then
Dim CMD
Set DB=CreateObject("ADODB.Connection")
Set CMD=CreateObject("ADODB.Command")
DB.Open Session("DBSetting")
CMD.ActiveConnection =DB
CMD.CommandText ="PROC_INSERT"
CMD.CommandType =4
CMD.Execute ,Array("分户_借款合同_保证信息",strData," WHERE 机构代码='" & Session("WorkUnitCode") & "' AND 合同编号='" & strHTBH & "'")
DB.Close
Set CMD=Nothing
Set DB=Nothing
Response.Write (Err.number=0)
Response.End
ElseIf Len(strHTBH)>0 Then
Dim i,RS
strData=""
Set DB=CreateObject("ADODB.Connection")
DB.Open Session("DBSetting")
Set RS=DB.Execute("SELECT 机构代码,合同编号,保证人,法人代表,联系地址,联系电话,手机号码 FROM 分户_借款合同_保证信息 WHERE 机构代码='" & Session("WorkUnitCode") & "' AND 合同编号='" & strHTBH & "'")
For i=0 To RS.Fields.Count-1
strData=strData & "┇" & RS.Fields(i).Name
Next
strData=Mid(strData,2)
If Not RS.EOF Then
strData=strData & "┛" & RS.GetString(,,"┇","┛")
End If
RS.Close
DB.Close
Set RS=Nothing
Set DB=Nothing
If Right(strData,1)="┛" Then strData=Left(strData,Len(strData)-1)
Else
Response.End
End If
%>
<html>
<META http-equiv=Content-Type content="text/html; charset=gb2312">
<HEAD>
<link href="css/Dataform.css" rel="stylesheet" type="text/css">
<link href="css/WebGrid.css" rel="stylesheet" type="text/css">
<%
Response.Write "<script language=vbscript>" & vbcrlf
Response.Write "Dim m_strData" & vbcrlf
Response.Write "m_strData=" & chr(34) & strData & chr(34) & vbcrlf
Response.Write "</script>" & vbcrlf
%>
</head>
<body style="margin-left:8px">
<table style="width:536px" class="Dataform" cellspacing="0" id=tb1>
<thead>
<tr>
<th colspan="2">保证人登记</td>
</tr>
</thead>
<tbody>
<tr>
<td width="35%">机构代码:</td>
<td width="65%"><input type="text" id=jgdm value=<%=Session("WorkUnitCode")%> disabled></td>
</tr>
<tr>
<td width="35%">合同编号:</td>
<td width="65%"><input type="text" id=htbh value=<%=strHTBH%> disabled></td>
</tr>
<tr>
<td>保证人名称:</td>
<td><input type="text" id=khmc maxlength=20 style="width:200px"><font>*</font></td>
</tr>
<tr>
<td>法人代表:</td>
<td><input type="text" id=frdb maxlength=4></td>
</tr>
<tr>
<td>联系地址:</td>
<td><input type="text" id=lxdz maxlength=20 style="width:200px"></td>
</tr>
<tr>
<td>联系电话:</td>
<td><input type="text" id=lxdh maxlength=12></td>
</tr>
<tr>
<td>手机号码:</td>
<td><input type="text" id=sjhm maxlength=12></td>
</tr>
<tr style=display:none>
<td>操作日期:</td>
<td><input type="text" value=<%=Date%> id=czrq></td>
</tr>
<tr style=display:none>
<td>操作机构:</td>
<td><input type="text" id=czjg value=<%=Session("UnitCode")%>></td>
</tr>
<tr style=display:none>
<td>操作人员:</td>
<td><input type="text" id=czry value=<%=Session("UserName")%>></td>
</tr>
</tbody>
<tfoot>
<tr>
<td colspan=2 height=40 align=center valign=middle>
<input type="button" value=" 删除 " id=btnDelete> <input type="button" value=" 插入 " id=btnInsert> <input type="button" value=" 保存 " id=btnSave> <input type="button" value=" 关闭 " id=btnClose>
</td>
</tr>
</tfoot>
</table>
<div id=tblContainer>
</div>
</body>
<script language=vbscript>
Sub window_onload
If Right(m_strData,1)="┛" Then m_strData=Left(m_strData,Len(m_strData)-1)
tblContainer.innerHTML=MakeGridWithCheckBox(m_strData,"保证人信息")
End Sub
Sub btnInsert_onClick
Dim i,Values
Dim oTable,oRow
khmc.value=replace(khmc.value," ","")
If Len(khmc.value)=0 Then
MsgBox "客户名称为空,插入失败!",48,"提示"
Exit sub
End If
Set oTable=document.getElementById("datagrid")
'行数最多为5行(带标题行为6行)
If oTable.Rows.length>=5 Then
MsgBox "行数超过限制!",48,"提示"
Exit Sub
End If
'检查该资料是否已存在
If oTable.Rows.length>1 Then
For i=1 To oTable.Rows.length-1
Set oRow=oTable.Rows(i)
If Trim(oRow.cells(2).innerText)=khmc.value Then
MsgBox "该保证人已经存在,插入失败!",48,"提示"
Exit Sub
End If
Next
End If
'插入行
Values=Array(jgdm.value,htbh.value,khmc.value,frdb.value,lxdz.value,lxdh.value,sjhm.value)
Set oRow=oTable.insertRow
For i=0 To UBound(Values)
If Len(Values(i))=0 Then Values(i)=" "
oRow.insertCell().innerText=Values(i)
Next
oRow.insertCell().innerHTML="<INPUT type=checkbox name=asp_checkbox>"
End Sub
Sub btnDelete_onClick
Dim i,nLen
Dim oTable,oCheckBoxs
Set oTable=document.getElementById("datagrid")
Set oCheckBoxs=document.getElementsByName("asp_checkbox")
nLen = oCheckBoxs.length
For i=nLen-1 To 0 Step -1
If oCheckBoxs(i).Checked Then
oTable.deleteRow i+1
End If
Next
Set oTable=Nothing
Set oCheckBoxs=Nothing
End Sub
Sub btnSave_onClick
Dim i,j
Dim o,oTable,oRow,strData,strURL,strReturn
Set oTable=document.getElementById("datagrid")
If oTable.rows.length=1 Then
Msgbox "没有可供保存的数据!",48,"提示"
Exit Sub
End If
strData=""
For i=1 To oTable.rows.length-1
Set oRow=oTable.Rows(i)
For j=0 To oRow.cells.length-2 '不包括最后1列的选择项
strData=strData & Trim(oRow.cells(j).innerText) & "┇" '插入列标志
Next
strData=strData & czrq.value & "┇" & czjg.value & "┇" & czry.value & "┛"
Next
strData=Left(strData,Len(strData)-1) '去掉最后1个换行标志
Set o=CreateObject("IHttp.URL")
strURL=GetUrl & "借款合同_保证信息.asp?Data=" & strData & "&HTBH=" & htbh.value
strUrl=o.URLEncoding(strURL)
strReturn = o.GetResponse(strUrl)
Set o=Nothing
If CBool(strReturn) Then
MsgBox "数据已成功保存,请继续...",64,"提示"
'window.close
Else
MsgBox "数据保存失败,请检查原因!",48,"提示"
End If
End Sub
Sub btnClose_onClick
window.close
End Sub
'* *************************************
'* 带复选框的表格函数
'* *************************************
Function MakeGridWithCheckBox(invarText,invarCaption)
Dim i,j,strRows,strCols,strHTML