Tips und Tricks zu Perl

Perl unter Win32

Wie findet man unter Win32 alle vorhandenen Laufwerke heraus?

Dazu kann man z.B. das Modul Win32API::File verwenden. Kurzes Beispiel:

my @drives = &GetAvailableDrives();

sub GetAvailableDrives {
    use Win32API::File; # load Module

    my @drives = Win32API::File::getLogicalDrives(); 

    wantarray ? return @drives : return \@drives;
} # GetAvailableDrives

Diese Funktion schreibt alle logischen Laufwerke in eine Liste und gibt, je nachdem, ob beim Funktionsaufruf eine Liste oder ein Skalar, eine Liste oder eine Listenreferenz zurück (=> wantarray).

Wie finde ich unter Win32 heraus, von welchem Typ ein Laufwerk ist?

# lade Modul Win32API::File mit den benoetigten Konstanten
use Win32API::File qw(DRIVE_CDROM DRIVE_FIXED DRIVE_REMOTE 
                      DRIVE_RAMDISK DRIVE_REMOVABLE 
                      DRIVE_NO_ROOT_DIR DRIVE_UNKNOWN
  );
  
my $drives = &GetAvailableDrives();
foreach my $drive(@$drives){
  my $driveType = &GetDriveType( $drive );
  print "$drive $driveType\n";
}
# ------------------------------------------------------------
# gibt Liste von allen gefundenen Laufwerken zurück
sub GetAvailableDrives { 
  my @roots = &Win32API::File::getLogicalDrives();
  return (\@roots);
} # GetAvailableDrives
# ------------------------------------------------------------
# gibt fuer einen Laufwerksbuchstaben den Laufwerkstyp zurück
sub GetDriveType { 
  my ($drive) = @_;
  my $driveType = &Win32API::File::GetDriveType( $drive );
  
  return "DRIVE_FIXED" if $driveType == DRIVE_FIXED;
  return "DRIVE_CDROM" if $driveType == DRIVE_CDROM;
  return "DRIVE_REMOTE" if $driveType == DRIVE_REMOTE;
  return "DRIVE_REMOVABLE" if $driveType == DRIVE_REMOVABLE;
  return "DRIVE_RAMDISK" if $driveType ==DRIVE_RAMDISK ;
  return "DRIVE_NO_ROOT_DIR" if $driveType == DRIVE_NO_ROOT_DIR;
  return "DRIVE_UNKNOWN" if $driveType == DRIVE_UNKNOWN;
} # GetDriveType
# ------------------------------------------------------------

Wie kann ich unter Windows XP automatisch das Hintergrundbild ändern?

Ich habe meiner Lebenspartnerin mal vor Ewigkeiten ein kleines Script geschrieben, das bei jedem Windows-Reboot ein neues Hintergrundbild setzt. Unter älteren Windows-Versionen war das einfach: man mußte nur ein Bild als Hintergrundbild setzen, und dies dann bei jedem Start durch das neue überschreiben.

#! /usr/bin/perl -w
use strict;
use File::DosGlob('glob');
use File::Copy;

my ($pattern) = shift || 'd:\backgr\*.bmp';
my ($pic) = shift || 'C:\win98\back.bmp';

my (@files) = glob($pattern);
copy($files[int(rand $#files)], $pic) or die ("ERROR: $!\n");

Dies funktioniert leider unter WindowsXP nicht mehr; deshalb habe ich für sie auf die Schnelle mal den folgenden Code geschrieben:

#! /usr/bin/perl
use warnings;
use strict;
use FindBin ();
use File::Spec;
use Win32::API;

use constant SPI_SETDESKWALLPAPER  => 20;
use constant SPIF_UPDATEANDSENDINI => 3;
use constant NULL                  => 0;

# Bilddateien liegen in ../
(my $path = $FindBin::Bin) =~ s~/bin$~~;

# Liste der Bilddateien holen
opendir( my $DIR, $path )
  or die "Error: can't opendir '$path': $!\n";
my @files = grep { -f $_ }
  map { File::Spec->catfile( $path, $_ ) }
  grep { /.gif$/i or /.jpe?g$/i or /.bmp$/i }
  readdir($DIR);
closedir($DIR);

# ein zufaelliges Bild aus @images auswaehlen
my $maxImageId = $#files;
my $randomId   = int rand $maxImageId + 1;
my $image      = $files[$randomId];
print "Max: $maxImageId => using $randomId: $image\n";

# $image als Hintergrundbild setzen
my $syspinf = Win32::API->new('user32','SystemParametersInfo',
  [ qw(I I P I) ], 'I')
  or die "Could not import function.\n";
$syspinf->Call(SPI_SETDESKWALLPAPER, 0, $image, SPIF_UPDATEANDSENDINI);

Wenn man im Windows-Autostart eine Verknüpfung auf dieses Script erstellt, ändert sich bei jedem Windows-Start das Hintergrundbild.

Letztes Update dieser Seite: Sunday, 06-Aug-2006 13:29:31 CEST