⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 再上传小程序:区号身份证手机号码归属地查询 V1.0
💻 PAS
字号:
unit Main;

interface

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

type
  TForm1 = 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;
    Button1: TButton;
    Button2: TButton;
    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 Button1Click(Sender: TObject);
    procedure Button2Click(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);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

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

uses About;


{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  if ADOCN.ConnectionString<>'' then
    begin
      ADOCN.Connected:=False;
      ADOCN.ConnectionString:='';
    end;
  ADOCN.ConnectionString := 'Data Source=' + ExtractFilePath(Application.ExeName) + 'Data.Mdb';
  ADOCN.Connected:=True;
end;

procedure TForm1.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 TForm1.Btn_SearchIDClick(Sender: TObject);
var
  QWID,ID,NewID,IsVal,InputValue:String;
  IsExist:Boolean;
  i:integer;
  Month,Day:string;
begin
  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 TForm1.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:
       begin
         XYM :='1';
       end;
     1:begin
         XYM :='0';
       end;
     2:begin
         XYM :='X';
       end;
     3:begin
         XYM :='9';
       end;
     4:begin
         XYM :='8';
       end;
     5:begin
         XYM :='7';
       end;
     6:begin
         XYM :='6';
       end;
     7:begin
         XYM :='5';
       end;
     8:begin
         XYM :='4';
       end;
     9:begin
         XYM :='3';
       end;
     10:begin
         XYM :='2';
        end;
  end;
  Result:=XYM;
end;
procedure TForm1.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 TForm1.TabSheet1Show(Sender: TObject);
begin
  Edt_Post.SetFocus;
end;

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

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

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Form2.Show;
end;

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

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

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

end.

⌨️ 快捷键说明

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