home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _e50da39663f5c1593786cff4d710189f < prev    next >
Text File  |  2000-03-15  |  9KB  |  353 lines
  1. package Win32::Shortcut;
  2. #######################################################################
  3. #
  4. # Win32::Shortcut - Perl Module for Shell Link Interface
  5. # ^^^^^^^^^^^^^^^
  6. # This module creates an object oriented interface to the Win32
  7. # Shell Links (IShellLink interface).
  8. #
  9. # Version: 0.03 (07 Apr 1997)
  10. #
  11. #######################################################################
  12.  
  13. require Exporter;       # to export the constants to the main:: space
  14. require DynaLoader;     # to dynuhlode the module.
  15.  
  16. @ISA= qw( Exporter DynaLoader );
  17. @EXPORT = qw(
  18.     SW_SHOWMAXIMIZED
  19.     SW_SHOWMINNOACTIVE
  20.     SW_SHOWNORMAL
  21. );
  22.  
  23.  
  24. #######################################################################
  25. # This AUTOLOAD is used to 'autoload' constants from the constant()
  26. # XS function.  If a constant is not found then control is passed
  27. # to the AUTOLOAD in AutoLoader.
  28. #
  29.  
  30. sub AUTOLOAD {
  31.     my($constname);
  32.     ($constname = $AUTOLOAD) =~ s/.*:://;
  33.     #reset $! to zero to reset any current errors.
  34.     $!=0;
  35.     my $val = constant($constname, @_ ? $_[0] : 0);
  36.     if ($! != 0) {
  37.  
  38.     # [dada] This results in an ugly Autoloader error
  39.  
  40.     #if ($! =~ /Invalid/) {
  41.     #    $AutoLoader::AUTOLOAD = $AUTOLOAD;
  42.     #    goto &AutoLoader::AUTOLOAD;
  43.     #} else {
  44.     
  45.     # [dada] ... I prefer this one :)
  46.  
  47.         ($pack, $file, $line) = caller;
  48.         undef $pack; # [dada] and get rid of "used only once" warning...
  49.         die "Win32::Shortcut::$constname is not defined, used at $file line $line.";
  50.  
  51.     #}
  52.     }
  53.     eval "sub $AUTOLOAD { $val }";
  54.     goto &$AUTOLOAD;
  55. }
  56.  
  57.  
  58. #######################################################################
  59. # STATIC OBJECT PROPERTIES
  60. #
  61. $VERSION = "0.03";
  62.  
  63. #######################################################################
  64. # PUBLIC METHODS
  65. #
  66.  
  67. #======== ### CLASS CONSTRUCTOR
  68. sub new {
  69. #========
  70.     my($class, $file) = @_;
  71.     my $self = {}; 
  72.     my $ilink = 0; 
  73.     my $ifile = 0;
  74.  
  75.     ($ilink, $ifile) = _Instance();
  76.  
  77.     if($ilink and $ifile) {
  78.         $self->{'ilink'} = $ilink;
  79.         $self->{'ifile'} = $ifile;
  80.         bless $self;
  81.         # Initialize properties
  82.         $self->{'File'}             = "";
  83.         $self->{'Path'}             = "";
  84.         $self->{'Arguments'}        = "";
  85.         $self->{'WorkingDirectory'} = "";
  86.         $self->{'Description'}      = "";
  87.         $self->{'ShowCmd'}          = 0;
  88.         $self->{'Hotkey'}           = 0;
  89.         $self->{'IconLocation'}     = "";
  90.         $self->{'IconNumber'}       = 0;
  91.  
  92.         $self->Load($file) if $file;
  93.         
  94.     } else {
  95.         return undef;
  96.     }
  97.     $self;
  98. }  
  99.  
  100. #=========
  101. sub Load {
  102. #=========
  103.     my($self, $file) = @_;
  104.     return undef unless ref($self);
  105.   
  106.     my $result = _Load($self->{'ilink'}, $self->{'ifile'}, $file);
  107.  
  108.     if(defined($result)) {
  109.   
  110.         # fill the properties of $self
  111.         $self->{'File'} = $file;
  112.         $self->{'Path'} = _GetPath($self->{'ilink'}, $self->{'ifile'},0);
  113.         $self->{'ShortPath'} = _GetPath($self->{'ilink'}, $self->{'ifile'},1);
  114.         $self->{'Arguments'} = _GetArguments($self->{'ilink'}, $self->{'ifile'});
  115.         $self->{'WorkingDirectory'} = _GetWorkingDirectory($self->{'ilink'}, $self->{'ifile'});
  116.         $self->{'Description'} = _GetDescription($self->{'ilink'}, $self->{'ifile'});
  117.         $self->{'ShowCmd'} = _GetShowCmd($self->{'ilink'}, $self->{'ifile'});
  118.         $self->{'Hotkey'} = _GetHotkey($self->{'ilink'}, $self->{'ifile'});
  119.         ($self->{'IconLocation'},
  120.          $self->{'IconNumber'}) = _GetIconLocation($self->{'ilink'}, $self->{'ifile'});
  121.     }
  122.     return $result;
  123. }
  124.  
  125.  
  126. #========
  127. sub Set {
  128. #========
  129.     my($self, $path, $arguments, $dir, $description, $show, $hotkey, 
  130.        $iconlocation, $iconnumber) = @_;
  131.     return undef unless ref($self);
  132.  
  133.     $self->{'Path'}             = $path;
  134.     $self->{'Arguments'}        = $arguments;
  135.     $self->{'WorkingDirectory'} = $dir;
  136.     $self->{'Description'}      = $description;
  137.     $self->{'ShowCmd'}          = $show;
  138.     $self->{'Hotkey'}           = $hotkey;
  139.     $self->{'IconLocation'}     = $iconlocation;
  140.     $self->{'IconNumber'}       = $iconnumber;
  141.     return 1;
  142. }
  143.  
  144.  
  145. #=========
  146. sub Save {
  147. #=========
  148.     my($self, $file) = @_;
  149.     return undef unless ref($self);
  150.  
  151.     return undef if not $file and not $self->{'File'};
  152.     $file = $self->{'File'} if not $file;
  153.  
  154.     _SetPath($self->{'ilink'}, $self->{'ifile'}, $self->{'Path'});
  155.     _SetArguments($self->{'ilink'}, $self->{'ifile'}, $self->{'Arguments'});
  156.     _SetWorkingDirectory($self->{'ilink'}, $self->{'ifile'}, $self->{'WorkingDirectory'});
  157.     _SetDescription($self->{'ilink'}, $self->{'ifile'}, $self->{'Description'});
  158.     _SetShowCmd($self->{'ilink'}, $self->{'ifile'}, $self->{'ShowCmd'});
  159.     _SetHotkey($self->{'ilink'}, $self->{'ifile'}, $self->{'Hotkey'});
  160.     _SetIconLocation($self->{'ilink'}, $self->{'ifile'},
  161.                      $self->{'IconLocation'}, $self->{'IconNumber'});
  162.  
  163.     my $result = _Save($self->{'ilink'}, $self->{'ifile'}, $file);
  164.     return $result;
  165. }
  166.  
  167. #============
  168. sub Resolve {
  169. #============
  170.     my($self, $flags) = @_;
  171.     return undef unless ref($self);
  172.     $flags = 1 unless defined($flags);
  173.     my $result = _Resolve($self->{'ilink'}, $self->{'ifile'}, $flags);
  174.     return $result;
  175. }
  176.  
  177.  
  178. #==========
  179. sub Close {
  180. #==========
  181.     my($self) = @_;
  182.     return undef unless ref($self);
  183.  
  184.     my $result = _Release($self->{'ilink'}, $self->{'ifile'});
  185.     $self->{'released'} = 1;
  186.     return $result;
  187. }
  188.  
  189. #=========
  190. sub Path {
  191. #=========
  192.     my($self, $value) = @_;
  193.     return undef unless ref($self);
  194.  
  195.     if(not defined($value)) {
  196.         return $self->{'Path'};
  197.     } else {
  198.         $self->{'Path'} = $value;
  199.     }
  200.     return $self->{'Path'};
  201. }
  202.  
  203. #==============
  204. sub ShortPath {
  205. #==============
  206.     my($self) = @_;
  207.     return undef unless ref($self);
  208.     return $self->{'ShortPath'};
  209. }
  210.  
  211. #==============
  212. sub Arguments {
  213. #==============
  214.     my($self, $value) = @_;
  215.     return undef unless ref($self);
  216.  
  217.     if(not defined($value)) {
  218.         return $self->{'Arguments'};
  219.     } else {
  220.         $self->{'Arguments'} = $value;
  221.     }
  222.     return $self->{'Arguments'};
  223. }
  224.  
  225. #=====================
  226. sub WorkingDirectory {
  227. #=====================
  228.     my($self, $value) = @_;
  229.     return undef unless ref($self);
  230.  
  231.     if(not defined($value)) {
  232.         return $self->{'WorkingDirectory'};
  233.     } else {
  234.         $self->{'WorkingDirectory'} = $value;
  235.     }
  236.     return $self->{'WorkingDirectory'};
  237. }
  238.  
  239.  
  240. #================
  241. sub Description {
  242. #================
  243.     my($self, $value) = @_;
  244.     return undef unless ref($self);
  245.  
  246.     if(not defined($value)) {
  247.         return $self->{'Description'};
  248.     } else {
  249.         $self->{'Description'} = $value;
  250.     }
  251.     return $self->{'Description'};
  252. }
  253.  
  254. #============
  255. sub ShowCmd {
  256. #============
  257.     my($self, $value) = @_;
  258.     return undef unless ref($self);
  259.  
  260.     if(not defined($value)) {
  261.         return $self->{'ShowCmd'};
  262.     } else {
  263.         $self->{'ShowCmd'} = $value;
  264.     }
  265.     return $self->{'ShowCmd'};
  266. }
  267.  
  268. #===========
  269. sub Hotkey {
  270. #===========
  271.     my($self, $value) = @_;
  272.     return undef unless ref($self);
  273.  
  274.     if(not defined($value)) {
  275.         return $self->{'Hotkey'};
  276.     } else {
  277.         $self->{'Hotkey'} = $value;
  278.     }
  279.     return $self->{'Hotkey'};
  280. }
  281.  
  282. #=================
  283. sub IconLocation {
  284. #=================
  285.     my($self, $value) = @_;
  286.     return undef unless ref($self);
  287.  
  288.     if(not defined($value)) {
  289.         return $self->{'IconLocation'};
  290.     } else {
  291.         $self->{'IconLocation'} = $value;
  292.     }
  293.     return $self->{'IconLocation'};
  294. }
  295.  
  296. #===============
  297. sub IconNumber {
  298. #===============
  299.     my($self, $value) = @_;
  300.     return undef unless ref($self);
  301.  
  302.     if(not defined($value)) {
  303.         return $self->{'IconNumber'};
  304.     } else {
  305.         $self->{'IconNumber'} = $value;
  306.     }
  307.     return $self->{'IconNumber'};
  308. }
  309.  
  310. #============
  311. sub Version {
  312. #============
  313.     # [dada] to get rid of the "used only once" warning...
  314.     return $VERSION;
  315. }
  316.  
  317.  
  318. #######################################################################
  319. # PRIVATE METHODS
  320. #
  321.  
  322. #============ ### CLASS DESTRUCTOR
  323. sub DESTROY {
  324. #============
  325.     my($self) = @_;
  326.  
  327.     if(not $self->{'released'}) {
  328.         _Release($self->{'ilink'}, $self->{'ifile'});
  329.     }
  330. }
  331.  
  332. #======== ### PACKAGE DESTRUCTOR
  333. sub END { 
  334. #========
  335.     # print "Exiting...\n";
  336.     _Exit(); 
  337. }
  338.  
  339. #######################################################################
  340. # dynamically load in the Shortcut.pll module.
  341. #
  342.  
  343. bootstrap Win32::Shortcut;
  344.  
  345. # Preloaded methods go here.
  346.  
  347. #Currently Autoloading is not implemented in Perl for win32
  348. # Autoload methods go after __END__, and are processed by the autosplit program.
  349.  
  350. 1;
  351. __END__
  352.  
  353.