📄 unimain.pas

📁 查询邮政区号、身份证号、手机号的归属地
💻 PAS
字号:
unit uniMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, Grids, DBGrids, DB, ADODB,
  WinSkinData, SysPath;

type
  TfrmMain = class(TForm)
    ADOCN: TADOConnection;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    DBGrid1: TDBGrid;
    Edt_Post: TEdit;
    Btn_SearchP: TButton;
    TabSheet2: TTabSheet;
    Label2: TLabel;
    Edt_ID: TEdit;
    Mem_ID: TMemo;
    Btn_SearchID: TButton;
    TabSheet3: TTabSheet;
    Label3: TLabel;
    Edt_Mobile: TEdit;
    Btn_SearchM: TButton;
    Mem_Mobile: TMemo;
    DataSource1: TDataSource;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    ADOQuery3: TADOQuery;
    Btn_Quit: TButton;
    SkinData: TSkinData;
    SysPath: TSysPath;
    procedure FormCreate(Sender: TObject);
    procedure Btn_SearchPClick(Sender: TObject);
    procedure Btn_SearchIDClick(Sender: TObject);
    Function IDToNewID(ID:String):String;
    procedure Btn_SearchMClick(Sender: TObject);
    procedure TabSheet1Show(Sender: TObject);
    procedure TabSheet2Show(Sender: TObject);
    procedure TabSheet3Show(Sender: TObject);
    procedure Btn_QuitClick(Sender: TObject);
    procedure Edt_PostKeyPress(Sender: TObject; var Key: Char);
    procedure Edt_IDKeyPress(Sender: TObject; var Key: Char);
    procedure Edt_MobileKeyPress(Sender: TObject; var Key: Char);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  arr: array[1..17] of string=('7','9','10','5','8','4','2','1','6','3','7','9','10','5','8','4','2');

implementation

{$R *.dfm}
{$R Res\Data.RES}

uses
  uniFunc;

var
  DataFile:String='';

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Self.Icon:=Application.Icon;
  DataFile:=SysPath.System+'Data.mdb';
  if ExtractRes('Database','Data',DataFile)=0 then
  begin
    if ADOCN.ConnectionString<>'' then
    begin
      ADOCN.Connected:=False;
      ADOCN.ConnectionString:='';
    end;
    ADOCN.ConnectionString:='Data Source='+DataFile;
    ADOCN.Connected:=True;
  end
  else
  begin
    Application.MessageBox('找不到数据库文件！','错误',MB_OK+MB_ICONError+MB_SystemModal);
    Application.Terminate;
  end;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  try
    ADOCN.Connected:=False;
    if FileExists(DataFile) then
    DeleteFile(DataFile);
  except
  end;
end;

procedure TfrmMain.Btn_SearchPClick(Sender: TObject);
begin
  if trim(Edt_Post.Text)='' then
  begin
    ShowMessage('请输入邮政区号！');
    Edt_Post.SetFocus;
    Exit;
  end;
  with ADOQuery1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('Select * from Data where 区号=:Post');
    Parameters.ParamByName('Post').Value:=trim(Edt_Post.Text);
    Open;
  end;
end;

procedure TfrmMain.Btn_SearchIDClick(Sender: TObject);
var
  QWID,ID,NewID,IsVal,InputValue:String;
  IsExist:Boolean;
  i:integer;
  Month,Day:string;
begin
  IsExist:=False;
  ID:=Trim(Edt_ID.Text);
  //位数的判断
  if (Length(ID)<>15) And (Length(ID)<>18)  then
  begin
    Mem_ID.Clear;
    ShowMessage('身份证号码不对，应该是15或者18位！');
    Edt_ID.SetFocus;
    Exit;
  end;
  //判断年月日的正确性
  if Length(ID)=15 then
  begin
    Month:=Copy(ID,9,2);
    Day:=Copy(ID,11,2);
  end
  else if Length(ID)=18 then
  begin
    Month:=Copy(ID,11,2);
    Day:=Copy(ID,13,2);
  end;
  if not (((StrToInt(Month))>=01) and ((StrToInt(Month))<=12)) then
  begin
    Mem_ID.Clear;
    Showmessage('身份证号月份不对，请检查！');
    Edt_ID.SetFocus;
    Exit;
  end;
  if not (((StrToInt(Day))>=01) and ((StrToInt(Day))<=31)) then
  begin
    Mem_ID.Clear;
    Showmessage('身份证号日期不对，请检查！');
    Edt_ID.SetFocus;
    Exit;
  end;
  //如果数据是粘贴进来的，判断是否是正确的
  InputValue:=ID;
  for i:=1 to Length(InputValue) do
  begin
    IsVal:=Copy(InputValue,1,1);
    if not (((IsVal>='0') and (IsVal<='9')) or (UpperCase(IsVal)='X')) then
    begin
      Mem_ID.Clear;
      ShowMessage('身份证号码无效，请检查！');
      Edt_ID.SetFocus;
      Edt_ID.SelectAll;
      Exit;
    end;
    Delete(InputValue,1,1);
  end;
  QWID:=copy(ID,1,6);
  with ADOQuery2 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select DQ from  SFZ Where BM=:ID');
    Parameters.ParamByName('ID').Value:=QWID;
    Open;
    if IsEmpty then
    begin
      Close;
      SQL.Clear;
      SQL.Add('select DQ from  SFZ Where BM=:ID');
      Parameters.ParamByName('ID').Value:=copy(QWID,1,4)+'00';
      Open;
      if IsEmpty then
      begin
        Close;
        SQL.Clear;
        SQL.Add('select DQ from  SFZ Where BM=:ID');
        Parameters.ParamByName('ID').Value:=copy(QWID,1,2)+'0000';
        Open;
        if IsEmpty then IsExist:=False;
      end;
    end
    else IsExist:=True;
    Mem_ID.Lines.Clear;
    Mem_ID.Lines.Add('查身份证 ：'+ID);
    if IsExist then
    begin
       Mem_ID.Lines.Add('原户籍地 ：'+FieldByName('DQ').AsString);
    end;
  end;
  if Length(ID)=15 then
  begin
    NewID:=Copy(ID,1,6)+'19'+Copy(ID,7,6)+Copy(ID,13,3);
    NewID:=NewID+IDToNewID(NewID);
  end
  else if Length(ID)=18 then
  begin
    NewID:=ID;
  end;
  Mem_ID.Lines.Add('出生年月 ：'+Copy(NewID,7,4)+'年'+Copy(NewID,11,2)+'月'+Copy(NewID,13,2)+'日');
  Mem_ID.Lines.Add('新身份证 ：'+NewID);
  if (StrToInt(Copy(NewID,17,1)) Mod 2)=0 then
    Mem_ID.Lines.Add('性　   别  ：女')
  else
    Mem_ID.Lines.Add('性　   别  ：男');
