main.pas

DELPHI实现 身份证归属地查询 18位身份证验证

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, inifiles;

type
  TfrmMain = class(TForm)
    EdtSfz: TEdit;
    Label1: TLabel;
    EdtAddr: TEdit;
    btnOK: TButton;
    EdtBorn: TEdit;
    EdtSex: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label2: TLabel;
    EdtnewSfz: TEdit;
    btnExit: TButton;
    cbCheck: TCheckBox;
    EdtCheck: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure cbCheckClick(Sender: TObject);
    procedure EdtSfzKeyPress(Sender: TObject; var Key: Char);
    procedure EdtSfzContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure EdtSfzMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    function SfzAddr(sfzStr: string):string;
    function SfzBorn(SfzStr: string):TDate;
    function SfzSex(SfzStr : string):boolean;
    function NewSfz(SfzStr : string):string;
    function SfzCheck(SfzStr :string) :Integer;
  end;

var
  frmMain: TfrmMain;
  ini : Tinifile;
  sPath : string;
  A : array[0..16] of Integer = (7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)     ;
  CheckCode : array [0..10] of string = ('1', '0', 'X', '9', '8', '7', '6', '5', '4', '3', '2')   ;
{
18位公民身份证号码的编排规则

　　本资料从网上多处说明整理而来。如有错误请发邮件到：[e-mail]，谢谢。

　　18位身份证标准在国家质量技术监督局于1999年7月1日实施的GB11643-1999《公民身份号码》中做了明确规定。

　　GB11643-1999《公民身份号码》为GB11643-1989《社会保障号码》的修订版，其中指出将原标准名称“社会保障号码”更名为“公民身份号码”，另外GB11643-1999《公民身份号码》从实施之日起代替GB11643-1989。

　　公民身份号码是特征组合码，由十七位数字本体码和一位校验码组成。排列顺序从左至右依次为：六位数字地址码，八位数字出生日期码，三位数字顺序码和一位校验码。其含义如下：

　　1. 地址码：表示编码对象常住户口所在县(市、旗、区)的行政区划代码，按GB/T2260的规定执行。

　　2. 出生日期码：表示编码对象出生的年、月、日，按GB/T7408的规定执行，年、月、日分别用4位、2位、2位数字表示，之间不用分隔符。

　　3. 顺序码：表示在同一地址码所标识的区域范围内，对同年、同月、同日出生的人编定的顺序号，顺序码的奇数分配给男性，偶数分配给女性。

　　校验的计算方式：

　　1. 对前17位数字本体码加权求和
　　公式为：S = Sum(Ai * Wi), i = 0, ... , 16
　　其中Ai表示第i位置上的身份证号码数字值，Wi表示第i位置上的加权因子，其各位对应的值依次为：
    7 9 10 5 8 4 2 1 6 3 7 9 10 5 8 4 2

　　2. 以11对计算结果取模
　　Y = mod(S, 11)

　　3. 根据模的值得到对应的校验码
　　对应关系为：
　　   Y值： 0 1 2 3 4 5 6 7 8 9 10
　　校验码： 1 0 X 9 8 7 6 5 4 3 2
}
implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
    Application.Title := Caption;
    Application.HintPause := 0;
    Application.HintHidePause := 8000;
    Application.HintColor := clWhite;

    sPath := IncludeTrailingBackslash(extractfilePath(Application.ExeName));

    cbCheck.Checked := true;
    Ini := Tinifile.Create(sPath + 'sfz.dll');
end;

function TfrmMain.SfzAddr(sfzStr: string): string;
var
    addr: string;
begin
    addr := copy(sfzstr,1,6);
    try
        result := Ini.ReadString('sfz',Addr,'未知地址');
    except
        Result := '未知地址'
    end;
end;

function TfrmMain.SfzBorn(SfzStr: string): TDate;
var
    bornStr : string;
begin
    case length(SfzStr) of
      18 :
      begin
        BornStr := copy(SfzStr,7,8);

      end;
      15:
      begin
        BornStr := copy(SfzStr,7,6);
        if (StrtoInt(copy(BornStr,1,2))< 10 )then
            BornStr := '20' + BornStr
        else
            BornStr := '19' + BornStr;

      end
      else begin
          showmessage('错误的身份证号码');
          Result := StrtoDate('1900-01-01');
          exit;
      end;
    end;
    Insert('-',BornStr,7);
    Insert('-',BornStr,5);
    try
        Result := StrtoDate(BornStr);
    except
        ShowMessage('错误的身份证出生日期');
        result :=  StrtoDate('1900-01-01');
    end;
end;

procedure TfrmMain.btnOKClick(Sender: TObject);
begin
    EdtAddr.Clear;
    EdtNewSfz.Clear;
    EdtBorn.Clear;
    EdtSex.Clear;
    EdtCheck.Clear;

    if not fileExists(sPath + 'sfz.dll') then
    begin
        Application.MessageBox('信息库 sfz.dll  不存在,无法进行查询','温馨提示',mb_iconInformation);
        Application.BringToFront;
        exit;
    end;
    
    if not (Length(EdtSfz.Text)  in [15,18])  then
    begin
        Application.MessageBox('身份证号码长度不对,请检查!  ','温馨提示',mb_iconInformation);
        exit;
    end;
    EdtAddr.font.Color := clBlue;
    EdtAddr.Text := SfzAddr(EdtSfz.Text);
    if EdtAddr.Text = '未知地址' then
    begin
        EdtAddr.Font.Color := clRed;
//        exit;
    end;


    EdtBorn.Text := formatDateTime('yyyy"年"mm"月"DD"日"',SfzBorn(EdtSfz.Text));
    if SfzSex(EdtSfz.Text) then
        EdtSex.Text := '男'
    else
        EdtSex.Text := '女';
    EdtNewSFz.Text := NewSfz(EdtSFz.Text);

    if cbCheck.Checked then
      case SfzCheck(EdtSfz.Text) of
      1:
        begin
            EdtCheck.Font.Color := clBlue;
            EdtCheck.Text := '效验正确'   ;
        end;
      0:
        begin
            EdtCheck.Font.Color := clRed;
            Edtcheck.Text := '效验失败';
        end;
      else
        begin
            EdtCheck.Font.Color := clBlue;
            EdtCheck.Text := '没有效验'   ;
        end;
      end;
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
    close;
end;

function TfrmMain.SfzSex(SfzStr: string): boolean;
begin
    result := false;
    case length(SfzStr) of
      18 :
      begin
        Result := ((strtoInt(copy(sfzStr,15,3)) mod 2) = 1);
      end;
      15:
      begin
        Result := ((strtoInt(copy(sfzStr,13,3)) mod 2) = 1);
      end
    end
end;

function TfrmMain.NewSfz(SfzStr: string): string;
var
    Oldyear, Newyear, s :string;
    i, sum, Y   : Integer;
begin
    if length(SfzStr) = 18 then Result := SfzStr
    else if length(sfzStr) = 15 then
    begin
        Oldyear :=  copy(SfzStr,7,2);
        if StrtoInt(OldYear) < 10 then NewYear := '20'+Oldyear
        else
            Newyear := '19'+OldYear;
        delete(SfzStr,7,2);
        Insert(Newyear,SfzStr,7);
        sum := 0;
        for i := 0 to 16 do
        begin
            s := Copy(SfzStr,i+1,1);
            sum := sum + StrToInt(s)* A[i];
        end;
        Y := sum mod 11;
        Result := SfzStr + checkCode[Y];
    end
    else
        Result := '无法转换的身份证号码';
end;

function TfrmMain.SfzCheck(SfzStr: string): Integer;
var
    Ai : Array[0..16] of integer;
    i,Value : integer;
begin
    Result := 2;
    Value := 0;
    if Length(SfzStr) = 18 then
    begin
        for i := 0 to 16 do
        begin
            try
                Ai[i] := StrtoInt(copy(SfzStr,i+1,1));
            except
                Showmessage('身份证号码有误');
                exit;
            end;
        end;
        for i := 0 to 16 do
        begin
            Value := Value + ai[i]*A[i];
        end;

        Value := Value mod 11  ;
        if uppercase(copy(sfzStr,18,1))= uppercase(CheckCode[Value])  then
            Result := 1
        else
            result := 0;
    end
    else
        Result := 2;
end;

procedure TfrmMain.cbCheckClick(Sender: TObject);
begin
    EdtCheck.Visible := cbCheck.Checked;
    EdtCheck.Clear;
end;

procedure TfrmMain.EdtSfzKeyPress(Sender: TObject; var Key: Char);
begin
//    showmessage(InttoStr(Integer(key)));
    if not (key in ['1'..'9','0',#13,#22,#8,'x','X']) then
    begin
        key := #0;
    end;
end;

procedure TfrmMain.EdtSfzContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
begin
    Handled := false;
end;

procedure TfrmMain.EdtSfzMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    Tedit(sender).Hint := TEdit(sender).Text;
end;

end.