获取身份证号码信息

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.