?? internet.pm
字號:
( $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;
}
} else {
($newhandle, $filename) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
if(!$newhandle) {
$self->{'Error'} = "Can't read FTP directory.";
return undef;
} else {
while($nextfile) {
push(@results, $filename);
($nextfile, $filename) = InternetFindNextFile($newhandle);
# print "List.no more files\n" if !$nextfile;
}
InternetCloseHandle($newhandle);
return @results;
}
}
}
#====================
sub Ls { List(@_); }
sub Dir { List(@_); }
#====================
#=================
sub FileAttrInfo {
#=================
my($self,$attr) = @_;
my @attrinfo = ();
push(@attrinfo, "READONLY") if $attr & 1;
push(@attrinfo, "HIDDEN") if $attr & 2;
push(@attrinfo, "SYSTEM") if $attr & 4;
push(@attrinfo, "DIRECTORY") if $attr & 16;
push(@attrinfo, "ARCHIVE") if $attr & 32;
push(@attrinfo, "NORMAL") if $attr & 128;
push(@attrinfo, "TEMPORARY") if $attr & 256;
push(@attrinfo, "COMPRESSED") if $attr & 2048;
return (wantarray)? @attrinfo : join(" ", @attrinfo);
}
#===========
sub Binary {
#===========
my($self) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP") {
$self->{'Error'} = "Binary() only on FTP sessions.";
return undef;
}
$self->{'Mode'} = "bin";
return undef;
}
#======================
sub Bin { Binary(@_); }
#======================
#==========
sub Ascii {
#==========
my($self) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP") {
$self->{'Error'} = "Ascii() only on FTP sessions.";
return undef;
}
$self->{'Mode'} = "asc";
return undef;
}
#=====================
sub Asc { Ascii(@_); }
#=====================
#========
sub Get {
#========
my($self, $remote, $local, $overwrite, $flags, $context) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP") {
$self->{'Error'} = "Get() only on FTP sessions.";
return undef;
}
my $mode = ($self->{'Mode'} eq "asc" ? 1 : 2);
$remote = "" unless defined($remote);
$local = $remote unless defined($local);
$overwrite = 0 unless defined($overwrite);
$flags = 0 unless defined($flags);
$context = 0 unless defined($context);
my $retval = FtpGetFile($self->{'handle'},
$remote,
$local,
$overwrite,
$flags,
$mode,
$context);
$self->{'Error'} = "Can't get file." unless defined($retval);
return $retval;
}
#===========
sub Rename {
#===========
my($self, $oldname, $newname) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP") {
$self->{'Error'} = "Rename() only on FTP sessions.";
return undef;
}
my $retval = FtpRenameFile($self->{'handle'}, $oldname, $newname);
$self->{'Error'} = "Can't rename file." unless defined($retval);
return $retval;
}
#======================
sub Ren { Rename(@_); }
#======================
#===========
sub Delete {
#===========
my($self, $filename) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP") {
$self->{'Error'} = "Delete() only on FTP sessions.";
return undef;
}
my $retval = FtpDeleteFile($self->{'handle'}, $filename);
$self->{'Error'} = "Can't delete file." unless defined($retval);
return $retval;
}
#======================
sub Del { Delete(@_); }
#======================
#========
sub Put {
#========
my($self, $local, $remote, $context) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "FTP") {
$self->{'Error'} = "Put() only on FTP sessions.";
return undef;
}
my $mode = ($self->{'Mode'} eq "asc" ? 1 : 2);
$context = 0 unless defined($context);
my $retval = FtpPutFile($self->{'handle'}, $local, $remote, $mode, $context);
$self->{'Error'} = "Can't put file." unless defined($retval);
return $retval;
}
#######################################################################
# HTTP CLASS METHODS
#
#========= ### HTTP CONSTRUCTOR
sub HTTP {
#=========
my($self, $new, $server, $username, $password, $port, $flags, $context) = @_;
return undef unless ref($self);
if(ref($server) and ref($server) eq "HASH") {
my $myserver = $server->{'server'};
$username = $server->{'username'};
$password = $password->{'host'};
$port = $server->{'port'};
$flags = $server->{'flags'};
$context = $server->{'context'};
undef $server;
$server = $myserver;
}
$server = "" unless defined($server);
$username = "anonymous" unless defined($username);
$password = "" unless defined($username);
$port = 80 unless defined($port);
$flags = 0 unless defined($flags);
$context = 0 unless defined($context);
my $newhandle = InternetConnect($self->{'handle'}, $server, $port,
$username, $password,
constant("INTERNET_SERVICE_HTTP", 0),
$flags, $context);
if($newhandle) {
$self->{'connections'}++;
$_[1] = _new($newhandle);
$_[1]->{'Type'} = "HTTP";
$_[1]->{'username'} = $username;
$_[1]->{'password'} = $password;
$_[1]->{'server'} = $server;
$_[1]->{'accept'} = "text/*\0image/gif\0image/jpeg";
return $newhandle;
} else {
return undef;
}
}
#================
sub OpenRequest {
#================
# alternatively to Request:
# it creates a new HTTP_Request object
# you can act upon it with AddHeader, SendRequest, ReadFile, QueryInfo, Close, ...
my($self, $new, $path, $method, $version, $referer, $accept, $flags, $context) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "HTTP") {
$self->{'Error'} = "OpenRequest() only on HTTP sessions.";
return undef;
}
if(ref($path) and ref($path) eq "HASH") {
$method = $path->{'method'};
$version = $path->{'version'};
$referer = $path->{'referer'};
$accept = $path->{'accept'};
$flags = $path->{'flags'};
$context = $path->{'context'};
my $mypath = $path->{'path'};
undef $path;
$path = $mypath;
}
$method = "GET" unless defined($method);
$path = "/" unless defined($path);
$version = "HTTP/1.0" unless defined($version);
$referer = "" unless defined($referer);
$accept = $self->{'accept'} unless defined($accept);
$flags = 0 unless defined($flags);
$context = 0 unless defined($context);
$path = "/".$path if substr($path,0,1) ne "/";
my $newhandle = HttpOpenRequest($self->{'handle'},
$method,
$path,
$version,
$referer,
$accept,
$flags,
$context);
if($newhandle) {
$_[1] = _new($newhandle);
$_[1]->{'Type'} = "HTTP_Request";
$_[1]->{'method'} = $method;
$_[1]->{'request'} = $path;
$_[1]->{'accept'} = $accept;
return $newhandle;
} else {
return undef;
}
}
#================
sub SendRequest {
#================
my($self, $postdata) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "HTTP_Request") {
$self->{'Error'} = "SendRequest() only on HTTP requests.";
return undef;
}
$postdata = "" unless defined($postdata);
return HttpSendRequest($self->{'handle'}, "", $postdata);
}
#==============
sub AddHeader {
#==============
my($self, $header, $flags) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "HTTP_Request") {
$self->{'Error'} = "AddHeader() only on HTTP requests.";
return undef;
}
$flags = constant("HTTP_ADDREQ_FLAG_ADD", 0) if (!defined($flags) or $flags == 0);
return HttpAddRequestHeaders($self->{'handle'}, $header, $flags);
}
#==============
sub QueryInfo {
#==============
my($self, $header, $flags) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "HTTP_Request") {
$self->{'Error'}="QueryInfo() only on HTTP requests.";
return undef;
}
$flags = constant("HTTP_QUERY_CUSTOM", 0) if (!defined($flags) and defined($header));
my @queryresult = HttpQueryInfo($self->{'handle'}, $flags, $header);
return (wantarray)? @queryresult : join(" ", @queryresult);
}
#============
sub Request {
#============
# HttpOpenRequest+HttpAddHeaders+HttpSendRequest+InternetReadFile+HttpQueryInfo
my($self, $path, $method, $version, $referer, $accept, $flags, $postdata) = @_;
return undef unless ref($self);
if($self->{'Type'} ne "HTTP") {
$self->{'Error'} = "Request() only on HTTP sessions.";
return undef;
}
if(ref($path) and ref($path) eq "HASH") {
$method = $path->{'method'};
$version = $path->{'version'};
$referer = $path->{'referer'};
$accept = $path->{'accept'};
$flags = $path->{'flags'};
$postdata = $path->{'postdata'};
my $mypath = $path->{'path'};
undef $path;
$path = $mypath;
}
my $content = "";
my $result = "";
my @queryresult = ();
my $statuscode = "";
my $headers = "";
$path = "/" unless defined($path);
$method = "GET" unless defined($method);
$version = "HTTP/1.0" unless defined($version);
$referer = "" unless defined($referer);
$accept = $self->{'accept'} unless defined($accept);
$flags = 0 unless defined($flags);
$postdata = "" unless defined($postdata);
$path = "/".$path if substr($path,0,1) ne "/";
my $newhandle = HttpOpenRequest($self->{'handle'},
$method,
$path,
$version,
$referer,
$accept,
0,
$flags);
if($newhandle) {
$result = HttpSendRequest($newhandle, "", $postdata);
if(defined($result)) {
$statuscode = HttpQueryInfo($newhandle,
constant("HTTP_QUERY_STATUS_CODE", 0), "");
$headers = HttpQueryInfo($newhandle,
constant("HTTP_QUERY_RAW_HEADERS_CRLF", 0), "");
$content = ReadEntireFile($newhandle);
InternetCloseHandle($newhandle);
return($statuscode, $headers, $content);
} else {
return undef;
}
} else {
return undef;
}
}
#######################################################################
# END OF THE PUBLIC METHODS
#
#========= ### SUB-CLASSES CONSTRUCTOR
sub _new {
#=========
my $self = {};
if ($_[0]) {
$self->{'handle'} = $_[0];
bless $self;
} else {
undef($self);
}
$self;
}
#============ ### CLASS DESTRUCTOR
sub DESTROY {
#============
my($self) = @_;
# print "Closing handle $self->{'handle'}...\n";
InternetCloseHandle($self->{'handle'});
# [dada] rest in peace
}
#=============
sub callback {
#=============
my($name, $status, $info) = @_;
$callback_code{$name} = $status;
$callback_info{$name} = $info;
}
#######################################################################
# dynamically load in the Internet.pll module.
#
bootstrap Win32::Internet;
# Preloaded methods go here.
#Currently Autoloading is not implemented in Perl for win32
# Autoload methods go after __END__, and are processed by the autosplit program.
1;
__END__
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -