📄 fxidck.cbl
字号:
*****************************************************************************
***pass-rtn-req = 1 "请输入身份证号"
***pass-rtn-req = 2 "请输入18或15位身份证号"
***pass-rtn-req = 3 "请输入正确年份的身份证号"
***pass-rtn-req = 4 "请输入正确校验码的身份证号"
***pass-rtn-req = 5 "请输入正确户籍的身份证号"
***pass-rtn-req = 6 "请输入正确字符的身份证号"
***pass-rtn-req = 7 "请输入正确月份的身份证号"
***pass-rtn-req = 8 "请输入正确天数的身份证号"
***pass-rtn-req = 9 "请输入有效生日的身份证号"
***pass-rtn-req = 0 表示输入正确无误
***pass-rtn-id15-18 把15位身份证编号转为18位
***pass-rtn-add 返回的户籍信息
***pass-rtn-dte 返回的生日信息
***pass-rtn-sex 返回的性别信息
******************************************************************************
identification division.
*2000 yr. enhanced.
program-id. FXIDCK.
author. Apollo.
environment division.
input-output section.
data division.
working-storage section.
*copy acclen.c.
copy lib60sda.v.
copy lib60dio.v.
copy lib60man.v.
copy lib60str.v.
copy lib60num.v.
copy lib60y20.v.
copy idcs.var.
copy supe.var.
01 check-num1 pic 99.
01 check-num2 pic x(1).
01 check-num3 pic x(3).
01 check-num5 pic 9(10).
01 check-num6 pic 9(2).
01 check-num7 pic 9(4).
01 check15-num1 pic x(6).
01 check15-num2 pic x(9).
01 check15-num3 pic x(17).
01 check15-num4 pic 9.
01 checknum pic x.
01 check-dte-num pic x(2).
01 check-dte-num1 pic x(4).
01 check-dte-num2 pic x(8).
01 mod-num pic 9(5).
01 sex-num pic 9.
01 place-num pic 99.
01 check-sum pic 9(6).
01 mod-id-num pic 9(10).
01 addnum1 pic x(30).
01 addnum2 pic x(30).
01 addnum3 pic x(30).
01 addnum4 pic x(60).
01 pass-id1 pic x(18).
01 pass-id15 pic x(18).
01 check-sys-dte.
03 check-sys-dte-pri.
05 check-sys-dte-yy pic xx.
05 check-sys-dte-mm pic 99.
03 check-sys-dte-dd pic 99.
01 check-sys-dte1.
03 check-sys-dte1-pri.
05 check-sys-dte1-yyyy pic 9(4).
05 check-sys-dte1-mm pic 99.
03 check-sys-dte1-dd pic 99.
01 check-pass-add pic x(100).
linkage section.
copy link.var.
01 pass-msg.
03 pass-id pic x(18).
03 pass-rtn-id15-18 pic x(18).
03 pass-rtn-req pic 9(2).
03 pass-rtn-add pic x(60).
03 pass-rtn-dte.
05 pass-rtn-dte-pri.
07 pass-rtn-dte-yy pic x(2).
07 pass-rtn-dte-mm pic 99.
05 pass-rtn-dte-dd pic 99.
03 pass-rtn-sex pic x(2).
procedure division using link-inf pass-msg.
pgm-edit-idcd.
*
perform pgm-ini.
perform check-id.
go to pgm-end.
pgm-ini.
move "FXIDCK" to link-pgm-id.
move pass-id to pass-id1.
initialize check-sys-dte.
initialize check-sys-dte1.
initialize pass-msg.
check-id.
move 0 to pass-rtn-req.
if pass-rtn-req = 0
perform check-length thru check-length-e.
if pass-rtn-req = 0
perform check-pre6.
if pass-rtn-req = 0
perform check-dte-sex thru check-dte-sex-e.
if pass-rtn-req = 0
perform check-last1 thru check-last1-e.
if pass-rtn-req = 0
perform check-rtn-add
perform check-rtn-dte-sex.
if pass-rtn-req = 0
and check-num3 = spaces
move pass-id1 to pass-rtn-id15-18
move pass-id15 to pass-id.
if pass-rtn-req = 0
move pass-id1 to pass-id.
check-rtn-dte-sex.
initialize pass-rtn-dte.
move spaces to check-dte-num2.
move pass-id1 (7:8) to check-dte-num2.
move check-dte-num2 to y20-yyyy-dte.
perform y20-to-yy-dte.
move y20-dte to pass-rtn-dte.
if sex-num = 0
move "女" to pass-rtn-sex
else
move "男" to pass-rtn-sex
end-if.
check-rtn-add.
move spaces to check15-num1.
move spaces to check-dte-num.
move pass-id1 (1:2) to check-dte-num.
string check-dte-num "0000" delimited by space
into check15-num1.
move check15-num1 to idcs-six.
perform read-idcs.
move idcs-add to addnum1.
move spaces to check15-num1.
move spaces to check-dte-num1.
move pass-id1 (1:4) to check-dte-num1.
string check-dte-num1 "00" delimited by space
into check15-num1.
move check15-num1 to idcs-six.
perform read-idcs.
move idcs-add to addnum2.
move spaces to check15-num1.
move spaces to addnum4.
move pass-id1 (1:6) to check15-num1.
move check15-num1 to idcs-six.
perform read-idcs.
move idcs-add to addnum3.
string addnum2 addnum3 delimited by space
into addnum4.
move spaces to check-pass-add.
move spaces to pass-rtn-add.
string addnum1 addnum4 delimited by space
into check-pass-add.
move check-pass-add to pass-rtn-add.
check-pre6.
move spaces to check15-num1.
move pass-id1 (1:6) to check15-num1.
move check15-num1 to idcs-six.
perform read-idcs.
if rw-sta not = "OK"
move 5 to pass-rtn-req
end-if.
check-last1.
move 18 to place-num.
move 1 to check-num1.
check-last1-loop.
move spaces to check-num2.
move 0 to check15-num4.
move 0 to check-num5.
move pass-id1 (check-num1:1) to check-num2.
move check-num2 to check15-num4
compute check-num5 = 2 ** (place-num - 1).
move 11 to mod-num.
perform mod-id.
multiply check15-num4 by check-num5 giving check-num6.
add check-num6 to check-sum.
add 1 to check-num1.
subtract 1 from place-num.
if place-num = 1
move 0 to check-num5
move check-sum to check-num5
move 11 to mod-num
perform mod-id
perform tran-mod-checknum
else
go to check-last1-loop
end-if.
move 0 to check-sum.
move spaces to check-num2.
move pass-id1 (18:1) to check-num2.
if check-num2 not = checknum
move 4 to pass-rtn-req
go to check-last1-e
end-if.
check-last1-e.
exit.
check-dte-sex.
move spaces to check-dte-num.
move pass-id1(7:2) to check-dte-num.
if check-dte-num not = "19"
and check-dte-num not = "20"
move 3 to pass-rtn-req
go to check-dte-sex-e
end-if.
perform y20-get-sys-dte.
move y20-yyyy to check-sys-dte1-yyyy.
move y20-sys-mm to check-sys-dte1-mm.
move y20-sys-dd to check-sys-dte1-dd.
move spaces to check-dte-num1.
move 0 to mod-id-num.
move pass-id1(7:4) to check-dte-num1.
move check-dte-num1 to check-num7.
compute mod-id-num = check-sys-dte1-yyyy - check-num7.
if mod-id-num < 16
or check-num7 > check-sys-dte1-yyyy
move 9 to pass-rtn-req
go to check-dte-sex-e
end-if.
move spaces to check-dte-num.
move pass-id1(11:2) to check-dte-num.
move check-dte-num to check-num1.
if check-num1 < 1
or check-num1 > 12
move 7 to pass-rtn-req
go to check-dte-sex-e
end-if.
if mod-id-num = 16
if check-sys-dte1-mm < check-num1
move 9 to pass-rtn-req
go to check-dte-sex-e
end-if
end-if.
move spaces to check-dte-num.
move pass-id1(13:2) to check-dte-num.
move check-dte-num to check-num6.
evaluate check-num1
when 1
if check-num6 < 1
or check-num6 > 31
move 8 to pass-rtn-req
go to check-dte-sex-e
end-if
when 2
move spaces to check-dte-num1
move pass-id1(7:4) to check-dte-num1
move check-dte-num1 to check-num7
move check-num7 to check-num5
move 100 to mod-num
perform mod-id
if check-num5 = 0
move check-num7 to check-num5
move 400 to mod-num
perform mod-id
if check-num5 = 0
if check-num6 < 1
or check-num6 > 29
move 8 to pass-rtn-req
go to check-dte-sex-e
end-if
else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -