////////////////////////////////////////////////////////////////////////////////
//  单元用途：身份证号码相关处理                                              //
//  单元作者：池龙                                                            //
////////////////////////////////////////////////////////////////////////////////
//  备    注：                                                                //
//      区划代码转换为名称的部分，需要从外部文件中读取区划定义的数据（如随单  //
//  元发布的文件 regioncode.dat ）。                                          //
//                                                                            //
//      该文件为纯文本文件，每行是一个代码和名称的对应关系。代码和名称之间以  //
//  逗号作分隔。以#开头的行作为注释行，空行不处理。程序中作了一定的容错处理， //
//  通常情况下，不正确的数据会被略过。但在重新编排时，还是请尽量保证数据的正  //
//  确性。                                                                    //
//                                                                            //
//　　　另外，为了保证查找的效率，所以要求文件中的记录按区划代码由小到大的顺  //
//　序排列。      　                                                          //
////////////////////////////////////////////////////////////////////////////////

unit ascidnum;

interface

uses
  Controls,
  Classes,
  SysUtils;

type
//性别
  TSex = (sexUnknown,   //未知
          sexMale,      //男性
          sexFemale);   //女性

//身份证号码的类型
  TIDNumType = (idnum15,   //15位
                idnum18);  //18位

//校验结果
  TChecksumRst = (csNoChecksum,       //无校验（15位）
                  csChecksumError,    //错误
                  csChecksumCorrect); //正确

//个人信息
  TIDNumInfo = record
    IDNumType   : TIDNumType;   //身份证号码类型
    RegionCode  : string;       //区划代码
    RegionStr   : string;       //区划名称
    BirthDay    : TDate;        //生日
    Sex         : TSex;         //性别
    ChecksumRst : TChecksumRst; //校验结果
  end;

//区划代码对应关系
  TRegionCodeTransRec = record
    RegionCode: string;     //代码
    RegionStr : string;     //名称
  end;

  TRegionCodeTransArray = array of TRegionCodeTransRec;

//分离过的区域代码
  TSepRegionCode = record
    ProvinceCode : string; //省级代码
    CityCode     : string; //市级代码
    CountyCode   : string; //区县级代码
  end;

  TStrArray = array of string;

const
//18位身份证号码的校验方式中使用的常量
//从左向右，除了末尾的校验位之外，每位的权值
  cPosPowerArray : array[1..17] of integer = (7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2);

//得到的校验值对应的第18位字符
  cCheckSumValueArray : array[0..10] of char = ('1', '0', 'X', '9', '8', '7', '6', '5', '4', '3', '2');

//取身份证号码中的信息
//为了加快速度，不将区划代码进行转换
//需要取得确切的区划名称，用GetRegionStr函数
function GetIDNumInfo(IDNum: string; var IDNumInfo: TIDNumInfo): boolean;

//检查身份证号码的有效性
//内部仍然是利用GetIDNumInfo函数
function IsIDNumValid(IDNum: string): boolean;

//将15位身份证号码扩展为18位
function ExpandIDNum(IDNum15: string; var IDNum18: string): boolean;

//根据区划代码取相应的字符串
function GetRegionStr(RegionCode: string; FromFileName: string): string; overload;

function GetRegionStr(RegionCode: string): string; overload;

function GetRegionStr(var IDNumInfo: TIDNumInfo; FromFileName: string): boolean; overload;

function GetRegionStr(var IDNumInfo: TIDNumInfo): boolean; overload;

//从文件中区划代码信息
function LoadRegionDat(FromFileName: string; var RegionCodeArray: TRegionCodeTransArray): boolean; overload;
//下面这个函数的作用是直接将区划代码信息读入到本单元的公用变量里
function LoadRegionDat(FromFileName: string): boolean; overload;

implementation

var
  RegionCodeTransArray : TRegionCodeTransArray;

//判断这个字符是否为数字
function IsDigiChar(TestChar: Char): boolean;
begin
//直接判断文字
  Result := TestChar in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
//当然这里也可以使用判断字符ASCII值所在区间的方法，如：
//  Result := ord(TestChar) in [ord('0')..ord('9')];
end;

//判断一个字符串是否全部由数字组成
function IsDigiStr(TestStr: string): boolean;
var
  Count0 : integer;
begin
  if Length(TestStr) > 0 then
  begin
    Result := true;
    for Count0 := 1 to Length(TestStr) do
      if not IsDigiChar(TestStr[Count0]) then
      begin
        Result := false;
        Break;
      end;
  end else
    Result := false;
end;

//用于生成18位身份证号码中的校验字符
//注意：此函数不检查前17位的有效性以及其是否为数字
function GenIDNumCheckSumChar(IDNum18: string): char;
var
  DataSum : integer;
  Count0 : integer;
begin
  if length(IDNum18) = 18 then
  begin
    DataSum := 0;
//将前17位上的各个数字加权累加
    for Count0 := 1 to 17 do
      Inc(DataSum, StrtoInt(IDNum18[Count0]) * cPosPowerArray[Count0]);
//结果取模，再从字典中得到对应的字符
    Result := cCheckSumValueArray[DataSum mod 11];
  end else
    Result := ' ';
end;

//将15位身份证号码扩展为18位
function ExpandIDNum(IDNum15: string; var IDNum18: string): boolean;
var
  IDNumInfo: TIDNumInfo;
  TmpIDNum : string;
begin
  Result := false;
  IDNum18 := '';
//先检察原有的号码是否正确
  if (length(IDNum15) = 15) and GetIDNumInfo(IDNum15, IDNumInfo) then
  begin
//行政区划代码 + 生日 + 顺序码 + 校验
    TmpIDNum := IDNumInfo.RegionCode + formatdatetime('yyyymmdd', IDNumInfo.BirthDay) + Copy(IDNum15, 13, 3) + ' ';
//生成校验码，补到末位
    TmpIDNum[18] := GenIDNumCheckSumChar(TmpIDNum);
    IDNum18      := TmpIDNum;
    Result       := true;
  end;
end;

function GetIDNumInfo(IDNum: string; var IDNumInfo: TIDNumInfo): boolean;
var
  ToProcess : boolean;
  IDNumLen,
  Year, Month, Day : word;
  SexMark          : char;
begin
  Result := false;
  FillChar(IDNumInfo, sizeof(IDNumInfo), #0);

  IDNumLen := length(IDNum);
  if IDNumLen in [15, 18] then
  begin
    ToProcess := false;
//检查字符串是否符合要求
    case IDNumLen of
//15位身份证号码，全部要求为数字
      15  : begin
              ToProcess := IsDigiStr(IDNum);
              IDNumInfo.IDNumType := idnum15;
              IDNumInfo.ChecksumRst := csNoChecksum;
            end;
//18位身份证号码，前17位必须是数字，最后一位除数字外，可能是"X"
      18  : begin
              ToProcess := IsDigiStr(Copy(IDNum, 1, 17)) and (IsDigiChar(IDNum[18]) or (IDNum[18] in ['x', 'X']));
              IDNumInfo.IDNumType := idnum18;
            end;
    end;

    if ToProcess then
    begin
//取区划代码
      IDNumInfo.RegionCode := Copy(IDNum, 1, 6);

//取生日信息
      case IDNumInfo.IDNumType of
        idnum15 : begin
                    Year  := strtoint('19' + Copy(IDNum, 7, 2));
                    Month := strtoint(Copy(IDNum, 9, 2));
                    Day   := strtoint(Copy(IDNum, 11, 2));
                  end;
        idnum18 : begin
                    Year  := strtoint(Copy(IDNum, 7, 4));
                    Month := strtoint(Copy(IDNum, 11, 2));
                    Day   := strtoint(Copy(IDNum, 13, 2));
                  end;
        else
        begin
          Year  := 0;
          Month := 0;
          Day   := 0;
        end;
      end;
//尝试将生日信息转换成日期
      try
        IDNumInfo.BirthDay := EncodeDate(Year, Month, Day);
      except
        ToProcess := false;
      end;

      if ToProcess then
      begin
//取性别
        SexMark := '1';
//取性别标志
        case IDNumInfo.IDNumType of
          idnum15 : SexMark := IDNum[15];
          idnum18 : SexMark := IDNum[17];
        end;
//判断性别
        case strtoint(SexMark) mod 2 of
          0 : IDNumInfo.Sex := sexFemale;
          1 : IDNumInfo.Sex := sexMale;
        end;

//如果是18位的身份证，判断校验是否正确
        if IDNumInfo.IDNumType = idnum18 then
        begin
          if CompareText(GenIDNumCheckSumChar(IDNum), IDNum[18]) = 0 then
          begin
            IDNumInfo.ChecksumRst := csChecksumCorrect;
            Result := true;
          end;
        end else
          Result := true;
      end;
    end;
  end;
end;

//判断身份证号码是否正确，通过从中取信息是否成功来判定。
function IsIDNumValid(IDNum: string): boolean;
var
  TmpIDNumInfo : TIDNumInfo;
begin
  Result := GetIDNumInfo(IDNum, TmpIDNumInfo);
end;

//将区划代码转换成名称
function RegionCode2Str(RegionCode: string; RegionCodeArray: TRegionCodeTransArray): string;

//在列表中搜索指定的区划代码所对应的名称
//用折半查找，所以要求输入的对应关系必须是有序的
  function SearchRegionStr(SearchRegionCode: string): string;
  var
    SearchFrom,
    SearchTo,
    CheckIdx,
    SearchValue,
    CheckValue   : integer;
  begin
    Result := '';

    SearchFrom   := low(RegionCodeArray);
    SearchTo     := high(RegionCodeArray);
    SearchValue  := StrToInt(SearchRegionCode);
    while SearchFrom <= SearchTo do
    begin
      CheckIdx := (SearchFrom + SearchTo) div 2;
      CheckValue := StrToInt(RegionCodeArray[CheckIdx].RegionCode);

      if CheckValue = SearchValue then
      begin
        Result := RegionCodeArray[CheckIdx].RegionStr;
        Break;
      end else
        if CheckValue > SearchValue then
        begin
          SearchTo := CheckIdx - 1;
        end else
          if CheckValue < SearchValue then
          begin
            SearchFrom := CheckIdx + 1;
          end;
    end;
  end;

var
  SepRegionCode : TSepRegionCode;
  TmpStr,
  SearchRst : string;
begin
  Result := '';
//区划代码为6位
  if (length(RegionCode) = 6) and IsDigiStr(RegionCode) and (length(RegionCodeArray) > 0) then
  begin
//分解区划代码
    SepRegionCode.ProvinceCode := Copy(RegionCode, 1, 2);
    SepRegionCode.CityCode     := Copy(RegionCode, 3, 2);
    SepRegionCode.CountyCode   := Copy(RegionCode, 5, 2);

//省级的区划代码不包括11以下的组合
    if StrToInt(SepRegionCode.ProvinceCode) > 10 then
    begin
//列表内搜索省的名称
      TmpStr := '';
      SearchRst := SearchRegionStr(SepRegionCode.ProvinceCode + '0000');
      if length(SearchRst) > 0 then
      begin
        TmpStr := SearchRst;
//在列表内搜索市的名称
        SearchRst := SearchRegionStr(SepRegionCode.ProvinceCode + SepRegionCode.CityCode + '00');
        if length(SearchRst) > 0 then
        begin
          if not((SearchRst = '市辖区') or (SearchRst = '县')) then
            TmpStr := TmpStr + SearchRst;
//在列表内搜索县的名称
          SearchRst := SearchRegionStr(SepRegionCode.ProvinceCode + SepRegionCode.CityCode + SepRegionCode.CountyCode);
          if length(SearchRst) > 0 then
          begin
            if not((SearchRst = '市辖区') or (SearchRst = '县')) then
              TmpStr := TmpStr + SearchRst;
          end;
        end;
      end;

      Result := TmpStr;
    end;

  end;

end;

//取区划名称
function GetRegionStr(RegionCode: string; FromFileName: string): string;
var
  RegionCodeArray: TRegionCodeTransArray;
begin
  if LoadRegionDat(FromFileName, RegionCodeArray) then
    Result := RegionCode2Str(RegionCode, RegionCodeArray)
  else
    Result := '';
end;

//取区划名称
function GetRegionStr(RegionCode: string): string;
begin
  Result := RegionCode2Str(RegionCode, RegionCodeTransArray);
end;

//取区划名称
function GetRegionStr(var IDNumInfo: TIDNumInfo; FromFileName: string): boolean;
var
  RegionStr : string;
begin
  RegionStr := GetRegionStr(IDNumInfo.RegionCode, FromFileName);
  if not (RegionStr = '') then
  begin
    IDNumInfo.RegionStr := RegionStr;
    Result := true;
  end else
    Result := false;
end;

//取区划名称
function GetRegionStr(var IDNumInfo: TIDNumInfo): boolean;
var
  RegionStr : string;
begin
  RegionStr := GetRegionStr(IDNumInfo.RegionCode);
  if not (RegionStr = '') then
  begin
    IDNumInfo.RegionStr := RegionStr;
    Result := true;
  end else
    Result := false;
end;

//根据指定分隔符分解字符串，并存入数组
function  DecodeStr2Array(Source: string; SepChar: char; var Rst: TStrArray): integer;
var
  Count, CutFrom, Len: word;

  procedure AddStr(Str: string);
  begin
    SetLength(Rst, length(Rst) + 1);
    Rst[high(Rst)] := Str;
  end;
begin
  Result := 0;
  SetLength(Rst, 0);
  len := length(Source);
  if len > 0 then
  begin
    CutFrom := 1;

    for count := 1 to len do //逐字符扫描字符串，遇到分隔符时则切断串获得数据
      if (Source[count] = SepChar) then begin
        AddStr(Copy(Source, CutFrom, count - CutFrom));
        CutFrom := count + 1;
        if Count = Len then
          AddStr('');
      end else
        if count = len then
        begin
          AddStr(Copy(Source, CutFrom, count - CutFrom + 1));
          Break;
        end;

    Result := length(Rst);
  end;
end;

//把区划代码和名称的对应关系从文件读到变量中
function LoadRegionDat(FromFileName: string; var RegionCodeArray: TRegionCodeTransArray): boolean;
var
  Count0 : integer;
  RegionDatFile : TStringList;
  StrArray      : TStrArray;
begin
  Result := false;
  SetLength(RegionCodeArray, 0);

  if FileExists(FromFileName) then
  begin
    RegionDatFile := TStringList.Create;
//读入文件
    try
      RegionDatFile.LoadFromFile(FromFileName);
    except

    end;
//处理数据
    for Count0 := 0 to RegionDatFile.Count - 1 do
//跳过空行
      if length(RegionDatFile[Count0]) > 0 then
      begin
//跳过以#开头的行（注释行）
        if not (RegionDatFile[Count0][1] = '#') then
        begin
//分解数据
          if (DecodeStr2Array(RegionDatFile[Count0], ',', StrArray) = 2) and   //以,分隔的两个字段
            (length(StrArray[0]) = 6) and                                      //代码长度为6个字符
            IsDigiStr(StrArray[0]) and                                         //代码必须全部是数字
            (length(StrArray[1]) > 0) then                                     //名称长度必须大于1
          begin
//增加内容
            SetLength(RegionCodeArray, length(RegionCodeArray) + 1);
            RegionCodeArray[high(RegionCodeArray)].RegionCode := StrArray[0];
            RegionCodeArray[high(RegionCodeArray)].RegionStr  := StrArray[1];
          end;
        end;
      end;

    Result := length(RegionCodeArray) > 0;

    RegionDatFile.Free;
  end;
end;

//直接将区划代码信息读入到本单元的公用变量里
function LoadRegionDat(FromFileName: string): boolean;
begin
  Result := LoadRegionDat(FromFileName, RegionCodeTransArray);
end;

initialization
  SetLength(RegionCodeTransArray, 0);

end.