Thanks all for the feedback.
I've fixed my implementation with a little bit of help with Jan Dubois (he
indirectly tipped me off to use a null character at the end of the string,
which worked). I've improved my module a bit with some things from Bill
Luebkert's implementation.
Also, as Jan pointed out to me, it might be smart to have the module also
work on Perl filehandle level. Therefor I've also added a perlify()
subroutine which seems to work.
Thanks all!
----- Original Message -----
From: "$Bill Luebkert" <[EMAIL PROTECTED]>
To: "Siebe Tolsma" <[EMAIL PROTECTED]>
Sent: Saturday, June 18, 2005 2:42 PM
Subject: Re: Win32::API and Unicode filenames
> Siebe Tolsma wrote:
>
> > Hello!
> >
> > Considering Perl cannot open files with Unicode filenames by default I
> > decided to create a Win32 module which imports functions like
> > CreateFileW from kernel32.dll and let it write/read files through that.
> > The OS I am writing this for will always be Windows, and in all cases >=
> > 2K (so 2K, XP, 2K3, etc). I have no interest in supporting older systems
> > like 9x and NT (yet?). I've already implemented a some of the functions
> > (fopen, fclose, fread, fwrite, fseek) and the basic thing works, but,
> > there is one "slight" problem/oddity.
> >
> > I have the following code:
>
> I'm on XP Pro with FAT32, so my version may not work for you, but it
> creates the file (with boxes for characters in explorer).
>
> use strict;
> use warnings;
> use Encode qw (encode decode);
> use Data::Dumper; $Data::Dumper::Indent=1; $Data::Dumper::Sortkeys=1;
>
> our ($CreateFile, $ReadFile, $WriteFile, $CloseHandle);
>
> import_APIs (); # currently using the wide version of CreateFile here
> import_constants ();
>
> # filename: e6 8a a5 e7 ba b8 2e 70 6c
> # filename: æ Š ¥ ç º ¸ . p l
>
> my $fname = pack 'H*', 'e68aa5e7bab82e706c';
> $fname = decode ('utf8', $fname);
> # $fname = encode ('UTF-16LE', $fname);
> $fname = encode ('UTF-16', $fname);
> # doesn't like UTF-16LE unless path parsing off for fopen
>
> # my $path_parsing = '\\\\?\\'; # turn off path parsing with this
> my $path_parsing = '';
>
> my $fh;
> if ($fh = fopen (\$fh, '>', $fname)) {
> print "open '$fname' worked\n";
> fwrite ($fh, "Line 1\nLine 2\nLine 3\n");
> fclose ($fh);
> }
> exit;
>
>
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
>
> sub fopen { # $ret = fopen ($fh, $mode, $filename);
> my $sref = shift; # Reference
> my $mode = shift; # < > >> +< +> +>>
> my $file = shift; # Filename
>
> my %file_perms = (
> '<' => &GENERIC_READ,
> '>' => &GENERIC_WRITE,
> '>>' => &GENERIC_WRITE,
> '+<' => &GENERIC_READ | &GENERIC_WRITE,
> '+>' => &GENERIC_READ | &GENERIC_WRITE,
> '+>>' => &GENERIC_READ | &GENERIC_WRITE,
> );
> my $fmode = $file_perms{$mode} || 0;
>
> my %file_cr_dist = (
> '<' => &OPEN_EXISTING,
> '>' => &CREATE_ALWAYS,
> '>>' => &OPEN_ALWAYS,
> '+<' => &OPEN_EXISTING,
> '+>' => &TRUNCATE_EXISTING,
> '+>>' => &OPEN_ALWAYS,
> );
> my $fcd = $file_cr_dist{$mode};
>
> die "Illegal mode '$mode'\n" if $fmode <= 0;
>
> my $lpFileName = pack 'a*', $path_parsing . $file;
> my $dwDesiredAccess = $fmode;
> my $dwShareMode = 0;
> my $lpSecurityAttributes = 0;
> my $dwCreationDisposition = $fcd;
> my $dwFlagsAndAttributes = &FILE_ATTRIBUTE_NORMAL;
> my $hTemplateFile = 0;
>
> my $fh = $CreateFile->Call($lpFileName, $dwDesiredAccess, $dwShareMode,
> $lpSecurityAttributes, $dwCreationDisposition, $dwFlagsAndAttributes,
> $hTemplateFile);
>
> print Data::Dumper->Dump([$fh, $lpFileName, $dwDesiredAccess,
> $dwCreationDisposition, $dwFlagsAndAttributes], [qw($fh $lpFileName
> $dwDesiredAccess $dwCreationDisposition $dwFlagsAndAttributes)]) if
> $debug;
>
> if ($fh != &INVALID_HANDLE_VALUE) {
> return $fh;
> } else {
> die "CreateFile '$file': $! ($^E)";
> }
>
> }
>
>
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
>
> sub fread {
> my $fh = shift;
> my $str = shift;
>
> my $lpBuffer = pack 'a*', "\000" x 32768;
> my $nNumberOfBytesToRead = 32768;
> my $lpNumberOfBytesRead = pack 'L', 0;
> my $lpOverlapped = 0;
>
> print Data::Dumper->Dump([$fh, $nNumberOfBytesToRead,
> $lpOverlapped], [qw($fh $nNumberOfBytesToRead $lpOverlapped)]) if
> $debug;
>
> my $bytes;
> my $ret = $ReadFile->Call($fh, $lpBuffer, $nNumberOfBytesToRead,
> $lpNumberOfBytesRead, $lpOverlapped);
> if ($ret) {
> $bytes = unpack 'L', $lpNumberOfBytesRead;
> print Data::Dumper->Dump([$ret, $bytes], [qw($ret $bytes)]) if $debug;
> $$str = unpack 'a*', $lpBuffer;
> return $bytes;
> } else {
> warn "Error reading file: $! ($^E)";
> return 0;
> }
>
> }
>
>
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
>
> sub fwrite {
> my $fh = shift;
> my $str = shift;
>
> my $lpBuffer = pack 'a*', $str;
> my $nNumberOfBytesToWrite = length $str;
> my $lpNumberOfBytesWritten = pack 'L', 0;
> my $lpOverlapped = 0;
>
> print Data::Dumper->Dump([$fh, $lpBuffer, $nNumberOfBytesToWrite,
> $lpOverlapped], [qw($fh $lpBuffer $nNumberOfBytesToWrite
$lpOverlapped)]) if
> $debug;
>
> my $bytes;
> my $ret = $WriteFile->Call($fh, $lpBuffer, $nNumberOfBytesToWrite,
> $lpNumberOfBytesWritten, $lpOverlapped);
> $bytes = unpack 'L', $lpNumberOfBytesWritten;
> print Data::Dumper->Dump([$ret, $bytes], [qw($ret $bytes)]) if $debug;
> if ($ret) {
> return $bytes;
> } else {
> warn "Error writing file: $! ($^E)";
> return 0;
> }
>
> }
>
>
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
>
> sub fclose { # $ret = fclose ($fh);
> my $fh = shift;
>
> my $ret = $CloseHandle->Call($fh);
> print "CloseHandle '$fh'; ret=$ret\n" if $debug;
> return $ret;
>
> }
>
>
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
>
> sub import_APIs {
>
> # CreateFile defaults to CreateFileA (setting to CreateFileW)
> $CreateFile = new Win32::API('kernel32', 'CreateFileW', 'PIIPIIN', 'N') or
> die "import CreateFile: $! ($^E)";
> $ReadFile = new Win32::API('kernel32', 'ReadFile', 'IPIPP', 'N') or
> die "import ReadFile: $! ($^E)";
> $WriteFile = new Win32::API('kernel32', 'WriteFile', 'IPIPP', 'N') or
> die "import WriteFile: $! ($^E)";
> $CloseHandle = new Win32::API("kernel32", "CloseHandle", 'I', 'I') or
> die "import CloseHandle: $! ($^E)";
>
> }
>
>
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
>
> sub import_constants {
>
> use constant GENERIC_READ => 0x80000000;
> use constant GENERIC_WRITE => 0x40000000;
>
> use constant CREATE_NEW => 1;
> use constant CREATE_ALWAYS => 2;
> use constant OPEN_EXISTING => 3;
> use constant OPEN_ALWAYS => 4;
> use constant TRUNCATE_EXISTING => 5;
>
> use constant INVALID_HANDLE_VALUE => (-1);
> use constant FILE_ATTRIBUTE_NORMAL => 0x00000080;
>
> }
>
>
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
>
> __END__
>
> --
> ,-/- __ _ _ $Bill Luebkert Mailto:[EMAIL PROTECTED]
> (_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED]
> / ) /--< o // // Castle of Medieval Myth & Magic
http://www.todbe.com/
> -/-' /___/_<_</_</_ http://dbecoll.tripod.com/ (My Perl/Lakers stuff)
>
_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
