?? internet.pm
字號:
sub ControlSendTimeout {
#=======================
my($self, $value) = @_;
return undef unless ref($self);
return Option($self, constant("INTERNET_OPTION_CONTROL_SEND_TIMEOUT", 0), $value);
}
#================
sub QueryOption {
#================
my($self, $option) = @_;
return undef unless ref($self);
return InternetQueryOption($self->{'handle'}, $option);
}
#==============
sub SetOption {
#==============
my($self, $option, $value) = @_;
return undef unless ref($self);
return InternetSetOption($self->{'handle'}, $option, $value);
}
#=============
sub CrackURL {
#=============
my($self, $URL, $flags) = @_;
return undef unless ref($self);
$flags = constant("ICU_ESCAPE", 0) unless defined($flags);
my @newurl = InternetCrackUrl($URL, $flags);
if(!defined($newurl[0])) {
$self->{'Error'} = "Cannot crack URL.";
return undef;
} else {
return @newurl;
}
}
#==============
sub CreateURL {
#==============
my($self, $scheme, $hostname, $port,
$username, $password,
$path, $extrainfo, $flags) = @_;
return undef unless ref($self);
if(ref($scheme) and ref($scheme) eq "HASH") {
$flags = $hostname;
$hostname = $scheme->{'hostname'};
$port = $scheme->{'port'};
$username = $scheme->{'username'};
$password = $scheme->{'password'};
$path = $scheme->{'path'};
$extrainfo = $scheme->{'extrainfo'};
my $myscheme = $scheme->{'scheme'};
undef $scheme;
$scheme = $myscheme;
}
$hostname = "" unless defined($hostname);
$port = 0 unless defined($port);
$username = "" unless defined($username);
$password = "" unless defined($password);
$path = "" unless defined($path);
$extrainfo = "" unless defined($extrainfo);
$flags = constant("ICU_ESCAPE", 0) unless defined($flags);
my $newurl = InternetCreateUrl($scheme, $hostname, $port,
$username, $password,
$path, $extrainfo, $flags);
if(!defined($newurl)) {
$self->{'Error'} = "Cannot create URL.";
return undef;
} else {
return $newurl;
}
}
#====================
sub CanonicalizeURL {
#====================
my($self, $URL, $flags) = @_;
return undef unless ref($self);
my $newurl = InternetCanonicalizeUrl($URL, $flags);
if(!defined($newurl)) {
$self->{'Error'} = "Cannot canonicalize URL.";
return undef;
} else {
return $newurl;
}
}
#===============
sub CombineURL {
#===============
my($self, $baseURL, $relativeURL, $flags) = @_;
return undef unless ref($self);
my $newurl = InternetCombineUrl($baseURL, $relativeURL, $flags);
if(!defined($newurl)) {
$self->{'Error'} = "Cannot combine URL(s).";
return undef;
} else {
return $newurl;
}
}
#======================
sub SetStatusCallback {
#======================
my($self) = @_;
return undef unless ref($self);
my $callback = InternetSetStatusCallback($self->{'handle'});
print "callback=$callback, constant=",constant("INTERNET_INVALID_STATUS_CALLBACK", 0), "\n";
if($callback == constant("INTERNET_INVALID_STATUS_CALLBACK", 0)) {
return undef;
} else {
return $callback;
}
}
#======================
sub GetStatusCallback {
#======================
my($self, $context) = @_;
$context = $self if not defined $context;
return($callback_code{$context}, $callback_info{$context});
}
#==========
sub Error {
#==========
my($self) = @_;
return undef unless ref($self);
my $errtext = "";
my $tmp = "";
my $errnum = Win32::GetLastError();
if($errnum < 12000) {
$errtext = Win32::FormatMessage($errnum);
$errtext =~ s/[\r\n]//g;
} elsif($errnum == 12003) {
($tmp, $errtext) = InternetGetLastResponseInfo();
chomp $errtext;
1 while($errtext =~ s/(.*)\n//); # the last line should be significative...
# otherwise call GetResponse() to get it whole
} elsif($errnum >= 12000) {
$errtext = FormatMessage($errnum);
$errtext =~ s/[\r\n]//g;
} else {
$errtext="Error";
}
if($errnum == 0 and defined($self->{'Error'})) {
if($self->{'Error'} == -2) {
$errnum = -2;
$errtext = "Asynchronous operations not available.";
} else {
$errnum = -1;
$errtext = $self->{'Error'};
}
}
return (wantarray)? ($errnum, $errtext) : "\[".$errnum."\] ".$errtext;
}
#============
sub Version {
#============
my $dll = InternetDllVersion();
$dll =~ s/\0//g;
return (wantarray)? ($Win32::Internet::VERSION, $dll)
: $Win32::Internet::VERSION."/".$dll;
}
#==========
sub Close {
#==========
my($self, $handle) = @_;
if(!defined($handle)) {
return undef unless ref($self);
$handle = $self->{'handle'};
}
InternetCloseHandle($handle);
}
#######################################################################
# FTP CLASS METHODS
#
#======== ### FTP CONSTRUCTOR
sub FTP {
#========
my($self, $new, $server, $username, $password, $port, $pasv, $context) = @_;
return undef unless ref($self);
if(ref($server) and ref($server) eq "HASH") {
$port = $server->{'port'};
$username = $server->{'username'};
$password = $password->{'host'};
my $myserver = $server->{'server'};
$pasv = $server->{'pasv'};
$context = $server->{'context'};
undef $server;
$server = $myserver;
}
$server = "" unless defined($server);
$username = "anonymous" unless defined($username);
$password = "" unless defined($password);
$port = 21 unless defined($port);
$context = 0 unless defined($context);
if(defined($pasv)) {
$pasv=constant("INTERNET_CONNECT_FLAG_PASSIVE",0) if $pasv ne 0;
} else {
$pasv=$self->{'pasv'};
}
my $newhandle = InternetConnect($self->{'handle'}, $server, $port,
$username, $password,
constant("INTERNET_SERVICE_FTP", 0),
$pasv, $context);
if($newhandle) {
$self->{'connections'}++;
$_[1] = _new($newhandle);
$_[1]->{'Type'} = "FTP";
$_[1]->{'Mode'} = "bin";
$_[1]->{'pasv'} = $pasv;
$_[1]->{'username'} = $username;
$_[1]->{'password'} = $password;
$_[1]->{'server'} = $server;
return $newhandle;
} else {
return undef;
}
}
#========
sub Pwd {
#========
my($self) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
$self->{'Error'} = "Pwd() only on FTP sessions.";
return undef;
}
return FtpGetCurrentDirectory($self->{'handle'});
}
#=======
sub Cd {
#=======
my($self, $path) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP" || !defined($self->{'handle'})) {
$self->{'Error'} = "Cd() only on FTP sessions.";
return undef;
}
my $retval = FtpSetCurrentDirectory($self->{'handle'}, $path);
if(!defined($retval)) {
return undef;
} else {
return $path;
}
}
#====================
sub Cwd { Cd(@_); }
sub Chdir { Cd(@_); }
#====================
#==========
sub Mkdir {
#==========
my($self, $path) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
$self->{'Error'} = "Mkdir() only on FTP sessions.";
return undef;
}
my $retval = FtpCreateDirectory($self->{'handle'}, $path);
$self->{'Error'} = "Can't create directory." unless defined($retval);
return $retval;
}
#====================
sub Md { Mkdir(@_); }
#====================
#=========
sub Mode {
#=========
my($self, $value) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
$self->{'Error'} = "Mode() only on FTP sessions.";
return undef;
}
if(!defined($value)) {
return $self->{'Mode'};
} else {
my $modesub = ($value =~ /^a/i) ? "Ascii" : "Binary";
$self->$modesub($_[0]);
}
return $self->{'Mode'};
}
#==========
sub Rmdir {
#==========
my($self, $path) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
$self->{'Error'} = "Rmdir() only on FTP sessions.";
return undef;
}
my $retval = FtpRemoveDirectory($self->{'handle'}, $path);
$self->{'Error'} = "Can't remove directory." unless defined($retval);
return $retval;
}
#====================
sub Rd { Rmdir(@_); }
#====================
#=========
sub Pasv {
#=========
my($self, $value) = @_;
return undef unless ref($self);
if(defined($value) and $self->{'Type'} eq "Internet") {
if($value == 0) {
$self->{'pasv'} = 0;
} else {
$self->{'pasv'} = 1;
}
}
return $self->{'pasv'};
}
#=========
sub List {
#=========
my($self, $pattern, $retmode) = @_;
return undef unless ref($self);
my $retval = "";
my $size = "";
my $attr = "";
my $ctime = "";
my $atime = "";
my $mtime = "";
my $csec = 0; my $cmin = 0; my $chou = 0; my $cday = 0; my $cmon = 0; my $cyea = 0;
my $asec = 0; my $amin = 0; my $ahou = 0; my $aday = 0; my $amon = 0; my $ayea = 0;
my $msec = 0; my $mmin = 0; my $mhou = 0; my $mday = 0; my $mmon = 0; my $myea = 0;
my $newhandle = 0;
my $nextfile = 1;
my @results = ();
my ($filename, $altname, $file);
if($self->{'Type'} ne "FTP") {
$self->{'Error'} = "List() only on FTP sessions.";
return undef;
}
$pattern = "" unless defined($pattern);
$retmode = 1 unless defined($retmode);
if($retmode == 2) {
( $newhandle,$filename, $altname, $size, $attr,
$csec, $cmin, $chou, $cday, $cmon, $cyea,
$asec, $amin, $ahou, $aday, $amon, $ayea,
$msec, $mmin, $mhou, $mday, $mmon, $myea
) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
if(!$newhandle) {
$self->{'Error'} = "Can't read FTP directory.";
return undef;
} else {
while($nextfile) {
$ctime = join(",", ($csec, $cmin, $chou, $cday, $cmon, $cyea));
$atime = join(",", ($asec, $amin, $ahou, $aday, $amon, $ayea));
$mtime = join(",", ($msec, $mmin, $mhou, $mday, $mmon, $myea));
push(@results, $filename, $altname, $size, $attr, $ctime, $atime, $mtime);
( $nextfile, $filename, $altname, $size, $attr,
$csec, $cmin, $chou, $cday, $cmon, $cyea,
$asec, $amin, $ahou, $aday, $amon, $ayea,
$msec, $mmin, $mhou, $mday, $mmon, $myea
) = InternetFindNextFile($newhandle);
}
InternetCloseHandle($newhandle);
return @results;
}
} elsif($retmode == 3) {
( $newhandle,$filename, $altname, $size, $attr,
$csec, $cmin, $chou, $cday, $cmon, $cyea,
$asec, $amin, $ahou, $aday, $amon, $ayea,
$msec, $mmin, $mhou, $mday, $mmon, $myea
) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
if(!$newhandle) {
$self->{'Error'} = "Can't read FTP directory.";
return undef;
} else {
while($nextfile) {
$ctime = join(",", ($csec, $cmin, $chou, $cday, $cmon, $cyea));
$atime = join(",", ($asec, $amin, $ahou, $aday, $amon, $ayea));
$mtime = join(",", ($msec, $mmin, $mhou, $mday, $mmon, $myea));
$file = { "name" => $filename,
"altname" => $altname,
"size" => $size,
"attr" => $attr,
"ctime" => $ctime,
"atime" => $atime,
"mtime" => $mtime,
};
push(@results, $file);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -