发信人: ilike()
整理人: edison(2000-01-20 01:20:48), 站内信件
|
被SD伟大精神感动，我也奉献一把吧。
读IP地址网上我见的几个PB程序其实都是访问注册表的，这种方法很多时候会失
效的。
通过winsock取IP地址有人说不能用PB写，因为数据结构中有指针的指针的指针的
指针。
下面这段程序演示了如何使用PB处理这种指针的指针的指针的指针的情况。
另,to 飘香
你给的程序不是很通用的，必须netbios被网络协议支持才行，不过除了netbios
外，我也不知道会有什么方法。
$PBExportHeader$w_getip.srw
$PBExportComments$取本机IP地址
forward
global type w_getip from Window
end type
type st_3 from statictext within w_getip
end type
type st_ip from statictext within w_getip
end type
type st_hostname from statictext within w_getip
end type
type st_2 from statictext within w_getip
end type
type st_1 from statictext within w_getip
end type
type cb_1 from commandbutton within w_getip
end type
end forward
type str_wsadata from structure
unsignedinteger wversion
unsignedinteger whighversion
character szdescription[257]
character szsystemstatus[129]
unsignedinteger imaxsockets
unsignedinteger imaxudpdg
string lpvendorinfo
end type
type str_hostent from structure
unsignedlong h_name
unsignedlong h_aliases
unsignedinteger h_addrtype
unsignedinteger h_length
unsignedlong h_addrlist
end type
global type w_getip from Window
int X=823
int Y=360
int Width=2208
int Height=916
boolean TitleBar=true
string Title="取本机IP地址"
long BackColor=79741120
boolean ControlMenu=true
boolean MinBox=true
boolean MaxBox=true
boolean Resizable=true
st_3 st_3
st_ip st_ip
st_hostname st_hostname
st_2 st_2
st_1 st_1
cb_1 cb_1
end type
global w_getip w_getip
type prototypes
function ulong inet_ntoa(ulong in_addr) library "ws2_32"
function integer WSAStartup ( uint wVersionRequested, ref str_wsadata
lpwsadata ) library "ws2_32"
function integer WSACleanup ( ) library "ws2_32"
function ulong gethostbyname( string name ) library "ws2_32"
function int gethostname(ref string name, int namelen)library "ws2_32"
function ulong RtlMoveMemory ( ref str_hostent dest, ulong source, ulo
ng length ) library "kernel32"
function ulong RtlMoveMemory ( ref blob dest, ulong source, ulong leng
th ) library "kernel32"
function ulong RtlMoveMemory ( ref ulong dest , ulong source, ulong le
ngth ) library "kernel32"
function ulong RtlMoveMemory ( ref string dest, ulong source, ulong le
ngth ) library "kernel32"
end prototypes
on w_getip.create
this.st_3=create st_3
this.st_ip=create st_ip
this.st_hostname=create st_hostname
this.st_2=create st_2
this.st_1=create st_1
this.cb_1=create cb_1
this.Control[]={this.st_3,&
this.st_ip,&
this.st_hostname,&
this.st_2,&
this.st_1,&
this.cb_1}
end on
on w_getip.destroy
destroy(this.st_3)
destroy(this.st_ip)
destroy(this.st_hostname)
destroy(this.st_2)
destroy(this.st_1)
destroy(this.cb_1)
end on
type st_3 from statictext within w_getip
int X=718
int Y=552
int Width=1371
int Height=140
boolean Enabled=false
string Text="by:ilike bbs.nease.net-PB论坛版主"
boolean FocusRectangle=false
long TextColor=33554432
long BackColor=67108864
int TextSize=-12
int Weight=400
string FaceName="Arial"
FontCharSet FontCharSet=Ansi!
FontFamily FontFamily=Swiss!
FontPitch FontPitch=Variable!
end type
type st_ip from statictext within w_getip
int X=1042
int Y=236
int Width=1038
int Height=76
boolean Enabled=false
boolean FocusRectangle=false
long TextColor=33554432
long BackColor=67108864
int TextSize=-12
int Weight=400
string FaceName="Arial"
FontCharSet FontCharSet=Ansi!
FontFamily FontFamily=Swiss!
FontPitch FontPitch=Variable!
end type
type st_hostname from statictext within w_getip
int X=1047
int Y=84
int Width=1074
int Height=76
boolean Enabled=false
boolean FocusRectangle=false
long TextColor=33554432
long BackColor=67108864
int TextSize=-12
int Weight=400
string FaceName="Arial"
FontCharSet FontCharSet=Ansi!
FontFamily FontFamily=Swiss!
FontPitch FontPitch=Variable!
end type
type st_2 from statictext within w_getip
int X=773
int Y=244
int Width=247
int Height=76
boolean Enabled=false
string Text="IP地址:"
boolean FocusRectangle=false
long TextColor=33554432
long BackColor=67108864
int TextSize=-12
int Weight=400
string FaceName="Arial"
FontCharSet FontCharSet=Ansi!
FontFamily FontFamily=Swiss!
FontPitch FontPitch=Variable!
end type
type st_1 from statictext within w_getip
int X=709
int Y=88
int Width=325
int Height=76
boolean Enabled=false
string Text="主机名称:"
boolean FocusRectangle=false
long TextColor=33554432
long BackColor=67108864
int TextSize=-12
int Weight=400
string FaceName="Arial"
FontCharSet FontCharSet=Ansi!
FontFamily FontFamily=Swiss!
FontPitch FontPitch=Variable!
end type
type cb_1 from commandbutton within w_getip
int X=69
int Y=68
int Width=549
int Height=640
int TabOrder=10
string Text="Get IP"
int TextSize=-12
int Weight=400
string FaceName="Arial"
FontCharSet FontCharSet=Ansi!
FontFamily FontFamily=Swiss!
FontPitch FontPitch=Variable!
end type
event clicked;// 初始化winsock
Integer li_WSAVersion = 257 // 最低要求的Winsock版本号，0x101
ulong ll_HostEntAddr, ll_addr_list, ll_IPAddr, ll_StringIP
str_WSAData lstr_WSA
str_hostent lstr_hostent
String ls_hostName, ls_ip
integer li_rc
// 初始化Winsock
li_rc = WSAStartup ( li_WSAVersion, lstr_WSA )
// 取得主机名称
ls_HostName = Space ( 65 )
gethostname ( ls_hostname, 64 )
If Trim ( ls_hostname ) = "" Then Goto l_release
st_hostname.text = ls_hostname
// 取IP地址，返回指向结构HostEnt的指针
ll_HostEntAddr = gethostbyname ( ls_hostname )
If ll_HostEntAddr = 0 Then Goto l_release
// 将指针所指的内容移到结构中以便读取
RtlMoveMemory ( lstr_hostent, ll_HostEntAddr, 16 )
// 取得指向IP地址的指针, ll_addr_list指向一个指向IP地址的指针数组
ll_addr_list = lstr_hostent.h_Addrlist
ulong ll_IP
ls_IP = Space ( 257 )
Do While True
RtlMoveMemory ( ll_IPAddr , ll_addr_list, 4 )
If ll_IPAddr = 0 Then Exit
RtlMoveMemory ( ll_IP, ll_IPAddr, 4 )
// 将数值型的IP地址转换为字符型, 返回值为char*
ll_StringIP = inet_ntoa ( ll_IP )
// 将char*移入PB中读取
RtlMoveMemory ( ls_ip, ll_stringIP, 256 )
st_ip.text = ls_ip
// 指针加4，继续读取下一个IP地址
ll_addr_list += 4
Loop
l_release:
// 释放资源
WSACleanup ( )
end event
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.96.156.11]
|
|