男人泪何滋味
写字楼里写字间,写字间中程序员。程序人员写程序,又将程序换饭钱。 酒醒只在屏前坐,酒醉还来屏下眠。酒醉酒醒日复日,屏前屏下年复年。 但愿老死电脑间,不愿鞠躬老板前。奔驰宝马贵者趣,公交自行程序员。 别人笑我太疯癫,我笑自己命太贱。但见满街漂亮妹,哪个归得程序员。

很久以前写了个手机号归属地在线查询功能放在盒子上了,今天不小心打开盒子,发现还在,我都忘了。

感谢 skaly 的回复,我又用有道的那个接口,写了个小例子,同时也会传到盒子上。delphi就这了,盒子加油吧!

组件用到NativeXml可自行下载,盒子,解析xml的,有道这个传回来的是gbk的编码.

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, NativeXml, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    function PostData(Atype: Integer; AValue: string): string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Clear;
  Edit2.Clear;
  Edit3.Clear;
  Button1.Caption := '查询';
  Button2.Caption := '查询';
  Button3.Caption := '查询';
  Memo1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  xml: TNativeXml;
begin
  if Edit1.Text <> EmptyStr then
  begin
    xml := TNativeXml.Create(nil);
    try
      xml.ReadFromString(UTF8Encode(PostData(0, Edit1.Text)));
      with Memo1.Lines do
      begin
        Add('type:' + xml.Root.NodeByName('product').AttributeByName['type'].Value);
        Add('ip:' + xml.Root.NodeByName('product').NodeByName('ip').ValueUnicode);
        Add('location:' + xml.Root.NodeByName('product').NodeByName('location').ValueUnicode);
      end;
    finally
      xml.Free;
    end;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    TForm1.PostData
  功能:      查询函数
  作者:
  日期:      2012.08.08
  参数:      Atype: Integer(0:ip 1:手机 2:身份证); AValue: string      
  返回值:    string
-------------------------------------------------------------------------------}

function TForm1.PostData(Atype: Integer; AValue: string): string;
var
  ParamLst: TStrings;
const
  Url = 'http://www.youdao.com/smartresult-xml/search.s'; //?type=%s&q=%s
begin
  ParamLst := TStringList.Create;
  try
    case Atype of
      0: ParamLst.Add('type=ip');
      1: ParamLst.Add('type=mobile');
      2: ParamLst.Add('type=id');
    end;
    ParamLst.Add('q=' + AValue);
    Result := IdHTTP1.Post(Url, ParamLst);
  finally
    ParamLst.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  xml: TNativeXml;
begin
  if Edit2.Text <> EmptyStr then
  begin
    xml := TNativeXml.Create(nil);
    try
      xml.ReadFromString(UTF8Encode(PostData(1, Edit2.Text)));
      with Memo1.Lines do
      begin
        Add('type:' + xml.Root.NodeByName('product').AttributeByName['type'].Value);
        Add('phonenum:' + xml.Root.NodeByName('product').NodeByName('phonenum').ValueUnicode);
        Add('location:' + xml.Root.NodeByName('product').NodeByName('location').ValueUnicode);
      end;
    finally
      xml.Free;
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  xml: TNativeXml;
begin
  if Edit3.Text <> EmptyStr then
  begin
    xml := TNativeXml.Create(nil);
    try
      xml.ReadFromString(UTF8Encode(PostData(2, Edit3.Text)));
      with Memo1.Lines do
      begin
        Add('type:' + xml.Root.NodeByName('product').AttributeByName['type'].Value);
        Add('code:' + xml.Root.NodeByName('product').NodeByName('code').ValueUnicode);
        Add('location:' + xml.Root.NodeByName('product').NodeByName('location').ValueUnicode);
        Add('birthday:' + xml.Root.NodeByName('product').NodeByName('birthday').ValueUnicode);
        Add('gender:' + xml.Root.NodeByName('product').NodeByName('gender').ValueUnicode);
      end;
    finally
      xml.Free;
    end;
  end;
end;

end.

 

Unit1.dfm

object Form1: TForm1
  Left = 271
  Top = 203
  Width = 335
  Height = 278
  Caption = 'ip、手机号、身份证查询'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = '宋体'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 12
  object Label1: TLabel
    Left = 56
    Top = 24
    Width = 24
    Height = 12
    Caption = 'ip:'
  end
  object Label2: TLabel
    Left = 32
    Top = 64
    Width = 48
    Height = 12
    Caption = '手机号:'
  end
  object Label3: TLabel
    Left = 20
    Top = 104
    Width = 60
    Height = 12
    Caption = '身份证号:'
  end
  object Edit1: TEdit
    Left = 81
    Top = 22
    Width = 121
    Height = 20
    TabOrder = 0
    Text = 'Edit1'
  end
  object Edit2: TEdit
    Left = 81
    Top = 61
    Width = 121
    Height = 20
    TabOrder = 1
    Text = 'Edit2'
  end
  object Edit3: TEdit
    Left = 81
    Top = 99
    Width = 121
    Height = 20
    TabOrder = 2
  end
  object Button1: TButton
    Left = 216
    Top = 19
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 3
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 216
    Top = 57
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 4
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 216
    Top = 95
    Width = 75
    Height = 25
    Caption = 'Button3'
    TabOrder = 5
    OnClick = Button3Click
  end
  object Memo1: TMemo
    Left = 0
    Top = 136
    Width = 319
    Height = 104
    Align = alBottom
    Lines.Strings = (
      'Memo1')
    TabOrder = 6
  end
  object IdHTTP1: TIdHTTP
    MaxLineAction = maException
    ReadTimeout = 0
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.ContentRangeEnd = 0
    Request.ContentRangeStart = 0
    Request.ContentType = 'text/html'
    Request.Accept = 'text/html, */*'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    HTTPOptions = [hoForceEncodeParams]
    Left = 152
    Top = 128
  end
end
posted on 2012-08-08 15:25  男人泪何滋味  阅读(397)  评论(0编辑  收藏  举报