end;

function TfrmMain.IDToNewID(ID: String): String;
var
  i,S:Integer;
  XYM:String;
  Ai,Wi:string;
begin
  S:=0;
  for i:=1 to 17 do
  begin
    Ai:=Copy(ID,i,1);
    Wi:= arr[i];
    S:=S+StrToInt(Ai)*StrToInt(Wi);
  end;
  Case (S Mod 11) of
  0 : XYM :='1';
  1 : XYM :='0';
  2 : XYM :='X';
  3 : XYM :='9';
  4 : XYM :='8';
  5 : XYM :='7';
  6 : XYM :='6';
  7 : XYM :='5';
  8 : XYM :='4';
  9 : XYM :='3';
  10: XYM :='2';
  end;
  Result:=XYM;
end;

procedure TfrmMain.Btn_SearchMClick(Sender: TObject);
var
  Mno,InputValue,IsVal:String;
  i:integer;
begin
  if Length(trim(Edt_Mobile.Text))<>11 then
  begin
    Mem_Mobile.Clear;
    ShowMessage('手机号码位数不对，应该是11位！');
    Edt_Mobile.SetFocus;
    Exit;
  end;
  //如果数据是粘贴进来的，判断是否是正确的
  InputValue:=Trim(Edt_Mobile.Text);
  for i:=1 to Length(InputValue) do
  begin
    IsVal:=Copy(InputValue,1,1);
    if not ((IsVal>='0') and (IsVal<='9')) then
    begin
      Mem_Mobile.Clear;
      ShowMessage('身份证号码无效，请检查！');
      Edt_Mobile.SetFocus;
      Edt_Mobile.SelectAll;
      Exit;
    end;
    Delete(InputValue,1,1);
  end;
  Mno:=copy(Trim(Edt_Mobile.Text),1,7);
  with ADOQuery3 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from sj where 号码B<='+Mno +' and 号码E>='+Mno);
    Open;
    if RecordCount>0 then
    begin
      Mem_Mobile.Lines.Clear;
      Mem_Mobile.Lines.Add('手机地区　:　'+FieldByName('地区').AsString);
      Mem_Mobile.Lines.Add('手机城市　:　'+FieldByName('城市').AsString);
      Mem_Mobile.Lines.Add('手机区号　:　'+FieldByName('区号').AsString);
      Mem_Mobile.Lines.Add('手机类型　:　'+FieldByName('类型').AsString);
    end
    else
    begin
      Mem_Mobile.Lines.Clear;
      Mem_Mobile.Lines.Add('手机地区　:　未知地区');
    end;
  end;
end;

procedure TfrmMain.Btn_QuitClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.TabSheet1Show(Sender: TObject);
begin
  Edt_Post.SetFocus;
end;

procedure TfrmMain.TabSheet2Show(Sender: TObject);
begin
  Edt_ID.SetFocus;
end;

procedure TfrmMain.TabSheet3Show(Sender: TObject);
begin
  Edt_Mobile.SetFocus;
end;

procedure TfrmMain.Edt_PostKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then  Btn_SearchP.Click;
end;

procedure TfrmMain.Edt_IDKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then  Btn_SearchID.Click;
end;

procedure TfrmMain.Edt_MobileKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then  Btn_SearchM.Click;
end;

end.
💿 文件大小 413 K
👤 上传用户 hqq
📂 所属分类手机短信编程
🏷️ 相关标签

#查询 #手机 #身份证
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -