1. HRESULT SHSetKnownFolderPath(
2.   __in  REFKNOWNFOLDERID rfid,
3.   __in  DWORD dwFlags,
4.   __in  HANDLE hToken,
5.   __in  PCWSTR pszPath
6. );

1. void SHChangeNotify(
2.             LONG wEventId,
3.             UINT uFlags,
4.   __in_opt  LPCVOID dwItem1,
5.   __in_opt  LPCVOID dwItem2
6. );

1. HRESULT CLSIDFromString(
2.   LPOLESTR lpsz,
3.   LPCLSID pclsid
4. );

1. use strict;
2. use Win32;
3. use Win32::API;
4. $Win32::API::DEBUG = 1;
6. # intialisation du pointeur
7. my $pclsid = pack ('lssC8', "x\00" );
8. # initialisation de la fonction
9. my $CLSIDFromString = new Win32::API("Ole32", 'CLSIDFromString', 'NP', 'N') || die;
10. # appel de la fonction
11. $CLSIDFromString->Call('{4BD8D571-6D19-48D3-BE97-422220080E43}', $pclsid );

#!/usr/local/bin/perl
use strict;
use warnings;
 
use Win32;
use Win32::API;
$Win32::API::DEBUG = 1;
 
 
my $MultiByteToWideChar = new Win32::API("KERNEL32", "MultiByteToWideChar", "INPIPI", "I" ) or die "Can't Import OLE32 or find MultiByteToWideChar";
my $CLSIDFromProgID = new Win32::API("OLE32", "CLSIDFromProgID", "PP", "N" ) or die "Can't Import OLE32 or find CLSIDFromProgID";
my $StringFromCLSID = new Win32::API("OLE32", "StringFromCLSID", "PP", "N" ) or die "Can't Import OLE32 or find StringFromCLSID";
my $CLSIDFromString = new Win32::API("OLE32", "CLSIDFromString", "PP", "N" ) || die "Can't find CLSIDFromString: $!\n";
 
 
# On va tester avec ce cas trouve dans la base de registres
#WMP.DeskBand.1 <= ProgID
#HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{0A4286EA-E355-44FB-8086-AF3DF7645BD9} <= Windows Media Player
 
my $progid = "WMP.DeskBand.1";
my $oleprogid = COlestr($progid); # translate it to wide chars
my $classid = "\0" x 16; # 16 bytes data
 
my $result = $CLSIDFromProgID->Call($oleprogid, $classid );
if ($result) {
    printf "Error: 0x%x\n", $result;
}
else {
    # vérifions que l'appel a marche
    my ($data1, $data2, $data3, $data4, $data5, $data6, $data7, $data8, $data9, $data10, $data11) = unpack 'LSSC8', $classid; 
    printf "{%x-%x-%x-%x%x-%x%x%x%x%x%x}\n", $data1, $data2, $data3, $data4, $data5, $data6, $data7, $data8, $data9, $data10, $data11;
    # on devrait avoir {0A4286EA-E355-44FB-8086-AF3DF7645BD9}
}
 
my $PPV = pack 'P', 0; # au retour, contiendra la OLESTR allouee
my $ppv = pack 'P', $PPV; # C'est tordu, fallait le trouver, pour le parametre LPOLESTR *
$result = $StringFromCLSID->Call($classid, $ppv);
if ($result) {
    printf "Error: 0x%x\n", $result;
}
else {
    $PPV = unpack 'P[76]', $ppv;
    print $PPV, "\n";
    # on devrait avoir {0A4286EA-E355-44FB-8086-AF3DF7645BD9} chaque lettre occupant 2 cases
}
# note: $PPV doit etre desalloué par un appel a OLE si on est un bon petit programmeur
# respectueux de la mémoire qui ne lui appartient pas...
 
my $newstring = $PPV . "\0"; # le retour etait un OLESTR, pas un COLESTR et c'etait un piege
$classid = "\0" x 16; # 16 bytes data
$result = $CLSIDFromString->Call($newstring, $classid);
 
if ($result) {
    printf "Error: 0x%x\n", $result;
}
else {
    my ($data1, $data2, $data3, $data4, $data5, $data6, $data7, $data8, $data9, $data10, $data11) = unpack 'LSSC8', $classid; 
    printf "{%x-%x-%x-%x%x-%x%x%x%x%x%x}\n", $data1, $data2, $data3, $data4, $data5, $data6, $data7, $data8, $data9, $data10, $data11;
    # on devrait avoir {0A4286EA-E355-44FB-8086-AF3DF7645BD9}
}
 
#test avec une string en ascii
$newstring = '{0A4286EA-E355-44FB-8086-AF3DF7645BD9}';
$oleprogid = COlestr($newstring);
$classid = "\0" x 16; # 16 bytes data
$result = $CLSIDFromString->Call($oleprogid, $classid);
 
if ($result) {
    printf "Error: 0x%x\n", $result;
}
else {
    my ($data1, $data2, $data3, $data4, $data5, $data6, $data7, $data8, $data9, $data10, $data11) = unpack 'LSSC8', $classid; 
    printf "{%x-%x-%x-%x%x-%x%x%x%x%x%x}\n", $data1, $data2, $data3, $data4, $data5, $data6, $data7, $data8, $data9, $data10, $data11;
    # on devrait avoir {0A4286EA-E355-44FB-8086-AF3DF7645BD9}
}
 
# la subroutine perl StringIDToClassID fait aussi bien
$newstring = '{0A4286EA-E355-44FB-8086-AF3DF7645BD9}';
my $refclsid = StringIDToClassID($newstring);
$PPV = pack 'P', 0;
$ppv = pack 'P', $PPV;
$result = $StringFromCLSID->Call($refclsid, $ppv);
 
if ($result) {
    printf "Error: 0x%x\n", $result;
}
else {
    $PPV = unpack 'P[76]', $ppv;
    print $PPV, "\n";
    # on devrait avoir {0A4286EA-E355-44FB-8086-AF3DF7645BD9} chaque lettre occupant 2 cases
}
 
 
# transforme une chaine en ansi en une en wide chars
sub Olestr {
    my $ansistr = shift;
    my $lg = length($ansistr);
    my $olestring =  "\0" x (2*$lg);
    $MultiByteToWideChar->Call(0, 0, $ansistr, $lg, $olestring, $lg);
    return $olestring;
}
 
# transforme une chaine en ansi en une en wide chars terminée par un \0
# ne pas l'avoir fait a ete la principale source de bugs qui faisait que
# les appels foiraient
sub COlestr {
    my $ansistr = shift;
    my $lg = length($ansistr);
    my $olestring =  "\0" x (2*$lg);
    $MultiByteToWideChar->Call(0, 0, $ansistr, $lg, $olestring, $lg);
    $olestring = $olestring . "\0";
    return $olestring;
}
 
# On peut aussi le faire en perl sans passer par des appels OLE
# La chaine en entree est en ansi, pas en wide chars
sub StringIDToClassID {
    my $strID = shift;
    $strID =~ s/^{|}$//g; 
    my @c = split /-/, $strID; 
    my $classID = pack 'LSSC8', 
                        hex $c[0], 
                        hex $c[1], 
                        hex $c[2],
                        hex (substr $c[3], 0, 2), hex (substr $c[3], 2, 2), 
                        hex (substr $c[4], 0, 2), hex (substr $c[4], 2, 2), 
                        hex (substr $c[4], 4, 2), hex (substr $c[4], 6, 2), 
                        hex (substr $c[4], 8, 2), hex (substr $c[4], 10, 2);
    return $classID;
}

1. $newstring = '{4BD8D571-6D19-48D3-BE97-422220080E43}';
2. $oleprogid = COlestr($newstring);
3. $classid = "\0" x 16; # 16 bytes data
4. $result = $CLSIDFromString->Call($oleprogid, $classid);
5. my $path = COlestr("c:\\temp" );
6. my $SHSetKnownFolderPath = new Win32::API("Shell32", 'SHSetKnownFolderPath', 'PNNP', 'N') || die;
7. $SHSetKnownFolderPath->Call($classid, 0, 0, $path);
8. my $SHChangeNotify = new Win32::API("Shell32", 'SHChangeNotify', 'NIPP', '') || die;
9. $SHChangeNotify->Call(0x8000000, 0x1000, "\x00", "\x00" );

#!/usr/local/bin/perl
use strict;
use warnings;
use Encode;
use String::Scanf;
 
use Win32;
use Win32::API;
$Win32::API::DEBUG = 1;
 
my $CLSIDFromProgID = new Win32::API("OLE32", "CLSIDFromProgID", "PP", "N" ) or die "Can't Import OLE32 or find CLSIDFromProgID";
my $ProgIDFromCLSID = new Win32::API("OLE32", "ProgIDFromCLSID", "PP", "N" ) or die "Can't Import OLE32 or find ProgIDFromCLSID";
 
# Deux subs en perl qui permettent de convertir d'une string Perl a une string unicode Windows
# et réciproquement.
# Transformer d'abord en chaine C terminée par un 0 une chaine perl qu'on va passer à du code Windows
# en ajoutant "\0" à la fin.    
sub AnsiToOlestr {
    my $input = substr(encode("utf16", $_[0]), 2); 
    return join '', map {pack( "c2", reverse( unpack( "c2", $_ )))} ($input =~ m/..?/g );
}
 
sub OlestrToAnsi {
    my $input = join '', map {pack( "c2", reverse( unpack( "c2", $_ )))} ($_[0] =~ m/..?/g );
    return decode("utf16", "\xfe\xff".$input);
}
 
# ces deux subs en perl remplacent les fonctions correspondantes de OLE32, mais se font sur une base de
# strings Perl et non de strings unicode Windows
sub CLSIDFromString {
    my @c = sscanf("{%s-%s-%s-%s-%s}", $_[0]);
    return pack 'LSSC8', 
                        hex $c[0], 
                        hex $c[1], 
                        hex $c[2],
                        hex (substr $c[3], 0, 2), hex (substr $c[3], 2, 2), 
                        hex (substr $c[4], 0, 2), hex (substr $c[4], 2, 2), 
                        hex (substr $c[4], 4, 2), hex (substr $c[4], 6, 2), 
                        hex (substr $c[4], 8, 2), hex (substr $c[4], 10, 2);
}
 
sub StringFromCLSID {
    my @a = (unpack 'LSSC8', $_[0]); 
    return sprintf("{%x-%x-%x-%x%x-%x%x%x%x%x%x}", @a);
}
 
# petit test
 
my $progid = "WMP.DeskBand.1"."\0"; # On en fait une chaine C
my $oleprogid = AnsiToOlestr($progid); # On transforme en Unicode à la windows
my $classid = "\0" x 16; # 16 bytes data 
 
my $result = $CLSIDFromProgID->Call($oleprogid, $classid );
if ($result) {
    printf "Error: 0x%x\n", $result;
}
else {
    print StringFromCLSID($classid), "\n";
    # on devrait avoir {0A4286EA-E355-44FB-8086-AF3DF7645BD9}
}
 
my $string = '{0A4286EA-E355-44FB-8086-AF3DF7645BD9}';
$classid = CLSIDFromString($string);
my $PPV = pack 'P', 0; 
my $ppv = pack 'P', $PPV; 
$result = $ProgIDFromCLSID->Call($classid, $ppv );
if ($result) {
    printf "Error: 0x%x\n", $result;
}
else {
    $PPV = unpack 'P[256]', $ppv;
    if ($PPV =~ m/\x00\x00\x00.*/) {
    $PPV =~ s/\x00\x00\x00.*/\x00/;
    }
    elsif ($PPV =~ m/\x00\x00.*/) {
    $PPV =~ s/\x00\x00.*//;
    }
    else {
    print "Warning: Truncating result string from ProgIDFromCLSID call\n"; 
    }
    print OlestrToAnsi($PPV), "\n";
    # on devrait avoir "WMP.DeskBand.1"
}
 
__END__
 
 
# Pas testé parce que je suis sous XP ou SHSetKnownFolderPath n'est pas implémenté:
# Je ferais ainsi pour le bout de code que tu as donné:
 
my $SHSetKnownFolderPath = new Win32::API("Shell32", 'SHSetKnownFolderPath', 'PNNP', 'N') || die;
my $SHChangeNotify = new Win32::API("Shell32", 'SHChangeNotify', 'NIPP', '') || die;
 
$classid = CLSIDFromString("{4BD8D571-6D19-48D3-BE97-422220080E43}" );
my $path = AnsiToOlestr("c:\\temp"."\0" );
$SHSetKnownFolderPath->Call($classid, 0, 0, $path);
$SHChangeNotify->Call(0x8000000, 0x1000, "\x00", "\x00" );