mciSendCommand is actually pretty simple. The tricky part is preparing the structure for its fourth argument, since the structure varies based on the second argument.
I imagine it would look like the following:
package MCI;
use strict;
use warnings;
use Encode qw( decode );
use Win32::API qw( );
use constant {
# Messages
MCI_INFO => 0x80A
MCI_RECORD => 0x80F,
...
# Flags
MCI_NOTIFY => 0x01,
MCI_WAIT => 0x02,
...
};
my $send_command = Win32::API->new(
'Winmm.dll', 'mciSendCommandW', 'NNNP', 'N',
);
sub send_command {
my ($device, $msg, $flags, $packed_parms) = @_;
my $rv = $send_command->Call($device, $msg, $flags, $packed_parms);
return 1 if $rv == 0;
die(MCI::Error->new($rv));
}
sub info {
my ($device, $flags, $win_handle, $max_chars) = @_;
$max_chars ||= 256;
my $size = $max_chars * 2;
my $str_buf = "\0" x $size;
# MCI_INFO_PARMS
my $packed_params = pack("IPI",
$win_handle,
$str_buf,
$size,
);
return undef if !send_command(
$device,
MCI_INFO,
$flags,
$packed_params,
);
my ($new_size) = unpack("x4x4I", $packed_params);
return decode('UCS-2le', substr($str_buf, 0, $new_size)); # Or $ne
+w_size-2?
}
sub record {
my ($device, $flags, $win_handle, $from, $to) = @_;
# MCI_RECORD_PARMS
my $packed_params = pack('III',
$win_handle,
$from,
$to,
);
return send_command(
$device,
MCI_RECORD,
$flags,
$packed_params,
);
}
...
1;
package MCI::Error;
use strict;
use warnings;
sub new {
my ($class, $error) = @_;
my $msg = ...mciGetErrorString...;
return bless({
code => $error & 0xFFFF,
driver_id => $error >> 16,
msg => $msg,
}, $class);
}
...
1;
|