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