qqwry.pas

一套非常好用的delphi控件,方便程序员工作

{******************************************************************}
{*                       qqwry.PAS - TQQwry                       *}
{*                           版本 1.00                            *}
{*                         版权属于alicsoft                       *}
{*                     http://www.alicsoft.com                    *}
{*                         [e-mail]                      *}
{*                       属性  QQwry: String                      *}
{*           方法 function Ip2Address(Const Ip: String):String    *}
{******************************************************************}
unit qqwry;

interface

uses
  Classes, SysUtils, StrUtils;

type

  TQQwry = class(TComponent)

  private
    firststartIp, lastStartIp, ipcount: Cardinal;
    endIpOff: Cardinal;
    countryFlag: Integer;
		country: string;
    local: string ;
    FileStream: TFileStream;

    FQQWry: String;

    procedure FSetQQwry(const QQwry: String);

    function GetCardinal(const Ip: String):Cardinal;

    function GetStr:string;
    function GetFlagStr(offSet :integer):string;
    procedure GetCountry;
  published
    property QQWry: String read FQQWry write FSetQQwry;
  public
    function Ip2Address(Const Ip: String):String;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TQQwry]);
end;

constructor TQQwry.Create(AOwner: TComponent);
begin
  inherited;
  FileStream := nil;
  if QQWry <> '' then
    QQWry := FQQWry;
end;

destructor TQQwry.Destroy;
begin
  FileStream.Free;
  inherited;
end;

procedure TQQwry.FSetQQwry(const QQwry: String);
begin
  try
    if FileStream <> nil then
      FileStream.Free;
    FQQWry := QQWry;
    FileStream := TFileStream.Create(QQWry, fmOpenRead + fmShareDenyWrite);
    FileStream.Seek(0, soFromBeginning);
    FileStream.Read(firststartip, 4);
    FileStream.Read(lastStartIp, 4);
    ipcount := (lastStartIp - firststartIp) div 7;
  except
    FileStream.Free;
    FileStream := Nil;
    FQQwry := '';
  end;
end;

function TQQwry.GetStr:string;
var
  lowC: char;
begin
  Result := '';
	while true do
  begin
    FileStream.Read(lowC, 1);
		if (lowC = #0) then
      break;
    Result := Result + lowC;
  end;
end;

function TQQwry.GetFlagStr(offSet :integer):string;
var
  flag: Integer;
  buf: array [0..2] of byte;
begin
  flag := 0;
	while true do
  begin
    FileStream.Position := offSet;
    FileStream.Read(flag, 1);
    if (flag = 1) or (flag = 2) then
    begin
      FileStream.Read(buf, 3);
      if (flag = 2) then
      begin
			  countryFlag := 2;
        endIpOff := offSet - 4;
      end;
			offSet := Cardinal(buf[0])+ Cardinal(buf[1]) shl 8 + Cardinal(buf[2]) shl 16;
    end
    else
      break;
  end;
  if(offSet < 12) then
    Result := ' '
  else
  begin
	  FileStream.Position := offSet;
    result := GetStr;
  end
end;

procedure TQQwry.GetCountry;
begin
  case countryFlag of
    1, 2:
    begin
      country := GetFlagStr(endIpOff + 4);
      if countryFlag = 1 then
        local := ' '
      else
        local := GetFlagStr(endIpOff + 8);
    end;
    else
    begin
      country := GetFlagStr(endIpOff + 4);
      local := GetFlagStr(FileStream.Position);
    end;
  end;
end;

function TQQwry.GetCardinal(const Ip: String):Cardinal;
var
  i, p: Integer;
  b : Boolean;
  n1, n2, n3, n4: Cardinal;
  p1, p2: Integer;
begin
  p := 0;
  b := False;
  Result := 0;
  for i := 1 to Length(Ip) do
  begin
    if Ip[i] = '.' then
      p := p + 1
    else
      b := (Ip[i] >= '0') and (Ip[i] <= '9');
  end;
  if not b or (p <> 3) then
    Exit;

  p1 := 1;
  p2 := PosEx('.', Ip, p1 + 1);
  n1 := Cardinal(StrToInt(Copy(Ip, p1, p2 - p1)));

  p1 := p2 + 1;
  p2 := PosEx('.', Ip, p1 + 1);
  n2 := Cardinal(StrToInt(Copy(Ip, p1, p2 - p1)));

  p1 := p2 + 1;
  p2 := PosEx('.', Ip, p1 + 1);
  n3 := Cardinal(StrToInt(Copy(Ip, p1, p2 - p1)));

  p1 := p2 + 1;
  n4 := Cardinal(StrToInt(Copy(Ip, p1, 3)));

  Result := n1 shl 24 + n2 shl 16 + n3 shl 8 + n4;

end;

function TQQwry.Ip2Address(Const Ip: String):String;
  function findip(Const Ip, n1, n2: Cardinal):Cardinal;
  var
    offset: Cardinal;
    startip: Cardinal;
  begin
    Result := (n1 + n2) div 2;
    offset := firstStartIp + Result * 7;
    FileStream.Position := offset;
    FileStream.Read(startip, 4);
    if n2 - n1 > 1 then
    begin
      if Ip < startip then
        Result := findip(ip, n1, Result)
      else
        Result := findip(ip, Result, n2);
    end;
  end;
var
  startip: Cardinal;
  endip: Cardinal;
  offset: Cardinal;
  i: Cardinal;
  buf: array [0..2] of byte;
begin
  Result := ' ';
  if FileStream = nil then
    Exit;
  i := findip(GetCardinal(Ip), 0, ipcount);
  offset := firstStartIp + i * 7;
  FileStream.Position := offset;
  FileStream.Read(startip, 4);
  FileStream.Read(buf, 3);
  endIpOff := Cardinal(buf[0]) + Cardinal(buf[1]) shl 8 + Cardinal(buf[2]) shl 16 ;
  FileStream.Position := endIpOff;
  FileStream.Read(endip, 4);
  FileStream.Read(countryFlag, 1);
  countryFlag := countryFlag and 255;
  GetCountry;
  Result := country + #9 + local;
end;

end.