族谱信息浏览

<% Dim rsval(30,10) on Error Resume Next '页头 Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "族谱信息浏览" Response.Write "" Response.Write "" Response.write "族谱信息浏览" '获取查询目标(ID) IDnum=trim(Request.QueryString("ID")) ' Response.Write "
你要查询的是:" & IDnum &"的记录!
" If IDnum="" Then IDnum=trim(Request.Form("ID")) If IDnum="" Then Response.Redirect("whos4e.htm") End If End If '打开中仙池氏人名库 CoStr="Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("/chi/db/chis.mdb") Set Conn=Server.CreateObject("ADODB.Connection") Conn.Open CoStr CommandText="select * from man where ID like '" & IDnum & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 ficount=rs.Fields.Count recount=rs.RecordCount ' Response.Write "
共发现" & recount &"个记录!
" If recount>0 Then ReDim rsval(ficount,2) '把本人信息先装入数组rsval()中 For I=0 To ficount-1 rsval(I,0)= rs(I).Value rsval(I,1)= rs(I).Value ' Response.write "
" & I &"、" & rsval(I,0) & "
" Next ' Response.write "" & rs(24) & "" rs.Close Set rs=nothing ' Set Conn=nothing '数据已装入数组rsval(ficount,recount),记录集暂关闭 '2002.12.15已增加三个字段,具体如下: '0 ID 36 '1 Gen int '2 GSGen int '3 Iflive bool '4 Name1 8 名 '5 Dif long '6 Name2 8 字或名 '7 Name4 8 篆或印 '8 Name3 8 号 '9 Name5 8 房 '10 Father 36 ID '11 Mother long '12 Order int 序 '13 Herit 36 嗣父ID '14 HeritGP 36 嗣祖ID '15 BirthYear int '16 BirthDate 20 '17 Birthtime 2 '18 DeathYear int '19 DeathDate 20 '20 Deathtime 2 '21 Bury 50 '22 Education 20 '23 Career 30 '24 Legend mem '25 Praise mem '2003.10.28又增加一个字段，插入在Legend之前： '24 Memo txt 256 备注 '25 Legend mem 传略 '26 Praise mem 赞曰 ' '2009.2.12又增加一个字段，放在最后： '27 Visible char 是否公开 ' '2011.5.14又增加三个字段，放在最后： '28 Genno char 行辈总排序 (浙江永康池氏专用) '29 Branch char 派 (浙江永康池氏首用,决定用于本人姓名之后) '30 Ages int 寿 (数值型便于统计) '下一步调用函数获取相应的中文名 For I=0 To ficount-1 rsval(I,1)=getchinesename(rsval(I,0),I) Next '2009.2.12增加是否公开字段后，增加该内容的检验开关： If Left(rsval(27,0),1)<"y" Then Response.write "
有关信息受到保护，暂不能查询。" Response.write "
请再试别的记录!
" Set Conn=nothing Else '先显示被查询人名——及支系、性别 '2009.6.15增加是否朝鲜/韩国池氏的检验开关： IsKorean = 0 Response.write "" If rsval(1,0)>3 Then Response.write "入闽始祖鲤腾公第" & rsval(1,0) &"代孙：" End If Select Case Left(rsval(0,0),1) Case "a" Response.write "福建闽侯安樟半山新居公第"& rsval(2,0) &"代：" Case "b" Response.write "福建闽清际峰池宝公第"& rsval(2,0) &"代：" Case "c" Response.write "贵州池潮公第"& rsval(2,0) &"代：" ' Response.write "福建陈熹公第"& rsval(2,0) &"代：" Case "d" Response.write "山西定襄卫村池龙公第"& rsval(2,0) &"代：" Case "f" Response.write "江西赣州七里镇池溥公第"& rsval(2,0) &"代：" Case "g" Response.write "福建尤溪中仙高叟公第"& rsval(2,0) &"代：" Case "h" Response.write "浙江永康君举公第"& rsval(2,0) &"代：" Case "i" Response.write "广州石牌村达源公第"& rsval(2,0) &"代：" Case "j" Response.write "广东揭阳池家渡小三公第"& rsval(2,0) &"代：" Case "k" IsKorean = 1 Response.write "韩国忠州池镜公第"& rsval(2,0) &"代：" Case "l" Response.write "福建长乐旧池、新池文季公第"& rsval(2,0) &"代：" Case "m" Response.write "福建闽侯西乾佛居公第"& rsval(2,0) &"代：" Case "n" Response.write "浙江上虞汤浦镇岙岭下村(新屋台门)：" Case "o" Response.write "安徽全椒白酒赵店村：" Case "p" Response.write "江苏常州天宁雕庄池家塘希文公"& rsval(2,0) &"代：" Case "q" Response.write "福州大洋高山公第"& rsval(2,0) &"代：" Case "r" Response.write "浙江瑞安前池第"& rsval(2,0) &"代：" Case "s" Response.write "福建南平前峰善甫公第"& rsval(2,0) &"代：" Case "t" Response.write "湖北孝感昆泰公" & rsval(2,0) &"代：" Case "u" Response.write "福建仙游、莆田新生公第"& rsval(2,0) &"代：" Case "v" Response.write "福建陈熹公第"& rsval(2,0) &"代：" Case "w" Response.write "闽迁浙江平阳可祖-信-公兴-养龙-振香-国纯公支系：" Case "x" Response.write "福建闽清下杭师法公第"& rsval(2,0) &"代：" Case "y" Response.write "福建尤溪岳溪渊叟公第"& rsval(2,0) &"代：" Case "z" Response.write "福建闽清丰洋志成公第"& rsval(2,0) &"代：" Case Else ' Response.write "福建闽清际峰池宝公第"& rsval(2,0) &"代孙：" End Select Response.write "" & rsval(4,0) & "" If Right(rsval(0,0),1) > "m" Then Response.write "(女)" End If If len(rsval(29,0))>0 Then Response.write "——" & rsval(29,0) &"派" End If Response.write "" '显示父母信息区和其他信息区的头部 Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" '显示兄弟姐妹区 Response.write "" Response.write "" '显示本人信息区 Response.write "" End If rs.Close Set rs=nothing Response.write "" Response.write "

" Response.write "

父母信息区

" Response.write "" Response.write "" Response.write "" If IsNull(rsval(10,0)) Then Response.write "" Else Response.write "" End If Response.write "" If IsNull(rsval(11,0)) Then Response.write "" Else Response.write "" End If Response.write "" If IsNull(rsval(13,0)) and IsNull(rsval(14,0)) Then Response.write "" Else If IsNull(rsval(13,0)) Then Response.write "" Else If IsNull(rsval(14,0)) Then Response.write "" Else Response.write "" End If End If End If '20090411增加祖父信息，并把祖父代码暂存于rsval(0,1)，名字暂存在rsval(4,1)： If not IsNull(rsval(10,0)) Then rsval(0,1)=getchinesename(rsval(10,0),1) rsval(4,1)=getchinesename(rsval(0,1),10) Response.write "" If instr("nu",rsval(4,1)) Then Response.write "" Else Response.write "" End If End If Response.write "" Response.write "

生父:

" & rsval(10,1) &"

生母:

" & rsval(11,1) &"

嗣父|祖:

" & rsval(13,1) &"

" & rsval(14,1) &"

" & rsval(13,1) &"

" & rsval(13,1) &"|" & rsval(14,1) &"

祖:

" & rsval(4,1) &"

" Response.write "

兄弟姐妹

本人信息区

子女

孙辈

" Response.write "" If Not IsNull(rsval(10,0)) Then showbrothername rsval(10,0),rsval(0,0) End If '先以生父为准列出兄弟 'Response.write "

" If Not IsNull(rsval(13,0)) Then showbrothername rsval(13,0),rsval(0,0) End If '再以ID号所凭据的嗣父为准列出兄弟 Response.write "

" Response.write "

" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.Close Set rs=nothing Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.Close Set rs=nothing Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" '长字段部分需要重新打开数据库 CommandText="select Memo,Praise from man where ID like '" & rsval(0,0) & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 Response.write "" Response.write "" ' Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" ' Response.write "" ' Response.write "" ' Response.write "" ' Response.write "" ' Response.write "" ' Response.write "" ' Response.write "" ' Response.write "" rs.Close Set rs=nothing '以下是新增加的配偶信息部分 Response.write "" Response.write "" CommandText="select * from wife where HusbandID like '" & rsval(0,0) & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 recount=rs.RecordCount If recount<1 Then Response.write "" Else ' Response.Write "
共发现" & recount &"个记录!
" Response.write "" Response.write "

字：" & rsval(6,0) & "	印：" & rsval(7,0) & "	号：" & rsval(8,0) & "	房：" & rsval(9,0) & "
生日：	" & rsval(15,0) '另一个表需要重新打开数据库 CommandText="select * from CKdate where 公元 like '" & rsval(15,0) &"'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 if IsKorean Then Response.write "_" & rs("朝鲜帝代").Value & rs("干支").Value & "年" Else Response.write "_" & rs("朝代").Value & rs("年号").Value & rs("编年").Value & "年" & rs("干支").Value &" " End If Response.write "	" & rsval(16,0) & "	生时:" & rsval(17,0) & "
卒日：	" & rsval(18,0) '另一个表需要重新打开数据库 CommandText="select * from CKdate where 公元 like '" & rsval(18,0) &"'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 If IsKorean Then Response.write "_" & rs("朝鲜帝代").Value & rs("干支").Value & "年" Else Response.write "_" & rs("朝代").Value & rs("年号").Value & rs("编年").Value & "年" & rs("干支").Value &" " End If Response.write "	" & rsval(19,0) & "	卒时:" & rsval(20,0) & "
教育：	" & rsval(22,0) & "	职位：	" & rsval(23,0) & "
葬：	" & rsval(21,0) & "
备注	" & rsval(24,0) & "			" & rs("Memo").Value & "
赞曰	" & rs("Praise").Value & "
传略	" & rsval(25,0) & "
赞曰	" & rsval(26,0) & "
配偶	无此信息			" '无此信息

" Response.write "" Response.write "" Response.write "" ' Response.write "" If recount > 5 Then recount = 5 End If For I=0 To recount-1 Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.MoveNext Next Response.write "

房序	姓名	养育数
" & rs("Name1").Value & "	" & recount & "
" & rs(3).value & "	" & rs(4) &"	" & rs(7) & "

" Response.write "

" Response.write "" '显示子女信息区 Response.write "" Response.write "" showbrothername rsval(0,0),"" '先以本人ID号作为生父或嗣父调用列出兄弟函数 Response.write "

" Response.write "" '显示孙辈信息区 Response.write "" Response.write "" showgreatsonname2(rsval(0,0)) Response.write "

