![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
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.