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.