" Response.write "" '显示数组rsval(ficount,recount)中的数据 ' For J=0 To recount-1 ' Response.write "" ' For I=4 To ficount-1 ' Response.write "" & rsval(I,1) & "" ' Next ' Response.write "" ' Next Response.write "" Response.write "" Response.write "
池氏人名库目前有四万多条记录，主要是池氏应天公、文季公、师法公及池镜公支系宗谱，整理工作仍在进行中。" Response.write "
如发现错讹，请与阿池联系。——2009.6.15" Set Conn=nothing End If Else rs.Close Set rs=nothing Set Conn=nothing Response.write "数据库出错!" Response.Write "
没有发现您要找的记录,请重新再试!
" End IF 'Response.End Response.Write " " Response.Write " " %> <% Function getchinesename(strval,fnum) If IsNull(strval) Then getchinesename = "nu" Else Select Case fnum '20090411增加1取父亲代码 Case 1 CommandText="select Father from man where ID like '" & strval & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 getchinesename = rs("Father").Value rs.Close Set rs=nothing Case 10 CommandText="select Name1 from man where ID like '" & strval & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 getchinesename = rs("Name1").Value rs.Close Set rs=nothing Case 13 CommandText="select Name1 from man where ID like '" & strval & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 getchinesename = rs("Name1").Value rs.Close Set rs=nothing Case 14 CommandText="select Name1 from man where ID like '" & strval & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 getchinesename = rs("Name1").Value rs.Close Set rs=nothing Case 11 CommandText="select Name from wife where WifeID like '" & strval & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 getchinesename = rs("Name").Value rs.Close Set rs=nothing Case Else getchinesename = strval End Select End If End Function Sub showbrothername(fatherID,sonID) Dim recount CommandText="select ID,Name1,Order,Herit,HeritGP from man where Father like '" & fatherID & "' or Herit like '" & fatherID & "' " 'ORDER BY man.Order Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 recount=rs.RecordCount If recount > 25 Then recount = 25 End If For I=0 To recount-1 Response.write "" If sonID=rs("ID").Value Then Response.write "" & rs("Name1").Value & "(" & rs("Order").Value & ")" Else Response.write "" & rs("Name1").Value & "(" & rs("Order").Value & ")" End If If fatherID = rs("Herit").Value Then Response.write "(嗣)" Else If Not IsNull(rs("Herit")) or Not IsNull(rs("HeritGP")) Then Response.write "(出嗣)" End If End If Response.write "" Response.write "" rs.MoveNext Next rs.Close Set rs=nothing End Sub Sub showheritbrothername(heritfatherID,sonID) Dim recount CommandText="select ID,Name1,Order from man where Father like '" & heritfatherID & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 recount=rs.RecordCount If recount > 25 Then recount = 25 End If For I=0 To recount-1 Response.write "" If sonID=rs("ID").Value Then Response.write "" & rs("Name1").Value & "(" & rs("Order").Value & ")" Else Response.write "" & rs("Name1").Value & "(" & rs("Order").Value & ")" End If Response.write "" rs.MoveNext Next rs.Close Set rs=nothing End Sub Sub showgreatsonname(fatherID) Dim recount CommandText="select ID,Name1 from man where ID like '" & fatherID & "__' or HeritGP like '" & fatherID & "'" Set rs=Server.CreateObject("ADODB.Recordset") rs.Open CommandText,Conn,1,1 recount=rs.RecordCount If recount > 25 Then recount = 25 End If For I=0 To recount-1 Response.write "" Response.write "" & rs("Name1").Value & "" ' Response.write "" & recount & "" Response.write "" rs.MoveNext Next rs.Close Set rs=nothing End Sub Sub showgreatsonname2(GfatherID) Dim recount ' CommandText2="select ID,Name1 from man where Father like '" & GfatherID & "'" CommandText2="select ID,Name1 from man where Father like '" & GfatherID & "' or Herit like '" & GfatherID & "'" Set rs2=Server.CreateObject("ADODB.Recordset") rs2.Open CommandText2,Conn,1,1 recount=rs2.RecordCount For I=0 To recount-1 CommandText1="select ID,Name1,Order,Herit from man where Father like '" & rs2("ID").Value & "' or Herit like '" & rs2("ID").Value & "'" Set rs1=Server.CreateObject("ADODB.Recordset") rs1.Open CommandText1,Conn,1,1 recountt=rs1.RecordCount For J=0 To recountt-1 Response.write "" Response.write "" & rs1("Name1").Value & "(" & rs1("Order").Value & ")" ' If Not IsNull( rs1("Herit")) Then ' Response.write "(嗣)" ' End If Response.write "" Response.write "" rs1.MoveNext Next rs1.Close Set rs1=nothing 'Response.write "

" rs2.MoveNext Next rs2.Close Set rs2=nothing CommandText3="select ID,Name1 from man where HeritGP like '" & GfatherID & "'" Set rs3=Server.CreateObject("ADODB.Recordset") rs3.Open CommandText3,Conn,1,1 recount=rs3.RecordCount For I=0 To recount-1 Response.write "" Response.write "" & rs3("Name1").Value & "(嗣)" Response.write "" rs3.MoveNext Next rs3.Close Set rs3=nothing End Sub %>