大悟还俗

邮箱 key_ok@qq.com 我的收集 http://pan.baidu.com/share/home?uk=1177427271
  新随笔  :: 联系 :: 订阅 订阅  :: 管理

取得身份证号码的含义

Posted on 2013-10-09 17:25  大悟还俗_2  阅读(348)  评论(0编辑  收藏  举报
unit Unit1;
 
interface
 
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls, ExtCtrls, Grids;
 
type
 TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
 private
 protected
    { Private declarations }
 public
    { Public declarations }
 end;
 
var
 Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses Math;
 
const
 cCityCode: array[0..91] of string =(
'','','','','','','','','','','',
'北京','天津','河北','山西','内蒙古','','','','','',
'辽宁','吉林','黑龙江','','','','','','','',
'上海','江苏','浙江','安微','福建','江西','山东','','','',
'河南','湖北','湖南','广东','广西','海南','','','',
'重庆','四川','贵州','云南','西藏','','','','','','',
'陕西','甘肃','青海','宁夏','新疆','','','','','',
'台湾','','','','','','','','','',
'香港','澳门','','','','','','','','',
'国外');
 
function CheckCidInfo(mCidCode: string): string;
var
 S: set of Char;
 I: Integer;
 vDateTime: TDateTime;
 T: Double;
begin
 if Length(mCidCode)<>18 then
 begin
    Result :='#编码必须是18位';
    Exit;
 end;
 S :=[];
 for I :=1 to 17 do Include(S, mCidCode[I]);
 if S -['0'..'9']<>[] then
 begin
    Result :='#编码前17位必须是数字';
    Exit;
 end;
 if not (mCidCode[18] in ['0'..'9','x','X']) then
 begin
    Result :='#最后一位必须是数字或者是X';
    Exit;
 end;
 I := StrToIntDef(Copy(mCidCode,1,2),0);
 if (I > High(cCityCode)) or (cCityCode[I]='') then
 begin
    Result :='#地址码不正确';
    Exit;
 end;
 Result :='地区:'+ cCityCode[I];
 if not TryStrToDate(Copy(mCidCode,7,4)+'-'+
    Copy(mCidCode,11,2)+'-'+ Copy(mCidCode,13,2), vDateTime) then
 begin
    Result :='#生日码不正确'+ Copy(mCidCode,7,4)+'-'+
    Copy(mCidCode,11,2)+'-'+ Copy(mCidCode,13,2);
    Exit;
 end;
 if (vDateTime > Date) or (vDateTime < StrToDate('1900-10-01')) then
 begin
    Result :='#生日不符合逻辑';
    Exit;
 end;
 Result := Result +' 生日:'+ FormatDateTime('yyyy-mm-dd', vDateTime);
 
 if mCidCode[18] in ['x','X'] then mCidCode[18]:='a';
 T :=0;
 for I :=18 downto 1 do
    T := T + Trunc(Power(2, I -1)) mod 11* StrToInt('$'+ mCidCode[19- I]);
 if Trunc(T) mod 11<>1 then
 begin
    Result :='#非法校验码'+ IntToStr(Trunc(T) mod 11);
    Exit;
 end;
 
 Result := Result +' 性别:'+
    Copy(WideString('男女'), Ord(Ord(mCidCode[17]) mod 2=0)+1,1);
end;{ CheckCidInfo }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 Caption := CheckCidInfo(Edit1.Text);
end;
 
end.
View Code