The IUP module is a cross-platform GUI toolkit designed to run on MS Windows (incl. Cygwin), GTK+ and Motif/X11. On all platform it uses native GUI widgets.
https://metacpan.org/module/KMX/IUP-0.100/lib/IUP.pod
Perl Win32::GUI文档
1、介绍：https://metacpan.org/module/ROBERTMAY/Win32-GUI-1.06/docs/GUI /Tutorial.pod
2、使用手册：http://perl-win32-gui.sourceforge.net/cgi-bin /docs.cgi?doc=reference-packages
免费Perl打包工具
1、Cava Packager
之前我用的。刚打开看了下，似乎改了不少。
介绍：http://www.cavapackager.com/appdocs/overview-quickstart.htm
下载：http://www.cavapackager.com/
2、pp
台湾的传奇 唐凤作品，许伦的最爱。
https://metacpan.org/module/pp
收费Perl 打包工具
1、BoxedApp
http://www.boxedapp.com/boxedapppacker/order.html#.UWIzM1t5HDc
2、Perl Dev Kit (PDK)
http://www.activestate.com/perl-dev-kit
附送一个小demo
use File::Basename qw(dirname basename);
use Data::Dump qw(ddx);
use Win32::GUI();
use Win32::Process;
use Win32;
use Win32::SystemInfo;
use POSIX qw(strftime);
$|++;
my %phash;
Win32::SystemInfo::ProcessorInfo(%phash);
my $thread_num = $phash{NumProcessors} * 2 + 1;
undef %phash;
my $rootdir = Win32::GetCwd();
chdir($rootdir);
my $tempdir = $rootdir . '/tmp/';
my $libdir = $rootdir . '/lib/';
my $confdir = $rootdir . '/conf/';
my $errlogfile = $rootdir . '/log/errlog.log';
my $inputdir = readfile("$confdir/indir.conf") || $rootdir;
my $outputdir = readfile("$confdir/outdir.conf") || $rootdir;
my $radio_checked = readfile("$confdir/radio.conf") || 'flv';
$MyIcon = new Win32::GUI::Icon("logo.ico");
$MyClass = new Win32::GUI::Class(-name => "my_Win32GUI_class_with_changed_icon",
-icon => $MyIcon,);
my $W1 = Win32::GUI::Window->new(
-name => "W1",
-title => "FLV文件分析小工具 v1.00",
-pos => [30, 30],
-size => [800, 600],
-class => $MyClass,
);
my $inputfile_textfiled =
$W1->AddTextfield(
-name => 'Textfield1',
-text => '',
-prompt => ["待分析FLV文件:", 90],
-pos => [10, 20],
-size => [320, 20],
-align => 'left',
);
$W1->AddButton(-name => "Button1", -text => "浏览..", -pos => [435, 20],);
my $checkbox1 = $W1->AddCheckbox(
-name => "Checkbox1",
-text => "只看关键帧",
-checked => 1,
-pos => [500, 20],
);
$W1->AddButton(
-name => "Button3",
-text => "开始分析",
-pos => [650, 20],
-size => [110, 20]
);
my $inputfile_textfiled2 =
$W1->AddTextfield(
-name => 'Textfield2',
-multiline => 1,
-readonly => 1,
-text => '',
-pos => [10, 50],
-size => [760, 500],
-align => 'left',
);
$W1->Show();
Win32::GUI::Dialog();
exit(0);
sub Button1_Click
{
my $file =
Win32::GUI::GetOpenFileName(
-title => "选择要分析的文件 ..",
-file => "\0" . " " x 256,
-directory => $inputdir,
-filter => ["FLV video files" => "*.flv;*.hlv",],
);
$inputfile_textfiled->{'-text'} = $file;
return 1;
}
sub Button3_Click
{
my $input = $inputfile_textfiled->{'-text'};
unless (-e $input and -f $input and -s $input)
{
Win32::MsgBox('请正确选择待转文件', MB_ICONINFORMATION, '错误');
return 0;
}
unless ($input =~ /lv/)
{
Win32::MsgBox('请正确选择待转文件', MB_ICONINFORMATION, '错误');
return 0;
}
my $file = $input;
my $filesize = -s $file;
my $tpos = 13;
open FH, $file or die $!;
seek FH, 13, 0 or die $!;
my $result =
"偏移量\t\tTAG类型\t\tTAG大小\t\t时间\t\t编码\t\t帧类型\t\t包类型\r\n\r\n";
while ($tpos < $filesize)
{
my $buf;
read FH, $buf, 1 or die $!;
my ($type) = unpack("C", $buf);
read FH, $buf, 3 or die $!;
my ($size) = unpack("N", chr(0) . $buf);
read FH, $buf, 3 or die $!;
my ($time) = unpack("N", chr(0) . $buf);
read FH, $buf, 1 or die $!;
my ($timeext) = unpack("C", $buf);
read FH, $buf, 3 or die $!;
my ($streamid) = unpack("N", chr(0) . $buf);
read FH, $buf, 1 or die $!;
my ($byte) = unpack("C", $buf);
my $codec = '-1';
my $frametype = "-1";
if ($type == 8)
{
$codec = $byte >> 4;
}
elsif ($type == 9)
{
$codec = $byte & 0xffff;
$frametype = $byte >> 4;
}
read FH, $buf, 1 or die $!;
my ($ptype) = unpack("C", $buf);
if ($type == 18)
{
$ptype = -1;
}
if ($type == 18)
{
$type = 'script';
}
elsif ($type == 8)
{
$type = 'audio';
}
elsif ($type == 9)
{
$type = 'video';
}
if ($frametype == 1)
{
$frametype = 'key';
}
else
{
$frametype = '';
}
if ($ptype == 0)
{
$ptype = 'codec header';
}
else
{
$ptype = '';
}
if ($checkbox1->Checked)
{
$result .=
"$tpos\t\t$type\t\t$size\t\t$time\t\t$codec\t\t$frametype\t\t$ptype\r\n"
if ($frametype eq 'key');
}
else
{
$result .=
"$tpos\t\t$type\t\t$size\t\t$time\t\t$codec\t\t$frametype\t\t$ptype\r\n";
}
$tpos += $size + 4 + 11;
seek FH, $tpos, 0 or die $!;
}
close FH;
#Win32::MsgBox('文件分析完成', MB_ICONINFORMATION, '完成');
$inputfile_textfiled2->{'-text'} = $result;
return 1;
}
sub W1_Terminate
{
return -1;
}
sub process
{
my $exefile = shift;
my $cmd = shift;
my $process;
my $exitcode;
Win32::Process::Create($process, $exefile, $cmd, 0, NORMAL_PRIORITY_CLASS,
".");
$process->Suspend();
$process->Resume();
$process->Wait(INFINITE);
$process->GetExitCode($exitcode);
if ($exitcode != 0)
{
logerr($^E . $exefile . $cmd);
}
return $exitcode; #exitcode=0 means right, 1 means wrong.
}
sub logerr
{
my $message = shift;
$message =
strftime("%Y-%m-%d %H:%M:%S", localtime) . "\t" . $message . "\n";
open my $fh, '>>', $errlogfile;
print $fh $message;
close $fh;
return 1;
}
sub readfile
{
my $file = shift or return 0;
local $/;
open my $fh, '<', $file;
my $content = <$fh>;
close $fh;
return $content;
}
sub writefile
{
my $file = shift or return 0;
my $content = shift;
open my $fh, '>', $file;
print $fh $content;
close $fh;
return 1;
}
sub tailfile
{
my $file = shift or return 0;
my $content = "";
open(F, $file) or die $!;
seek(F, 0, 2); # set handler at the end of $file
until ($content =~ m/\n(.*)\n?$/)
{
my $string;
if (seek(F, -1024, 1)) # backward 1024 bytes
{
my $n = read(F, $string, 1024) or die $!;
$content = $string . $content;
last if ($n < 1024);
seek(F, -1024, 1);
}
else
{
my $len = tell F;
seek(F, 0, 0) || die "see error at $file";
read(F, $string, $len) or die $!;
$content = $string . $content;
last;
}
}
close(F);
if ($content =~ m/\n\n$/)
{
print "\n";
}
elsif ($content =~ m/\n?(.*)\n?$/)
{
print "$1\n";
}
else
{
print $content, "\n";
}
}