如何得到本机的上网IP(200)(200分)

如题

function GetIPAddress : string;
var
Sdata : TWSAData;
ErrorCode: Integer;
HEnt: PHostEnt;
IPAddr : TInAddr;
CName : PChar;
iSize : longword;
begin
isize := MAX_COMPUTERNAME_LENGTH;

GetMem(CName, iSize);

Try
GetComputerName(CName, iSize);

ErrorCode := WSAStartup($0101, SData);

if ErrorCode = 0 then
begin
Try
HEnt := GetHostbyName(CName);

if HEnt <> nil then
begin
with IPAddr, HEnt^ do
begin
S_un_b.s_b1 := h_addr^[0];
S_un_b.s_b2 := h_addr^[1];
S_un_b.s_b3 := h_addr^[2];
S_un_b.s_b4 := h_addr^[3];
end;
Result := inet_ntoa(IPAddr);
end;
Finally
ErrorCode := WSACleanup;
end;
end;
Finally
FreeMem(CName);
end;
end;

要报错啊！Access violation at address 00000000.Read of address FFFFFFFF

在我的win2000＋delphi5上很正常啊。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, WinSock;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
ClientSocket1: TClientSocket;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

function GetIPAddress : string;
var
Sdata : TWSAData;
ErrorCode: Integer;
HEnt: PHostEnt;
IPAddr : TInAddr;
CName : PChar;
iSize : longword;
begin
isize := MAX_COMPUTERNAME_LENGTH;

GetMem(CName, iSize);

Try
GetComputerName(CName, iSize);

ErrorCode := WSAStartup($0101, SData);

if ErrorCode = 0 then
begin
Try
HEnt := GetHostbyName(CName);

if HEnt <> nil then
begin
with IPAddr, HEnt^ do
begin
S_un_b.s_b1 := h_addr^[0];
S_un_b.s_b2 := h_addr^[1];
S_un_b.s_b3 := h_addr^[2];
S_un_b.s_b4 := h_addr^[3];
end;
Result := inet_ntoa(IPAddr);
end;
Finally
ErrorCode := WSACleanup;
end;
end;
Finally
FreeMem(CName);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := GetIPAddress;
end;

end.

我也写一个~
uses WinSock;
Function GetIPAddress: String;
var
phosteHostEnt;
Buffer:array[0..100] of char;
WSAData:TWSADATA;
begin
result:='';
if WSASTartup($0101, WSAData) <> 0 then exit;
GetHostName(Buffer,Sizeof(Buffer));
phoste:=GetHostByName(buffer);
if phoste = nil then
begin
result:='127.0.0.1';
end
else
result:=StrPas(inet_ntoa(PInAddr(phoste^.h_addr_list^)^));
WSACleanup;
end;

我是win98+delphi6.0

你快试试！好了把分给我

你可以逐步执行，看是那句出错。

uses Winsock;

// returns ISP assigned IP
function LocalIP : string;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I : Integer;
GInitData : TWSADATA;

begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^ <> nil do begin
result:=StrPas(inet_ntoa(pptr^^));
Inc(I);
end;
WSACleanup;
end;

[]好像有一个叫做FolkOICQ的补丁程序，可以拷贝到QQ安装目录，直接在发送消息窗口
就可看到对方IP,不妨找来试试？

up

出来了，但不是我要的！

谁用过QQ的IP探测器！要的是那个IP!

要的是上网的IP,不是本机的IP

你的“上网ip”指的是独立ip?

还是不对！

先自己测试一下好吗？

注意：不是本机的IP,
是ISP返回的IP.

来自：李颖, 时间：2000-4-26 21:49:00, ID：232186
程序如下：

var
WSData: TWSAData;
Buffer: array[0..63] of Char;
HostEnt: PHostEnt;
PPInAddr: ^PInAddr;

LocalIP: DWord;
IPString: String;

//取本机IP地址
procedure GetIP;
begin
LocalIP:=0;
IPString:='';
try
WSAStartUp($101, WSData);
GetHostName(Buffer, SizeOf(Buffer));
HostEnt:=GetHostByName(Buffer);
if Assigned(HostEnt) then
begin
PPInAddr:=@(PInAddr(HostEnt.H_Addr_List^));
while Assigned(PPInAddr^) do
begin
IPString:=StrPas(INet_NToA(PPInAddr^^));
LocalIP:=PPInAddr^^.S_Addr;
Inc(PPInAddr);
end;
end;
finally
try
WSACleanUp;
except
end;
end;
end;

//取本机IP地址,返回4字节格式
function GetIPAddress: DWORD;
begin
GetIP;
Result := LocalIP;
end;


//取本机IP地址,返回点分隔字符串格式
function GetLocalIP: String;
begin
GetIP;
Result := IPString;
end;

>> 我想说winipcfg得到的只是网卡在局域网上的IP，不能得到ISP动态分配的IP
上面的代码是我自己写的，
我没测试过是否能得到你要的。。。
试试看先！


来自：李颖, 时间：2000-4-26 21:51:00, ID：232188
忘了写了，上面的程序需要
uses
.....<font color=red>WinSock</font>....

旧资料中有啊？

随时随刻知道自己的IP
资料编号：22692　来源：电脑爱好者　首先打开Delphi新建一个工程，添加一个定时器Timer1、一个标签Label1、一个PopupMenu1，并且为PopupMenu1添加一个Exit菜单项。下面就是全部的源代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls, Winsock; //首先要添加winsock
type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
PopupMenu1: TPopupMenu;
Exit: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
oldx,oldy: integer;//添加变量,用做移动窗体
oldIp: string;
implementation
{$R *.dfm}
//下面就是关键所在了
function LIP : string;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I : Integer;
GInitData : TWSADATA;
begin
WSAStartup($101, GInitData);
Result := ’’;
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^ <> nil do begin
result:=StrPas(inet_ntoa(pptr^^));
Inc(I);
end;
WSACleanup;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
with Label1 do //定义属性
begin
Caption:=’’;
Font.Charset:=ANSI_CHARSET;
Font.Name:=’Arial’;
Font.Size:=10;
Font.Color:=clRed;
Align:=alClient;
PopupMenu:=popupmenu1;
end;

Timer1.Interval:=1000;
Timer1.Enabled:=true;
Label1.Caption:=’IP:’+LIP; //赋值，把Ip赋值给label1
oldIp:=LIP;
BorderStyle:=bsNone;
Alphablend:=true; //呵呵，这个就是让窗口变透明的办法了
Alphablendvalue:=100;
FormStyle:=fsStayOnTop; //让窗体总在最前面
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption :=’IP:’+LIP;
if oldip <> LIP then
Showmessage(’IP地址已经改变,请检查!’);//提醒用户
end;

procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssleft in shift then //移动窗体Form1
begin
Form1.Left:=Form1.Left+x-oldx;
Form1.Top:=Form1.top+y-oldy;
end;
end;

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
oldx:=x;
oldy:=y;
end;

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

给你一个函数
//获取本机IP地址；InternetIP=TRUE为上网地质
Function GetLocalIp(InternetIP:boolean):String;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
IP: String;
begin
Screen.Cursor := crHourGlass;
try
WSAStartup($101, GInitData);
IP:='0.0.0.0';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then
begin
ShowMessage(IP);
Result:=IP;
Exit;
end;
pPtr := PaPInAddr(phe^.h_addr_list);
if InternetIP then
begin
I := 0;
while pPtr^ <> nil do
begin
IP := inet_ntoa(pptr^^);
Inc(I);
end;
end
else
IP := inet_ntoa(pptr^[0]^);
WSACleanup;
Result:=IP;//如果上网则为上网ip否则是网卡ip
finally
Screen.Cursor := crDefault;
end;
end;

function GetLocalIP:String;
VAR
ch : ARRAY[1..32] OF Char;
i : Integer;
WSData: TWSAData;
MyHost: PHostEnt;
begin
IF WSAstartup(2,wsdata)<>0 THEN BEGIN
Halt(2);
END;
try
IF getHostName(@ch[1],32)<>0 THEN BEGIN
Halt(3); END;
except
halt(3);
end;
MyHost:=GetHostByName(@ch[1]);
IF MyHost=NIL THEN BEGIN
Halt(4);
END ELSE BEGIN
FOR i:=1 TO 4 DO BEGIN
Result:=Result+IntToStr(Ord(MyHost.h_addr^[i-1]));
if i<4 then Result:=Result+'.';
END;
END;
END;

没有一个能满足要求的！