home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _5f70e6426cf8178e4f22da9cdc7fbc84 < prev    next >
Encoding:
Text File  |  2000-03-16  |  1.2 KB  |  41 lines
  1. use Win32::OLE;
  2.  
  3. my $error = AddFileExtMapping(@ARGV);
  4. print Win32::OLE->LastError if Win32::OLE->LastError;
  5. print "Press [ ENTER ] to continue:"; <STDIN>;
  6. exit($error);
  7.  
  8. sub AddFileExtMapping {
  9.     
  10.     my $serverID        = shift;
  11.     my $virtDir            = shift;
  12.     my $fileExt            = shift;
  13.     my $execPath        = shift;
  14.     my $methodExclude        = shift;
  15.     my $flags            = shift;
  16.  
  17.     my $node = "IIS://localhost/W3SVC/$serverID/ROOT";
  18.     $node .= "/$virtDir" if length($virtDir) > 0;
  19.  
  20.     # Get the IIsVirtualDir Automation Object
  21.     my $server = Win32::OLE->GetObject($node);
  22.     
  23.     # create our new script mapping entry
  24.     my $scriptMapping = "$fileExt,$execPath";
  25.     $scriptMapping .= ",$methodExclude" if length($methodExclude > 2);
  26.     $scriptMapping .= ",$flags";
  27.     
  28.     my @ScriptMaps = @{$server->{ScriptMaps}};
  29.     my @NewScriptMaps = map { 
  30.     /^\Q$fileExt,\E.*/ ? $scriptMapping : $_ } @ScriptMaps;
  31.     push(@NewScriptMaps, $scriptMapping) 
  32.     unless grep {/^\Q$fileExt,\E.*/} @NewScriptMaps;
  33.     print join("\n", @NewScriptMaps);
  34.     
  35.     $server->{ScriptMaps} = \@NewScriptMaps;
  36.  
  37.     # Save the new script mappings
  38.     $server->SetInfo(); 
  39. }
  40.  
  41.