From Peter at PSDT.com Thu Jan 13 17:56:50 2005 From: Peter at PSDT.com (Peter Scott) Date: Thu Jan 13 17:56:55 2005 Subject: [VPM] Victoria Perl Mongers meeting January 18 Message-ID: <6.1.2.0.2.20050113175015.0866d620@shell2.webquarry.com> Victoria.pm will meet at its regular date and time, and a less common place, on Tuesday, January 18, 7pm, at UVic. The location is David F. Strong Building C113. See http://uvic.ca for maps if necessary. At the first Victoria Perl Mongers meeting of 2005 we shall extend the holiday spirit a bit and entertain ourselves with an exploration of Damian Conway's SelfGOL. See http://libarynth.f0.am/cgi-bin/twiki/view/Libarynth/SelfGOL for source. Yes, it's obfuscated (duh). But that doesn't mean that this will be (entirely) an exercise in unrolling useless obfuscation techniques. We'll discover quite a few useful and interesting features of Perl along the way, useful and understandable to beginners and experts. In fact, Conway bases an entire seminar on this topic (http://damian.conway.org/Seminars/Extreme.html). We don't have as long as he usually takes, so we may not finish. But we'll have fun nonetheless. If you have a copy of the Camel or a laptop with Perl installed, bring it along. This will be a freewheeling exploration of numerous features of Perl and the chance for everyone to ask questions and find out something new. Other topics to be covered as time permits; make requests for anything particular. (Courtesy copy to VLUG members by permission of the list manager. Victoria.pm's home page is .) -- Peter Scott Pacific Systems Design Technologies http://www.perldebugged.com/ *** New! *** http://www.perlmedic.com/ From darren at DarrenDuncan.net Thu Jan 13 22:24:46 2005 From: darren at DarrenDuncan.net (Darren Duncan) Date: Thu Jan 13 22:34:18 2005 Subject: [VPM] Peter Scott's book shilled on Perl.com Message-ID: Have a look here: http://www.perl.com/pub/a/2005/01/13/quality_assurance.html An Introduction to Quality Assurance by Tom McTighe In the second paragraph it says: To deal with the frustration of constantly being wrong, I began to view programming more as a game that I enjoyed than as an epic battle, and I started looking at things from the compiler's perspective. This view has improved my overall approach to software immensely. I was also fortunate to discover Perl Debugged by Peter Scott and Ed Wright. The authors provide a wealth of information about debugging and testing Perl scripts, but they also emphasize that the right mental attitude is often the key to a programmer's success. Basically, they say that you should enjoy what you do. Congrats Peter. I don't know how often you get mentioned in places other than where your book is sold, but there's another one. -- Darren Duncan From Peter at PSDT.com Mon Jan 17 05:57:00 2005 From: Peter at PSDT.com (Peter Scott) Date: Mon Jan 17 16:25:07 2005 Subject: [VPM] Victoria Perl Mongers meeting tomorrow Message-ID: <6.1.2.0.2.20050113175655.0866d620@shell2.webquarry.com> Victoria.pm will meet at its regular date and time, and a less common place, tomorrow, Tuesday, January 18, 7pm, at UVic. The location is David F. Strong Building C113. See http://uvic.ca for maps if necessary. At the first Victoria Perl Mongers meeting of 2005 we shall extend the holiday spirit a bit and entertain ourselves with an exploration of Damian Conway's SelfGOL. See http://libarynth.f0.am/cgi-bin/twiki/view/Libarynth/SelfGOL for source. Yes, it's obfuscated (duh). But that doesn't mean that this will be (entirely) an exercise in unrolling useless obfuscation techniques. We'll discover quite a few useful and interesting features of Perl along the way, useful and understandable to beginners and experts. In fact, Conway bases an entire seminar on this topic (http://damian.conway.org/Seminars/Extreme.html). We don't have as long as he usually takes, so we may not finish. But we'll have fun nonetheless. If you have a copy of the Camel or a laptop with Perl installed, bring it along. This will be a freewheeling exploration of numerous features of Perl and the chance for everyone to ask questions and find out something new. Other topics to be covered as time permits; make requests for anything particular. (Courtesy copy to VLUG members by permission of the list manager. Victoria.pm's home page is .) -- Peter Scott Pacific Systems Design Technologies http://www.perldebugged.com/ *** New! *** http://www.perlmedic.com/ From jeremygwa at hotmail.com Tue Jan 18 23:03:12 2005 From: jeremygwa at hotmail.com (Jeremy Aiyadurai) Date: Tue Jan 18 23:04:11 2005 Subject: [VPM] next meeting subject Message-ID: Hey all, thanks Peter for your presentation of deciphering obfuscation, i learned new things about perl. I gotta get your book, so my code will be manage-able. How much? and where can I get it? Next Meeting Subject Suggestion For the next meeting....whenever that will be....may I suggest that we discuss "All things perl with binary".....perl and binary....eg. perls binary function, encoding , decoding, pack, unpack etc. I find binary myself to be confusing as i alway am used to using high level programming languages, such as perl. It is great to know, though, as I need it when using the Win32::API, to pack and unpack data in the parameters of win32 api functions. Also, I have attempted many times to try and create a simple gnutella client....but could not understand the protocol or unpacking and packing it. So if your all ok with that, let me know....maybe things will change before then......thanks for putting up me;) -Jeremy A. From darren at DarrenDuncan.net Tue Jan 18 23:17:59 2005 From: darren at DarrenDuncan.net (Darren Duncan) Date: Tue Jan 18 23:28:13 2005 Subject: [VPM] next meeting subject In-Reply-To: Message-ID: On Tue, 18 Jan 2005, Jeremy Aiyadurai wrote: > For the next meeting....whenever that will be....may I suggest that we > discuss "All things perl with binary".....perl and binary....eg. perls > binary function, encoding , decoding, pack, unpack etc. That topic sounds fine to me. I could stand to learn some new things in this area myself. And I can share some things I've already learned. -- Darren Duncan From Peter at PSDT.com Wed Jan 19 12:10:40 2005 From: Peter at PSDT.com (Peter Scott) Date: Wed Jan 19 12:10:46 2005 Subject: [VPM] next meeting subject In-Reply-To: References: Message-ID: <6.1.2.0.2.20050119120912.023e6210@shell2.webquarry.com> At 11:17 PM 1/18/2005, Darren Duncan wrote: >On Tue, 18 Jan 2005, Jeremy Aiyadurai wrote: > > For the next meeting....whenever that will be....may I suggest that we > > discuss "All things perl with binary".....perl and binary....eg. perls > > binary function, encoding , decoding, pack, unpack etc. > >That topic sounds fine to me. I could stand to learn some new things in >this area myself. And I can share some things I've already learned. Noted. Who else has any requests or volunteers to talk about Perl and binary matters? We can make this session one with multiple presenters talking for brief periods each. -- Peter Scott Pacific Systems Design Technologies http://www.perldebugged.com/ *** New! *** http://www.perlmedic.com/ From jeremygwa at hotmail.com Fri Jan 21 22:27:43 2005 From: jeremygwa at hotmail.com (Jeremy Aiyadurai) Date: Sat Jan 22 11:54:49 2005 Subject: [VPM] module memory leak Message-ID: hi all, i am using a module called Win32::IPHelper. I call two of its functions inside an infinite loop, (yes it needs to be infinite). The program eats memory fast, between 4 and 15 KB / sec What can i do so it does not eat memory like this? The problem does not seem to be my code, I think it is the module. Thanks in advance for any help. -Jeremy A. below is the program to test for yourself. ------- use Win32::IPHelper; sub portprocloop { my @cp; my @PROCUDP_EX_TABLE; my @PROCTCP_EX_TABLE; my @PP; while (1) { @PROCUDP_EX_TABLE = (-1); @PROCTCP_EX_TABLE = (-1); @PP = (-1); $ret = Win32::IPHelper::AllocateAndGetUdpExTableFromStack( \@PROCUDP_EX_TABLE, $bOrder ); $ret = Win32::IPHelper::AllocateAndGetTcpExTableFromStack( \@PROCTCP_EX_TABLE, $bOrder ); push(@PP,@PROCUDP_EX_TABLE); push(@PP,@PROCTCP_EX_TABLE); foreach (@PP) { #print $_->{ProcessId},",",$_->{LocalPort},"\n"; } Win32::Sleep(200); } } portprocloop(); From abez at abez.ca Sat Jan 22 14:17:07 2005 From: abez at abez.ca (abez) Date: Sat Jan 22 14:17:38 2005 Subject: [VPM] module memory leak In-Reply-To: Message-ID: The call > Win32::IPHelper::AllocateAndGetUdpExTableFromStack( > \@PROCUDP_EX_TABLE, > $bOrder ); has the word allocate in it even tho it says fromstack. You might be losing memory then by not deallocating. More importantly tho you never pop @PP, it keeps growing in size. So you will be allocating more memory for @PP all the time. abram On Fri, 21 Jan 2005, Jeremy Aiyadurai wrote: > hi all, > > i am using a module called Win32::IPHelper. > I call two of its functions inside an infinite loop, (yes it needs to be > infinite). > > The program eats memory fast, between 4 and 15 KB / sec > > What can i do so it does not eat memory like this? The problem does not seem > to be my code, > I think it is the module. > > Thanks in advance for any help. > > -Jeremy A. > > below is the program to test for yourself. > ------- > use Win32::IPHelper; > > sub portprocloop { > > > my @cp; > my @PROCUDP_EX_TABLE; > my @PROCTCP_EX_TABLE; > my @PP; > > while (1) { > > @PROCUDP_EX_TABLE = (-1); > @PROCTCP_EX_TABLE = (-1); > @PP = (-1); > > $ret = > Win32::IPHelper::AllocateAndGetUdpExTableFromStack( > \@PROCUDP_EX_TABLE, > $bOrder ); > > $ret = > Win32::IPHelper::AllocateAndGetTcpExTableFromStack( > \@PROCTCP_EX_TABLE, > $bOrder ); > > push(@PP,@PROCUDP_EX_TABLE); > push(@PP,@PROCTCP_EX_TABLE); > > foreach (@PP) { > > #print $_->{ProcessId},",",$_->{LocalPort},"\n"; > > } > Win32::Sleep(200); > } > > } > > > > portprocloop(); > > > _______________________________________________ > Victoria-pm mailing list > Victoria-pm@pm.org > http://mail.pm.org/mailman/listinfo/victoria-pm > -- abez ------------------------------------------ http://www.abez.ca/ Abram Hindle (abez@abez.ca) ------------------------------------------ abez From darren at DarrenDuncan.net Sat Jan 22 14:25:07 2005 From: darren at DarrenDuncan.net (Darren Duncan) Date: Sat Jan 22 14:25:21 2005 Subject: [VPM] module memory leak In-Reply-To: References: Message-ID: At 2:17 PM -0800 1/22/05, abez wrote: >More importantly tho you never pop @PP, it keeps growing in size. So you >will be allocating more memory for @PP all the time. I don't see the size of these arrays as a problem, since each turn through the only infinite loop I am aware of erases the entire array, resetting it to a single element containing the number "-1", below. >On Fri, 21 Jan 2005, Jeremy Aiyadurai wrote: > > while (1) { > > @PROCUDP_EX_TABLE = (-1); >> @PROCTCP_EX_TABLE = (-1); > > @PP = (-1); -- Darren Duncan From darren at DarrenDuncan.net Sat Jan 22 14:35:58 2005 From: darren at DarrenDuncan.net (Darren Duncan) Date: Sat Jan 22 14:36:14 2005 Subject: [VPM] module memory leak In-Reply-To: References: Message-ID: Jeremy, something you should do right away is put a "use strict; use warnings;" at the top of your program. You should formally declare $bOrder. Also, as abez said, you probably need to call an IPHelper function that has 'Free' or 'Unallocate' or similar, if there is one, passing each array element that the Allocate function returned. -- Darren Duncan From jeremygwa at hotmail.com Sat Jan 22 15:56:01 2005 From: jeremygwa at hotmail.com (Jeremy Aiyadurai) Date: Mon Jan 24 09:46:46 2005 Subject: [VPM] module memory leak Message-ID: hi all, Thanks for your help so far. The following is a module function, that I use in the program. does anyone see anything that could cause a leak? I have attached the entire module to this email, for your reference. Thanks in advance for your help -Jeremy A. ####################################################################### # Win32::IPHelper::AllocateAndGetTcpExTableFromStack(\@TCP_EX_TABLE, $bOrder) # # UNDOCUMENTED # Retrieves the same list as GetTcpTable() # with the addditional ProcessId for each connection # ####################################################################### # # Prototype # DWORD (WINAPI *pAllocateAndGetTcpExTableFromStack)( # PMIB_TCPEXTABLE *pTcpTable, // buffer for the connection table # BOOL bOrder, // sort the table? # HANDLE heap, # DWORD zero, # DWORD flags # ); # # Parameters # pTcpTable # [out] Pointer to a TCP_EX_TABLE connection table structure # bOrder # [in] Specifies whether the connection table should be sorted. # If this parameter is TRUE, the table is sorted in the order of: # 1 - Local IP address # 2 - Local port # 3 - Remote IP address # 4 - Remote port # heap # [in] Handle to the heap of the calling process, obtained by GetProcessHeap() # zero # [in] undocumented # flags # [in] undocumented # # Return Values # If the function succeeds, the return value is NO_ERROR. # If the function fails, use FormatMessage to obtain the message string for the returned error. # ####################################################################### sub AllocateAndGetTcpExTableFromStack { unless($AllocateAndGetTcpExTableFromStack) { croak 'AllocateAndGetTcpExTableFromStack() function is not available on this platform'; } #if(scalar(@_) ne 2) #{ # croak 'Usage: AllocateAndGetTcpExTableFromStack(\\\@TCP_EX_TABLE, \$bOrder)'; #} #my $TCPTABLE = shift; my $TCPTABLE = shift; my $order = shift(@_) ? 1 : 0; my $pTcpExTable = pack('L', 0); my $bOrder = $order; my $zero = 0; my $flags = 2; # function call my $ret = $AllocateAndGetTcpExTableFromStack->Call($pTcpExTable, $bOrder, _GetProcessHeap(), $zero, $flags); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to AllocateAndGetTcpExTableFromStack() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } my $elements = unpack('L', unpack('P4', $pTcpExTable)); my $TcpExTable = unpack('P' . (24 * $elements + 4) , $pTcpExTable); my $pos = 0; my $value; ($pos, $elements) = _shiftunpack(\$TcpExTable, $pos, 4, 'L'); for(1..$elements) { my %hash; my $data; ($pos, $data) = _shiftunpack(\$TcpExTable, $pos, 24, 'L a4 nx2 a4 nx2 L'); $hash{'State'} = $TCP_STATES{$data->[0]}; $hash{'LocalAddr'} = inet_ntoa($data->[1]); $hash{'LocalPort'} = $data->[2]; $hash{'RemoteAddr'} = inet_ntoa($data->[3]); $hash{'RemotePort'} = $data->[0] eq 2 ? 0 : $data->[4]; $hash{'ProcessId'} = $data->[5]; push @$TCPTABLE, \%hash; } ###### #Added my me my $order = undef; my $pTcpExTable = undef; my $bOrder = undef; my $zero = undef; my $flags = undef; ##### return $ret; } >From: Darren Duncan >To: victoria-pm@pm.org >Subject: Re: [VPM] module memory leak >Date: Sat, 22 Jan 2005 14:35:58 -0800 > >Jeremy, something you should do right away is put a "use strict; use >warnings;" at the top of your program. You should formally declare >$bOrder. > >Also, as abez said, you probably need to call an IPHelper function that has >'Free' or 'Unallocate' or similar, if there is one, passing each array >element that the Allocate function returned. > >-- Darren Duncan >_______________________________________________ >Victoria-pm mailing list >Victoria-pm@pm.org >http://mail.pm.org/mailman/listinfo/victoria-pm -------------- next part -------------- package Win32::IPHelper; use 5.006; use strict; #use warnings; use Carp; use Socket qw(inet_ntoa inet_aton); use Win32; use Win32::API; use enum; require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use Win32::IPHelper ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( AddIPAddress DeleteIPAddress GetIfEntry GetAdaptersInfo GetInterfaceInfo GetAdapterIndex IpReleaseAddress IpRenewAddress GetTcpTable GetUdpTable ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw(); our $VERSION = '0.03'; my $GetProcessHeap = new Win32::API ('Kernel32', 'GetProcessHeap', [], 'N') or croak 'can\'t find GetProcessHeap() function'; my $AddIPAddress = new Win32::API ('Iphlpapi', 'AddIPAddress', ['N', 'N', 'N', 'P', 'P'], 'N') or croak 'can\'t find AddIPAddress() function'; my $DeleteIPAddress = new Win32::API ('Iphlpapi', 'DeleteIPAddress', ['N'], 'N') or croak 'can\'t find DeleteIPAddress() function'; my $GetIfEntry = new Win32::API ('Iphlpapi', 'GetIfEntry', ['P'], 'N') or croak 'can\'t find GetIfEntry() function'; my $GetAdaptersInfo = new Win32::API ('Iphlpapi', 'GetAdaptersInfo', ['P', 'P'], 'N') or croak 'can\'t find GetAdaptersInfo() function'; my $GetInterfaceInfo = new Win32::API ('Iphlpapi', 'GetInterfaceInfo', ['P', 'P'], 'N') or croak 'can\'t find GetInterfaceInfo() function'; my $GetAdapterIndex = new Win32::API ('Iphlpapi', 'GetAdapterIndex', ['P', 'P'], 'N') or croak 'can\'t find GetAdapterIndex() function'; my $IpReleaseAddress = new Win32::API ('Iphlpapi', 'IpReleaseAddress', ['P'], 'N') or croak 'can\'t find IpReleaseAddress() function'; my $IpRenewAddress = new Win32::API ('Iphlpapi', 'IpRenewAddress', ['P'], 'N') or croak 'can\'t find IpRenewAddress() function'; my $GetTcpTable = new Win32::API ('Iphlpapi', 'GetTcpTable', ['P', 'P', 'N'], 'N') or croak 'can\'t find GetTcpTable() function'; my $GetUdpTable = new Win32::API ('Iphlpapi', 'GetUdpTable', ['P', 'P', 'N'], 'N') or croak 'can\'t find GetUdpTable() function'; # UNDOCUMENTED # Available only on Windows XP/2003 my $AllocateAndGetTcpExTableFromStack = new Win32::API ('Iphlpapi', 'AllocateAndGetTcpExTableFromStack', ['P', 'N', 'N', 'N', 'N'], 'N') or undef; my $AllocateAndGetUdpExTableFromStack = new Win32::API ('Iphlpapi', 'AllocateAndGetUdpExTableFromStack', ['P', 'N', 'N', 'N', 'N'], 'N') or undef; # Preloaded methods go here. use enum qw( NO_ERROR=0 :MAX_INTERFACE_ NAME_LEN=256 :MAX_ADAPTER_ ADDRESS_LENGTH=8 DESCRIPTION_LENGTH=128 NAME=128 NAME_LENGTH=256 :ERROR_ SUCCESS=0 NOT_SUPPORTED=50 INVALID_PARAMETER=87 BUFFER_OVERFLOW=111 INSUFFICIENT_BUFFER=122 NO_DATA=232 :MAXLEN_ IFDESCR=256 PHYSADDR=8 ); # TCP States my %TCP_STATES = ( 1 => 'CLOSED', 2 => 'LISTENING', 3 => 'SYN_SENT', 4 => 'SYN_RCVD', 5 => 'ESTABLISHED', 6 => 'FIN_WAIT1', 7 => 'FIN_WAIT2', 8 => 'CLOSE_WAIT', 9 => 'CLOSING', 10 => 'LAST_ACK', 11 => 'TIME_WAIT', 12 => 'DELETE_TCB' ); our $DEBUG = 0; ################################# # PUBLIC Functions (exportable) # ################################# ####################################################################### # Win32::IPHelper::AddIPAddress() # # The AddIPAddress function adds the specified IP address to the # specified adapter. # ####################################################################### # Usage: # $ret = AddIPAddress($Address, $IpMask, $IfIndex, \$NTEContext, \$NTEInstance); # # Output: # $ret = 0 for success, a number for error # # Input: # $Address = IP address to add # $IpMask = Subnet Mask for IP address # $IfIndex = adapter index # # Output: # \$NTEContext = ref to Net Table Entry context # \$NTEInstance = ref to Net Table Entry instance # ####################################################################### # function AddIPAddress # # The AddIPAddress function adds the specified IP address to the # specified adapter. # # # DWORD AddIPAddress( # IPAddr Address, // IP address to add # IPMask IpMask, // subnet mask for IP address # DWORD IfIndex, // index of adapter # PULONG NTEContext, // Net Table Entry context # PULONG NTEInstance // Net Table Entry Instance # ); # ####################################################################### sub AddIPAddress { if(scalar(@_) ne 5) { croak 'Usage: AddIPAddress(\$Address, \$IpMask, \$IfIndex, \\\$NTEContext, \\\$NTEInstance)'; } my $Address = unpack('L', inet_aton(shift)); my $IpMask = unpack('L', inet_aton(shift)); my $IfIndex = shift; my $NTEContext = shift; my $NTEInstance = shift; # $AddIPAddress = new Win32::API ('Iphlpapi', 'AddIPAddress', ['N', 'N', 'N', 'P', 'P'], 'N') or croak 'can\'t find AddIPAddress() function'; # initialize area for the NTE data $$NTEContext = pack("L", 0); $$NTEInstance = pack("L", 0); # function call my $ret = $AddIPAddress->Call($Address, $IpMask, $IfIndex, $$NTEContext, $$NTEInstance); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to AddIPAddress() returned %u: %s\n", $ret, Win32::FormatMessage($ret); } # unpack values... $$NTEContext = unpack("L", $$NTEContext); $$NTEInstance = unpack("L", $$NTEInstance); return $ret; } ####################################################################### # Win32::IPHelper::DeleteIPAddress() # # The DeleteIPAddress function deletes an IP address previously added # using AddIPAddress. # ####################################################################### # Usage: # $ret = DeleteIPAddress($NTEContext); # # Output: # $ret = 0 for success, a number for error # # Input: # $NTEContext = Net Table Entry context # ####################################################################### # function DeleteIPAddress # # The DeleteIPAddress function deletes an IP address previously added # using AddIPAddress. # # # DWORD DeleteIPAddress( # ULONG NTEContext // Net Table Entry context # ); # ####################################################################### sub DeleteIPAddress { if(scalar(@_) ne 1) { croak 'Usage: DeleteIPAddress(\$NTEContext)'; } my $NTEContext = pack("L", shift); # $DeleteIPAddress = new Win32::API ('Iphlpapi', 'DeleteIPAddress', ['N'], 'N') or croak 'can\'t find DeleteIPAddress() function'; # function call my $ret = $DeleteIPAddress->Call(unpack('L', $NTEContext)); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to DeleteIPAddress() returned %u: %s\n", $ret, Win32::FormatMessage($ret); } return $ret; } ####################################################################### # Win32::IPHelper::GetIfEntry() # # The GetIfEntry function retrieves information for the specified # interface on the local computer. # ####################################################################### # Usage: # $ret = GetIfEntry($IfIndex, \%pIfRow); # # Output: # $ret = 0 for success, a number for error # # Input: # $IfIndex = adapter index # # Output: # \%pIfRow = ref to the data structure # ####################################################################### # function GetIfEntry # # The GetIfEntry function retrieves information for the specified # interface on the local computer. # # DWORD GetIfEntry( # PMIB_IFROW pIfRow // pointer to interface entry # ); # # ####################################################################### sub GetIfEntry { if(scalar(@_) ne 2) { croak 'Usage: GetIfEntry(\$IfIndex, \\\%pIfRow)'; } my $IfIndex = shift; my $buffer = shift; # $GetIfEntry = new Win32::API ('Iphlpapi', 'GetIfEntry', ['P'], 'N') or croak 'can\'t find GetIfEntry() function'; my $lpBuffer; $lpBuffer .= pack("C@".MAX_INTERFACE_NAME_LEN*2, 0); $lpBuffer .= pack("L", $IfIndex); $lpBuffer .= pack("L@".16, 0); $lpBuffer .= pack("C@".MAXLEN_PHYSADDR, 0); $lpBuffer .= pack("L@".64, 0); $lpBuffer .= pack("C@".MAXLEN_IFDESCR, 0); # first call just to read the size my $ret = $GetIfEntry->Call($lpBuffer); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to GetIfEntry() returned %u: %s\n", $ret, Win32::FormatMessage($ret); } else { (undef, %$buffer) = _MIB_IFROW(\$lpBuffer, 0); } return $ret; } ####################################################################### # Win32::IPHelper::GetAdaptersInfo() # # The GetAdaptersInfo function retrieves adapter information for the # local computer. # ####################################################################### # Usage: # $ret = GetAdaptersInfo(\@IP_ADAPTER_INFO); # # Output: # $ret = 0 for success, a number for error # # Input: # \@array = reference to the array to be filled with decoded data # ####################################################################### # function GetAdaptersInfo # # The GetAdaptersInfo function retrieves adapter information for the # local computer. # # DWORD GetAdaptersInfo( # PIP_ADAPTER_INFO pAdapterInfo, // buffer to receive data # PULONG pOutBufLen // size of data returned # ); # ####################################################################### sub GetAdaptersInfo { if(scalar(@_) ne 1) { croak 'Usage: GetAdaptersInfo(\\\@IP_ADAPTER_INFO)'; } my $buffer = shift; my $base_size = 2048; # $GetAdaptersInfo = new Win32::API ('Iphlpapi', 'GetAdaptersInfo', ['P', 'P'], 'N') or croak 'can\'t find GetAdaptersInfo() function'; # initialize area for the buffer size my $lpBuffer = pack("L@".$base_size, 0); my $lpSize = pack("L", $base_size); # first call just to read the size my $ret = $GetAdaptersInfo->Call($lpBuffer, $lpSize); # check returned value... if($ret != NO_ERROR) { if($ret == ERROR_BUFFER_OVERFLOW) { # initialize area for the buffer content $base_size = unpack("L", $lpSize); $lpBuffer = pack("L@".$base_size, 0); # second call to read data $ret = $GetAdaptersInfo->Call($lpBuffer, $lpSize); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to GetAdaptersInfo() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } } else { $DEBUG and carp sprintf "The call to GetAdaptersInfo() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } } # decode data into the supplied buffer area (undef, @$buffer) = _IP_ADAPTER_INFO(\$lpBuffer, 0); return 0; } ####################################################################### # Win32::IPHelper::GetInterfaceInfo() # # The GetInterfaceInfo function obtains a list of the network interface # adapters on the local system. # ####################################################################### # Usage: # $ret = GetInterfaceInfo(\%IP_INTERFACE_INFO); # # Output: # $ret = 0 for success, a number for error # # Input: # \%hash = reference to the hash to be filled with decoded data # ####################################################################### # function GetInterfaceInfo # # The GetInterfaceInfo function obtains a list of the network interface # adapters on the local system. # # DWORD GetInterfaceInfo( # PIP_INTERFACE_INFO pIfTable, // buffer to receive info # PULONG dwOutBufLen // size of buffer # ); # ####################################################################### sub GetInterfaceInfo { if(scalar(@_) ne 1) { croak 'Usage: GetInterfaceInfo(\\\%IP_INTERFACE_INFO)'; } my $buffer = shift; my $base_size = 2048; # $GetInterfaceInfo = new Win32::API ('Iphlpapi', 'GetInterfaceInfo', ['P', 'P'], 'N') or croak 'can\'t find GetInterfaceInfo() function'; # initialize area for the buffer size my $lpBuffer = pack("L@".$base_size, 0); my $lpSize = pack("L", $base_size); # first call just to read the size my $ret = $GetInterfaceInfo->Call($lpBuffer, $lpSize); # check returned value... if($ret != NO_ERROR) { if($ret == ERROR_INSUFFICIENT_BUFFER) { # initialize area for the buffer content $base_size = unpack("L", $lpSize); $lpBuffer = pack("L@".$base_size, 0); # second call to read data $ret = $GetInterfaceInfo->Call($lpBuffer, $lpSize); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to GetInterfaceInfo() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } } else { $DEBUG and carp sprintf "The call to GetInterfaceInfo() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } } # decode data into the supplied buffer area (undef, %$buffer) = _IP_INTERFACE_INFO(\$lpBuffer, 0); return 0; } ####################################################################### # Win32::IPHelper::GetAdapterIndex(\$AdapterName, \$IfIndex) # # The GetAdapterIndex function obtains the index of an adapter, given # its name. # ####################################################################### # # Prototype # DWORD GetAdapterIndex( # LPWSTR AdapterName, # PULONG IfIndex # ); # # Parameters # AdapterName # [in] Pointer to a Unicode string that specifies the name of the adapter. # IfIndex # [out] Pointer to a ULONG variable that points to the index of the adapter. # # Return Values # If the function succeeds, the return value is NO_ERROR. # If the function fails, use FormatMessage to obtain the message string for the returned error. # ####################################################################### sub GetAdapterIndex { if(scalar(@_) ne 2) { croak 'Usage: GetAdapterIndex(\\\$AdapterName, \\\$IfIndex)'; } my $AdapterName = shift; my $IfIndex = shift; # prepare the buffer for IfIndex $$IfIndex = pack('L', 0); # $GetAdapterIndex = new Win32::API ('Iphlpapi', 'GetAdapterIndex', ['P', 'P'], 'N') or croak 'can\'t find GetAdapterIndex() function'; # function call my $ret = $GetAdapterIndex->Call(_ToUnicodeSz('\DEVICE\TCPIP_'.$$AdapterName), $$IfIndex); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to GetAdapterIndex() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } # unpack IfIndex for later use $$IfIndex = unpack('L', $$IfIndex); return $ret; } ####################################################################### # Win32::IPHelper::IpReleaseAddress(\%IP_ADAPTER_INDEX_MAP) # # The IpReleaseAddress function releases an IP address previously # obtained through Dynamic Host Configuration Protocol (DHCP). # ####################################################################### # # Prototype # DWORD IpReleaseAddress( # PIP_ADAPTER_INDEX_MAP AdapterInfo # ); # # Parameters # AdapterInfo # [in] Pointer to an IP_ADAPTER_INDEX_MAP structure that # specifies the adapter associated with the IP address to release. # # Return Values # If the function succeeds, the return value is NO_ERROR. # If the function fails, use FormatMessage to obtain the message string for the returned error. # ####################################################################### sub IpReleaseAddress { if(scalar(@_) ne 1) { croak 'Usage: IpReleaseAddress(\\\%IP_ADAPTER_INDEX_MAP)'; } my $AdapterInfo = shift; # prepare the IP_ADAPTER_INDEX_MAP structure my $ip_adapter_index_map = pack("L", $$AdapterInfo{'Index'}); $ip_adapter_index_map .= pack("Z*@".(2 * MAX_ADAPTER_NAME), _ToUnicodeSz($$AdapterInfo{'Name'})); # $IpReleaseAddress = new Win32::API ('Iphlpapi', 'IpReleaseAddress', ['P'], 'N') or croak 'can\'t find IpReleaseAddress() function'; # function call my $ret = $IpReleaseAddress->Call($ip_adapter_index_map); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to IpReleaseAddress() returned %u: %s\n", $ret, Win32::FormatMessage($ret); } return $ret; } ####################################################################### # Win32::IPHelper::IpRenewAddress(\%IP_ADAPTER_INDEX_MAP) # # The IpRenewAddress function renews a lease on an IP address previously # obtained through Dynamic Host Configuration Protocol (DHCP). # ####################################################################### # # Prototype # DWORD IpRenewAddress( # PIP_ADAPTER_INDEX_MAP AdapterInfo # ); # # Parameters # AdapterInfo # [in] Pointer to an IP_ADAPTER_INDEX_MAP structure that # specifies the adapter associated with the IP address to renew. # # Return Values # If the function succeeds, the return value is NO_ERROR. # If the function fails, use FormatMessage to obtain the message string for the returned error. # ####################################################################### sub IpRenewAddress { if(scalar(@_) ne 1) { croak 'Usage: IpRenewAddress(\\\%IP_ADAPTER_INDEX_MAP)'; } my $AdapterInfo = shift; # prepare the IP_ADAPTER_INDEX_MAP structure my $ip_adapter_index_map = pack("L", $$AdapterInfo{'Index'}); $ip_adapter_index_map .= pack("Z*@".(2 * MAX_ADAPTER_NAME), _ToUnicodeSz($$AdapterInfo{'Name'})); # $IpRenewAddress = new Win32::API ('Iphlpapi', 'IpRenewAddress', ['P'], 'N') or croak 'can\'t find IpRenewAddress() function'; # function call my $ret = $IpRenewAddress->Call($ip_adapter_index_map); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to IpRenewAddress() returned %u: %s\n", $ret, Win32::FormatMessage($ret); } return $ret; } ####################################################################### # Win32::IPHelper::GetTcpTable(\@TCP_TABLE, $bOrder) # # The GetTcpTable function retrieves the TCP connection table. # ####################################################################### # # Prototype # DWORD GetTcpTable( # PMIB_TCPTABLE pTcpTable, # PDWORD pdwSize, # BOOL bOrder # ); # # Parameters # pTcpTable # [out] Pointer to a buffer that receives the TCP connection table as a MIB_TCPTABLE structure. # pdwSize # [in, out] On input, specifies the size of the buffer pointed to by the pTcpTable parameter. # On output, if the buffer is not large enough to hold the returned connection table, the function sets this parameter equal to the required buffer size. # bOrder # [in] Specifies whether the connection table should be sorted. # If this parameter is TRUE, the table is sorted in the order of: # 1 - Local IP address # 2 - Local port # 3 - Remote IP address # 4 - Remote port # # Return Values # If the function succeeds, the return value is NO_ERROR. # If the function fails, use FormatMessage to obtain the message string for the returned error. # ####################################################################### sub GetTcpTable { if(scalar(@_) ne 2) { croak 'Usage: GetTcpTable(\\\@TCP_TABLE, \$bOrder)'; } my $TCPTABLE = shift; my $order = shift(@_) ? 1 : 0; my $size = 2048; my $pTcpTable = pack("C@".$size, 0); my $pdwSize = pack('L', $size); my $bOrder = $order; # function call my $ret = $GetTcpTable->Call($pTcpTable, $pdwSize, $bOrder); if($ret != ERROR_SUCCESS) { if($ret == ERROR_INSUFFICIENT_BUFFER) { my $multi = int(unpack('L', $pdwSize) / $size) + 1; $size = $size * $multi; $pTcpTable = pack("C@".$size, 0); $pdwSize = pack('L', $size); $ret = $GetTcpTable->Call($pTcpTable, $pdwSize, $bOrder); if($ret != ERROR_SUCCESS) { $DEBUG and carp sprintf "GetTcpTable() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } } else { $DEBUG and carp sprintf "The call to GetTcpTable() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } } my $pos = 0; my $elements = 0; my $value; ($pos, $elements) = _shiftunpack(\$pTcpTable, $pos, 4, 'L'); for(1..$elements) { my %hash; my $data; ($pos, $data) = _shiftunpack(\$pTcpTable, $pos, 20, 'L a4 nx2 a4 nx2'); my $cnt = 0; $hash{'State'} = $TCP_STATES{$data->[0]}; $hash{'LocalAddr'} = inet_ntoa($data->[1]); $hash{'LocalPort'} = $data->[2]; $hash{'RemoteAddr'} = inet_ntoa($data->[3]); $hash{'RemotePort'} = $data->[0] eq 2 ? 0 : $data->[4]; push @$TCPTABLE, \%hash; } } ####################################################################### # Win32::IPHelper::AllocateAndGetTcpExTableFromStack(\@TCP_EX_TABLE, $bOrder) # # UNDOCUMENTED # Retrieves the same list as GetTcpTable() # with the addditional ProcessId for each connection # ####################################################################### # # Prototype # DWORD (WINAPI *pAllocateAndGetTcpExTableFromStack)( # PMIB_TCPEXTABLE *pTcpTable, // buffer for the connection table # BOOL bOrder, // sort the table? # HANDLE heap, # DWORD zero, # DWORD flags # ); # # Parameters # pTcpTable # [out] Pointer to a TCP_EX_TABLE connection table structure # bOrder # [in] Specifies whether the connection table should be sorted. # If this parameter is TRUE, the table is sorted in the order of: # 1 - Local IP address # 2 - Local port # 3 - Remote IP address # 4 - Remote port # heap # [in] Handle to the heap of the calling process, obtained by GetProcessHeap() # zero # [in] undocumented # flags # [in] undocumented # # Return Values # If the function succeeds, the return value is NO_ERROR. # If the function fails, use FormatMessage to obtain the message string for the returned error. # ####################################################################### sub AllocateAndGetTcpExTableFromStack { unless($AllocateAndGetTcpExTableFromStack) { croak 'AllocateAndGetTcpExTableFromStack() function is not available on this platform'; } #if(scalar(@_) ne 2) #{ # croak 'Usage: AllocateAndGetTcpExTableFromStack(\\\@TCP_EX_TABLE, \$bOrder)'; #} #my $TCPTABLE = shift; my $TCPTABLE = shift; my $order = shift(@_) ? 1 : 0; my $pTcpExTable = pack('L', 0); my $bOrder = $order; my $zero = 0; my $flags = 2; # function call my $ret = $AllocateAndGetTcpExTableFromStack->Call($pTcpExTable, $bOrder, _GetProcessHeap(), $zero, $flags); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to AllocateAndGetTcpExTableFromStack() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } my $elements = unpack('L', unpack('P4', $pTcpExTable)); my $TcpExTable = unpack('P' . (24 * $elements + 4) , $pTcpExTable); my $pos = 0; my $value; ($pos, $elements) = _shiftunpack(\$TcpExTable, $pos, 4, 'L'); for(1..$elements) { my %hash; my $data; ($pos, $data) = _shiftunpack(\$TcpExTable, $pos, 24, 'L a4 nx2 a4 nx2 L'); $hash{'State'} = $TCP_STATES{$data->[0]}; $hash{'LocalAddr'} = inet_ntoa($data->[1]); $hash{'LocalPort'} = $data->[2]; $hash{'RemoteAddr'} = inet_ntoa($data->[3]); $hash{'RemotePort'} = $data->[0] eq 2 ? 0 : $data->[4]; $hash{'ProcessId'} = $data->[5]; push @$TCPTABLE, \%hash; } my $order = undef; my $pTcpExTable = undef; my $bOrder = undef; my $zero = undef; my $flags = undef; return $ret; } ####################################################################### # Win32::IPHelper::GetUdpTable(\@UDP_TABLE, $bOrder) # # The GetUdpTable function retrieves the User Datagram Protocol (UDP) listener table. # ####################################################################### # # Prototype # DWORD GetUdpTable( # PMIB_UDPTABLE pUdpTable, # PDWORD pdwSize, # BOOL bOrder # ); # # Parameters # pTcpTable # [out] Pointer to a buffer that receives the UDP listener table as a MIB_UDPTABLE structure. # pdwSize # [in, out] On input, specifies the size of the buffer pointed to by the pUdpTable parameter. # On output, if the buffer is not large enough to hold the returned connection table, # the function sets this parameter equal to the required buffer size. # bOrder # [in] Specifies whether the connection table should be sorted. # If this parameter is TRUE, the table is sorted in the order of: # 1 - Local IP address # 2 - Local port # # Return Values # If the function succeeds, the return value is NO_ERROR. # If the function fails, use FormatMessage to obtain the message string for the returned error. # ####################################################################### sub GetUdpTable { if(scalar(@_) ne 2) { croak 'Usage: GetUdp(\\\@UDP_TABLE, \$bOrder)'; } my $UDPTABLE = shift; my $order = shift(@_) ? 1 : 0; my $size = 2048; my $pUdpTable = pack("C@".$size, 0); my $pdwSize = pack('L', $size); my $bOrder = $order; # function call my $ret = $GetUdpTable->Call($pUdpTable, $pdwSize, $bOrder); if($ret != ERROR_SUCCESS) { if($ret == ERROR_INSUFFICIENT_BUFFER) { my $multi = int(unpack('L', $pdwSize) / $size) + 1; $size = $size * $multi; $pUdpTable = pack("C@".$size, 0); $pdwSize = pack('L', $size); $ret = $GetUdpTable->Call($pUdpTable, $pdwSize, $bOrder); if($ret != ERROR_SUCCESS) { $DEBUG and carp sprintf "The call to GetUdpTable() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } } else { $DEBUG and carp sprintf "The call to GetUdpTable() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } } my $pos = 0; my $elements = 0; my $value; ($pos, $elements) = _shiftunpack(\$pUdpTable, $pos, 4, 'L'); for(1..$elements) { my %hash; my $data; ($pos, $data) = _shiftunpack(\$pUdpTable, $pos, 8, 'a4 n'); $hash{'LocalAddr'} = inet_ntoa($data->[0]); $hash{'LocalPort'} = $data->[1]; push @$UDPTABLE, \%hash; } } ####################################################################### # Win32::IPHelper::AllocateAndGetUdpExTableFromStack(\@UDP_EX_TABLE, $bOrder) # # UNDOCUMENTED # Retrieves the same list as GetUdpTable() # with the addditional ProcessId for each connection # ####################################################################### # # Prototype # DWORD (WINAPI *pAllocateAndGetUdpExTableFromStack)( # PMIB_TCPEXTABLE *pUdpTable, // buffer for the connection table # BOOL bOrder, // sort the table? # HANDLE heap, # DWORD zero, # DWORD flags # ); # # Parameters # pUdpTable # [out] Pointer to a UDP_EX_TABLE connection table structure # bOrder # [in] Sort the table by LocalAddr ? # # Return Values # If the function succeeds, the return value is NO_ERROR. # If the function fails, use FormatMessage to obtain the message string for the returned error. # ####################################################################### sub AllocateAndGetUdpExTableFromStack { unless($AllocateAndGetUdpExTableFromStack) { croak 'AllocateAndGetUdpExTableFromStack() function is not available on this platform'; } #if(scalar(@_) ne 2) #{ # croak 'Usage: AllocateAndGetUdpExTableFromStack(\\\@UDP_EX_TABLE, \$bOrder)'; #} my $UDPTABLE = shift; my $order = shift(@_) ? 1 : 0; my $pUdpExTable = pack('L', 0); my $bOrder = $order; my $zero = 0; my $flags = 2; # function call my $ret = $AllocateAndGetUdpExTableFromStack->Call($pUdpExTable, $bOrder, _GetProcessHeap(), $zero, $flags); if($ret != NO_ERROR) { $DEBUG and carp sprintf "The call to AllocateAndGetUdpExTableFromStack() returned %u: %s\n", $ret, Win32::FormatMessage($ret); return $ret; } my $elements = unpack('L', unpack('P4', $pUdpExTable)); my $UdpExTable = unpack('P' . (12 * $elements + 4) , $pUdpExTable); my $pos = 0; my $value; ($pos, $elements) = _shiftunpack(\$UdpExTable, $pos, 4, 'L'); for(1..$elements) { my %hash; my $data; ($pos, $data) = _shiftunpack(\$UdpExTable, $pos, 12, 'a4 nx2 L'); $hash{'LocalAddr'} = inet_ntoa($data->[0]); $hash{'LocalPort'} = $data->[1]; $hash{'ProcessId'} = $data->[2]; push @$UDPTABLE, \%hash; } my $order = undef; my $pUdpExTable = undef; my $bOrder = undef; my $zero = undef; my $flags = undef; return $ret; } #################################### # PRIVATE Functions (not exported) # #################################### ####################################################################### # _MIB_IFROW() # # The MIB_IFROW structure stores information about a particular # interface. # ####################################################################### # Usage: # ($pos, %hash) = _MIB_IFROW(\$buffer, $position); # # Output: # $pos = new position in buffer (for the next call) # %hash = the decoded data structure # # Input: # \$buffer = reference to the buffer to decode # $position = first byte to decode # ####################################################################### # struct MIB_IFROW # # The MIB_IFROW structure stores information about a particular # interface. # # typedef struct _MIB_IFROW { # WCHAR wszName[MAX_INTERFACE_NAME_LEN]; # DWORD dwIndex; // index of the interface # DWORD dwType; // type of interface # DWORD dwMtu; // max transmission unit # DWORD dwSpeed; // speed of the interface # DWORD dwPhysAddrLen; // length of physical address # BYTE bPhysAddr[MAXLEN_PHYSADDR]; // physical address of adapter # DWORD dwAdminStatus; // administrative status # DWORD dwOperStatus; // operational status # DWORD dwLastChange; // last time operational status changed # DWORD dwInOctets; // octets received # DWORD dwInUcastPkts; // unicast packets received # DWORD dwInNUcastPkts; // non-unicast packets received # DWORD dwInDiscards; // received packets discarded # DWORD dwInErrors; // erroneous packets received # DWORD dwInUnknownProtos; // unknown protocol packets received # DWORD dwOutOctets; // octets sent # DWORD dwOutUcastPkts; // unicast packets sent # DWORD dwOutNUcastPkts; // non-unicast packets sent # DWORD dwOutDiscards; // outgoing packets discarded # DWORD dwOutErrors; // erroneous packets sent # DWORD dwOutQLen; // output queue length # DWORD dwDescrLen; // length of bDescr member # BYTE bDescr[MAXLEN_IFDESCR]; // interface description # } MIB_IFROW,*PMIB_IFROW; # ####################################################################### sub _MIB_IFROW { my ($buffer, $pos) = @_; my %hash; ($pos, $hash{'Name'}) = _shiftunpack($buffer, $pos, MAX_INTERFACE_NAME_LEN*2, "Z" . MAX_INTERFACE_NAME_LEN*2); ($pos, $hash{'Index'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'Type'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'Mtu'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'Speed'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'PhysAddrLen'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'PhysAddr'}) = _shiftunpack($buffer, $pos, MAXLEN_PHYSADDR, "H" . MAXLEN_PHYSADDR * 2); ($pos, $hash{'AdminStatus'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'OperStatus'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'LastChange'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'InOctets'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'InUcastPkts'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'InNUcastPkts'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'InDiscards'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'InErrors'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'InUnknownProtos'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'OutOctets'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'OutUcastPkts'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'OutNUcastPkts'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'OutDiscards'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'OutErrors'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'OutQLen'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'DescrLen'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'Descr'}) = _shiftunpack($buffer, $pos, MAXLEN_IFDESCR, "Z" . MAXLEN_IFDESCR * 2); return ($pos, %hash); } ####################################################################### # _IP_ADAPTER_INFO() # # Decodes an IP_ADAPTER_INFO data structure and returns data # into a Perl array # ####################################################################### # Usage: # ($pos, @array) = _IP_ADAPTER_INFO(\$buffer, $position); # # Output: # $pos = new position in buffer (for the next call) # @array = the decoded data structure # # Input: # \$buffer = reference to the buffer to decode # $position = first byte to decode # ####################################################################### # struct IP_ADAPTER_INFO # # The IP_ADAPTER_INFO structure contains information about a particular # network adapter on the local computer. # # typedef struct _IP_ADAPTER_INFO { # struct _IP_ADAPTER_INFO* Next; # DWORD ComboIndex; # char AdapterName[MAX_ADAPTER_NAME_LENGTH + 4]; # char Description[MAX_ADAPTER_DESCRIPTION_LENGTH + 4]; # UINT AddressLength; # BYTE Address[MAX_ADAPTER_ADDRESS_LENGTH]; # DWORD Index; # UINT Type; # UINT DhcpEnabled; # PIP_ADDR_STRING CurrentIpAddress; # IP_ADDR_STRING IpAddressList; # IP_ADDR_STRING GatewayList; # IP_ADDR_STRING DhcpServer; # BOOL HaveWins; # IP_ADDR_STRING PrimaryWinsServer; # IP_ADDR_STRING SecondaryWinsServer; # time_t LeaseObtained; # time_t LeaseExpires; # } IP_ADAPTER_INFO, *PIP_ADAPTER_INFO; # ####################################################################### sub _IP_ADAPTER_INFO { my ($buffer, $pos) = @_; my $size = 640; my %hash; my @array; my $next; ($pos, $next) =_shiftunpack($buffer, $pos, 4, "P".$size); ($pos, $hash{'ComboIndex'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'AdapterName'}) = _shiftunpack($buffer, $pos, (MAX_ADAPTER_NAME_LENGTH + 4), "Z" . (MAX_ADAPTER_NAME_LENGTH + 4)); ($pos, $hash{'Description'}) = _shiftunpack($buffer, $pos, (MAX_ADAPTER_DESCRIPTION_LENGTH + 4), "Z" . (MAX_ADAPTER_DESCRIPTION_LENGTH + 4)); ($pos, $hash{'AddressLength'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'Address'}) = _shiftunpack($buffer, $pos, MAX_ADAPTER_ADDRESS_LENGTH, "H" . MAX_ADAPTER_ADDRESS_LENGTH * 2); ($pos, $hash{'Index'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'Type'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'DhcpEnabled'}) = _shiftunpack($buffer, $pos, 4, "L"); my $CurrentIpAddress; ($pos, $CurrentIpAddress) = _shiftunpack($buffer, $pos, 4, "P40"); if($CurrentIpAddress) { @{ $hash{'CurrentIpAddress'} } = _IP_ADDR_STRING(\$CurrentIpAddress, 0); } ($pos, @{ $hash{'IpAddressList'} }) = _IP_ADDR_STRING($buffer, $pos); ($pos, @{ $hash{'GatewayList'} }) = _IP_ADDR_STRING($buffer, $pos); ($pos, @{ $hash{'DhcpServer'} }) = _IP_ADDR_STRING($buffer, $pos); ($pos, $hash{'HaveWins'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, @{ $hash{'PrimaryWinsServer'} }) = _IP_ADDR_STRING($buffer, $pos); ($pos, @{ $hash{'SecondaryWinsServer'} }) = _IP_ADDR_STRING($buffer, $pos); ($pos, $hash{'LeaseObtained'}) =_shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'LeaseExpires'}) =_shiftunpack($buffer, $pos, 4, "L"); push @array, \%hash; if($next) { my ($pos, @results) = _IP_ADAPTER_INFO(\$next, 0); push @array, @results; } return ($pos, @array); } ####################################################################### # _IP_ADDR_STRING() # # Decodes an _IP_ADDR_STRING data structure and returns data # into a Perl array # ####################################################################### # Usage: # ($pos, @array) = _IP_ADDR_STRING(\$buffer, $position); # # Output: # $pos = new position in buffer (for the next call) # @array = the decoded data structure # # Input: # \$buffer = reference to the buffer to decode # $position = first byte to decode # ####################################################################### # struct IP_ADDR_STRING # # The IP_ADDR_STRING structure represents a node in a linked-list # of IP addresses. # # typedef struct _IP_ADDR_STRING { # struct _IP_ADDR_STRING* Next; # IP_ADDRESS_STRING IpAddress; # IP_MASK_STRING IpMask; # DWORD Context; # } IP_ADDR_STRING, *PIP_ADDR_STRING; # ####################################################################### sub _IP_ADDR_STRING { my ($buffer, $pos) = @_; my $size = 40; my %hash; my @array; my $next; ($pos, $next) = _shiftunpack($buffer, $pos, 4, "P".$size); ($pos, $hash{'IpAddress'}) = _shiftunpack($buffer, $pos, 16, "Z16"); ($pos, $hash{'IpMask'}) = _shiftunpack($buffer, $pos, 16, "Z16"); ($pos, $hash{'Context'}) = _shiftunpack($buffer, $pos, 4, "L"); push @array, \%hash; if($next) { my ($pos, @results) = _IP_ADDR_STRING(\$next, 0); push @array, @results; } return ($pos, @array); } ####################################################################### # _IP_ADAPTER_INDEX_MAP() # # Decodes an _IP_ADAPTER_INDEX_MAP data structure and returns data # into a Perl hash # ####################################################################### # Usage: # ($pos, %hash) = _IP_ADAPTER_INDEX_MAP(\$buffer, $position); # # Output: # $pos = new position in buffer (for the next call) # %hash = the decoded data structure # # Input: # \$buffer = reference to the buffer to decode # $position = first byte to decode # ####################################################################### # struct IP_ADAPTER_INDEX_MAP # # The IP_ADAPTER_INDEX_MAP structure pairs an adapter name with # the index of that adapter. # # typedef struct _IP_ADAPTER_INDEX_MAP { # ULONG Index // adapter index # WCHAR Name [MAX_ADAPTER_NAME]; // name of the adapter # } IP_ADAPTER_INDEX_MAP, * PIP_ADAPTER_INDEX_MAP; # ####################################################################### sub _IP_ADAPTER_INDEX_MAP { my $size = 4 + 4; wantarray or return $size; my ($buffer, $pos) = @_; my %hash; my $NamePtr; ($pos, $hash{'Index'}) = _shiftunpack($buffer, $pos, 4, "L"); ($pos, $hash{'Name'}) = _shiftunpackWCHAR($buffer, $pos, (2 * MAX_ADAPTER_NAME)); return ($pos, %hash); } ####################################################################### # _IP_INTERFACE_INFO() # # Decodes an _IP_INTERFACE_INFO data structure and returns data # into a Perl array # ####################################################################### # Usage: # ($pos, @array) = _IP_INTERFACE_INFO(\$buffer, $position); # # Output: # $pos = new position in buffer (for the next call) # @array = the decoded data structure # # Input: # \$buffer = reference to the buffer to decode # $position = first byte to decode # ####################################################################### # struct IP_INTERFACE_INFO # # The IP_INTERFACE_INFO structure contains a list of the network # interface adapters on the local system. # # typedef struct _IP_INTERFACE_INFO { # LONG NumAdapters; // number of adapters in array # IP_ADAPTER_INDEX_MAP Adapter[1]; // adapter indices and names # } IP_INTERFACE_INFO,*PIP_INTERFACE_INFO; # ####################################################################### sub _IP_INTERFACE_INFO { my $size = 4 + 4; wantarray or return $size; my ($buffer, $pos) = @_; my %hash; my @array; ($pos, $hash{'NumAdapters'}) = _shiftunpack($buffer, $pos, 4, "l"); for(my $cnt=0; $cnt < $hash{'NumAdapters'}; $cnt++) { my %map; ($pos, %map) = _IP_ADAPTER_INDEX_MAP($buffer, $pos); push @{ $hash{'Adapters'} }, \%map; } return ($pos, %hash); } ####################################################################### # _shiftunpack # # Decodes a part of a given buffer and returns list data and new position # ####################################################################### # Usage: # ($pos, @values) = _shiftunpack(\$buffer, $position, $size, $elements); # # Output: # $pos = new position in buffer (for the next call) # @values = the decoded data values # # Input: # \$buffer = reference to the buffer to decode # $position = first byte to decode # $size = number of bytes to decode # $elements = type of data to decode (see 'pack()' in Perl functions) # ####################################################################### sub _shiftunpack { my ($buffer, $position, $size, $element) = @_; my $buf = substr($$buffer, $position, $size); my @values = unpack($element, $buf); $position += $size; if(scalar(@values) > 1) { return($position, \@values); } else { return($position, $values[0]); } } ####################################################################### # _shiftunpackWCHAR # # Decodes a UNICODE part of a given buffer and returns data and new # position # ####################################################################### # Usage: # ($pos, $value) = _shiftunpackWCHAR(\$buffer, $position, $size); # # Output: # $pos = new position in buffer (for the next call) # $value = the decoded data value # # Input: # \$buffer = reference to the buffer to decode # $position = first byte to decode # $size = number of bytes to decode # ####################################################################### sub _shiftunpackWCHAR { my ($buffer, $position, $size) = @_; my $buf = substr($$buffer, $position, $size); my $value = pack( "C*", unpack("S*", $buf)); $value = unpack("Z*", $value); $position += $size; return($position, $value); } ####################################################################### # _debugbuffer # # Decodes and prints the content of a buffer # ####################################################################### # Usage: # _debugbuffer(\$buffer); # # Input: # \$buffer = reference to the buffer to print # ####################################################################### sub _debugbuffer { my $buffer = $_[0]; my (@data) = unpack("C*", $$buffer); printf "Buffer size: %d\n", scalar(@data); my $cnt = 0; foreach my $i (@data) { my $char = ''; if(32 <= $i and $i < 127) { $char = chr($i); } printf "%03d -> 0x%02x --> %03d ---> %s\n", $cnt++, $i, $i, $char; } } ####################################################################### # WCHAR = _ToUnicodeChar(string) # converts a perl string in a 16-bit (pseudo) unicode string ####################################################################### sub _ToUnicodeChar { my $string = shift or return(undef); $string =~ s/(.)/$1\x00/sg; return $string; } ####################################################################### # WSTR = _ToUnicodeSz(string) # converts a perl string in a null-terminated 16-bit (pseudo) unicode string ####################################################################### sub _ToUnicodeSz { my $string = shift or return(undef); return _ToUnicodeChar($string."\x00"); } ####################################################################### # string = _FromUnicode(WSTR) # converts a null-terminated 16-bit unicode string into a regular perl string ####################################################################### sub _FromUnicode { my $string = shift or return(undef); $string = unpack("Z*", pack( "C*", unpack("S*", $string))); return($string); } ####################################################################### # HANDLE = GetProcessHeap() # The GetProcessHeap function obtains a handle to the heap of the calling process. # This handle can then be used in subsequent calls to the heap functions. ####################################################################### sub _GetProcessHeap { return $GetProcessHeap->Call(); } 1; __END__ =head1 NAME Win32::IPHelper - Perl wrapper for Win32 IP Helper functions and structures. =head1 SYNOPSIS use Win32::IPHelper; $ret = Win32::IPHelper::GetInterfaceInfo(\%IP_INTERFACE_INFO); $ret = Win32::IPHelper::GetAdaptersInfo(\@IP_ADAPTER_INFO); $ret = Win32::IPHelper::GetAdapterIndex(\$AdapterName, \$IfIndex); $ret = Win32::IPHelper::GetIfEntry($IfIndex, \%MIB_IFROW); $ret = Win32::IPHelper::AddIPAddress($Address, $IpMask, $IfIndex, \$NTEContext, \$NTEInstance); $ret = Win32::IPHelper::DeleteIPAddress($NTEContext); $ret = Win32::IPHelper::IpReleaseAddress(\%AdapterInfo); $ret = Win32::IPHelper::IpRenewAddress(\%AdapterInfo); $ret = Win32::IPHelper::GetTcpTable(\@TCP_TABLE, $bOrder); $ret = Win32::IPHelper::AllocateAndGetTcpExTableFromStack(\@TCP_EX_TABLE, $bOrder); $ret = Win32::IPHelper::GetUdpTable(\@UDP_TABLE, $bOrder); $ret = Win32::IPHelper::AllocateAndGetUdpExTableFromStack(\@UDP_EX_TABLE, $bOrder); =head1 DESCRIPTION Interface to Win32 IP Helper functions and data structures, needed to retrieve and modify configuration settings for the Transmission Control Protocol/Internet Protocol (TCP/IP) transport on the local computer. This module covers a small subset of the functions and data structures provided by the Win32 IP Helper API. B The Internet Protocol Helper (IP Helper) API enables the retrieval and modification of network configuration settings for the local computer. B The IP Helper API is applicable in any computing environment where programmatically manipulating TCP/IP configuration is useful. Typical applications include IP routing protocols and Simple Network Management Protocol (SNMP) agents. B The IP Helper API is designed for use by C/C++ programmers. Programmers should also be familiar with TCP/IP networking concepts. B The IP Helper API is supported on: =over 4 =item * Microsoft Windows 98 =item * Microsoft Windows Millennium Edition =item * Microsoft Windows NT version 4.0 with Service Pack 4 =item * Microsoft Windows 2000 =item * Microsoft Windows XP =item * Microsoft Windows .NET Server 2003 family =back B Not all operating systems support all functions. If an IP Helper function is called on a platform that does not support the function, ERROR_NOT_SUPPORTED is returned. For more specific information about which operating systems support a particular function, refer to the Requirements sections in the documentation. The complete SDK Reference documentation is available online through Microsoft MSDN Library (http://msdn.microsoft.com/library/default.asp) =head2 EXPORT None by default. =head1 FUNCTIONS =head2 GetInterfaceInfo(\%IP_INTERFACE_INFO) The GetInterfaceInfo function obtains a IP_INTERFACE_INFO structure that contains the list of the network interface adapters on the local system. B use Win32::IPHelper; use Data::Dumper; my %IP_INTERFACE_INFO; $ret = Win32::IPHelper::GetInterfaceInfo(\%IP_INTERFACE_INFO); if($ret == 0) { print Data::Dumper->Dump([\%IP_INTERFACE_INFO], [qw(IP_INTERFACE_INFO)]); } else { printf "GetInterfaceInfo() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B The GetAdaptersInfo and GetInterfaceInfo functions do not return information about the loopback interface B Client: Included in Windows XP, Windows 2000 Professional, Windows Me, Windows 98. Server: Included in Windows .NET Server 2003, Windows 2000 Server. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 GetAdaptersInfo(\@IP_ADAPTER_INFO) The GetAdaptersInfo function obtains a list of IP_ADAPTER_INFO structures that contains adapter information for the local computer. B use Win32::IPHelper; use Data::Dumper; my @IP_ADAPTER_INFO; $ret = Win32::IPHelper::GetAdaptersInfo(\@IP_ADAPTER_INFO); if($ret == 0) { print Data::Dumper->Dump([\@IP_ADAPTER_INFO], [qw(IP_ADAPTER_INFO)]); } else { printf "GetAdaptersInfo() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B The GetAdaptersInfo and GetInterfaceInfo functions do not return information about the loopback interface Windows XP/Windows .NET Server 2003 family or later: The list of adapters returned by GetAdaptersInfo includes unidirectional adapters. To generate a list of adapters that can both send and receive data, call I, and exclude the returned adapters from the list returned by GetAdaptersInfo. B Client: Included in Windows XP, Windows 2000 Professional, Windows Me, Windows 98. Server: Included in Windows .NET Server 2003, Windows 2000 Server. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 GetAdapterIndex(\$AdapterName,\$IfIndex) The GetAdapterIndex function obtains the index of an adapter, given its name. B use Win32::IPHelper; my $IfIndex; # the value for AdapterName is found in @IP_ADAPTER_INFO, for example # $IP_ADAPTER_INFO[0]{'AdapterName'}; my $AdapterName = '{88CE272F-847A-40CF-BFBA-001D9AD97450}'; $ret = Win32::IPHelper::GetAdapterIndex(\$AdapterName,\$IfIndex); if($ret == 0) { printf "Index for '%s' interface is %u\n", $AdapterName, $IfIndex; } else { printf "GetAdapterIndex() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B Client: Included in Windows XP, Windows 2000 Professional. Server: Included in Windows .NET Server 2003, Windows 2000 Server. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 GetIfEntry($IfIndex,\%MIB_IFROW) The GetIfEntry function retrieves a MIB_IFROW structure information for the specified interface on the local computer. B use Win32::IPHelper; use Data::Dumper; my $IfIndex; # the value for AdapterName is found in @IP_ADAPTER_INFO, for example # $IP_ADAPTER_INFO[0]{'AdapterName'}; my $AdapterName = '{88CE272F-847A-40CF-BFBA-001D9AD97450}'; $ret = Win32::IPHelper::GetAdapterIndex(\$AdapterName,\$IfIndex); if($ret == 0) { my %MIB_IFROW; $ret = Win32::IPHelper::GetIfEntry($IfIndex,\%MIB_IFROW); if($ret == 0) { print Data::Dumper->Dump([\%MIB_IFROW], [qw(MIB_IFROW)]); } else { printf "GetIfEntry() error %u: %s\n", $ret, Win32::FormatMessage($ret); } } else { printf "GetAdapterIndex() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B Client: Included in Windows XP, Windows 2000 Professional, Windows NT Workstation 4.0 SP4 and later, Windows Me, Windows 98. Server: Included in Windows .NET Server 2003, Windows 2000 Server, Windows NT Server 4.0 SP4 and later. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 AddIPAddress($Address,$IpMask,$IfIndex,\$NTEContext,\$NTEInstance) The AddIPAddress function adds the specified IP address to the specified adapter. B use Win32::IPHelper; my $IfIndex; # the value for AdapterName is found in @IP_ADAPTER_INFO, for example # $IP_ADAPTER_INFO[0]{'AdapterName'}; my $AdapterName = '{88CE272F-847A-40CF-BFBA-001D9AD97450}'; $ret = Win32::IPHelper::GetAdapterIndex(\$AdapterName,\$IfIndex); if($ret == 0) { my $Address = '192.168.1.10'; my $IpMask = '255.255.255.0'; my $NTEContext; my $NTEInstance; $ret = Win32::IPHelper::AddIPAddress($Address,$IpMask,$IfIndex,\$NTEContext,\$NTEInstance); if($ret == 0) { printf "Address has been added successfully with Context=%u\n", $NTEContext; } else { printf "AddIPAddress() error %u: %s\n", $ret, Win32::FormatMessage($ret); } } else { printf "GetAdapterIndex() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B The IP address created by I is not persistent. The address exists only as long as the adapter object exists. Restarting the computer destroys the address, as does manually resetting the network interface card (NIC). Also, certain PnP events may destroy the address. B Client: Included in Windows XP, Windows 2000 Professional. Server: Included in Windows .NET Server 2003, Windows 2000 Server. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 DeleteIPAddress($NTEContext) The DeleteIPAddress function deletes an IP address previously added using I. B use Win32::IPHelper; my $NTEContext = 2; $ret = Win32::IPHelper::DeleteIPAddress($NTEContext); if($ret == 0) { printf "Address has been deleted successfully from Context=%u\n", $NTEContext; } else { printf "DeleteIPAddress() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B Client: Included in Windows XP, Windows 2000 Professional. Server: Included in Windows .NET Server 2003, Windows 2000 Server. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 IpReleaseAddress(\%AdapterInfo) The IpReleaseAddress function releases an IP address previously obtained through Dynamic Host Configuration Protocol (DHCP). B use Win32::IPHelper; my %IP_INTERFACE_INFO; $ret = Win32::IPHelper::GetInterfaceInfo(\%IP_INTERFACE_INFO); if($ret == 0) { my %AdapterInfo = %{ $IP_INTERFACE_INFO{'Adapters'}[0] }; $ret = Win32::IPHelper::IpReleaseAddress(\%AdapterInfo); if($ret == 0) { print "Address has been released successfully\n"; } else { printf "IpReleaseAddress() error %u: %s\n", $ret, Win32::FormatMessage($ret); } } else { printf "GetInterfaceInfo() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B Client: Included in Windows XP, Windows 2000 Professional, Windows Me, Windows 98. Server: Included in Windows .NET Server 2003, Windows 2000 Server. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 IpRenewAddress(\%AdapterInfo) The IpRenewAddress function renews a lease on an IP address previously obtained through Dynamic Host Configuration Protocol (DHCP). B use Win32::IPHelper; my %IP_INTERFACE_INFO; $ret = Win32::IPHelper::GetInterfaceInfo(\%IP_INTERFACE_INFO); if($ret == 0) { my %AdapterInfo = %{ $IP_INTERFACE_INFO{'Adapters'}[0] }; $ret = Win32::IPHelper::IpRenewAddress(\%AdapterInfo); if($ret == 0) { print "Address has been renewed successfully\n"; } else { printf "IpRenewAddress() error %u: %s\n", $ret, Win32::FormatMessage($ret); } } else { printf "GetInterfaceInfo() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B Client: Included in Windows XP, Windows 2000 Professional, Windows Me, Windows 98. Server: Included in Windows .NET Server 2003, Windows 2000 Server. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 GetTcpTable(\@TCP_TABLE,$bOrder) The GetTcpTable function retrieves the TCP connection table. B use Win32::IPHelper; use Data::Dumper; my @TCP_TABLE; my $bOrder = 1; $ret = Win32::IPHelper::GetTcpTable(\@TCP_TABLE, $bOrder); if($ret == 0) { print Data::Dumper->Dump([\@TCP_TABLE], [qw(TCP_TABLE)]); } else { printf "GetTcpTable() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B Client: Requires Windows XP, Windows 2000 Professional, Windows NT Workstation 4.0 SP4 and later, Windows Me, or Windows 98. Server: Requires Windows Server 2003, Windows 2000 Server, or Windows NT Server 4.0 SP4 and later. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 AllocateAndGetTcpExTableFromStack(\@TCP_EX_TABLE,$bOrder) The AllocateAndGetTcpExTableFromStack function retrieves the TCP connection table with the additional ProcessId. B use Win32::IPHelper; use Data::Dumper; my @TCP_EX_TABLE; my $bOrder = 1; $ret = Win32::IPHelper::AllocateAndGetTcpExTableFromStack(\@TCP_EX_TABLE, $bOrder); if($ret == 0) { print Data::Dumper->Dump([\@TCP_EX_TABLE], [qw(TCP_EX_TABLE)]); } else { printf "AllocateAndGetTcpExTableFromStack() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B The AllocateAndGetTcpExTableFromStack function is undocumented and is available only in Windows XP and Windows Server 2003. B Client: Requires Windows XP. Server: Requires Windows Server 2003. Header: Undeclared. Library: Iphlpapi.dll. =head2 GetUdpTable(\@UDP_TABLE,$bOrder) The GetUdpTable function retrieves the User Datagram Protocol (UDP) listener table. B use Win32::IPHelper; use Data::Dumper; my @UDP_TABLE; my $bOrder = 1; $ret = Win32::IPHelper::GetTcpTable(\@UDP_TABLE, $bOrder); if($ret == 0) { print Data::Dumper->Dump([\@UDP_TABLE], [qw(UDP_TABLE)]); } else { printf "GetUdpTable() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B Client: Requires Windows XP, Windows 2000 Professional, Windows NT Workstation 4.0 SP4 and later, Windows Me, or Windows 98. Server: Requires Windows Server 2003, Windows 2000 Server, or Windows NT Server 4.0 SP4 and later. Header: Declared in Iphlpapi.h. Library: Iphlpapi.dll. =head2 AllocateAndGetUdpExTableFromStack(\@UDP_EX_TABLE,$bOrder) The AllocateAndGetTcpExTableFromStack function retrieves the User Datagram Protocol (UDP) listener table with the additional ProcessId. B use Win32::IPHelper; use Data::Dumper; my @TCP_EX_TABLE; my $bOrder = 1; $ret = Win32::IPHelper::AllocateAndGetUdpExTableFromStack(\@UDP_EX_TABLE, $bOrder); if($ret == 0) { print Data::Dumper->Dump([\@UDP_EX_TABLE], [qw(UDP_EX_TABLE)]); } else { printf "AllocateAndGetUdpExTableFromStack() error %u: %s\n", $ret, Win32::FormatMessage($ret); } B If the function succeeds, the return value is 0. If the function fails, the error code can be decoded with Win32::FormatMessage($ret). B The AllocateAndGetUdpExTableFromStack function is undocumented and is available only in Windows XP and Windows Server 2003. B Client: Requires Windows XP. Server: Requires Windows Server 2003. Header: Undeclared. Library: Iphlpapi.dll. =head1 CREDITS Thanks to Aldo Calpini for the powerful Win32::API module that makes this thing work. =head1 AUTHOR Luigino Masarati, Elmasarati@hotmail.comE =cut From glim at mycybernet.net Mon Jan 24 17:34:00 2005 From: glim at mycybernet.net (glim@mycybernet.net) Date: Mon Jan 24 17:33:32 2005 Subject: [VPM] Yet Another Perl Conference North America 2005 announces call-for-papers Message-ID: YAPC::NA 2005 (Yet Another Perl Conference, North America) has just released its call-for-papers; potential and aspiring speakers can submit a presentation proposal via: http://yapc.org/America/cfp-2005.shtml The dates of the conference are Monday - Wednesday 27-29 June 2005. The location will be in downtown Toronto, Ontario, Canada. (Note that a different date block was previously announced, but has been moved to accomodate venue availability.) The close of the call-for-papers is April 18, 2005 at 11:59 pm. If you have any questions regarding the call-for-papers or speaking at YAPC::NA 2005 please email na-author@yapc.org We would love to hear from potential sponsors. Please contact the organizers at na-sponsor@yapc.org to learn about the benefits of sponsorship. Other information regarding the conference (e.g. venue, registration specifics) will be announced soon. We look forward to your submissions and a great conference! From Peter at PSDT.com Mon Jan 31 16:46:31 2005 From: Peter at PSDT.com (Peter Scott) Date: Mon Jan 31 16:46:35 2005 Subject: [VPM] Feb 15 Perl Mongers meeting Message-ID: <6.1.2.0.2.20050131122644.02849be0@shell2.webquarry.com> Let's start on the February meeting. We were looking at having several people present short topics I believe. Let's get some interest matched up with some volunteers. We had one request for pack/unpack; I too would like to hear about those, which is another way of saying that I'm not going to give that presentation. What else? -- Peter Scott Pacific Systems Design Technologies http://www.perldebugged.com/ *** New! *** http://www.perlmedic.com/