Perl-Code <--> WIN-API Hilfe bei UMTS-Karte

#!perl -w

use Win32::IPHelper;
use Data::Dumper;

# no buffering, direct output
$| = 1;

my $AdapterID=0;
my $AdapterDescription=0;

# Adapter auswaehlen

my $Adapter='1000 MT Mobile Connection';
#my $Adapter='VPN';

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)]);
my $i=0;
while ($IP_ADAPTER_INFO[$i]) {
if ($IP_ADAPTER_INFO[$i]{'Description'}=~/$Adapter/) {
$AdapterID=$IP_ADAPTER_INFO[$i]{'AdapterName'};
$AdapterDescription=$IP_ADAPTER_INFO[$i]{'Description'};
}
$i++;
}
} else {
printf "GetAdaptersInfo() error %u: %s\n", $ret, Win32::FormatMessage($ret);
}

print "Name: $AdapterDescription\nAdapterID: $AdapterID\n\n";

# Adapter-Informationen auslesen (hier outoctets und inoctets
my $IfIndex;
$ret = Win32::IPHelper::GetAdapterIndex(\$AdapterID,\$IfIndex);

if ($ret == 0) {
my %MIB_IFROW;
$ret = Win32::IPHelper::GetIfEntry($IfIndex,\%MIB_IFROW);
if ($ret == 0) {
printf "Sent: %.3f MBytes\tReceived: %.3f MBytes",$MIB_IFROW{'OutOctets'}/1024/1024,$MIB_IFROW{'InOctets'}/1024/1024;
} else {
printf "GetIfEntry() error %u: %s\n", $ret, Win32::FormatMessage($ret);
}
} else {
printf "GetAdapterIndex() error %u: %s\n", $ret, Win32::FormatMessage($ret);
}

package main;

use strict;
use warnings;
use Win32API::CommPort;

use vars qw ( $debugout $io $STDIN $STDOUT $STDERR);

my $debugout=0;
my ($modem, $io, $buf, $strength) = 0;

# Nun wird die UMTS-Karte erkannt, ein IO auf die Karte zurückgegeben
($modem,$io) = &check_device();

# sub zur Abfrage der Signal-Stärke
$strength=&getStrength;

# Ausgabe der Signal-Stärke
print $strength;

$io->close;
undef $io;

sub getStrength {

# Zugriffsversuch auf die UMTS-Karte
unless(defined($io) && $io) {
exit 1;
}

# Modem Signal-Stärke herausfinden (Format:
my $strength = &iocmd($io, 'AT+CSQ');

# Signalstärke herausfiltern ( < 11: schlecht, > 12: normal, > 31: sehr gute Qualität)
$strength =~ /CSQ:\s+([\d,]+)/;

return $1;
}

sub dodebug {
print(@_) if ($debugout);
}

sub iocmd {
my($io, $at_cmd) = @_;
my ($ok, $buf, $cnt);

my(@dummy) = $io->is_status; # resets error
$io->reset_error;
&dodebug("$at_cmd\n");

$cnt = $io->write_bg("$at_cmd\r");
if ($cnt != (length($at_cmd) + 1)) {
($ok, $cnt) = $io->write_done(1); # block until done
warn("Schreibfehler bei: $at_cmd\n") unless ($ok);
}

sleep 1;

($ok, $buf, $cnt) = (0, "", 512);
my $got = $io->read_bg($cnt);
($ok, $got, $buf) = $io->read_done($got != $cnt); # block or not until done

&dodebug(":$buf:\n");
return $buf;
}

sub check_device {
# check device
my @device=();
print "Prüfe Karte...\n" if ($debugout);
@device=`devcon find "usb\\VID_0AF0*MI_00*"`;
if ($device[0]=~/No matching devices found/) {
@device=`devcon find "OPTIONBUS\\*_MDM*"`;
}
my $modem=0;
print @device if ($debugout);

my $dummy=0;
($dummy,$modem)=split (': ',$device[0]);
chomp($modem);

my $io = new Win32API::CommPort ("\\\\.\\$modem", 1);

print "Folgende Karte wurde erkannt: $modem\n" if ($debugout);
print "Folgender IO: $io\n" if ($debugout);

return $modem, $io;
}