diff options
Diffstat (limited to 'win32/ext')
| -rw-r--r-- | win32/ext/Win32API/File/Changes | 99 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm | 361 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/File.pm | 3035 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/File.xs | 647 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/Makefile.PL | 127 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/README | 132 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/buffers.h | 423 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/cFile.h | 1 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/cFile.pc | 165 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/const2perl.h | 193 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/ppport.h | 283 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/t/file.t | 402 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/t/tie.t | 79 | ||||
| -rw-r--r-- | win32/ext/Win32API/File/typemap | 140 |
14 files changed, 6087 insertions, 0 deletions
diff --git a/win32/ext/Win32API/File/Changes b/win32/ext/Win32API/File/Changes new file mode 100644 index 0000000000..147b69471c --- /dev/null +++ b/win32/ext/Win32API/File/Changes @@ -0,0 +1,99 @@ +Revision history for Perl extension Win32API::File. + +0.10 2005-09-09 + - Added GetFileAttributes() function and corresponding constants. + (Patches from Kenneth Olwing from 2004-11-12). + - cygwin patches from Rafael Kitover and Reini Urban. + This includes the addition of the GetFileSize(), getFileSize() + setFilePointer() and GetOverlappedResult() methods and the + experimental new object oriented interface. All file position + operations use either Math::BigInt objects or 8 byte integers + (cygwin) for file offsets. + +0.0901 2005-08-30 + - increased version number to show difference to standalone + CPAN release of Win32API-File-0.09.zip + +0.09 2005-02-18 + - Support 5.007+ + +0.09 [libwin32 version only] + - Add AUTHOR and ABSTRACT_FROM to Makefile.PL. + - Trivial speed improvements. + - Fixed F<test.pl> if Z: is a valid drive letter. + +0.08 2000-04-07 + - C<GetOsFHandle> now returns false for failure. + - New F<buffers.h> supports C++ compilers. + - Read-only output-only parameters now generate an error. + - Added fileLastError() since C<$^E> is often quickly overwritten. + - Complete rewrite of how C constants are made available in Perl. + - Added fileConstant(), a nice way to look-up constants at run time. + - Added Get/SetHandleInformation and HANDLE_FLAG_* constants. + - Added IOCTL_DISK_GET_MEDIA_TYPES since *_STORAGE_* fails for floppy. + - Added several example scripts. + +0.07 1999-08-17 + - Added DeleteFile(). + - Removed prototypes from OsFHandleOpen() and GetOsFHandle() since + the C<*> doesn't prevent warnings about bareword file handles and + prevents the useful usage message if no arguments given. + - Fixed bug due to failed C<(/k/i,/t/i)> in list context returning + C<()> not C<(undef,undef)> in modern versions of Perl. + - Change order of C<#include>s so can build with Perl5.005 and later. + - Fixed C<test.pl> to ignore Perl bug where C<$^E> is truncated. + - Turned on C<CAPI> in C<Makefile.PL> for certain versions of Perl. + - Updated C<README>. + +0.06 1999-08-10 + - Switch to new buffers.h and "Hungarian" notation! + - Added full documentation! + - ReadFile() no longer tries to read more bytes than asked for + just because the scalar buffer can hold more bytes! + - createFile() does better DWIM for share mode. + - Return SV_NO rather than C<0> for Boolean false. + - For boolean args, non-empty strings are C<1>, don't convert to int. + - Added ":MEDIA_TYPE" export class. + - Added C<GENERIC_ALL> and C<GENERIC_EXECUTE> to ":GENERIC_" exports. + - Added C<FdGetOsFHandle()> and C<GetOsFHandle()>! + - Added C<OsFHandleOpenFd()> and C<OsFHandleOpen()>! + - Support calling C<constant()> without the useless integer argument. + - Auto-load/export constants with C<()> prototype so can be in-lined. + - Added C<IsRecognizedPartition()> and C<IsContainerPartition()>. + - Added C<getLogicalDrives()>. + - Added ":FILE_" export class for specific types of access to files. + - Added C<SECURITY_SQOS_PRESENT> to ":SECURITY_" export class. + - Added ":PARTITION_" export class for partition types. + - Seriously bulked up the test suite. + +0.05 1998-08-21 + - "-w" no longer warns that a buffer size of "=99" "isn't numeric". + nor if pass undef var for buffer size or output-only parameter. + - Added SetErrorMode() and :SEM_. + - createFile() sharing now defaults to "rw" to match C RTL. + - createFile() was ignoring "r" and "w" in access masks. + +0.04 1998-08-13 + - Added GetLogicalDrives and GetLogicalDriveStrings. + - Added GetDriveType and GetVolumeInformation. + - Added DRIVE_* for GetDriveType(). + - Added FS_* for GetVolumeInformation(). + - Added createFile(), getLogicalDrives(), and attrLetsToBits() helpers. + - CreateFile() returns: INVALID_HANDLE_VALUE->false, 0->"0 but true". + - More standardized "Hungarian" notation and uses buffers.h. + - Large unsigned values no longer made negative. + +0.03 1998-04-25 + - Added DDD_* constants to File.pm and moved codes mistakenly + exported for :DDD_ to be exported for :Misc. + - Split large group of constants to increase efficiency. + - Minor cosmetic fixes. + +0.02 1998-03-03 + - Added DeviceIoControl(). + - Added some IOCTL_STORAGE_* and IOCTL_DISK_* constants + - Taught test.pl to verify all exported functions and constants. + +0.01 1997-12-08 + - original version; based on Win32API::Registry. + - release to partner diff --git a/win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm b/win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm new file mode 100644 index 0000000000..d4f936e107 --- /dev/null +++ b/win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm @@ -0,0 +1,361 @@ +# This should eventually become part of MakeMaker as ExtUtils::Mkconst2perl. +# Documentation for this is very skimpy at this point. Full documentation +# will be added to ExtUtils::Mkconst2perl when it is created. +package ExtUtils::Myconst2perl; + +use strict; +use Config; + +use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION ); +BEGIN { + require Exporter; + push @ISA, 'Exporter'; + @EXPORT= qw( &Myconst2perl ); + @EXPORT_OK= qw( &ParseAttribs ); + $VERSION= 1.00; +} + +use Carp; +use File::Basename; +use ExtUtils::MakeMaker qw( neatvalue ); + +# Return the extension to use for a file of C++ source code: +sub _cc +{ + # Some day, $Config{_cc} might be defined for us: + return $Config{_cc} if $Config{_cc}; + return ".cxx"; # Seems to be the most widely accepted extension. +} + +=item ParseAttribs + +Parses user-firendly options into coder-firendly specifics. + +=cut + +sub ParseAttribs +{ + # Usage: ParseAttribs( "Package::Name", \%opts, {opt=>\$var} ); + my( $pkg, $hvAttr, $hvRequests )= @_; + my( $outfile, @perlfiles, %perlfilecodes, @cfiles, %cfilecodes ); + my @importlist= @{$hvAttr->{IMPORT_LIST}}; + my $perlcode= $hvAttr->{PERL_PE_CODE} || + 'last if /^\s*(bootstrap|XSLoader::load)\b/'; + my $ccode= $hvAttr->{C_PE_CODE} || + 'last if m#/[/*]\s*CONSTS_DEFINED\b|^\s*MODULE\b#'; + my $ifdef= $hvAttr->{IFDEF} || 0; + my $writeperl= !! $hvAttr->{WRITE_PERL}; + my $export= !! $hvAttr->{DO_EXPORT}; + my $importto= $hvAttr->{IMPORT_TO} || "_constants"; + my $cplusplus= $hvAttr->{CPLUSPLUS}; + $cplusplus= "" if ! defined $cplusplus; + my $object= ""; + my $binary= ""; + my $final= ""; + my $norebuild= ""; + my $subroutine= ""; + my $base; + my %params= ( + PERL_PE_CODE => \$perlcode, + PERL_FILE_LIST => \@perlfiles, + PERL_FILE_CODES => \%perlfilecodes, + PERL_FILES => sub { map {($_,$perlfilecodes{$_})} @perlfiles }, + C_PE_CODE => \$ccode, + C_FILE_LIST => \@cfiles, + C_FILE_CODES => \%cfilecodes, + C_FILES => sub { map {($_,$cfilecodes{$_})} @cfiles }, + DO_EXPORT => \$export, + IMPORT_TO => \$importto, + IMPORT_LIST => \@importlist, + SUBROUTINE => \$subroutine, + IFDEF => \$ifdef, + WRITE_PERL => \$writeperl, + CPLUSPLUS => \$cplusplus, + BASEFILENAME => \$base, + OUTFILE => \$outfile, + OBJECT => \$object, + BINARY => \$binary, + FINAL_PERL => \$final, + NO_REBUILD => \$norebuild, + ); + { my @err= grep {! defined $params{$_}} keys %$hvAttr; + carp "ExtUtils::Myconst2perl::ParseAttribs: ", + "Unsupported option(s) (@err).\n" + if @err; + } + $norebuild= $hvAttr->{NO_REBUILD} if exists $hvAttr->{NO_REBUILD}; + my $module= ( split /::/, $pkg )[-1]; + $base= "c".$module; + $base= $hvAttr->{BASEFILENAME} if exists $hvAttr->{BASEFILENAME}; + my $ext= ! $cplusplus ? ($Config{_c}||".c") + : $cplusplus =~ /^[.]/ ? $cplusplus : _cc(); + if( $writeperl ) { + $outfile= $base . "_pc" . $ext; + $object= $base . "_pc" . ($Config{_o}||$Config{obj_ext}); + $object= $hvAttr->{OBJECT} if $hvAttr->{OBJECT}; + $binary= $base . "_pc" . ($Config{_exe}||$Config{exe_ext}); + $binary= $hvAttr->{BINARY} if $hvAttr->{BINARY}; + $final= $base . ".pc"; + $final= $hvAttr->{FINAL_PERL} if $hvAttr->{FINAL_PERL}; + $subroutine= "main"; + } elsif( $cplusplus ) { + $outfile= $base . $ext; + $object= $base . ($Config{_o}||$Config{obj_ext}); + $object= $hvAttr->{OBJECT} if $hvAttr->{OBJECT}; + $subroutine= "const2perl_" . $pkg; + $subroutine =~ s/\W/_/g; + } else { + $outfile= $base . ".h"; + } + $outfile= $hvAttr->{OUTFILE} if $hvAttr->{OUTFILE}; + if( $hvAttr->{PERL_FILES} ) { + carp "ExtUtils::Myconst2perl: PERL_FILES option not allowed ", + "with PERL_FILE_LIST nor PERL_FILE_CODES.\n" + if $hvAttr->{PERL_FILE_LIST} || $hvAttr->{PERL_FILE_CODES}; + %perlfilecodes= @{$hvAttr->{PERL_FILES}}; + my $odd= 0; + @perlfiles= grep {$odd= !$odd} @{$hvAttr->{PERL_FILES}}; + } else { + if( $hvAttr->{PERL_FILE_LIST} ) { + @perlfiles= @{$hvAttr->{PERL_FILE_LIST}}; + } elsif( $hvAttr->{PERL_FILE_CODES} ) { + @perlfiles= keys %{$hvAttr->{PERL_FILE_CODES}}; + } else { + @perlfiles= ( "$module.pm" ); + } + %perlfilecodes= %{$hvAttr->{PERL_FILE_CODES}} + if $hvAttr->{PERL_FILE_CODES}; + } + for my $file ( @perlfiles ) { + $perlfilecodes{$file}= $perlcode if ! $perlfilecodes{$file}; + } + if( ! $subroutine ) { + ; # Don't process any C source code files. + } elsif( $hvAttr->{C_FILES} ) { + carp "ExtUtils::Myconst2perl: C_FILES option not allowed ", + "with C_FILE_LIST nor C_FILE_CODES.\n" + if $hvAttr->{C_FILE_LIST} || $hvAttr->{C_FILE_CODES}; + %cfilecodes= @{$hvAttr->{C_FILES}}; + my $odd= 0; + @cfiles= grep {$odd= !$odd} @{$hvAttr->{C_FILES}}; + } else { + if( $hvAttr->{C_FILE_LIST} ) { + @cfiles= @{$hvAttr->{C_FILE_LIST}}; + } elsif( $hvAttr->{C_FILE_CODES} ) { + @cfiles= keys %{$hvAttr->{C_FILE_CODES}}; + } elsif( $writeperl || $cplusplus ) { + @cfiles= ( "$module.xs" ); + } + %cfilecodes= %{$hvAttr->{C_FILE_CODES}} if $hvAttr->{C_FILE_CODES}; + } + for my $file ( @cfiles ) { + $cfilecodes{$file}= $ccode if ! $cfilecodes{$file}; + } + for my $key ( keys %$hvRequests ) { + if( ! $params{$key} ) { + carp "ExtUtils::Myconst2perl::ParseAttribs: ", + "Unsupported output ($key).\n"; + } elsif( "SCALAR" eq ref( $params{$key} ) ) { + ${$hvRequests->{$key}}= ${$params{$key}}; + } elsif( "ARRAY" eq ref( $params{$key} ) ) { + @{$hvRequests->{$key}}= @{$params{$key}}; + } elsif( "HASH" eq ref( $params{$key} ) ) { + %{$hvRequests->{$key}}= %{$params{$key}}; + } elsif( "CODE" eq ref( $params{$key} ) ) { + @{$hvRequests->{$key}}= &{$params{$key}}; + } else { + die "Impossible value in \$params{$key}"; + } + } +} + +=item Myconst2perl + +Generates a file used to implement C constants as "constant subroutines" in +a Perl module. + +Extracts a list of constants from a module's export list by C<eval>ing the +first part of the Module's F<*.pm> file and then requesting some groups of +symbols be exported/imported into a dummy package. Then writes C or C++ +code that can convert each C constant into a Perl "constant subroutine" +whose name is the constant's name and whose value is the constant's value. + +=cut + +sub Myconst2perl +{ + my( $pkg, %spec )= @_; + my( $outfile, $writeperl, $ifdef, $export, $importto, @importlist, + @perlfile, %perlcode, @cfile, %ccode, $routine ); + ParseAttribs( $pkg, \%spec, { + DO_EXPORT => \$export, + IMPORT_TO => \$importto, + IMPORT_LIST => \@importlist, + IFDEF => \$ifdef, + WRITE_PERL => \$writeperl, + OUTFILE => \$outfile, + PERL_FILE_LIST => \@perlfile, + PERL_FILE_CODES => \%perlcode, + C_FILE_LIST => \@cfile, + C_FILE_CODES => \%ccode, + SUBROUTINE => \$routine, + } ); + my $module= ( split /::/, $pkg )[-1]; + + warn "Writing $outfile...\n"; + open( STDOUT, ">$outfile" ) or die "Can't create $outfile: $!\n"; + + my $code= ""; + my $file; + foreach $file ( @perlfile ) { + warn "Reading Perl file, $file: $perlcode{$file}\n"; + open( MODULE, "<$file" ) or die "Can't read Perl file, $file: $!\n"; + eval qq[ + while( <MODULE> ) { + $perlcode{$file}; + \$code .= \$_; + } + 1; + ] or die "$file eval: $@\n"; + close( MODULE ); + } + + print + "/* $outfile - Generated by ExtUtils::Myconst2perl::Myconst2perl */\n"; + if( $routine ) { + print "/* See start of $routine() for generation parameters used */\n"; + #print "#define main _main_proto" + # " /* Ignore Perl's main() prototype */\n\n"; + if( $writeperl ) { + # Here are more reasons why the WRITE_PERL option is discouraged. + if( $Config{useperlio} ) { + print "#define PERLIO_IS_STDIO 1\n"; + } + print "#define WIN32IO_IS_STDIO 1\n"; # May cause a warning + print "#define NO_XSLOCKS 1\n"; # What a hack! + } + foreach $file ( @cfile ) { + warn "Reading C file, $file: $ccode{$file}\n"; + open( XS, "<$file" ) or die "Can't read C file, $file: $!\n"; + my $code= $ccode{$file}; + $code =~ s#\\#\\\\#g; + $code =~ s#([^\s -~])#"\\x".sprintf "%02X",unpack "C",$1#ge; + $code =~ s#[*]/#*\\/#g; + print qq[\n/* Include $file: $code */\n]; + print qq[\n#line 1 "$file"\n]; + eval qq[ + while( <XS> ) { + $ccode{$file}; + print; + } + 1; + ] or die "$file eval: $@\n"; + close( XS ); + } + #print qq[\n#undef main\n]; + print qq[\n#define CONST2WRITE_PERL\n]; + print qq[\n#include "const2perl.h"\n\n]; + if( $writeperl ) { + print "int\nmain( int argc, char *argv[], char *envp[] )\n"; + } else { + print "void\n$routine( void )\n"; + } + } + print "{\n"; + + { + @ExtUtils::Myconst2perl::importlist= @importlist; + my $var= '@ExtUtils::Myconst2perl::importlist'; + my $port= $export ? "export" : "import"; + my $arg2= $export ? "q[$importto]," : ""; + local( $^W )= 0; + eval $code . "{\n" + . " { package $importto;\n" + . " warn qq[\u${port}ing to $importto: $var\\n];\n" + . " \$pkg->$port( $arg2 $var );\n" + . " }\n" + . " { no strict 'refs';\n" + . " $var= sort keys %{'_constants::'}; }\n" + . " warn 0 + $var, qq[ symbols ${port}ed.\\n];\n" + . "}\n1;\n" + or die "eval: $@\n"; + } + my @syms= @ExtUtils::Myconst2perl::importlist; + + my $if; + my $const; + print qq[ START_CONSTS( "$pkg" ) /* No ";" */\n]; + { + my( $head, $tail )= ( "/*", "\n" ); + if( $writeperl ) { + $head= ' printf( "#'; + $tail= '\\n" );' . "\n"; + print $head, " Generated by $outfile.", $tail; + } + print $head, " Package $pkg with options:", $tail; + $head= " *" if ! $writeperl; + my $key; + foreach $key ( sort keys %spec ) { + my $val= neatvalue($spec{$key}); + $val =~ s/\\/\\\\/g if $writeperl; + print $head, " $key => ", $val, $tail; + } + print $head, " Perl files eval'd:", $tail; + foreach $key ( @perlfile ) { + my $code= $perlcode{$key}; + $code =~ s#\\#\\\\#g; + $code =~ s#([^ -~])#"\\".sprintf "%03o",unpack "C",$1#ge; + $code =~ s#"#\\"#g if $writeperl; + print $head, " $key => ", $code, $tail; + } + if( $writeperl ) { + print $head, " C files included:", $tail; + foreach $key ( @cfile ) { + my $code= $ccode{$key}; + $code =~ s#\\#\\\\#g; + $code =~ s#([^ -~])#"\\".sprintf "%03o",unpack "C",$1#ge; + $code =~ s#"#\\"#g; + print $head, " $key => ", $code, $tail; + } + } else { + print " */\n"; + } + } + if( ! ref($ifdef) && $ifdef =~ /[^\s\w]/ ) { + my $sub= $ifdef; + $sub= 'sub { local($_)= @_; ' . $sub . ' }' + unless $sub =~ /^\s*sub\b/; + $ifdef= eval $sub; + die "$@: $sub\n" if $@; + if( "CODE" ne ref($ifdef) ) { + die "IFDEF didn't create subroutine reference: eval $sub\n"; + } + } + foreach $const ( @syms ) { + $if= "CODE" eq ref($ifdef) ? $ifdef->($const) : $ifdef; + if( ! $if ) { + $if= ""; + } elsif( "1" eq $if ) { + $if= "#ifdef $const\n"; + } elsif( $if !~ /^#/ ) { + $if= "#ifdef $if\n"; + } else { + $if= "$if\n"; + } + print $if + . qq[ const2perl( $const );\n]; + if( $if ) { + print "#else\n" + . qq[ noconst( $const );\n] + . "#endif\n"; + } + } + if( $writeperl ) { + print + qq[ printf( "1;\\n" );\n], + qq[ return( 0 );\n]; + } + print "}\n"; +} + +1; diff --git a/win32/ext/Win32API/File/File.pm b/win32/ext/Win32API/File/File.pm new file mode 100644 index 0000000000..b597fcfff0 --- /dev/null +++ b/win32/ext/Win32API/File/File.pm @@ -0,0 +1,3035 @@ +# File.pm -- Low-level access to Win32 file/dir functions/constants. + +package Win32API::File; + +use strict; +use integer; +use Carp; +use Config qw( %Config ); +use Fcntl qw( O_RDONLY O_RDWR O_WRONLY O_APPEND O_BINARY O_TEXT ); +use vars qw( $VERSION @ISA ); +use vars qw( @EXPORT @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS ); + +$VERSION= '0.10'; + +use base qw( Exporter DynaLoader Tie::Handle IO::File ); + +# Math::BigInt optimizations courtesy of Tels +BEGIN { + require Math::BigInt; + if (defined($Math::BigInt::VERSION) && $Math::BigInt::VERSION >= 1.60) { + Math::BigInt->import(lib => 'GMP'); + } +} + +my $_64BITINT = defined $Config{use64bitint} && + $Config{use64bitint} eq 'define'; + +my $THIRTY_TWO = $_64BITINT ? 32 : new Math::BigInt 32; + +my $FFFFFFFF = $_64BITINT ? 0xFFFFFFFF : new Math::BigInt 0xFFFFFFFF; + +@EXPORT= qw(); +%EXPORT_TAGS= ( + Func => [qw( attrLetsToBits createFile + fileConstant fileLastError getLogicalDrives + CloseHandle CopyFile CreateFile + DefineDosDevice DeleteFile DeviceIoControl + FdGetOsFHandle GetDriveType GetFileAttributes GetFileType + GetHandleInformation GetLogicalDrives GetLogicalDriveStrings + GetOsFHandle GetVolumeInformation IsRecognizedPartition + IsContainerPartition MoveFile MoveFileEx + OsFHandleOpen OsFHandleOpenFd QueryDosDevice + ReadFile SetErrorMode SetFilePointer + SetHandleInformation WriteFile GetFileSize + getFileSize setFilePointer GetOverlappedResult)], + FuncA => [qw( + CopyFileA CreateFileA DefineDosDeviceA + DeleteFileA GetDriveTypeA GetFileAttributesA GetLogicalDriveStringsA + GetVolumeInformationA MoveFileA MoveFileExA + QueryDosDeviceA )], + FuncW => [qw( + CopyFileW CreateFileW DefineDosDeviceW + DeleteFileW GetDriveTypeW GetFileAttributesW GetLogicalDriveStringsW + GetVolumeInformationW MoveFileW MoveFileExW + QueryDosDeviceW )], + Misc => [qw( + CREATE_ALWAYS CREATE_NEW FILE_BEGIN + FILE_CURRENT FILE_END INVALID_HANDLE_VALUE + OPEN_ALWAYS OPEN_EXISTING TRUNCATE_EXISTING )], + DDD_ => [qw( + DDD_EXACT_MATCH_ON_REMOVE DDD_RAW_TARGET_PATH + DDD_REMOVE_DEFINITION )], + DRIVE_ => [qw( + DRIVE_UNKNOWN DRIVE_NO_ROOT_DIR DRIVE_REMOVABLE + DRIVE_FIXED DRIVE_REMOTE DRIVE_CDROM + DRIVE_RAMDISK )], + FILE_ => [qw( + FILE_READ_DATA FILE_LIST_DIRECTORY + FILE_WRITE_DATA FILE_ADD_FILE + FILE_APPEND_DATA FILE_ADD_SUBDIRECTORY + FILE_CREATE_PIPE_INSTANCE FILE_READ_EA + FILE_WRITE_EA FILE_EXECUTE + FILE_TRAVERSE FILE_DELETE_CHILD + FILE_READ_ATTRIBUTES FILE_WRITE_ATTRIBUTES + FILE_ALL_ACCESS FILE_GENERIC_READ + FILE_GENERIC_WRITE FILE_GENERIC_EXECUTE )], + FILE_ATTRIBUTE_ => [qw( + INVALID_FILE_ATTRIBUTES + FILE_ATTRIBUTE_DEVICE FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_ENCRYPTED FILE_ATTRIBUTE_NOT_CONTENT_INDEXED + FILE_ATTRIBUTE_REPARSE_POINT FILE_ATTRIBUTE_SPARSE_FILE + FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_COMPRESSED + FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL + FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY + FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY )], + FILE_FLAG_ => [qw( + FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_DELETE_ON_CLOSE + FILE_FLAG_NO_BUFFERING FILE_FLAG_OVERLAPPED + FILE_FLAG_POSIX_SEMANTICS FILE_FLAG_RANDOM_ACCESS + FILE_FLAG_SEQUENTIAL_SCAN FILE_FLAG_WRITE_THROUGH + FILE_FLAG_OPEN_REPARSE_POINT )], + FILE_SHARE_ => [qw( + FILE_SHARE_DELETE FILE_SHARE_READ FILE_SHARE_WRITE )], + FILE_TYPE_ => [qw( + FILE_TYPE_CHAR FILE_TYPE_DISK FILE_TYPE_PIPE + FILE_TYPE_UNKNOWN )], + FS_ => [qw( + FS_CASE_IS_PRESERVED FS_CASE_SENSITIVE + FS_UNICODE_STORED_ON_DISK FS_PERSISTENT_ACLS + FS_FILE_COMPRESSION FS_VOL_IS_COMPRESSED )], + FSCTL_ => [qw( + FSCTL_SET_REPARSE_POINT FSCTL_GET_REPARSE_POINT + FSCTL_DELETE_REPARSE_POINT )], + HANDLE_FLAG_ => [qw( + HANDLE_FLAG_INHERIT HANDLE_FLAG_PROTECT_FROM_CLOSE )], + IOCTL_STORAGE_ => [qw( + IOCTL_STORAGE_CHECK_VERIFY IOCTL_STORAGE_MEDIA_REMOVAL + IOCTL_STORAGE_EJECT_MEDIA IOCTL_STORAGE_LOAD_MEDIA + IOCTL_STORAGE_RESERVE IOCTL_STORAGE_RELEASE + IOCTL_STORAGE_FIND_NEW_DEVICES IOCTL_STORAGE_GET_MEDIA_TYPES + )], + IOCTL_DISK_ => [qw( + IOCTL_DISK_FORMAT_TRACKS IOCTL_DISK_FORMAT_TRACKS_EX + IOCTL_DISK_GET_DRIVE_GEOMETRY IOCTL_DISK_GET_DRIVE_LAYOUT + IOCTL_DISK_GET_MEDIA_TYPES IOCTL_DISK_GET_PARTITION_INFO + IOCTL_DISK_HISTOGRAM_DATA IOCTL_DISK_HISTOGRAM_RESET + IOCTL_DISK_HISTOGRAM_STRUCTURE IOCTL_DISK_IS_WRITABLE + IOCTL_DISK_LOGGING IOCTL_DISK_PERFORMANCE + IOCTL_DISK_REASSIGN_BLOCKS IOCTL_DISK_REQUEST_DATA + IOCTL_DISK_REQUEST_STRUCTURE IOCTL_DISK_SET_DRIVE_LAYOUT + IOCTL_DISK_SET_PARTITION_INFO IOCTL_DISK_VERIFY )], + GENERIC_ => [qw( + GENERIC_ALL GENERIC_EXECUTE + GENERIC_READ GENERIC_WRITE )], + MEDIA_TYPE => [qw( + Unknown F5_1Pt2_512 F3_1Pt44_512 + F3_2Pt88_512 F3_20Pt8_512 F3_720_512 + F5_360_512 F5_320_512 F5_320_1024 + F5_180_512 F5_160_512 RemovableMedia + FixedMedia F3_120M_512 )], + MOVEFILE_ => [qw( + MOVEFILE_COPY_ALLOWED MOVEFILE_DELAY_UNTIL_REBOOT + MOVEFILE_REPLACE_EXISTING MOVEFILE_WRITE_THROUGH )], + SECURITY_ => [qw( + SECURITY_ANONYMOUS SECURITY_CONTEXT_TRACKING + SECURITY_DELEGATION SECURITY_EFFECTIVE_ONLY + SECURITY_IDENTIFICATION SECURITY_IMPERSONATION + SECURITY_SQOS_PRESENT )], + SEM_ => [qw( + SEM_FAILCRITICALERRORS SEM_NOGPFAULTERRORBOX + SEM_NOALIGNMENTFAULTEXCEPT SEM_NOOPENFILEERRORBOX )], + PARTITION_ => [qw( + PARTITION_ENTRY_UNUSED PARTITION_FAT_12 + PARTITION_XENIX_1 PARTITION_XENIX_2 + PARTITION_FAT_16 PARTITION_EXTENDED + PARTITION_HUGE PARTITION_IFS + PARTITION_FAT32 PARTITION_FAT32_XINT13 + PARTITION_XINT13 PARTITION_XINT13_EXTENDED + PARTITION_PREP PARTITION_UNIX + VALID_NTFT PARTITION_NTFT )], +); +@EXPORT_OK= (); +{ + my $key; + foreach $key ( keys(%EXPORT_TAGS) ) { + push( @EXPORT_OK, @{$EXPORT_TAGS{$key}} ); + #push( @EXPORT_FAIL, @{$EXPORT_TAGS{$key}} ) unless $key =~ /^Func/; + } +} +$EXPORT_TAGS{ALL}= \@EXPORT_OK; + +bootstrap Win32API::File $VERSION; + +# Preloaded methods go here. + +# To convert C constants to Perl code in cFile.pc +# [instead of C or C++ code in cFile.h]: +# * Modify F<Makefile.PL> to add WriteMakeFile() => +# CONST2PERL/postamble => [[ "Win32API::File" => ]] WRITE_PERL => 1. +# * Either comment out C<#include "cFile.h"> from F<File.xs> +# or make F<cFile.h> an empty file. +# * Make sure the following C<if> block is not commented out. +# * "nmake clean", "perl Makefile.PL", "nmake" + +if( ! defined &GENERIC_READ ) { + require "Win32API/File/cFile.pc"; +} + +sub fileConstant +{ + my( $name )= @_; + if( 1 != @_ || ! $name || $name =~ /\W/ ) { + require Carp; + Carp::croak( 'Usage: ',__PACKAGE__,'::fileConstant("CONST_NAME")' ); + } + my $proto= prototype $name; + if( defined \&$name + && defined $proto + && "" eq $proto ) { + no strict 'refs'; + return &$name; + } + return undef; +} + +# We provide this for backwards compatibility: +sub constant +{ + my( $name )= @_; + my $value= fileConstant( $name ); + if( defined $value ) { + $!= 0; + return $value; + } + $!= 11; # EINVAL + return 0; +} + +# BEGIN { +# my $code= 'return _fileLastError(@_)'; +# local( $!, $^E )= ( 1, 1 ); +# if( $! ne $^E ) { +# $code= ' +# local( $^E )= _fileLastError(@_); +# my $ret= $^E; +# return $ret; +# '; +# } +# eval "sub fileLastError { $code }"; +# die "$@" if $@; +# } + +package Win32API::File::_error; + +use overload + '""' => sub { + require Win32 unless defined &Win32::FormatMessage; + $_ = Win32::FormatMessage(Win32API::File::_fileLastError()); + tr/\r\n//d; + return $_; + }, + '0+' => sub { Win32API::File::_fileLastError() }, + 'fallback' => 1; + +sub new { return bless {}, shift } +sub set { Win32API::File::_fileLastError($_[1]); return $_[0] } + +package Win32API::File; + +my $_error = new Win32API::File::_error; + +sub fileLastError { + croak 'Usage: ',__PACKAGE__,'::fileLastError( [$setWin32ErrCode] )' if @_ > 1; + $_error->set($_[0]) if defined $_[0]; + return $_error; +} + +# Since we ISA DynaLoader which ISA AutoLoader, we ISA AutoLoader so we +# need this next chunk to prevent Win32API::File->nonesuch() from +# looking for "nonesuch.al" and producing confusing error messages: +use vars qw($AUTOLOAD); +sub AUTOLOAD { + require Carp; + Carp::croak( + "Can't locate method $AUTOLOAD via package Win32API::File" ); +} + +# Replace "&rout;" with "goto &rout;" when that is supported on Win32. + +# Aliases for non-Unicode functions: +sub CopyFile { &CopyFileA; } +sub CreateFile { &CreateFileA; } +sub DefineDosDevice { &DefineDosDeviceA; } +sub DeleteFile { &DeleteFileA; } +sub GetDriveType { &GetDriveTypeA; } +sub GetFileAttributes { &GetFileAttributesA; } +sub GetLogicalDriveStrings { &GetLogicalDriveStringsA; } +sub GetVolumeInformation { &GetVolumeInformationA; } +sub MoveFile { &MoveFileA; } +sub MoveFileEx { &MoveFileExA; } +sub QueryDosDevice { &QueryDosDeviceA; } + +sub OsFHandleOpen { + if( 3 != @_ ) { + croak 'Win32API::File Usage: ', + 'OsFHandleOpen(FILE,$hNativeHandle,"rwatb")'; + } + my( $fh, $osfh, $access )= @_; + if( ! ref($fh) ) { + if( $fh !~ /('|::)/ ) { + $fh= caller() . "::" . $fh; + } + no strict "refs"; + $fh= \*{$fh}; + } + my( $mode, $pref ); + if( $access =~ /r/i ) { + if( $access =~ /w/i ) { + $mode= O_RDWR; + $pref= "+<"; + } else { + $mode= O_RDONLY; + $pref= "<"; + } + } else { + if( $access =~ /w/i ) { + $mode= O_WRONLY; + $pref= ">"; + } else { + # croak qq<Win32API::File::OsFHandleOpen(): >, + # qq<Access ($access) missing both "r" and "w">; + $mode= O_RDONLY; + $pref= "<"; + } + } + $mode |= O_APPEND if $access =~ /a/i; + #$mode |= O_TEXT if $access =~ /t/i; + # Some versions of the Fcntl module are broken and won't autoload O_TEXT: + if( $access =~ /t/i ) { + my $o_text= eval "O_TEXT"; + $o_text= 0x4000 if $@; + $mode |= $o_text; + } + $mode |= O_BINARY if $access =~ /b/i; + my $fd = eval { OsFHandleOpenFd( $osfh, $mode ) }; + if ($@) { + return tie *{$fh}, __PACKAGE__, $osfh; + } + return undef if $fd < 0; + return open( $fh, $pref."&=".$fd ); +} + +sub GetOsFHandle { + if( 1 != @_ ) { + croak 'Win32API::File Usage: $OsFHandle= GetOsFHandle(FILE)'; + } + my( $file )= @_; + if( ! ref($file) ) { + if( $file !~ /('|::)/ ) { + $file= caller() . "::" . $file; + } + no strict "refs"; + # The eval "" is necessary in Perl 5.6, avoid it otherwise. + my $tied = !defined($^]) || $^] < 5.008 + ? eval "tied *{$file}" + : tied *{$file}; + + if (UNIVERSAL::isa($tied => __PACKAGE__)) { + return $tied->win32_handle; + } + + $file= *{$file}; + } + my( $fd )= fileno($file); + if( ! defined( $fd ) ) { + if( $file =~ /^\d+\Z/ ) { + $fd= $file; + } else { + return (); # $! should be set by fileno(). + } + } + my $h= FdGetOsFHandle( $fd ); + if( INVALID_HANDLE_VALUE() == $h ) { + $h= ""; + } elsif( "0" eq $h ) { + $h= "0 but true"; + } + return $h; +} + +sub getFileSize { + croak 'Win32API::File Usage: $size= getFileSize($hNativeHandle)' + if @_ != 1; + + my $handle = shift; + my $high_size = 0; + + my $low_size = GetFileSize($handle, $high_size); + + my $retval = $_64BITINT ? $high_size : new Math::BigInt $high_size; + + $retval <<= $THIRTY_TWO; + $retval += $low_size; + + return $retval; +} + +sub setFilePointer { + croak 'Win32API::File Usage: $pos= setFilePointer($hNativeHandle, $posl, $from_where)' + if @_ != 3; + + my ($handle, $pos, $from_where) = @_; + + my ($pos_low, $pos_high) = ($pos, 0); + + if ($_64BITINT) { + $pos_low = ($pos & $FFFFFFFF); + $pos_high = (($pos >> $THIRTY_TWO) & $FFFFFFFF); + } + elsif (UNIVERSAL::isa($pos => 'Math::BigInt')) { + $pos_low = ($pos & $FFFFFFFF)->numify(); + $pos_high = (($pos >> $THIRTY_TWO) & $FFFFFFFF)->numify(); + } + + my $retval = SetFilePointer($handle, $pos_low, $pos_high, $from_where); + + if (defined $pos_high && $pos_high != 0) { + $retval = new Math::BigInt $retval unless $_64BITINT; + $pos_high = new Math::BigInt $pos_high unless $_64BITINT; + + $retval += $pos_high << $THIRTY_TWO; + } + + return $retval; +} + +sub attrLetsToBits +{ + my( $lets )= @_; + my( %a )= ( + "a"=>FILE_ATTRIBUTE_ARCHIVE(), "c"=>FILE_ATTRIBUTE_COMPRESSED(), + "h"=>FILE_ATTRIBUTE_HIDDEN(), "o"=>FILE_ATTRIBUTE_OFFLINE(), + "r"=>FILE_ATTRIBUTE_READONLY(), "s"=>FILE_ATTRIBUTE_SYSTEM(), + "t"=>FILE_ATTRIBUTE_TEMPORARY() ); + my( $bits )= 0; + foreach( split(//,$lets) ) { + croak "Win32API::File::attrLetsToBits: Unknown attribute letter ($_)" + unless exists $a{$_}; + $bits |= $a{$_}; + } + return $bits; +} + +use vars qw( @_createFile_Opts %_createFile_Opts ); +@_createFile_Opts= qw( Access Create Share Attributes + Flags Security Model ); +@_createFile_Opts{@_createFile_Opts}= (1) x @_createFile_Opts; + +sub createFile +{ + my $opts= ""; + if( 2 <= @_ && "HASH" eq ref($_[$#_]) ) { + $opts= pop( @_ ); + } + my( $sPath, $svAccess, $svShare )= @_; + if( @_ < 1 || 3 < @_ ) { + croak "Win32API::File::createFile() usage: \$hObject= createFile(\n", + " \$sPath, [\$svAccess_qrw_ktn_ce,[\$svShare_rwd,]]", + " [{Option=>\$Value}] )\n", + " options: @_createFile_Opts\nCalled"; + } + my( $create, $flags, $sec, $model )= ( "", 0, [], 0 ); + if( ref($opts) ) { + my @err= grep( ! $_createFile_Opts{$_}, keys(%$opts) ); + @err and croak "_createFile: Invalid options (@err)"; + $flags= $opts->{Flags} if exists( $opts->{Flags} ); + $flags |= attrLetsToBits( $opts->{Attributes} ) + if exists( $opts->{Attributes} ); + $sec= $opts->{Security} if exists( $opts->{Security} ); + $model= $opts->{Model} if exists( $opts->{Model} ); + $svAccess= $opts->{Access} if exists( $opts->{Access} ); + $create= $opts->{Create} if exists( $opts->{Create} ); + $svShare= $opts->{Share} if exists( $opts->{Share} ); + } + $svAccess= "r" unless defined($svAccess); + $svShare= "rw" unless defined($svShare); + if( $svAccess =~ /^[qrw ktn ce]*$/i ) { + ( my $c= $svAccess ) =~ tr/qrw QRW//d; + $create= $c if "" ne $c && "" eq $create; + local( $_ )= $svAccess; + $svAccess= 0; + $svAccess |= GENERIC_READ() if /r/i; + $svAccess |= GENERIC_WRITE() if /w/i; + } elsif( "?" eq $svAccess ) { + croak + "Win32API::File::createFile: \$svAccess can use the following:\n", + " One or more of the following:\n", + "\tq -- Query access (same as 0)\n", + "\tr -- Read access (GENERIC_READ)\n", + "\tw -- Write access (GENERIC_WRITE)\n", + " At most one of the following:\n", + "\tk -- Keep if exists\n", + "\tt -- Truncate if exists\n", + "\tn -- New file only (fail if file already exists)\n", + " At most one of the following:\n", + "\tc -- Create if doesn't exist\n", + "\te -- Existing file only (fail if doesn't exist)\n", + " '' is the same as 'q k e'\n", + " 'r' is the same as 'r k e'\n", + " 'w' is the same as 'w t c'\n", + " 'rw' is the same as 'rw k c'\n", + " 'rt' or 'rn' implies 'c'.\n", + " Or \$svAccess can be numeric.\n", "Called from"; + } elsif( $svAccess == 0 && $svAccess !~ /^[-+.]*0/ ) { + croak "Win32API::File::createFile: Invalid \$svAccess ($svAccess)"; + } + if( $create =~ /^[ktn ce]*$/ ) { + local( $_ )= $create; + my( $k, $t, $n, $c, $e )= ( scalar(/k/i), scalar(/t/i), + scalar(/n/i), scalar(/c/i), scalar(/e/i) ); + if( 1 < $k + $t + $n ) { + croak "Win32API::File::createFile: \$create must not use ", + qq<more than one of "k", "t", and "n" ($create)>; + } + if( $c && $e ) { + croak "Win32API::File::createFile: \$create must not use ", + qq<both "c" and "e" ($create)>; + } + my $r= ( $svAccess & GENERIC_READ() ) == GENERIC_READ(); + my $w= ( $svAccess & GENERIC_WRITE() ) == GENERIC_WRITE(); + if( ! $k && ! $t && ! $n ) { + if( $w && ! $r ) { $t= 1; + } else { $k= 1; } + } + if( $k ) { + if( $c || $w && ! $e ) { $create= OPEN_ALWAYS(); + } else { $create= OPEN_EXISTING(); } + } elsif( $t ) { + if( $e ) { $create= TRUNCATE_EXISTING(); + } else { $create= CREATE_ALWAYS(); } + } else { # $n + if( ! $e ) { $create= CREATE_NEW(); + } else { + croak "Win32API::File::createFile: \$create must not use ", + qq<both "n" and "e" ($create)>; + } + } + } elsif( "?" eq $create ) { + croak 'Win32API::File::createFile: $create !~ /^[ktn ce]*$/;', + ' pass $svAccess as "?" for more information.'; + } elsif( $create == 0 && $create ne "0" ) { + croak "Win32API::File::createFile: Invalid \$create ($create)"; + } + if( $svShare =~ /^[drw]*$/ ) { + my %s= ( "d"=>FILE_SHARE_DELETE(), "r"=>FILE_SHARE_READ(), + "w"=>FILE_SHARE_WRITE() ); + my @s= split(//,$svShare); + $svShare= 0; + foreach( @s ) { + $svShare |= $s{$_}; + } + } elsif( $svShare == 0 && $svShare !~ /^[-+.]*0/ ) { + croak "Win32API::File::createFile: Invalid \$svShare ($svShare)"; + } + return CreateFileA( + $sPath, $svAccess, $svShare, $sec, $create, $flags, $model ); +} + + +sub getLogicalDrives +{ + my( $ref )= @_; + my $s= ""; + if( ! GetLogicalDriveStringsA( 256, $s ) ) { + return undef; + } + if( ! defined($ref) ) { + return split( /\0/, $s ); + } elsif( "ARRAY" ne ref($ref) ) { + croak 'Usage: C<@arr= getLogicalDrives()> ', + 'or C<getLogicalDrives(\\@arr)>', "\n"; + } + @$ref= split( /\0/, $s ); + return $ref; +} + +############################################################################### +# Experimental Tied Handle and Object Oriented interface. # +############################################################################### + +sub new { + my $class = shift; + $class = ref $class || $class; + + my $self = IO::File::new($class); + tie *$self, __PACKAGE__; + + $self->open(@_) if @_; + + return $self; +} + +sub TIEHANDLE { + my ($class, $win32_handle) = @_; + $class = ref $class || $class; + + return bless { + _win32_handle => $win32_handle, + _binmode => 0, + _buffered => 0, + _buffer => '', + _eof => 0, + _fileno => undef, + _access => 'r', + _append => 0, + }, $class; +} + +# This is called for getting the tied object from hard refs to glob refs in +# some cases, for reasons I don't quite grok. + +sub FETCH { return $_[0] } + +# Public accessors + +sub win32_handle{ $_[0]->{_win32_handle}||= $_[1] } + +# Protected accessors + +sub _buffer { $_[0]->{_buffer} ||= $_[1] } +sub _binmode { $_[0]->{_binmode} ||= $_[1] } +sub _fileno { $_[0]->{_fileno} ||= $_[1] } +sub _access { $_[0]->{_access} ||= $_[1] } +sub _append { $_[0]->{_append} ||= $_[1] } + +# Tie interface + +sub OPEN { + my $self = shift; + my $expr = shift; + croak "Only the two argument form of open is supported at this time" if @_; +# FIXME: this needs to parse the full Perl open syntax in $expr + + my ($mixed, $mode, $path) = + ($expr =~ /^\s* (\+)? \s* (<|>|>>)? \s* (.*?) \s*$/x); + + croak "Unsupported open mode" if not $path; + + my $access = 'r'; + my $append = $mode eq '>>' ? 1 : 0; + + if ($mixed) { + $access = 'rw'; + } elsif($mode eq '>') { + $access = 'w'; + } + + my $w32_handle = createFile($path, $access); + + $self->win32_handle($w32_handle); + + $self->seek(1,2) if $append; + + $self->_access($access); + $self->_append($append); + + return 1; +} + +sub BINMODE { + $_[0]->_binmode(1); +} + +sub WRITE { + my ($self, $buf, $len, $offset, $overlap) = @_; + + if ($offset) { + $buf = substr($buf, $offset); + $len = length($buf); + } + + $len = length($buf) if not defined $len; + + $overlap = [] if not defined $overlap;; + + my $bytes_written = 0; + + WriteFile ( + $self->win32_handle, $buf, $len, + $bytes_written, $overlap + ); + + return $bytes_written; +} + +sub PRINT { + my $self = shift; + + my $buf = join defined $, ? $, : "" => @_; + + $buf =~ s/\012/\015\012/sg unless $self->_binmode(); + + $buf .= $\ if defined $\; + + $self->WRITE($buf, length($buf), 0); +} + +sub READ { + my $self = shift; + my $into = \$_[0]; shift; + my ($len, $offset, $overlap) = @_; + + my $buffer = defined $self->_buffer ? $self->_buffer : ""; + my $buf_length = length($buffer); + my $bytes_read = 0; + my $data; + $offset = 0 if not defined $offset; + + if ($buf_length >= $len) { + $data = substr($buffer, 0, $len => ""); + $bytes_read = $len; + $self->_buffer($buffer); + } else { + if ($buf_length > 0) { + $len -= $buf_length; + substr($$into, $offset) = $buffer; + $offset += $buf_length; + } + + $overlap ||= []; + + ReadFile ( + $self->win32_handle, $data, $len, + $bytes_read, $overlap + ); + } + + $$into = "" if not defined $$into; + + substr($$into, $offset) = $data; + + return $bytes_read; +} + +sub READLINE { + my $self = shift; + my $line = ""; + + while ((index $line, $/) == $[-1) { # read until end of line marker + my $char = $self->GETC(); + + last if !defined $char || $char eq ''; + + $line .= $char; + } + + return undef if $line eq ''; + + return $line; +} + + +sub FILENO { + my $self = shift; + + return $self->_fileno() if defined $self->_fileno(); + + return -1 if $^O eq 'cygwin'; + +# FIXME: We don't always open the handle, better to query the handle or to set +# the right access info at TIEHANDLE time. + + my $access = $self->_access(); + my $mode = $access eq 'rw' ? O_RDWR : + $access eq 'w' ? O_WRONLY : O_RDONLY; + + $mode |= O_APPEND if $self->_append(); + + $mode |= O_TEXT if not $self->_binmode(); + + return $self->_fileno ( OsfHandleOpenFd ( + $self->win32_handle, $mode + )); +} + +sub SEEK { + my ($self, $pos, $whence) = @_; + + $whence = 0 if not defined $whence; + my @file_consts = map { + fileConstant($_) + } qw(FILE_BEGIN FILE_CURRENT FILE_END); + + my $from_where = $file_consts[$whence]; + + return setFilePointer($self->win32_handle, $pos, $from_where); +} + +sub TELL { +# SetFilePointer with position 0 at FILE_CURRENT will return position. + return $_[0]->SEEK(0, 1); +} + +sub EOF { + my $self = shift; + + my $current = $self->TELL() + 0; + my $end = getFileSize($self->win32_handle) + 0; + + return $current == $end; +} + +sub CLOSE { + my $self = shift; + + my $retval = 1; + + if (defined $self->win32_handle) { + $retval = CloseHandle($self->win32_handle); + + $self->win32_handle(undef); + } + + return $retval; +} + +# Only close the handle on explicit close, too many problems otherwise. +sub UNTIE {} + +sub DESTROY {} + +# End of Tie/OO Interface + +# Autoload methods go after =cut, and are processed by the autosplit program. + +1; +__END__ + +=head1 NAME + +Win32API::File - Low-level access to Win32 system API calls for files/dirs. + +=head1 SYNOPSIS + + use Win32API::File 0.08 qw( :ALL ); + + MoveFile( $Source, $Destination ) + or die "Can't move $Source to $Destination: ",fileLastError(),"\n"; + MoveFileEx( $Source, $Destination, MOVEFILE_REPLACE_EXISTING() ) + or die "Can't move $Source to $Destination: ",fileLastError(),"\n"; + [...] + +=head1 DESCRIPTION + +This provides fairly low-level access to the Win32 System API +calls dealing with files and directories. + +To pass in C<NULL> as the pointer to an optional buffer, pass in +an empty list reference, C<[]>. + +Beyond raw access to the API calls and related constants, this module +handles smart buffer allocation and translation of return codes. + +All functions, unless otherwise noted, return a true value for success +and a false value for failure and set C<$^E> on failure. + +=head2 Object Oriented/Tied Handle Interface + +WARNING: this is new code, use at your own risk. + +This version of C<Win32API::File> can be used like an C<IO::File> object: + + my $file = new Win32API::File "+> foo"; + binmode $file; + print $file "hello there\n"; + seek $file, 0, 0; + my $line = <$file>; + $file->close; + +It also supports tying via a win32 handle (for example, from C<createFile()>): + + tie FILE, 'Win32API::File', $win32_handle; + print FILE "..."; + +It has not been extensively tested yet and buffered I/O is not yet implemented. + +=head2 Exports + +Nothing is exported by default. The following tags can be used to +have large sets of symbols exported: C<":Func">, C<":FuncA">, +C<":FuncW">, C<":Misc">, C<":DDD_">, C<":DRIVE_">, C<":FILE_">, +C<":FILE_ATTRIBUTE_">, C<":FILE_FLAG_">, C<":FILE_SHARE_">, +C<":FILE_TYPE_">, C<":FS_">, C<":FSCTL_">, C<":HANDLE_FLAG_">, +C<":IOCTL_STORAGE_">, C<":IOCTL_DISK_">, C<":GENERIC_">, +C<":MEDIA_TYPE">, C<":MOVEFILE_">, C<":SECURITY_">, C<":SEM_">, +and C<":PARTITION_">. + +=over + +=item C<":Func"> + +The basic function names: C<attrLetsToBits>, C<createFile>, +C<fileConstant>, C<fileLastError>, C<getLogicalDrives>, +C<setFilePointer>, C<getFileSize>, +C<CloseHandle>, C<CopyFile>, C<CreateFile>, +C<DefineDosDevice>, C<DeleteFile>, C<DeviceIoControl>, +C<FdGetOsFHandle>, C<GetDriveType>, C<GetFileAttributes>, +C<GetFileSize>, C<GetFileType>, C<GetHandleInformation>, +C<GetLogicalDrives>, C<GetLogicalDriveStrings>, C<GetOsFHandle>, +C<GetOverlappedResult>, C<GetVolumeInformation>, C<IsContainerPartition>, +C<IsRecognizedPartition>, C<MoveFile>, C<MoveFileEx>, +C<OsFHandleOpen>, C<OsFHandleOpenFd>, C<QueryDosDevice>, +C<ReadFile>, C<SetErrorMode>, C<SetFilePointer>, +C<SetHandleInformation>, and C<WriteFile>. + +=over + +=item attrLetsToBits + +=item C<$uBits= attrLetsToBits( $sAttributeLetters )> + +Converts a string of file attribute letters into an unsigned value with +the corresponding bits set. C<$sAttributeLetters> should contain zero +or more letters from C<"achorst">: + +=over + +=item C<"a"> + +C<FILE_ATTRIBUTE_ARCHIVE> + +=item C<"c"> + +C<FILE_ATTRIBUTE_COMPRESSED> + +=item C<"h"> + +C<FILE_ATTRIBUTE_HIDDEN> + +=item C<"o"> + +C<FILE_ATTRIBUTE_OFFLINE> + +=item C<"r"> + +C<FILE_ATTRIBUTE_READONLY> + +=item C<"s"> + +C<FILE_ATTRIBUTE_SYSTEM> + +=item C<"t"> + +C<FILE_ATTRIBUTE_TEMPORARY> + +=back + +=item createFile + +=item C<$hObject= createFile( $sPath )> + +=item C<$hObject= createFile( $sPath, $rvhvOptions )> + +=item C<$hObject= createFile( $sPath, $svAccess )> + +=item C<$hObject= createFile( $sPath, $svAccess, $rvhvOptions )> + +=item C<$hObject= createFile( $sPath, $svAccess, $svShare )> + +=item C<$hObject= createFile( $sPath, $svAccess, $svShare, $rvhvOptions )> + +This is a Perl-friendly wrapper around C<CreateFile>. + +On failure, C<$hObject> gets set to a false value and C<regLastError()> +and C<$^E> are set to the reason for the failure. Otherwise, +C<$hObject> gets set to a Win32 native file handle which is alwasy +a true value [returns C<"0 but true"> in the impossible(?) case of +the handle having a value of C<0>]. + +C<$sPath> is the path to the file [or device, etc.] to be opened. See +C<CreateFile> for more information on possible special values for +C<$sPath>. + +C<$svAccess> can be a number containing the bit mask representing +the specific type(s) of access to the file that you desire. See the +C<$uAccess> parameter to C<CreateFile> for more information on these +values. + +More likely, C<$svAccess> is a string describing the generic type of +access you desire and possibly the file creation options to use. In +this case, C<$svAccess> should contain zero or more characters from +C<"qrw"> [access desired], zero or one character each from C<"ktn"> +and C<"ce">, and optional white space. These letters stand for, +respectively, "Query access", "Read access", "Write access", "Keep if +exists", "Truncate if exists", "New file only", "Create if none", and +"Existing file only". Case is ignored. + +You can pass in C<"?"> for C<$svAccess> to have an error message +displayed summarizing its possible values. This is very handy when +doing on-the-fly programming using the Perl debugger: + + Win32API::File::createFile: $svAccess can use the following: + One or more of the following: + q -- Query access (same as 0) + r -- Read access (GENERIC_READ) + w -- Write access (GENERIC_WRITE) + At most one of the following: + k -- Keep if exists + t -- Truncate if exists + n -- New file only (fail if file already exists) + At most one of the following: + c -- Create if doesn't exist + e -- Existing file only (fail if doesn't exist) + '' is the same as 'q k e' + 'r' is the same as 'r k e' + 'w' is the same as 'w t c' + 'rw' is the same as 'rw k c' + 'rt' or 'rn' implies 'c'. + Or $access can be numeric. + +C<$svAccess> is designed to be "do what I mean", so you can skip +the rest of its explanation unless you are interested in the complex +details. Note that, if you want write access to a device, you need +to specify C<"k"> [and perhaps C<"e">, as in C<"w ke"> or C<"rw ke">] +since Win32 suggests C<OPEN_EXISTING> be used when opening a device. + +=over + +=item C<"q"> + +Stands for "Query access". This is really a no-op since you always have +query access when you open a file. You can specify C<"q"> to document +that you plan to query the file [or device, etc.]. This is especially +helpful when you don't want read nor write access since something like +C<"q"> or C<"q ke"> may be easier to understand than just C<""> or C<"ke">. + +=item C<"r"> + +Stands for "Read access". Sets the C<GENERIC_READ> bit(s) in the +C<$uAccess> that is passed to C<CreateFile>. This is the default +access if the C<$svAccess> parameter is missing [or if it is C<undef> +and C<$rvhvOptions> doesn't specify an C<"Access"> option]. + +=item C<"w"> + +Stands for "Write access". Sets the C<GENERIC_WRITE> bit(s) in the +C<$uAccess> that is passed to C<CreateFile>. + +=item C<"k"> + +Stands for "Keep if exists". If the requested file exists, then it is +opened. This is the default unless C<GENERIC_WRITE> access has been +requested but C<GENERIC_READ> access has not been requested. Contrast +with C<"t"> and C<"n">. + +=item C<"t"> + +Stands for "Truncate if exists". If the requested file exists, then +it is truncated to zero length and then opened. This is the default if +C<GENERIC_WRITE> access has been requested and C<GENERIC_READ> access +has not been requested. Contrast with C<"k"> and C<"n">. + +=item C<"n"> + +Stands for "New file only". If the requested file exists, then it is +not opened and the C<createFile> call fails. Contrast with C<"k"> and +C<"t">. Can't be used with C<"e">. + +=item C<"c"> + +Stands for "Create if none". If the requested file does not +exist, then it is created and then opened. This is the default +if C<GENERIC_WRITE> access has been requested or if C<"t"> or +C<"n"> was specified. Contrast with C<"e">. + +=item C<"e"> + +Stands for "Existing file only". If the requested file does not +exist, then nothing is opened and the C<createFile> call fails. This +is the default unless C<GENERIC_WRITE> access has been requested or +C<"t"> or C<"n"> was specified. Contrast with C<"c">. Can't be +used with C<"n">. + +=back + +The characters from C<"ktn"> and C<"ce"> are combined to determine the +what value for C<$uCreate> to pass to C<CreateFile> [unless overridden +by C<$rvhvOptions>]: + +=over + +=item C<"kc"> + +C<OPEN_ALWAYS> + +=item C<"ke"> + +C<OPEN_EXISTING> + +=item C<"tc"> + +C<TRUNCATE_EXISTING> + +=item C<"te"> + +C<CREATE_ALWAYS> + +=item C<"nc"> + +C<CREATE_NEW> + +=item C<"ne"> + +Illegal. + +=back + +C<$svShare> controls how the file is shared, that is, whether other +processes can have read, write, and/or delete access to the file while +we have it opened. C<$svShare> will usually be a string containing zero +or more characters from C<"rwd"> but can also be a numeric bit mask. + +C<"r"> sets the C<FILE_SHARE_READ> bit which allows other processes to have +read access to the file. C<"w"> sets the C<FILE_SHARE_WRITE> bit which +allows other processes to have write access to the file. C<"d"> sets the +C<FILE_SHARE_DELETE> bit which allows other processes to have delete access +to the file [ignored under Windows 95]. + +The default for C<$svShare> is C<"rw"> which provides the same sharing as +using regular perl C<open()>. + +If another process currently has read, write, and/or delete access to +the file and you don't allow that level of sharing, then your call to +C<createFile> will fail. If you requested read, write, and/or delete +access and another process already has the file open but doesn't allow +that level of sharing, then your call to C<createFile> will fail. Once +you have the file open, if another process tries to open it with read, +write, and/or delete access and you don't allow that level of sharing, +then that process won't be allowed to open the file. + +C<$rvhvOptions> is a reference to a hash where any keys must be from +the list C<qw( Access Create Share Attributes Flags Security Model )>. +The meaning of the value depends on the key name, as described below. +Any option values in C<$rvhvOptions> override the settings from +C<$svAccess> and C<$svShare> if they conflict. + +=over + +=item Flags => $uFlags + +C<$uFlags> is an unsigned value having any of the C<FILE_FLAG_*> or +C<FILE_ATTRIBUTE_*> bits set. Any C<FILE_ATTRIBUTE_*> bits set via the +C<Attributes> option are logically C<or>ed with these bits. Defaults +to C<0>. + +If opening the client side of a named pipe, then you can also specify +C<SECURITY_SQOS_PRESENT> along with one of the other C<SECURITY_*> +constants to specify the security quality of service to be used. + +=item Attributes => $sAttributes + +A string of zero or more characters from C<"achorst"> [see C<attrLetsToBits> +for more information] which are converted to C<FILE_ATTRIBUTE_*> bits to +be set in the C<$uFlags> argument passed to C<CreateFile>. + +=item Security => $pSecurityAttributes + +C<$pSecurityAttributes> should contain a C<SECURITY_ATTRIBUTES> structure +packed into a string or C<[]> [the default]. + +=item Model => $hModelFile + +C<$hModelFile> should contain a handle opened with C<GENERIC_READ> +access to a model file from which file attributes and extended attributes +are to be copied. Or C<$hModelFile> can be C<0> [the default]. + +=item Access => $sAccess + +=item Access => $uAccess + +C<$sAccess> should be a string of zero or more characters from +C<"qrw"> specifying the type of access desired: "query" or C<0>, +"read" or C<GENERIC_READ> [the default], or "write" or +C<GENERIC_WRITE>. + +C<$uAccess> should be an unsigned value containing bits set to +indicate the type of access desired. C<GENERIC_READ> is the default. + +=item Create => $sCreate + +=item Create => $uCreate + +C<$sCreate> should be a string constaing zero or one character from +C<"ktn"> and zero or one character from C<"ce">. These stand for +"Keep if exists", "Truncate if exists", "New file only", "Create if +none", and "Existing file only". These are translated into a +C<$uCreate> value. + +C<$uCreate> should be one of C<OPEN_ALWAYS>, C<OPEN_EXISTING>, +C<TRUNCATE_EXISTING>, C<CREATE_ALWAYS>, or C<CREATE_NEW>. + +=item Share => $sShare + +=item Share => $uShare + +C<$sShare> should be a string with zero or more characters from +C<"rwd"> that is translated into a C<$uShare> value. C<"rw"> is +the default. + +C<$uShare> should be an unsigned value having zero or more of the +following bits set: C<FILE_SHARE_READ>, C<FILE_SHARE_WRITE>, and +C<FILE_SHARE_DELETE>. C<FILE_SHARE_READ|FILE_SHARE_WRITE> is the +default. + +=back + +Examples: + + $hFlop= createFile( "//./A:", "r", "r" ) + or die "Can't prevent others from writing to floppy: $^E\n"; + $hDisk= createFile( "//./C:", "rw ke", "" ) + or die "Can't get exclusive access to C: $^E\n"; + $hDisk= createFile( $sFilePath, "ke", + { Access=>FILE_READ_ATTRIBUTES } ) + or die "Can't read attributes of $sFilePath: $^E\n"; + $hTemp= createFile( "$ENV{Temp}/temp.$$", "wn", "", + { Attributes=>"hst", Flags=>FILE_FLAG_DELETE_ON_CLOSE() } ) + or die "Can't create temporary file, temp.$$: $^E\n"; + +=item getLogicalDrives + +=item C<@roots= getLogicalDrives()> + +Returns the paths to the root directories of all logical drives +currently defined. This includes all types of drive lettters, such +as floppies, CD-ROMs, hard disks, and network shares. A typical +return value on a poorly equipped computer would be C<("A:\\","C:\\")>. + +=item CloseHandle + +=item C<CloseHandle( $hObject )> + +Closes a Win32 native handle, such as one opened via C<CreateFile>. +Like most routines, returns a true value if successful and a false +value [and sets C<$^E> and C<regLastError()>] on failure. + +=item CopyFile + +=item C<CopyFile( $sOldFileName, $sNewFileName, $bFailIfExists )> + +C<$sOldFileName> is the path to the file to be copied. +C<$sNewFileName> is the path to where the file should be copied. +Note that you can B<NOT> just specify a path to a directory in +C<$sNewFileName> to copy the file to that directory using the +same file name. + +If C<$bFailIfExists> is true and C<$sNewFileName> is the path to +a file that already exists, then C<CopyFile> will fail. If +C<$bFailIfExists> is falsea, then the copy of the C<$sOldFileNmae> +file will overwrite the C<$sNewFileName> file if it already exists. + +Like most routines, returns a true value if successful and a false +value [and sets C<$^E> and C<regLastError()>] on failure. + +=item CreateFile + +=item C<$hObject= CreateFile( $sPath, $uAccess, $uShare, $pSecAttr, $uCreate, $uFlags, $hModel )> + +On failure, C<$hObject> gets set to a false value and C<$^E> and +C<fileLastError()> are set to the reason for the failure. Otherwise, +C<$hObject> gets set to a Win32 native file handle which is always a +true value [returns C<"0 but true"> in the impossible(?) case of the +handle having a value of C<0>]. + +C<$sPath> is the path to the file [or device, etc.] to be opened. + +C<$sPath> can use C<"/"> or C<"\\"> as path delimiters and can even +mix the two. We will usually only use C<"/"> in our examples since +using C<"\\"> is usually harder to read. + +Under Windows NT, C<$sPath> can start with C<"//?/"> to allow the use +of paths longer than C<MAX_PATH> [for UNC paths, replace the leading +C<"//"> with C<"//?/UNC/">, as in C<"//?/UNC/Server/Share/Dir/File.Ext">]. + +C<$sPath> can start with C<"//./"> to indicate that the rest of the +path is the name of a "DOS device." You can use C<QueryDosDevice> +to list all current DOS devices and can add or delete them with +C<DefineDosDevice>. If you get the source-code distribution of this +module from CPAN, then it includes an example script, F<ex/ListDevs.plx> +that will list all current DOS devices and their "native" definition. +Again, note that this doesn't work under Win95 nor Win98. + +The most common such DOS devices include: + +=over + +=item C<"//./PhysicalDrive0"> + +Your entire first hard disk. Doesn't work under Windows 95. This +allows you to read or write raw sectors of your hard disk and to use +C<DeviceIoControl> to perform miscellaneous queries and operations +to the hard disk. Writing raw sectors and certain other operations +can seriously damage your files or the function of your computer. + +Locking this for exclusive access [by specifying C<0> for C<$uShare>] +doesn't prevent access to the partitions on the disk nor their file +systems. So other processes can still access any raw sectors within +a partition and can use the file system on the disk as usual. + +=item C<"//./C:"> + +Your F<C:> partition. Doesn't work under Windows 95. This allows +you to read or write raw sectors of that partition and to use +C<DeviceIoControl> to perform miscellaneous queries and operations +to the partition. Writing raw sectors and certain other operations +can seriously damage your files or the function of your computer. + +Locking this for exclusive access doesn't prevent access to the +physical drive that the partition is on so other processes can +still access the raw sectors that way. Locking this for exclusive +access B<does> prevent other processes from opening the same raw +partition and B<does> prevent access to the file system on it. It +even prevents the current process from accessing the file system +on that partition. + +=item C<"//./A:"> + +The raw floppy disk. Doesn't work under Windows 95. This allows +you to read or write raw sectors of the floppy disk and to use +C<DeviceIoControl> to perform miscellaneous queries and operations +to the floopy disk or drive. + +Locking this for exclusive access prevents all access to the floppy. + +=item C<"//./PIPE/PipeName"> + +A named pipe, created via C<CreateNamedPipe>. + +=back + +C<$uAccess> is an unsigned value with bits set indicating the +type of access desired. Usually either C<0> ["query" access], +C<GENERIC_READ>, C<GENERIC_WRITE>, C<GENERIC_READ|GENERIC_WRITE>, +or C<GENERIC_ALL>. More specific types of access can be specified, +such as C<FILE_APPEND_DATA> or C<FILE_READ_EA>. + +C<$uShare> controls how the file is shared, that is, whether other +processes can have read, write, and/or delete access to the file while +we have it opened. C<$uShare> is an unsigned value with zero or more +of these bits set: C<FILE_SHARE_READ>, C<FILE_SHARE_WRITE>, and +C<FILE_SHARE_DELETE>. + +If another process currently has read, write, and/or delete access to +the file and you don't allow that level of sharing, then your call to +C<CreateFile> will fail. If you requested read, write, and/or delete +access and another process already has the file open but doesn't allow +that level of sharing, thenn your call to C<createFile> will fail. Once +you have the file open, if another process tries to open it with read, +write, and/or delete access and you don't allow that level of sharing, +then that process won't be allowed to open the file. + +C<$pSecAttr> should either be C<[]> [for C<NULL>] or a +C<SECURITY_ATTRIBUTES> data structure packed into a string. +For example, if C<$pSecDesc> contains a C<SECURITY_DESCRIPTOR> +structure packed into a string, perhaps via: + + RegGetKeySecurity( $key, 4, $pSecDesc, 1024 ); + +then you can set C<$pSecAttr> via: + + $pSecAttr= pack( "L P i", 12, $pSecDesc, $bInheritHandle ); + +C<$uCreate> is one of the following values: C<OPEN_ALWAYS>, +C<OPEN_EXISTING>, C<TRUNCATE_EXISTING>, C<CREATE_ALWAYS>, and +C<CREATE_NEW>. + +C<$uFlags> is an unsigned value with zero or more bits set indicating +attributes to associate with the file [C<FILE_ATTRIBUTE_*> values] or +special options [C<FILE_FLAG_*> values]. + +If opening the client side of a named pipe, then you can also set +C<$uFlags> to include C<SECURITY_SQOS_PRESENT> along with one of the +other C<SECURITY_*> constants to specify the security quality of +service to be used. + +C<$hModel> is C<0> [or C<[]>, both of which mean C<NULL>] or a Win32 +native handle opened with C<GENERIC_READ> access to a model file from +which file attributes and extended attributes are to be copied if a +new file gets created. + +Examples: + + $hFlop= CreateFile( "//./A:", GENERIC_READ(), + FILE_SHARE_READ(), [], OPEN_EXISTING(), 0, [] ) + or die "Can't prevent others from writing to floppy: $^E\n"; + $hDisk= createFile( $sFilePath, FILE_READ_ATTRIBUTES(), + FILE_SHARE_READ()|FILE_SHARE_WRITE(), [], OPEN_EXISTING(), 0, [] ) + or die "Can't read attributes of $sFilePath: $^E\n"; + $hTemp= createFile( "$ENV{Temp}/temp.$$", GENERIC_WRITE(), 0, + CREATE_NEW(), FILE_FLAG_DELETE_ON_CLOSE()|attrLetsToBits("hst"), [] ) + or die "Can't create temporary file, temp.$$: $^E\n"; + +=item DefineDosDevice + +=item C<DefineDosDevice( $uFlags, $sDosDeviceName, $sTargetPath )> + +Defines a new DOS device, overrides the current definition of a DOS +device, or deletes a definition of a DOS device. Like most routines, +returns a true value if successful and a false value [and sets C<$^E> +and C<regLastError()>] on failure. + +C<$sDosDeviceName> is the name of a DOS device for which we'd like +to add or delete a definition. + +C<$uFlags> is an unsigned value with zero or more of the following +bits set: + +=over + +=item C<DDD_RAW_TARGET_PATH> + +Indicates that C<$sTargetPath> will be a raw Windows NT object name. +This usually means that C<$sTargetPath> starts with C<"\\Device\\">. +Note that you cannot use C<"/"> in place of C<"\\"> in raw target path +names. + +=item C<DDD_REMOVE_DEFINITION> + +Requests that a definition be deleted. If C<$sTargetPath> is +C<[]> [for C<NULL>], then the most recently added definition for +C<$sDosDeviceName> is removed. Otherwise the most recently added +definition matching C<$sTargetPath> is removed. + +If the last definition is removed, then the DOS device name is +also deleted. + +=item C<DDD_EXACT_MATCH_ON_REMOVE> + +When deleting a definition, this bit causes each C<$sTargetPath> to +be compared to the full-length definition when searching for the most +recently added match. If this bit is not set, then C<$sTargetPath> +only needs to match a prefix of the definition. + +=back + +C<$sTargetPath> is the DOS device's specific definition that you +wish to add or delete. For C<DDD_RAW_TARGET_PATH>, these usually +start with C<"\\Device\\">. If the C<DDD_RAW_TARGET_PATH> bit is +not set, then C<$sTargetPath> is just an ordinary path to some file +or directory, providing the functionality of the B<subst> command. + +=item DeleteFile + +=item C<DeleteFile( $sFileName )> + +Deletes the named file. Compared to Perl's C<unlink>, C<DeleteFile> +has the advantage of not deleting read-only files. For B<some> +versions of Perl, C<unlink> silently calls C<chmod> whether it needs +to or not before deleting the file so that files that you have +protected by marking them as read-only are not always protected from +Perl's C<unlink>. + +Like most routines, returns a true value if successful and a false +value [and sets C<$^E> and C<regLastError()>] on failure. + +=item DeviceIoControl + +=item C<DeviceIoControl( $hDevice, $uIoControlCode, $pInBuf, $lInBuf, $opOutBuf, $lOutBuf, $olRetBytes, $pOverlapped )> + +Requests a special operation on an I/O [input/output] device, such +as ejecting a tape or formatting a disk. Like most routines, returns +a true value if successful and a false value [and sets C<$^E> and +C<regLastError()>] on failure. + +C<$hDevice> is a Win32 native file handle to a device [return value +from C<CreateFile>]. + +C<$uIoControlCode> is an unsigned value [a C<IOCTL_*> or C<FSCTL_*> +constant] indicating the type query or other operation to be performed. + +C<$pInBuf> is C<[]> [for C<NULL>] or a data structure packed into a +string. The type of data structure depends on the C<$uIoControlCode> +value. C<$lInBuf> is C<0> or the length of the structure in +C<$pInBuf>. If C<$pInBuf> is not C<[]> and C<$lInBuf> is C<0>, then +C<$lInBuf> will automatically be set to C<length($pInBuf)> for you. + +C<$opOutBuf> is C<[]> [for C<NULL>] or will be set to contain a +returned data structure packed into a string. C<$lOutBuf> indicates +how much space to allocate in C<$opOutBuf> for C<DeviceIoControl> to +store the data structure. If C<$lOutBuf> is a number and C<$opOutBuf> +already has a buffer allocated for it that is larger than C<$lOutBuf> +bytes, then this larger buffer size will be passed to C<DeviceIoControl>. +However, you can force a specific buffer size to be passed to +C<DeviceIoControl> by prepending a C<"="> to the front of C<$lOutBuf>. + +C<$olRetBytes> is C<[]> or is a scalar to receive the number of bytes +written to C<$opOutBuf>. Even when C<$olRetBytes> is C<[]>, a valid +pointer to a C<DWORD> [and not C<NULL>] is passed to C<DeviceIoControl>. +In this case, C<[]> just means that you don't care about the value +that might be written to C<$olRetBytes>, which is usually the case +since you can usually use C<length($opOutBuf)> instead. + +C<$pOverlapped> is C<[]> or is a C<OVERLAPPED> structure packed into +a string. This is only useful if C<$hDevice> was opened with the +C<FILE_FLAG_OVERLAPPED> flag set. + +=item FdGetOsFHandle + +=item C<$hNativeHandle= FdGetOsFHandle( $ivFd )> + +C<FdGetOsFHandle> simply calls C<_get_osfhandle()>. It was renamed +to better fit in with the rest the function names of this module, +in particular to distinguish it from C<GetOsFHandle>. It takes an +integer file descriptor [as from Perl's C<fileno>] and returns the +Win32 native file handle associated with that file descriptor or +C<INVALID_HANDLE_VALUE> if C<$ivFd> is not an open file descriptor. + +When you call Perl's C<open> to set a Perl file handle [like C<STDOUT>], +Perl calls C's C<fopen> to set a stdio C<FILE *>. C's C<fopen> calls +something like Unix's C<open>, that is, Win32's C<_sopen>, to get an +integer file descriptor [where 0 is for C<STDIN>, 1 for C<STDOUT>, etc.]. +Win32's C<_sopen> calls C<CreateFile> to set a C<HANDLE>, a Win32 native +file handle. So every Perl file handle [like C<STDOUT>] has an integer +file descriptor associated with it that you can get via C<fileno>. And, +under Win32, every file descriptor has a Win32 native file handle +associated with it. C<FdGetOsFHandle> lets you get access to that. + +C<$hNativeHandle> is set to C<INVALID_HANDLE_VALUE> [and +C<lastFileError()> and C<$^E> are set] if C<FdGetOsFHandle> fails. +See also C<GetOsFHandle> which provides a friendlier interface. + +=item fileConstant + +=item C<$value= fileConstant( $sConstantName )> + +Fetch the value of a constant. Returns C<undef> if C<$sConstantName> +is not the name of a constant supported by this module. Never sets +C<$!> nor C<$^E>. + +This function is rarely used since you will usually get the value of a +constant by having that constant imported into your package by listing +the constant name in the C<use Win32API::File> statement and then +simply using the constant name in your code [perhaps followed by +C<()>]. This function is useful for verifying constant names not in +Perl code, for example, after prompting a user to type in a constant +name. + +=item fileLastError + +=item C<$svError= fileLastError();> + +=item C<fileLastError( $uError );> + +Returns the last error encountered by a routine from this module. +It is just like C<$^E> except it isn't changed by anything except +routines from this module. Ideally you could just use C<$^E>, but +current versions of Perl often overwrite C<$^E> before you get a +chance to check it and really old versions of Perl don't really +support C<$^E> under Win32. + +Just like C<$^E>, in a numeric context C<fileLastError()> returns +the numeric error value while in a string context it returns a +text description of the error [actually it returns a Perl scalar +that contains both values so C<$x= fileLastError()> causes C<$x> +to give different values in string vs. numeric contexts]. + +The last form sets the error returned by future calls to +C<fileLastError()> and should not be used often. C<$uError> must +be a numeric error code. Also returns the dual-valued version +of C<$uError>. + +=item GetDriveType + +=item C<$uDriveType= GetDriveType( $sRootPath )> + +Takes a string giving the path to the root directory of a file system +[called a "drive" because every file system is assigned a "drive letter"] +and returns an unsigned value indicating the type of drive the file +system is on. The return value should be one of: + +=over + +=item C<DRIVE_UNKNOWN> + +None of the following. + +=item C<DRIVE_NO_ROOT_DIR> + +A "drive" that does not have a file system. This can be a drive letter +that hasn't been defined or a drive letter assigned to a partition +that hasn't been formatted yet. + +=item C<DRIVE_REMOVABLE> + +A floppy diskette drive or other removable media drive, but not a CD-ROM +drive. + +=item C<DRIVE_FIXED> + +An ordinary hard disk partition. + +=item C<DRIVE_REMOTE> + +A network share. + +=item C<DRIVE_CDROM> + +A CD-ROM drive. + +=item C<DRIVE_RAMDISK> + +A "ram disk" or memory-resident virtual file system used for high-speed +access to small amounts of temporary file space. + +=back + +=item GetFileAttributes + +=item C<$uAttrs = GetFileAttributes( $sPath )> + +Takes a path string and returns an unsigned value with attribute flags. +If it fails, it returns INVALID_FILE_ATTRIBUTES, otherwise it can be +one or more of the following values: + +=over + +=item C<FILE_ATTRIBUTE_ARCHIVE> + +The file or directory is an archive file or directory. Applications use +this attribute to mark files for backup or removal. + +=item C<FILE_ATTRIBUTE_COMPRESSED> + +The file or directory is compressed. For a file, this means that all of +the data in the file is compressed. For a directory, this means that +compression is the default for newly created files and subdirectories. + +=item C<FILE_ATTRIBUTE_DEVICE> + +Reserved; do not use. + +=item C<FILE_ATTRIBUTE_DIRECTORY> + +The handle identifies a directory. + +=item C<FILE_ATTRIBUTE_ENCRYPTED> + +The file or directory is encrypted. For a file, this means that all data +streams in the file are encrypted. For a directory, this means that +encryption is the default for newly created files and subdirectories. + +=item C<FILE_ATTRIBUTE_HIDDEN> + +The file or directory is hidden. It is not included in an ordinary directory +listing. + +=item C<FILE_ATTRIBUTE_NORMAL> + +The file or directory has no other attributes set. This attribute is valid +only if used alone. + +=item C<FILE_ATTRIBUTE_NOT_CONTENT_INDEXED> + +The file will not be indexed by the content indexing service. + +=item C<FILE_ATTRIBUTE_OFFLINE> + +The data of the file is not immediately available. This attribute indicates +that the file data has been physically moved to offline storage. This +attribute is used by Remote Storage, the hierarchical storage management +software. Applications should not arbitrarily change this attribute. + +=item C<FILE_ATTRIBUTE_READONLY> + +The file or directory is read-only. Applications can read the file but cannot +write to it or delete it. In the case of a directory, applications cannot +delete it. + +=item C<FILE_ATTRIBUTE_REPARSE_POINT> + +The file or directory has an associated reparse point. + +=item C<FILE_ATTRIBUTE_SPARSE_FILE> + +The file is a sparse file. + +=item C<FILE_ATTRIBUTE_SYSTEM> + +The file or directory is part of, or is used exclusively by, the operating +system. + +=item C<FILE_ATTRIBUTE_TEMPORARY> + +The file is being used for temporary storage. File systems avoid writing +data back to mass storage if sufficient cache memory is available, because +often the application deletes the temporary file shortly after the handle is +closed. In that case, the system can entirely avoid writing the data. +Otherwise, the data will be written after the handle is closed. + +=back + +=item GetFileType + +=item C<$uFileType= GetFileType( $hFile )> + +Takes a Win32 native file handle and returns a C<FILE_TYPE_*> constant +indicating the type of the file opened on that handle: + +=over + +=item C<FILE_TYPE_UNKNOWN> + +None of the below. Often a special device. + +=item C<FILE_TYPE_DISK> + +An ordinary disk file. + +=item C<FILE_TYPE_CHAR> + +What Unix would call a "character special file", that is, a device that +works on character streams such as a printer port or a console. + +=item C<FILE_TYPE_PIPE> + +Either a named or anonymous pipe. + +=back + +=item getFileSize + +=item C<$size= getFileSize( $hFile )> + +This is a Perl-friendly wrapper for the C<GetFileSize> (below) API call. + +It takes a Win32 native file handle and returns the size in bytes. Since the +size can be a 64 bit value, on non 64 bit integer Perls the value returned will +be an object of type C<Math::BigInt>. + +=item GetFileSize + +=item C<$iSizeLow= GetFileSize($win32Handle, $iSizeHigh)> + +Returns the size of a file pointed to by C<$win32Handle>, optionally storing +the high order 32 bits into C<$iSizeHigh> if it is not C<[]>. If $iSizeHigh is +C<[]>, a non-zero value indicates success. Otherwise, on failure the return +value will be C<0xffffffff> and C<fileLastError()> will not be C<NO_ERROR>. + +=item GetOverlappedResult + +=item C<$bRetval= GetOverlappedResult( $win32Handle, $pOverlapped, + $numBytesTransferred, $bWait )> + +Used for asynchronous IO in Win32 to get the result of a pending IO operation, +such as when a file operation returns C<ERROR_IO_PENDING>. Returns a false +value on failure. The C<$overlapped> structure and C<$numBytesTransferred> +will be modified with the results of the operation. + +As far as creating the C<$pOverlapped> structure, you are currently on your own. + +See L<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/getoverlappedresult.asp> for more information. + +=item GetLogicalDrives + +=item C<$uDriveBits= GetLogicalDrives()> + +Returns an unsigned value with one bit set for each drive letter currently +defined. If "A:" is currently a valid drive letter, then the C<1> bit +will be set in C<$uDriveBits>. If "B:" is valid, then the C<2> bit will +be set. If "Z:" is valid, then the C<2**26> [C<0x4000000>] bit will be +set. + +=item GetLogicalDriveStrings + +=item C<$olOutLength= GetLogicalDriveStrings( $lBufSize, $osBuffer )> + +For each currently defined drive letter, a C<'\0'>-terminated string +of the path to the root of its file system is constructed. All of +these strings are concatenated into a single larger string and an +extra terminating C<'\0'> is added. This larger string is returned +in C<$osBuffer>. Note that this includes drive letters that have +been defined but that have no file system, such as drive letters +assigned to unformatted partitions. + +C<$lBufSize> is the size of the buffer to allocate to store this +list of strings. C<26*4+1> is always sufficient and should usually +be used. + +C<$osBuffer> is a scalar to be set to contain the constructed string. + +C<$olOutLength> is the number of bytes actually written to C<$osBuffer> +but C<length($osBuffer)> can also be used to determine this. + +For example, on a poorly equipped computer, + + GetLogicalDriveStrings( 4*26+1, $osBuffer ); + +might set C<$osBuffer> to the 9-character string, C<"A:\\\0C:\\\0\0">. + +=item GetHandleInformation + +=item C<GetHandleInformation( $hObject, $ouFlags )> + +Retrieves the flags associated with a Win32 native file handle or object +handle. + +C<$hObject> is an open Win32 native file handle or an open Win32 native +handle to some other type of object. + +C<$ouFlags> will be set to an unsigned value having zero or more of +the bits C<HANDLE_FLAG_INHERIT> and C<HANDLE_FLAG_PROTECT_FROM_CLOSE> +set. See the C<":HANDLE_FLAG_"> export class for the meanings of these +bits. + +=item GetOsFHandle + +=item C<$hNativeHandle= GetOsFHandle( FILE )> + +Takes a Perl file handle [like C<STDIN>] and returns the Win32 native +file handle associated with it. See C<FdGetOsFHandle> for more +information about Win32 native file handles. + +C<$hNativeHandle> is set to a false value [and C<lastFileError()> and +C<$^E> are set] if C<GetOsFHandle> fails. C<GetOsFHandle> returns +C<"0 but true"> in the impossible(?) case of the handle having a value +of C<0>. + +=item GetVolumeInformation + +=item C<GetVolumeInformation( $sRootPath, $osVolName, $lVolName, $ouSerialNum, $ouMaxNameLen, $ouFsFlags, $osFsType, $lFsType )> + +Gets information about a file system volume, returning a true +value if successful. On failure, returns a false value and sets +C<fileLastError()> and C<$^E>. + +C<$sRootPath> is a string specifying the path to the root of the file system, +for example, C<"C:/">. + +C<$osVolName> is a scalar to be set to the string representing the +volume name, also called the file system label. C<$lVolName> is the +number of bytes to allocate for the C<$osVolName> buffer [see +L<Buffer Sizes> for more information]. + +C<$ouSerialNum> is C<[]> [for C<NULL>] or will be set to the numeric +value of the volume's serial number. + +C<$ouMaxNameLen> is C<[]> [for C<NULL>] or will be set to the maximum +length allowed for a file name or directory name within the file system. + +C<$osFsType> is a scalar to be set to the string representing the +file system type, such as C<"FAT"> or C<"NTFS">. C<$lFsType> is the +number of bytes to allocate for the C<$osFsType> buffer [see +L<Buffer Sizes> for more information]. + +C<$ouFsFlags> is C<[]> [for C<NULL>] or will be set to an unsigned integer +with bits set indicating properties of the file system: + +=over + +=item C<FS_CASE_IS_PRESERVED> + +The file system preserves the case of file names [usually true]. +That is, it doesn't change the case of file names such as forcing +them to upper- or lower-case. + +=item C<FS_CASE_SENSITIVE> + +The file system supports the ability to not ignore the case of file +names [but might ignore case the way you are using it]. That is, the +file system has the ability to force you to get the letter case of a +file's name exactly right to be able to open it. This is true for +"NTFS" file systems, even though case in file names is usually still +ignored. + +=item C<FS_UNICODE_STORED_ON_DISK> + +The file system preserves Unicode in file names [true for "NTFS"]. + +=item C<FS_PERSISTENT_ACLS> + +The file system supports setting Access Control Lists on files [true +for "NTFS"]. + +=item C<FS_FILE_COMPRESSION> + +The file system supports compression on a per-file basis [true for +"NTFS"]. + +=item C<FS_VOL_IS_COMPRESSED> + +The entire file system is compressed such as via "DoubleSpace". + +=back + +=item IsRecognizedPartition + +=item C<IsRecognizedPartition( $ivPartitionType )> + +Takes a partition type and returns whether that partition type is +supported under Win32. C<$ivPartitonType> is an integer value as from +the operating system byte of a hard disk's DOS-compatible partition +table [that is, a partition table for x86-based Win32, not, for +example, one used with Windows NT for Alpha processors]. For example, +the C<PartitionType> member of the C<PARTITION_INFORMATION> structure. + +Common values for C<$ivPartitionType> include C<PARTITION_FAT_12==1>, +C<PARTITION_FAT_16==4>, C<PARTITION_EXTENDED==5>, C<PARTITION_FAT32==0xB>. + +=item IsContainerPartition + +=item C<IsContainerPartition( $ivPartitionType )> + +Takes a partition type and returns whether that partition is a +"container" partition that is supported under Win32, that is, whether +it is an "extended" partition that can contain "logical" partitions. +C<$ivPartitonType> is as for C<IsRecognizedPartition>. + +=item MoveFile + +=item C<MoveFile( $sOldName, $sNewName )> + +Renames a file or directory. C<$sOldName> is the name of the existing +file or directory that is to be renamed. C<$sNewName> is the new name +to give the file or directory. Returns a true value if the move +succeeds. For failure, returns a false value and sets +C<fileLastErorr()> and C<$^E> to the reason for the failure. + +Files can be "renamed" between file systems and the file contents and +some attributes will be moved. Directories can only be renamed within +one file system. If there is already a file or directory named +C<$sNewName>, then C<MoveFile> will fail. + +=item MoveFileEx + +=item C<MoveFileEx( $sOldName, $sNewName, $uFlags )> + +Renames a file or directory. C<$sOldName> is the name of the existing +file or directory that is to be renamed. C<$sNewName> is the new name +to give the file or directory. Returns a true value if the move +succeeds. For failure, returns a false value and sets +C<fileLastErorr()> and C<$^E> to the reason for the failure. + +C<$uFlags> is an unsigned value with zero or more of the following bits set: + +=over + +=item C<MOVEFILE_REPLACE_EXISTING> + +If this bit is set and a file [but not a directory] named C<$sNewName> +already exists, then it will be replaced by C<$sOldName>. If this bit +is not set then C<MoveFileEx> will fail rather than replace an existing +C<$sNewName>. + +=item C<MOVEFILE_COPY_ALLOWED> + +Allows files [but not directories] to be moved between file systems +by copying the C<$sOldName> file data and some attributes to +C<$sNewName> and then deleting C<$sOldName>. If this bit is not set +[or if C<$sOldName> denotes a directory] and C<$sNewName> refers to a +different file system than C<$sOldName>, then C<MoveFileEx> will fail. + +=item C<MOVEFILE_DELAY_UNTIL_REBOOT> + +Preliminary verifications are made and then an entry is added to the +Registry to cause the rename [or delete] operation to be done the +next time this copy of the operating system is booted [right after +any automatic file system checks have completed]. This is not +supported under Windows 95. + +When this bit is set, C<$sNewName> can be C<[]> [for C<NULL>] to +indicate that C<$sOldName> should be deleted during the next boot +rather than renamed. + +Setting both the C<MOVEFILE_COPY_ALLOWED> and +C<MOVEFILE_DELAY_UNTIL_REBOOT> bits will cause C<MoveFileEx> to fail. + +=item C<MOVEFILE_WRITE_THROUGH> + +Ensures that C<MoveFileEx> won't return until the operation has +finished and been flushed to disk. This is not supported under +Windows 95. Only affects file renames to another file system, +forcing a buffer flush at the end of the copy operation. + +=back + +=item OsFHandleOpen + +=item C<OsFHandleOpen( FILE, $hNativeHandle, $sMode )> + +Opens a Perl file handle based on an already open Win32 native +file handle [much like C's C<fdopen()> does with a file descriptor]. +Returns a true value if the open operation succeeded. For failure, +returns a false value and sets C<$!> [and possibly C<fileLastError()> +and C<$^E>] to the reason for the failure. + +C<FILE> is a Perl file handle [in any of the supported forms, a +bareword, a string, a typeglob, or a reference to a typeglob] that +will be opened. If C<FILE> is already open, it will automatically +be closed before it is reopened. + +C<$hNativeHandle> is an open Win32 native file handle, probably the +return value from C<CreateFile> or C<createFile>. + +C<$sMode> is string of zero or more letters from C<"rwatb">. These +are translated into a combination C<O_RDONLY> [C<"r">], C<O_WRONLY> +[C<"w">], C<O_RDWR> [C<"rw">], C<O_APPEND> [C<"a">], C<O_TEXT> +[C<"t">], and C<O_BINARY> [C<"b">] flags [see the L<Fcntl> module] +that is passed to C<OsFHandleOpenFd>. Currently only C<O_APPEND> +and C<O_TEXT> have any significance. + +Also, a C<"r"> and/or C<"w"> in C<$sMode> is used to decide how the +file descriptor is converted into a Perl file handle, even though this +doesn't appear to make a difference. One of the following is used: + + open( FILE, "<&=".$ivFd ) # "r" w/o "w" + open( FILE, ">&=".$ivFd ) # "w" w/o "r" + open( FILE, "+<&=".$ivFd ) # both "r" and "w" + +C<OsFHandleOpen> eventually calls the Win32-specific C routine +C<_open_osfhandle()> or Perl's "improved" version called +C<win32_open_osfhandle()>. Prior to Perl5.005, C's +C<_open_osfhandle()> is called which will fail if +C<GetFileType($hNativeHandle)> would return C<FILE_TYPE_UNKNOWN>. For +Perl5.005 and later, C<OsFHandleOpen> calls C<win32_open_osfhandle()> +from the Perl DLL which doesn't have this restriction. + +=item OsFHandleOpenFd + +=item C<$ivFD= OsFHandleOpenFd( $hNativeHandle, $uMode )> + +Opens a file descriptor [C<$ivFD>] based on an already open Win32 +native file handle, C<$hNativeHandle>. This just calls the +Win32-specific C routine C<_open_osfhandle()> or Perl's "improved" +version called C<win32_open_osfhandle()>. Prior to Perl5.005 and in Cygwin +Perl, C's C<_open_osfhandle()> is called which will fail if +C<GetFileType($hNativeHandle)> would return C<FILE_TYPE_UNKNOWN>. For +Perl5.005 and later, C<OsFHandleOpenFd> calls C<win32_open_osfhandle()> from +the Perl DLL which doesn't have this restriction. + +C<$uMode> the logical combination of zero or more C<O_*> constants +exported by the C<Fcntl> module. Currently only C<O_APPEND> and +C<O_TEXT> have any significance. + +C<$ivFD> will be non-negative if the open operation was successful. +For failure, C<-1> is returned and C<$!> [and possibly +C<fileLastError()> and C<$^E>] is set to the reason for the failure. + +=item QueryDosDevice + +=item C<$olTargetLen= QueryDosDevice( $sDosDeviceName, $osTargetPath, $lTargetBuf )> + +Looks up the definition of a given "DOS" device name, yielding the +active Windows NT native device name along with any currently dormant +definitions. + +C<$sDosDeviceName> is the name of the "DOS" device whose definitions +we want. For example, C<"C:">, C<"COM1">, or C<"PhysicalDrive0">. +If C<$sDosDeviceName> is C<[]> [for C<NULL>], the list of all DOS +device names is returned instead. + +C<$osTargetPath> will be assigned a string containing the list of +definitions. The definitions are each C<'\0'>-terminate and are +concatenated into the string, most recent first, with an extra C<'\0'> +at the end of the whole string [see C<GetLogicalDriveStrings> for +a sample of this format]. + +C<$lTargetBuf> is the size [in bytes] of the buffer to allocate for +C<$osTargetPath>. See L<Buffer Sizes> for more information. + +C<$olTargetLen> is set to the number of bytes written to +C<$osTargetPath> but you can also use C<length($osTargetPath)> +to determine this. + +For failure, C<0> is returned and C<fileLastError()> and C<$^E> are +set to the reason for the failure. + +=item ReadFile + +=item C<ReadFile( $hFile, $opBuffer, $lBytes, $olBytesRead, $pOverlapped )> + +Reads bytes from a file or file-like device. Returns a true value if +the read operation was successful. For failure, returns a false value +and sets C<fileLastError()> and C<$^E> for the reason for the failure. + +C<$hFile> is a Win32 native file handle that is already open to the +file or device to read from. + +C<$opBuffer> will be set to a string containing the bytes read. + +C<$lBytes> is the number of bytes you would like to read. +C<$opBuffer> is automatically initialized to have a buffer large +enough to hold that many bytes. Unlike other buffer sizes, C<$lBytes> +does not need to have a C<"="> prepended to it to prevent a larger +value to be passed to the underlying Win32 C<ReadFile> API. However, +a leading C<"="> will be silently ignored, even if Perl warnings are +enabled. + +If C<$olBytesRead> is not C<[]>, it will be set to the actual number +of bytes read, though C<length($opBuffer)> can also be used to +determine this. + +C<$pOverlapped> is C<[]> or is a C<OVERLAPPED> structure packed +into a string. This is only useful if C<$hFile> was opened with +the C<FILE_FLAG_OVERLAPPED> flag set. + +=item SetErrorMode + +=item C<$uOldMode= SetErrorMode( $uNewMode )> + +Sets the mode controlling system error handling B<and> returns the +previous mode value. Both C<$uOldMode> and C<$uNewMode> will have +zero or more of the following bits set: + +=over + +=item C<SEM_FAILCRITICALERRORS> + +If set, indicates that when a critical error is encountered, the call +that triggered the error fails immediately. Normally this bit is not +set, which means that a critical error causes a dialogue box to appear +notifying the desktop user that some application has triggered a +critical error. The dialogue box allows the desktop user to decide +whether the critical error is returned to the process, is ignored, or +the offending operation is retried. + +This affects the C<CreateFile> and C<GetVolumeInformation> calls. + +Setting this bit is useful for allowing you to check whether a floppy +diskette is in the floppy drive. + +=item C<SEM_NOALIGNMENTFAULTEXCEPT> + +If set, this causes memory access misalignment faults to be +automatically fixed in a manner invisible to the process. This flag +is ignored on x86-based versions of Windows NT. This flag is not +supported on Windows 95. + +=item C<SEM_NOGPFAULTERRORBOX> + +If set, general protection faults do not generate a dialogue box but +can instead be handled by the process via an exception handler. This +bit should not be set by programs that don't know how to handle such +faults. + +=item C<SEM_NOOPENFILEERRORBOX> + +If set, then when an attempt to continue reading from or writing to +an already open file [usually on a removable medium like a floppy +diskette] finds the file no longer available, the call will +immediately fail. Normally this bit is not set, which means that +instead a dialogue box will appear notifying the desktop user that +some application has run into this problem. The dialogue box allows +the desktop user to decide whether the failure is returned to the +process, is ignored, or the offending operation is retried. + +This affects the C<ReadFile> and C<WriteFile> calls. + +=back + +=item setFilePointer + +=item C<$uNewPos = setFilePointer( $hFile, $ivOffset, $uFromWhere )> + +This is a perl-friendly wrapper for the SetFilePointer API (below). +C<$ivOffset> can be a 64 bit integer or C<Math::BigInt> object if your Perl +doesn't have 64 bit integers. The return value is the new offset and will +likewise be a 64 bit integer or a C<Math::BigInt> object. + +=item SetFilePointer + +=item C<$uNewPos = SetFilePointer( $hFile, $ivOffset, $ioivOffsetHigh, $uFromWhere )> + +The native Win32 version of C<seek()>. C<SetFilePointer> sets the +position within a file where the next read or write operation will +start from. + +C<$hFile> is a Win32 native file handle. + +C<$uFromWhere> is either C<FILE_BEGIN>, C<FILE_CURRENT>, or +C<FILE_END>, indicating that the new file position is being specified +relative to the beginning of the file, the current file pointer, or +the end of the file, respectively. + +C<$ivOffset> is [if C<$ioivOffsetHigh> is C<[]>] the offset [in bytes] +to the new file position from the position specified via +C<$uFromWhere>. If C<$ioivOffsetHigh> is not C<[]>, then C<$ivOffset> +is converted to an unsigned value to be used as the low-order 4 bytes +of the offset. + +C<$ioivOffsetHigh> can be C<[]> [for C<NULL>] to indicate that you are +only specifying a 4-byte offset and the resulting file position will +be 0xFFFFFFFE or less [just under 4GB]. Otherwise C<$ioivOfffsetHigh> +starts out with the high-order 4 bytes [signed] of the offset and gets +set to the [unsigned] high-order 4 bytes of the resulting file position. + +The underlying C<SetFilePointer> returns C<0xFFFFFFFF> to indicate +failure, but if C<$ioivOffsetHigh> is not C<[]>, you would also have +to check C<$^E> to determine whether C<0xFFFFFFFF> indicates an error +or not. C<Win32API::File::SetFilePointer> does this checking for you +and returns a false value if and only if the underlying +C<SetFilePointer> failed. For this reason, C<$uNewPos> is set to +C<"0 but true"> if you set the file pointer to the beginning of the +file [or any position with 0 for the low-order 4 bytes]. + +So the return value will be true if the seek operation was successful. +For failure, a false value is returned and C<fileLastError()> and +C<$^E> are set to the reason for the failure. + +=item SetHandleInformation + +=item C<SetHandleInformation( $hObject, $uMask, $uFlags )> + +Sets the flags associated with a Win32 native file handle or object +handle. Returns a true value if the operation was successful. For +failure, returns a false value and sets C<fileLastError()> and C<$^E> +for the reason for the failure. + +C<$hObject> is an open Win32 native file handle or an open Win32 native +handle to some other type of object. + +C<$uMask> is an unsigned value having one or more of the bits +C<HANDLE_FLAG_INHERIT> and C<HANDLE_FLAG_PROTECT_FROM_CLOSE> set. +Only bits set in C<$uMask> will be modified by C<SetHandleInformation>. + +C<$uFlags> is an unsigned value having zero or more of the bits +C<HANDLE_FLAG_INHERIT> and C<HANDLE_FLAG_PROTECT_FROM_CLOSE> set. +For each bit set in C<$uMask>, the cooresponding bit in the handle's +flags is set to the value of the cooresponding bit in C<$uFlags>. + +If C<$uOldFlags> were the value of the handle's flags before the +call to C<SetHandleInformation>, then the value of the handle's +flags afterward would be: + + ( $uOldFlags & ~$uMask ) | ( $uFlags & $uMask ) + +[at least as far as the C<HANDLE_FLAG_INHERIT> and +C<HANDLE_FLAG_PROTECT_FROM_CLOSE> bits are concerned.] + +See the C<":HANDLE_FLAG_"> export class for the meanings of these bits. + +=item WriteFile + +=item C<WriteFile( $hFile, $pBuffer, $lBytes, $ouBytesWritten, $pOverlapped )> + +Write bytes to a file or file-like device. Returns a true value if +the operation was successful. For failure, returns a false value and +sets C<fileLastError()> and C<$^E> for the reason for the failure. + +C<$hFile> is a Win32 native file handle that is already open to the +file or device to be written to. + +C<$pBuffer> is a string containing the bytes to be written. + +C<$lBytes> is the number of bytes you would like to write. If +C<$pBuffer> is not at least C<$lBytes> long, C<WriteFile> croaks. You +can specify C<0> for C<$lBytes> to write C<length($pBuffer)> bytes. +A leading C<"="> on C<$lBytes> will be silently ignored, even if Perl +warnings are enabled. + +C<$ouBytesWritten> will be set to the actual number of bytes written +unless you specify it as C<[]>. + +C<$pOverlapped> is C<[]> or is an C<OVERLAPPED> structure packed +into a string. This is only useful if C<$hFile> was opened with +the C<FILE_FLAG_OVERLAPPED> flag set. + +=back + +=item C<":FuncA"> + +The ASCII-specific functions. Each of these is just the same as the +version without the trailing "A". + + CopyFileA + CreateFileA + DefineDosDeviceA + DeleteFileA + GetDriveTypeA + GetFileAttributesA + GetLogicalDriveStringsA + GetVolumeInformationA + MoveFileA + MoveFileExA + QueryDosDeviceA + +=item C<":FuncW"> + +The wide-character-specific (Unicode) functions. Each of these is +just the same as the version without the trailing "W" except that +strings are expected in Unicode and some lengths are measured as +number of C<WCHAR>s instead of number of bytes, as indicated below. + +=over + +=item CopyFileW + +=item C<CopyFileW( $swOldFileName, $swNewFileName, $bFailIfExists )> + +C<$swOldFileName> and C<$swNewFileName> are Unicode strings. + +=item CreateFileW + +=item C<$hObject= CreateFileW( $swPath, $uAccess, $uShare, $pSecAttr, $uCreate, $uFlags, $hModel )> + +C<$swPath> is Unicode. + +=item DefineDosDeviceW + +=item C<DefineDosDeviceW( $uFlags, $swDosDeviceName, $swTargetPath )> + +C<$swDosDeviceName> and C<$swTargetPath> are Unicode. + +=item DeleteFileW + +=item C<DeleteFileW( $swFileName )> + +C<$swFileName> is Unicode. + +=item GetDriveTypeW + +=item C<$uDriveType= GetDriveTypeW( $swRootPath )> + +C<$swRootPath> is Unicode. + +=item GetFileAttributesW + +=item C<$uAttrs= GetFileAttributesW( $swPath )> + +C<$swPath> is Unicode. + +=item GetLogicalDriveStringsW + +=item C<$olwOutLength= GetLogicalDriveStringsW( $lwBufSize, $oswBuffer )> + +Unicode is stored in C<$oswBuffer>. C<$lwBufSize> and C<$olwOutLength> +are measured as number of C<WCHAR>s. + +=item GetVolumeInformationW + +=item C<GetVolumeInformationW( $swRootPath, $oswVolName, $lwVolName, $ouSerialNum, $ouMaxNameLen, $ouFsFlags, $oswFsType, $lwFsType )> + +C<$swRootPath> is Unicode and Unicode is written to C<$oswVolName> and +C<$oswFsType>. C<$lwVolName> and C<$lwFsType> are measures as number +of C<WCHAR>s. + +=item MoveFileW + +=item C<MoveFileW( $swOldName, $swNewName )> + +C<$swOldName> and C<$swNewName> are Unicode. + +=item MoveFileExW + +=item C<MoveFileExW( $swOldName, $swNewName, $uFlags )> + +C<$swOldName> and C<$swNewName> are Unicode. + +=item QueryDosDeviceW + +=item C<$olwTargetLen= QueryDosDeviceW( $swDeviceName, $oswTargetPath, $lwTargetBuf )> + +C<$swDeviceName> is Unicode and Unicode is written to +C<$oswTargetPath>. C<$lwTargetBuf> and C<$olwTargetLen> are measured +as number of C<WCHAR>s. + +=back + +=item C<":Misc"> + +Miscellaneous constants. Used for the C<$uCreate> argument of +C<CreateFile> or the C<$uFromWhere> argument of C<SetFilePointer>. +Plus C<INVALID_HANDLE_VALUE>, which you usually won't need to check +for since most routines translate it into a false value. + + CREATE_ALWAYS CREATE_NEW OPEN_ALWAYS + OPEN_EXISTING TRUNCATE_EXISTING INVALID_HANDLE_VALUE + FILE_BEGIN FILE_CURRENT FILE_END + +=item C<":DDD_"> + +Constants for the C<$uFlags> argument of C<DefineDosDevice>. + + DDD_EXACT_MATCH_ON_REMOVE + DDD_RAW_TARGET_PATH + DDD_REMOVE_DEFINITION + +=item C<":DRIVE_"> + +Constants returned by C<GetDriveType>. + + DRIVE_UNKNOWN DRIVE_NO_ROOT_DIR DRIVE_REMOVABLE + DRIVE_FIXED DRIVE_REMOTE DRIVE_CDROM + DRIVE_RAMDISK + +=item C<":FILE_"> + +Specific types of access to files that can be requested via the +C<$uAccess> argument to C<CreateFile>. + + FILE_READ_DATA FILE_LIST_DIRECTORY + FILE_WRITE_DATA FILE_ADD_FILE + FILE_APPEND_DATA FILE_ADD_SUBDIRECTORY + FILE_CREATE_PIPE_INSTANCE FILE_READ_EA + FILE_WRITE_EA FILE_EXECUTE + FILE_TRAVERSE FILE_DELETE_CHILD + FILE_READ_ATTRIBUTES FILE_WRITE_ATTRIBUTES + FILE_ALL_ACCESS FILE_GENERIC_READ + FILE_GENERIC_WRITE FILE_GENERIC_EXECUTE )], + +=item C<":FILE_ATTRIBUTE_"> + +File attribute constants. Returned by C<attrLetsToBits> and used in +the C<$uFlags> argument to C<CreateFile>. + + FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_COMPRESSED + FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL + FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY + FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY + +In addition, C<GetFileAttributes> can return these constants (or +INVALID_FILE_ATTRIBUTES in case of an error). + + FILE_ATTRIBUTE_DEVICE FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_ENCRYPTED FILE_ATTRIBUTE_NOT_CONTENT_INDEXED + FILE_ATTRIBUTE_REPARSE_POINT FILE_ATTRIBUTE_SPARSE_FILE + +=item C<":FILE_FLAG_"> + +File option flag constants. Used in the C<$uFlags> argument to +C<CreateFile>. + + FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_DELETE_ON_CLOSE + FILE_FLAG_NO_BUFFERING FILE_FLAG_OVERLAPPED + FILE_FLAG_POSIX_SEMANTICS FILE_FLAG_RANDOM_ACCESS + FILE_FLAG_SEQUENTIAL_SCAN FILE_FLAG_WRITE_THROUGH + FILE_FLAG_OPEN_REPARSE_POINT + +=item C<":FILE_SHARE_"> + +File sharing constants. Used in the C<$uShare> argument to +C<CreateFile>. + + FILE_SHARE_DELETE FILE_SHARE_READ FILE_SHARE_WRITE + +=item C<":FILE_TYPE_"> + +File type constants. Returned by C<GetFileType>. + + FILE_TYPE_CHAR FILE_TYPE_DISK + FILE_TYPE_PIPE FILE_TYPE_UNKNOWN + +=item C<":FS_"> + +File system characteristics constants. Placed in the C<$ouFsFlags> +argument to C<GetVolumeInformation>. + + FS_CASE_IS_PRESERVED FS_CASE_SENSITIVE + FS_UNICODE_STORED_ON_DISK FS_PERSISTENT_ACLS + FS_FILE_COMPRESSION FS_VOL_IS_COMPRESSED + +=item C<":HANDLE_FLAG_"> + +Flag bits modifying the behavior of an object handle and accessed via +C<GetHandleInformation> and C<SetHandleInformation>. + +=over + +=item HANDLE_FLAG_INHERIT + +If this bit is set, then children of this process who inherit handles +[that is, processes created by calls to the Win32 C<CreateProcess> API +with the C<bInheritHandles> parameter specified as C<TRUE>], will inherit +this particular object handle. + +=item HANDLE_FLAG_PROTECT_FROM_CLOSE + +If this bit is set, then calls to C<CloseHandle> against this handle +will be ignored, leaving the handle open and usable. + +=back + +=item C<":IOCTL_STORAGE_"> + +I/O control operations for generic storage devices. Used in the +C<$uIoControlCode> argument to C<DeviceIoControl>. Includes +C<IOCTL_STORAGE_CHECK_VERIFY>, C<IOCTL_STORAGE_MEDIA_REMOVAL>, +C<IOCTL_STORAGE_EJECT_MEDIA>, C<IOCTL_STORAGE_LOAD_MEDIA>, +C<IOCTL_STORAGE_RESERVE>, C<IOCTL_STORAGE_RELEASE>, +C<IOCTL_STORAGE_FIND_NEW_DEVICES>, and +C<IOCTL_STORAGE_GET_MEDIA_TYPES>. + +=over + +=item C<IOCTL_STORAGE_CHECK_VERIFY> + +Verify that a device's media is accessible. C<$pInBuf> and C<$opOutBuf> +should both be C<[]>. If C<DeviceIoControl> returns a true value, then +the media is currently accessible. + +=item C<IOCTL_STORAGE_MEDIA_REMOVAL> + +Allows the device's media to be locked or unlocked. C<$opOutBuf> should +be C<[]>. C<$pInBuf> should be a C<PREVENT_MEDIA_REMOVAL> data structure, +which is simply an interger containing a boolean value: + + $pInBuf= pack( "i", $bPreventMediaRemoval ); + +=item C<IOCTL_STORAGE_EJECT_MEDIA> + +Requests that the device eject the media. C<$pInBuf> and C<$opOutBuf> +should both be C<[]>. + +=item C<IOCTL_STORAGE_LOAD_MEDIA> + +Requests that the device load the media. C<$pInBuf> and C<$opOutBuf> +should both be C<[]>. + +=item C<IOCTL_STORAGE_RESERVE> + +Requests that the device be reserved. C<$pInBuf> and C<$opOutBuf> +should both be C<[]>. + +=item C<IOCTL_STORAGE_RELEASE> + +Releases a previous device reservation. C<$pInBuf> and C<$opOutBuf> +should both be C<[]>. + +=item C<IOCTL_STORAGE_FIND_NEW_DEVICES> + +No documentation on this IOCTL operation was found. + +=item C<IOCTL_STORAGE_GET_MEDIA_TYPES> + +Requests information about the type of media supported by the device. +C<$pInBuf> should be C<[]>. C<$opOutBuf> will be set to contain a +vector of C<DISK_GEOMETRY> data structures, which can be decoded via: + + # Calculate the number of DISK_GEOMETRY structures returned: + my $cStructs= length($opOutBuf)/(4+4+4+4+4+4); + my @fields= unpack( "L l I L L L" x $cStructs, $opOutBuf ) + my( @ucCylsLow, @ivcCylsHigh, @uMediaType, @uTracksPerCyl, + @uSectsPerTrack, @uBytesPerSect )= (); + while( @fields ) { + push( @ucCylsLow, unshift @fields ); + push( @ivcCylsHigh, unshift @fields ); + push( @uMediaType, unshift @fields ); + push( @uTracksPerCyl, unshift @fields ); + push( @uSectsPerTrack, unshift @fields ); + push( @uBytesPerSect, unshift @fields ); + } + +For the C<$i>th type of supported media, the following variables will +contain the following data. + +=over + +=item C<$ucCylsLow[$i]> + +The low-order 4 bytes of the total number of cylinders. + +=item C<$ivcCylsHigh[$i]> + +The high-order 4 bytes of the total number of cylinders. + +=item C<$uMediaType[$i]> + +A code for the type of media. See the C<":MEDIA_TYPE"> export class. + +=item C<$uTracksPerCyl[$i]> + +The number of tracks in each cylinder. + +=item C<$uSectsPerTrack[$i]> + +The number of sectors in each track. + +=item C<$uBytesPerSect[$i]> + +The number of bytes in each sector. + +=back + +=back + +=item C<":IOCTL_DISK_"> + +I/O control operations for disk devices. Used in the C<$uIoControlCode> +argument to C<DeviceIoControl>. Most of these are to be used on +physical drive devices like C<"//./PhysicalDrive0">. However, +C<IOCTL_DISK_GET_PARTITION_INFO> and C<IOCTL_DISK_SET_PARTITION_INFO> +should only be used on a single-partition device like C<"//./C:">. Also, +C<IOCTL_DISK_GET_MEDIA_TYPES> is documented as having been superceded but +is still useful when used on a floppy device like C<"//./A:">. + +Includes C<IOCTL_DISK_FORMAT_TRACKS>, C<IOCTL_DISK_FORMAT_TRACKS_EX>, +C<IOCTL_DISK_GET_DRIVE_GEOMETRY>, C<IOCTL_DISK_GET_DRIVE_LAYOUT>, +C<IOCTL_DISK_GET_MEDIA_TYPES>, C<IOCTL_DISK_GET_PARTITION_INFO>, +C<IOCTL_DISK_HISTOGRAM_DATA>, C<IOCTL_DISK_HISTOGRAM_RESET>, +C<IOCTL_DISK_HISTOGRAM_STRUCTURE>, C<IOCTL_DISK_IS_WRITABLE>, +C<IOCTL_DISK_LOGGING>, C<IOCTL_DISK_PERFORMANCE>, +C<IOCTL_DISK_REASSIGN_BLOCKS>, C<IOCTL_DISK_REQUEST_DATA>, +C<IOCTL_DISK_REQUEST_STRUCTURE>, C<IOCTL_DISK_SET_DRIVE_LAYOUT>, +C<IOCTL_DISK_SET_PARTITION_INFO>, and C<IOCTL_DISK_VERIFY>. + +=over + +=item C<IOCTL_DISK_GET_DRIVE_GEOMETRY> + +Request information about the size and geometry of the disk. C<$pInBuf> +should be C<[]>. C<$opOutBuf> will be set to a C<DISK_GEOMETRY> data +structure which can be decode via: + + ( $ucCylsLow, $ivcCylsHigh, $uMediaType, $uTracksPerCyl, + $uSectsPerTrack, $uBytesPerSect )= unpack( "L l I L L L", $opOutBuf ); + +=over + +=item C<$ucCylsLow> + +The low-order 4 bytes of the total number of cylinders. + +=item C<$ivcCylsHigh> + +The high-order 4 bytes of the total number of cylinders. + +=item C<$uMediaType> + +A code for the type of media. See the C<":MEDIA_TYPE"> export class. + +=item C<$uTracksPerCyl> + +The number of tracks in each cylinder. + +=item C<$uSectsPerTrack> + +The number of sectors in each track. + +=item C<$uBytesPerSect> + +The number of bytes in each sector. + +=back + +=item C<IOCTL_DISK_GET_PARTITION_INFO> + +Request information about the size and geometry of the partition. +C<$pInBuf> should be C<[]>. C<$opOutBuf> will be set to a +C<PARTITION_INFORMATION> data structure which can be decode via: + + ( $uStartLow, $ivStartHigh, $ucHiddenSects, $uPartitionSeqNumber, + $uPartitionType, $bActive, $bRecognized, $bToRewrite )= + unpack( "L l L L C c c c", $opOutBuf ); + +=over + +=item C<$uStartLow> and C<$ivStartHigh> + +The low-order and high-order [respectively] 4 bytes of the starting +offset of the partition, measured in bytes. + +=item C<$ucHiddenSects> + +The number of "hidden" sectors for this partition. Actually this is +the number of sectors found prior to this partiton, that is, the +starting offset [as found in C<$uStartLow> and C<$ivStartHigh>] +divided by the number of bytes per sector. + +=item C<$uPartitionSeqNumber> + +The sequence number of this partition. Partitions are numbered +starting as C<1> [with "partition 0" meaning the entire disk]. +Sometimes this field may be C<0> and you'll have to infer the +partition sequence number from how many partitions preceed it on +the disk. + +=item C<$uPartitionType> + +The type of partition. See the C<":PARTITION_"> export class for a +list of known types. See also C<IsRecognizedPartition> and +C<IsContainerPartition>. + +=item C<$bActive> + +C<1> for the active [boot] partition, C<0> otherwise. + +=item C<$bRecognized> + +Whether this type of partition is support under Win32. + +=item C<$bToRewrite> + +Whether to update this partition information. This field is not used +by C<IOCTL_DISK_GET_PARTITION_INFO>. For +C<IOCTL_DISK_SET_DRIVE_LAYOUT>, you must set this field to a true +value for any partitions you wish to have changed, added, or deleted. + +=back + +=item C<IOCTL_DISK_SET_PARTITION_INFO> + +Change the type of the partition. C<$opOutBuf> should be C<[]>. +C<$pInBuf> should be a C<SET_PARTITION_INFORMATION> data structure +which is just a single byte containing the new parition type [see +the C<":PARTITION_"> export class for a list of known types]: + + $pInBuf= pack( "C", $uPartitionType ); + +=item C<IOCTL_DISK_GET_DRIVE_LAYOUT> + +Request information about the disk layout. C<$pInBuf> should be C<[]>. +C<$opOutBuf> will be set to contain C<DRIVE_LAYOUT_INFORMATION> +structure including several C<PARTITION_INFORMATION> structures: + + my( $cPartitions, $uDiskSignature )= unpack( "L L", $opOutBuf ); + my @fields= unpack( "x8" . ( "L l L L C c c c" x $cPartitions ), + $opOutBuf ); + my( @uStartLow, @ivStartHigh, @ucHiddenSects, + @uPartitionSeqNumber, @uPartitionType, @bActive, + @bRecognized, @bToRewrite )= (); + for( 1..$cPartition ) { + push( @uStartLow, unshift @fields ); + push( @ivStartHigh, unshift @fields ); + push( @ucHiddenSects, unshift @fields ); + push( @uPartitionSeqNumber, unshift @fields ); + push( @uPartitionType, unshift @fields ); + push( @bActive, unshift @fields ); + push( @bRecognized, unshift @fields ); + push( @bToRewrite, unshift @fields ); + } + +=over + +=item C<$cPartitions> + +If the number of partitions on the disk. + +=item C<$uDiskSignature> + +Is the disk signature, a unique number assigned by Disk Administrator +[F<WinDisk.exe>] and used to identify the disk. This allows drive +letters for partitions on that disk to remain constant even if the +SCSI Target ID of the disk gets changed. + +=back + +See C<IOCTL_DISK_GET_PARTITION_INFORMATION> for information on the +remaining these fields. + +=item C<IOCTL_DISK_GET_MEDIA_TYPES> + +Is supposed to be superseded by C<IOCTL_STORAGE_GET_MEDIA_TYPES> but +is still useful for determining the types of floppy diskette formats +that can be produced by a given floppy drive. See +F<ex/FormatFloppy.plx> for an example. + +=item C<IOCTL_DISK_SET_DRIVE_LAYOUT> + +Change the partition layout of the disk. C<$pOutBuf> should be C<[]>. +C<$pInBuf> should be a C<DISK_LAYOUT_INFORMATION> data structure +including several C<PARTITION_INFORMATION> data structures. + + # Already set: $cPartitions, $uDiskSignature, @uStartLow, @ivStartHigh, + # @ucHiddenSects, @uPartitionSeqNumber, @uPartitionType, @bActive, + # @bRecognized, and @bToRewrite. + my( @fields, $prtn )= (); + for $prtn ( 1..$cPartition ) { + push( @fields, $uStartLow[$prtn-1], $ivStartHigh[$prtn-1], + $ucHiddenSects[$prtn-1], $uPartitionSeqNumber[$prtn-1], + $uPartitionType[$prtn-1], $bActive[$prtn-1], + $bRecognized[$prtn-1], $bToRewrite[$prtn-1] ); + } + $pInBuf= pack( "L L" . ( "L l L L C c c c" x $cPartitions ), + $cPartitions, $uDiskSignature, @fields ); + +To delete a partition, zero out all fields except for C<$bToRewrite> +which should be set to C<1>. To add a partition, increment +C<$cPartitions> and add the information for the new partition +into the arrays, making sure that you insert C<1> into @bToRewrite. + +See C<IOCTL_DISK_GET_DRIVE_LAYOUT> and +C<IOCTL_DISK_GET_PARITITON_INFORMATION> for descriptions of the +fields. + +=item C<IOCTL_DISK_VERIFY> + +Performs a logical format of [part of] the disk. C<$opOutBuf> should +be C<[]>. C<$pInBuf> should contain a C<VERIFY_INFORMATION> data +structure: + + $pInBuf= pack( "L l L", + $uStartOffsetLow, $ivStartOffsetHigh, $uLength ); + +=over + +=item C<$uStartOffsetLow> and C<$ivStartOffsetHigh> + +The low-order and high-order [respectively] 4 bytes of the offset [in +bytes] where the formatting should begin. + +=item C<$uLength> + +The length [in bytes] of the section to be formatted. + +=back + +=item C<IOCTL_DISK_FORMAT_TRACKS> + +Format a range of tracks on the disk. C<$opOutBuf> should be C<[]>. +C<$pInBuf> should contain a C<FORMAT_PARAMETERS> data structure: + + $pInBuf= pack( "L L L L L", $uMediaType, + $uStartCyl, $uEndCyl, $uStartHead, $uEndHead ); + +C<$uMediaType> if the type of media to be formatted. Mostly used to +specify the density to use when formatting a floppy diskette. See the +C<":MEDIA_TYPE"> export class for more information. + +The remaining fields specify the starting and ending cylinder and +head of the range of tracks to be formatted. + +=item C<IOCTL_DISK_REASSIGN_BLOCKS> + +Reassign a list of disk blocks to the disk's spare-block pool. +C<$opOutBuf> should be C<[]>. C<$pInBuf> should be a +C<REASSIGN_BLOCKS> data structure: + + $pInBuf= pack( "S S L*", 0, $cBlocks, @uBlockNumbers ); + +=item C<IOCTL_DISK_PERFORMANCE> + +Request information about disk performance. C<$pInBuf> should be C<[]>. +C<$opOutBuf> will be set to contain a C<DISK_PERFORMANCE> data structure: + + my( $ucBytesReadLow, $ivcBytesReadHigh, + $ucBytesWrittenLow, $ivcBytesWrittenHigh, + $uReadTimeLow, $ivReadTimeHigh, + $uWriteTimeLow, $ivWriteTimeHigh, + $ucReads, $ucWrites, $uQueueDepth )= + unpack( "L l L l L l L l L L L", $opOutBuf ); + +=item C<IOCTL_DISK_IS_WRITABLE> + +No documentation on this IOCTL operation was found. + +=item C<IOCTL_DISK_LOGGING> + +Control disk logging. Little documentation for this IOCTL operation +was found. It makes use of a C<DISK_LOGGING> data structure: + +=over + +=item DISK_LOGGING_START + +Start logging each disk request in a buffer internal to the disk device +driver of size C<$uLogBufferSize>: + + $pInBuf= pack( "C L L", 0, 0, $uLogBufferSize ); + +=item DISK_LOGGING_STOP + +Stop loggin each disk request: + + $pInBuf= pack( "C L L", 1, 0, 0 ); + +=item DISK_LOGGING_DUMP + +Copy the interal log into the supplied buffer: + + $pLogBuffer= ' ' x $uLogBufferSize + $pInBuf= pack( "C P L", 2, $pLogBuffer, $uLogBufferSize ); + + ( $uByteOffsetLow[$i], $ivByteOffsetHigh[$i], + $uStartTimeLow[$i], $ivStartTimeHigh[$i], + $uEndTimeLog[$i], $ivEndTimeHigh[$i], + $hVirtualAddress[$i], $ucBytes[$i], + $uDeviceNumber[$i], $bWasReading[$i] )= + unpack( "x".(8+8+8+4+4+1+1+2)." L l L l L l L L C c x2", $pLogBuffer ); + +=item DISK_LOGGING_BINNING + +Keep statics grouped into bins based on request sizes. + + $pInBuf= pack( "C P L", 3, $pUnknown, $uUnknownSize ); + +=back + +=item C<IOCTL_DISK_FORMAT_TRACKS_EX> + +No documentation on this IOCTL is included. + +=item C<IOCTL_DISK_HISTOGRAM_STRUCTURE> + +No documentation on this IOCTL is included. + +=item C<IOCTL_DISK_HISTOGRAM_DATA> + +No documentation on this IOCTL is included. + +=item C<IOCTL_DISK_HISTOGRAM_RESET> + +No documentation on this IOCTL is included. + +=item C<IOCTL_DISK_REQUEST_STRUCTURE> + +No documentation on this IOCTL operation was found. + +=item C<IOCTL_DISK_REQUEST_DATA> + +No documentation on this IOCTL operation was found. + +=back + +=item C<":FSCTL_"> + +File system control operations. Used in the C<$uIoControlCode> +argument to C<DeviceIoControl>. + +Includes C<FSCTL_SET_REPARSE_POINT>, C<FSCTL_GET_REPARSE_POINT>, +C<FSCTL_DELETE_REPARSE_POINT>. + +=over + +=item C<FSCTL_SET_REPARSE_POINT> + +Sets reparse point data to be associated with $hDevice. + +=item C<FSCTL_GET_REPARSE_POINT> + +Retrieves the reparse point data associated with $hDevice. + +=item C<FSCTL_DELETE_REPARSE_POINT> + +Deletes the reparse point data associated with $hDevice. + +=back + +=item C<":GENERIC_"> + +Constants specifying generic access permissions that are not specific +to one type of object. + + GENERIC_ALL GENERIC_EXECUTE + GENERIC_READ GENERIC_WRITE + +=item C<":MEDIA_TYPE"> + +Different classes of media that a device can support. Used in the +C<$uMediaType> field of a C<DISK_GEOMETRY> structure. + +=over + +=item C<Unknown> + +Format is unknown. + +=item C<F5_1Pt2_512> + +5.25" floppy, 1.2MB [really 1,200KB] total space, 512 bytes/sector. + +=item C<F3_1Pt44_512> + +3.5" floppy, 1.44MB [really 1,440KB] total space, 512 bytes/sector. + +=item C<F3_2Pt88_512> + +3.5" floppy, 2.88MB [really 2,880KB] total space, 512 bytes/sector. + +=item C<F3_20Pt8_512> + +3.5" floppy, 20.8MB total space, 512 bytes/sector. + +=item C<F3_720_512> + +3.5" floppy, 720KB total space, 512 bytes/sector. + +=item C<F5_360_512> + +5.25" floppy, 360KB total space, 512 bytes/sector. + +=item C<F5_320_512> + +5.25" floppy, 320KB total space, 512 bytes/sector. + +=item C<F5_320_1024> + +5.25" floppy, 320KB total space, 1024 bytes/sector. + +=item C<F5_180_512> + +5.25" floppy, 180KB total space, 512 bytes/sector. + +=item C<F5_160_512> + +5.25" floppy, 160KB total space, 512 bytes/sector. + +=item C<RemovableMedia> + +Some type of removable media other than a floppy diskette. + +=item C<FixedMedia> + +A fixed hard disk. + +=item C<F3_120M_512> + +3.5" floppy, 120MB total space. + +=back + +=item C<":MOVEFILE_"> + +Constants for use in C<$uFlags> arguments to C<MoveFileEx>. + + MOVEFILE_COPY_ALLOWED MOVEFILE_DELAY_UNTIL_REBOOT + MOVEFILE_REPLACE_EXISTING MOVEFILE_WRITE_THROUGH + +=item C<":SECURITY_"> + +Security quality of service values that can be used in the C<$uFlags> +argument to C<CreateFile> if opening the client side of a named pipe. + + SECURITY_ANONYMOUS SECURITY_CONTEXT_TRACKING + SECURITY_DELEGATION SECURITY_EFFECTIVE_ONLY + SECURITY_IDENTIFICATION SECURITY_IMPERSONATION + SECURITY_SQOS_PRESENT + +=item C<":SEM_"> + +Constants to be used with C<SetErrorMode>. + + SEM_FAILCRITICALERRORS SEM_NOGPFAULTERRORBOX + SEM_NOALIGNMENTFAULTEXCEPT SEM_NOOPENFILEERRORBOX + +=item C<":PARTITION_"> + +Constants describing partition types. + + PARTITION_ENTRY_UNUSED PARTITION_FAT_12 + PARTITION_XENIX_1 PARTITION_XENIX_2 + PARTITION_FAT_16 PARTITION_EXTENDED + PARTITION_HUGE PARTITION_IFS + PARTITION_FAT32 PARTITION_FAT32_XINT13 + PARTITION_XINT13 PARTITION_XINT13_EXTENDED + PARTITION_PREP PARTITION_UNIX + VALID_NTFT PARTITION_NTFT + +=item C<":ALL"> + +All of the above. + +=back + +=head1 BUGS + +None known at this time. + +=head1 AUTHOR + +Tye McQueen, tye@metronet.com, http://www.metronet.com/~tye/. + +=head1 SEE ALSO + +The pyramids. + +=cut diff --git a/win32/ext/Win32API/File/File.xs b/win32/ext/Win32API/File/File.xs new file mode 100644 index 0000000000..7dbe783c0e --- /dev/null +++ b/win32/ext/Win32API/File/File.xs @@ -0,0 +1,647 @@ +/* Win32API/File.xs */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +/*#include "patchlevel.h"*/ + +/* Uncomment the next line unless set "WRITE_PERL=>1" in Makefile.PL: */ +#define NEED_newCONSTSUB +#include "ppport.h" + +#ifdef WORD +# undef WORD +#endif + +#define WIN32_LEAN_AND_MEAN /* Tell windows.h to skip much */ +#include <windows.h> +#include <winioctl.h> + +/*CONSTS_DEFINED*/ + +#ifndef INVALID_SET_FILE_POINTER +# define INVALID_SET_FILE_POINTER ((DWORD)-1) +#endif + +#define oDWORD DWORD + +#if (PERL_REVISION <= 5 && PERL_VERSION < 5) || defined(__CYGWIN__) +# define win32_get_osfhandle _get_osfhandle +# ifdef __CYGWIN__ +# define win32_open_osfhandle(handle,mode) \ + (Perl_croak(aTHX_ "_open_osfhandle not implemented on Cygwin!"), -1) +# else +# define win32_open_osfhandle _open_osfhandle +# endif +# ifdef _get_osfhandle +# undef _get_osfhandle /* stolen_get_osfhandle() isn't available here */ +# endif +# ifdef _open_osfhandle +# undef _open_osfhandle /* stolen_open_osfhandle() isn't available here */ +# endif +#endif + +#ifndef XST_mUV +# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) +#endif + +#ifndef XSRETURN_UV +# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END +#endif + +#ifndef DEBUGGING +# define Debug(list) /*Nothing*/ +#else +# define Debug(list) ErrPrintf list +# include <stdarg.h> + static void + ErrPrintf( const char *sFmt, ... ) + { + va_list pAList; + static char *sEnv= NULL; + DWORD uErr= GetLastError(); + if( NULL == sEnv ) { + if( NULL == ( sEnv= getenv("DEBUG_WIN32API_FILE") ) ) + sEnv= ""; + } + if( '\0' == *sEnv ) + return; + va_start( pAList, sFmt ); + vfprintf( stderr, sFmt, pAList ); + va_end( pAList ); + SetLastError( uErr ); + } +#endif /* DEBUGGING */ + + +#include "buffers.h" /* Include this after DEBUGGING setup finished */ + +static LONG uLastFileErr= 0; + +static void +SaveErr( BOOL bFailed ) +{ + if( bFailed ) { + uLastFileErr= GetLastError(); + } +} + +MODULE = Win32API::File PACKAGE = Win32API::File + +PROTOTYPES: DISABLE + + +LONG +_fileLastError( uError=0 ) + DWORD uError + CODE: + if( 1 <= items ) { + uLastFileErr= uError; + } + RETVAL= uLastFileErr; + OUTPUT: + RETVAL + + +BOOL +CloseHandle( hObject ) + HANDLE hObject + CODE: + RETVAL = CloseHandle( hObject ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +CopyFileA( sOldFileName, sNewFileName, bFailIfExists ) + char * sOldFileName + char * sNewFileName + BOOL bFailIfExists + CODE: + RETVAL = CopyFileA( sOldFileName, sNewFileName, bFailIfExists ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +CopyFileW( swOldFileName, swNewFileName, bFailIfExists ) + WCHAR * swOldFileName + WCHAR * swNewFileName + BOOL bFailIfExists + CODE: + RETVAL = CopyFileW( swOldFileName, swNewFileName, bFailIfExists ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +HANDLE +CreateFileA( sPath, uAccess, uShare, pSecAttr, uCreate, uFlags, hModel ) + char * sPath + DWORD uAccess + DWORD uShare + void * pSecAttr + DWORD uCreate + DWORD uFlags + HANDLE hModel + CODE: + RETVAL= CreateFileA( sPath, uAccess, uShare, + pSecAttr, uCreate, uFlags, hModel ); + if( INVALID_HANDLE_VALUE == RETVAL ) { + SaveErr( 1 ); + XSRETURN_NO; + } else if( 0 == RETVAL ) { + XSRETURN_PV( "0 but true" ); + } else { + XSRETURN_UV( PTR2UV(RETVAL) ); + } + + +HANDLE +CreateFileW( swPath, uAccess, uShare, pSecAttr, uCreate, uFlags, hModel ) + WCHAR * swPath + DWORD uAccess + DWORD uShare + void * pSecAttr + DWORD uCreate + DWORD uFlags + HANDLE hModel + CODE: + RETVAL= CreateFileW( swPath, uAccess, uShare, + pSecAttr, uCreate, uFlags, hModel ); + if( INVALID_HANDLE_VALUE == RETVAL ) { + SaveErr( 1 ); + XSRETURN_NO; + } else if( 0 == RETVAL ) { + XSRETURN_PV( "0 but true" ); + } else { + XSRETURN_UV( PTR2UV(RETVAL) ); + } + + +BOOL +DefineDosDeviceA( uFlags, sDosDeviceName, sTargetPath ) + DWORD uFlags + char * sDosDeviceName + char * sTargetPath + CODE: + RETVAL = DefineDosDeviceA( uFlags, sDosDeviceName, sTargetPath ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +DefineDosDeviceW( uFlags, swDosDeviceName, swTargetPath ) + DWORD uFlags + WCHAR * swDosDeviceName + WCHAR * swTargetPath + CODE: + RETVAL = DefineDosDeviceW( uFlags, swDosDeviceName, swTargetPath ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +DeleteFileA( sFileName ) + char * sFileName + CODE: + RETVAL = DeleteFileA( sFileName ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +DeleteFileW( swFileName ) + WCHAR * swFileName + CODE: + RETVAL = DeleteFileW( swFileName ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +DeviceIoControl( hDevice, uIoControlCode, pInBuf, lInBuf, opOutBuf, lOutBuf, olRetBytes, pOverlapped ) + HANDLE hDevice + DWORD uIoControlCode + char * pInBuf + DWORD lInBuf = init_buf_l($arg); + char * opOutBuf = NO_INIT + DWORD lOutBuf = init_buf_l($arg); + oDWORD &olRetBytes + void * pOverlapped + CODE: + if( NULL != pInBuf ) { + if( 0 == lInBuf ) { + lInBuf= SvCUR(ST(2)); + } else if( SvCUR(ST(2)) < lInBuf ) { + croak( "%s: pInBuf shorter than specified (%d < %d)", + "Win32API::File::DeviceIoControl", SvCUR(ST(2)), lInBuf ); + } + } + grow_buf_l( opOutBuf,ST(4),char *, lOutBuf,ST(5) ); + RETVAL= DeviceIoControl( hDevice, uIoControlCode, pInBuf, lInBuf, + opOutBuf, lOutBuf, &olRetBytes, pOverlapped ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + opOutBuf trunc_buf_l( RETVAL, opOutBuf,ST(4), olRetBytes ); + olRetBytes + + +HANDLE +FdGetOsFHandle( ivFd ) + int ivFd + CODE: + RETVAL= (HANDLE) win32_get_osfhandle( ivFd ); + SaveErr( INVALID_HANDLE_VALUE == RETVAL ); + OUTPUT: + RETVAL + + +DWORD +GetDriveTypeA( sRootPath ) + char * sRootPath + CODE: + RETVAL = GetDriveTypeA( sRootPath ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +DWORD +GetDriveTypeW( swRootPath ) + WCHAR * swRootPath + CODE: + RETVAL = GetDriveTypeW( swRootPath ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +DWORD +GetFileAttributesA( sPath ) + char * sPath + CODE: + RETVAL = GetFileAttributesA( sPath ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +DWORD +GetFileAttributesW( swPath ) + WCHAR * swPath + CODE: + RETVAL = GetFileAttributesW( swPath ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +DWORD +GetFileType( hFile ) + HANDLE hFile + CODE: + RETVAL = GetFileType( hFile ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +GetHandleInformation( hObject, ouFlags ) + HANDLE hObject + oDWORD * ouFlags + CODE: + RETVAL = GetHandleInformation( hObject, ouFlags ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + ouFlags + + +DWORD +GetLogicalDrives() + CODE: + RETVAL = GetLogicalDrives(); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +DWORD +GetLogicalDriveStringsA( lBufSize, osBuffer ) + DWORD lBufSize = init_buf_l($arg); + char * osBuffer = NO_INIT + CODE: + grow_buf_l( osBuffer,ST(1),char *, lBufSize,ST(0) ); + RETVAL= GetLogicalDriveStringsA( lBufSize, osBuffer ); + if( lBufSize < RETVAL && autosize(ST(0)) ) { + lBufSize= RETVAL; + grow_buf_l( osBuffer,ST(1),char *, lBufSize,ST(0) ); + RETVAL= GetLogicalDriveStringsA( lBufSize, osBuffer ); + } + if( 0 == RETVAL || lBufSize < RETVAL ) { + SaveErr( 1 ); + } else { + trunc_buf_l( 1, osBuffer,ST(1), RETVAL ); + } + OUTPUT: + RETVAL + osBuffer ;/* The code for this appears above. */ + + +DWORD +GetLogicalDriveStringsW( lwBufSize, oswBuffer ) + DWORD lwBufSize = init_buf_lw($arg); + WCHAR * oswBuffer = NO_INIT + CODE: + grow_buf_lw( oswBuffer,ST(1), lwBufSize,ST(0) ); + RETVAL= GetLogicalDriveStringsW( lwBufSize, oswBuffer ); + if( lwBufSize < RETVAL && autosize(ST(0)) ) { + lwBufSize= RETVAL; + grow_buf_lw( oswBuffer,ST(1), lwBufSize,ST(0) ); + RETVAL= GetLogicalDriveStringsW( lwBufSize, oswBuffer ); + } + if( 0 == RETVAL || lwBufSize < RETVAL ) { + SaveErr( 1 ); + } else { + trunc_buf_lw( 1, oswBuffer,ST(1), RETVAL ); + } + OUTPUT: + RETVAL + oswBuffer ;/* The code for this appears above. */ + + +BOOL +GetVolumeInformationA( sRootPath, osVolName, lVolName, ouSerialNum, ouMaxNameLen, ouFsFlags, osFsType, lFsType ) + char * sRootPath + char * osVolName = NO_INIT + DWORD lVolName = init_buf_l($arg); + oDWORD &ouSerialNum = optUV($arg); + oDWORD &ouMaxNameLen = optUV($arg); + oDWORD &ouFsFlags = optUV($arg); + char * osFsType = NO_INIT + DWORD lFsType = init_buf_l($arg); + CODE: + grow_buf_l( osVolName,ST(1),char *, lVolName,ST(2) ); + grow_buf_l( osFsType,ST(6),char *, lFsType,ST(7) ); + RETVAL= GetVolumeInformationA( sRootPath, osVolName, lVolName, + &ouSerialNum, &ouMaxNameLen, &ouFsFlags, osFsType, lFsType ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + osVolName trunc_buf_z( RETVAL, osVolName,ST(1) ); + osFsType trunc_buf_z( RETVAL, osFsType,ST(6) ); + ouSerialNum + ouMaxNameLen + ouFsFlags + + +BOOL +GetVolumeInformationW( swRootPath, oswVolName, lwVolName, ouSerialNum, ouMaxNameLen, ouFsFlags, oswFsType, lwFsType ) + WCHAR * swRootPath + WCHAR * oswVolName = NO_INIT + DWORD lwVolName = init_buf_lw($arg); + oDWORD &ouSerialNum = optUV($arg); + oDWORD &ouMaxNameLen = optUV($arg); + oDWORD &ouFsFlags = optUV($arg); + WCHAR * oswFsType = NO_INIT + DWORD lwFsType = init_buf_lw($arg); + CODE: + grow_buf_lw( oswVolName,ST(1), lwVolName,ST(2) ); + grow_buf_lw( oswFsType,ST(6), lwFsType,ST(7) ); + RETVAL= GetVolumeInformationW( swRootPath, oswVolName, lwVolName, + &ouSerialNum, &ouMaxNameLen, &ouFsFlags, oswFsType, lwFsType ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + oswVolName trunc_buf_zw( RETVAL, oswVolName,ST(1) ); + oswFsType trunc_buf_zw( RETVAL, oswFsType,ST(6) ); + ouSerialNum + ouMaxNameLen + ouFsFlags + + +BOOL +IsRecognizedPartition( ivPartitionType ) + int ivPartitionType + CODE: + RETVAL = IsRecognizedPartition( ivPartitionType ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +IsContainerPartition( ivPartitionType ) + int ivPartitionType + CODE: + RETVAL = IsContainerPartition( ivPartitionType ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +MoveFileA( sOldName, sNewName ) + char * sOldName + char * sNewName + CODE: + RETVAL = MoveFileA( sOldName, sNewName ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +MoveFileW( swOldName, swNewName ) + WCHAR * swOldName + WCHAR * swNewName + CODE: + RETVAL = MoveFileW( swOldName, swNewName ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +MoveFileExA( sOldName, sNewName, uFlags ) + char * sOldName + char * sNewName + DWORD uFlags + CODE: + RETVAL = MoveFileExA( sOldName, sNewName, uFlags ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +MoveFileExW( swOldName, swNewName, uFlags ) + WCHAR * swOldName + WCHAR * swNewName + DWORD uFlags + CODE: + RETVAL = MoveFileExW( swOldName, swNewName, uFlags ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +long +OsFHandleOpenFd( hOsFHandle, uMode ) + long hOsFHandle + DWORD uMode + CODE: + RETVAL= win32_open_osfhandle( hOsFHandle, uMode ); + if( RETVAL < 0 ) { + SaveErr( 1 ); + XSRETURN_NO; + } else if( 0 == RETVAL ) { + XSRETURN_PV( "0 but true" ); + } else { + XSRETURN_IV( (IV) RETVAL ); + } + + +DWORD +QueryDosDeviceA( sDeviceName, osTargetPath, lTargetBuf ) + char * sDeviceName + char * osTargetPath = NO_INIT + DWORD lTargetBuf = init_buf_l($arg); + CODE: + grow_buf_l( osTargetPath,ST(1),char *, lTargetBuf,ST(2) ); + RETVAL= QueryDosDeviceA( sDeviceName, osTargetPath, lTargetBuf ); + SaveErr( 0 == RETVAL ); + OUTPUT: + RETVAL + osTargetPath trunc_buf_l( 1, osTargetPath,ST(1), RETVAL ); + + +DWORD +QueryDosDeviceW( swDeviceName, oswTargetPath, lwTargetBuf ) + WCHAR * swDeviceName + WCHAR * oswTargetPath = NO_INIT + DWORD lwTargetBuf = init_buf_lw($arg); + CODE: + grow_buf_lw( oswTargetPath,ST(1), lwTargetBuf,ST(2) ); + RETVAL= QueryDosDeviceW( swDeviceName, oswTargetPath, lwTargetBuf ); + SaveErr( 0 == RETVAL ); + OUTPUT: + RETVAL + oswTargetPath trunc_buf_lw( 1, oswTargetPath,ST(1), RETVAL ); + + +BOOL +ReadFile( hFile, opBuffer, lBytes, olBytesRead, pOverlapped ) + HANDLE hFile + BYTE * opBuffer = NO_INIT + DWORD lBytes = init_buf_l($arg); + oDWORD &olBytesRead + void * pOverlapped + CODE: + grow_buf_l( opBuffer,ST(1),BYTE *, lBytes,ST(2) ); + /* Don't read more bytes than asked for if buffer is already big: */ + lBytes= init_buf_l(ST(2)); + if( 0 == lBytes && autosize(ST(2)) ) { + lBytes= SvLEN( ST(1) ) - 1; + } + RETVAL= ReadFile( hFile, opBuffer, lBytes, &olBytesRead, pOverlapped ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + opBuffer trunc_buf_l( RETVAL, opBuffer,ST(1), olBytesRead ); + olBytesRead + + +BOOL +GetOverlappedResult( hFile, lpOverlapped, lpNumberOfBytesTransferred, bWait) + HANDLE hFile + LPOVERLAPPED lpOverlapped + LPDWORD lpNumberOfBytesTransferred + BOOL bWait + CODE: + RETVAL= GetOverlappedResult( hFile, lpOverlapped, + lpNumberOfBytesTransferred, bWait); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + lpOverlapped + lpNumberOfBytesTransferred + +DWORD +GetFileSize( hFile, lpFileSizeHigh ) + HANDLE hFile + LPDWORD lpFileSizeHigh + CODE: + RETVAL= GetFileSize( hFile, lpFileSizeHigh ); + SaveErr( NO_ERROR != GetLastError() ); + OUTPUT: + RETVAL + lpFileSizeHigh + +UINT +SetErrorMode( uNewMode ) + UINT uNewMode + + +LONG +SetFilePointer( hFile, ivOffset, ioivOffsetHigh, uFromWhere ) + HANDLE hFile + LONG ivOffset + LONG * ioivOffsetHigh + DWORD uFromWhere + CODE: + RETVAL= SetFilePointer( hFile, ivOffset, ioivOffsetHigh, uFromWhere ); + if( RETVAL == INVALID_SET_FILE_POINTER && (GetLastError() != NO_ERROR) ) { + SaveErr( 1 ); + XST_mNO(0); + } else if( 0 == RETVAL ) { + XST_mPV(0,"0 but true"); + } else { + XST_mIV(0,RETVAL); + } + OUTPUT: + ioivOffsetHigh + + +BOOL +SetHandleInformation( hObject, uMask, uFlags ) + HANDLE hObject + DWORD uMask + DWORD uFlags + CODE: + RETVAL = SetHandleInformation( hObject, uMask, uFlags ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + + +BOOL +WriteFile( hFile, pBuffer, lBytes, ouBytesWritten, pOverlapped ) + HANDLE hFile + BYTE * pBuffer + DWORD lBytes = init_buf_l($arg); + oDWORD &ouBytesWritten + void * pOverlapped + CODE: + /* SvCUR(ST(1)) might "panic" if pBuffer isn't valid */ + if( 0 == lBytes ) { + lBytes= SvCUR(ST(1)); + } else if( SvCUR(ST(1)) < lBytes ) { + croak( "%s: pBuffer value too short (%d < %d)", + "Win32API::File::WriteFile", SvCUR(ST(1)), lBytes ); + } + RETVAL= WriteFile( hFile, pBuffer, lBytes, + &ouBytesWritten, pOverlapped ); + SaveErr( !RETVAL ); + OUTPUT: + RETVAL + ouBytesWritten diff --git a/win32/ext/Win32API/File/Makefile.PL b/win32/ext/Win32API/File/Makefile.PL new file mode 100644 index 0000000000..c84d1de4cd --- /dev/null +++ b/win32/ext/Win32API/File/Makefile.PL @@ -0,0 +1,127 @@ +#!/usr/bin/perl -w +use ExtUtils::MakeMaker; +use Config; +use strict; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Win32API::File', + 'VERSION_FROM' => 'File.pm', # finds $VERSION + ( $Config{archname} =~ /-object\b/i ? ( 'CAPI' => 'TRUE' ) : () ), + ( $] < 5.005 ? () : + ( 'AUTHOR' => 'Tye McQueen <tye@metronet.com>', + 'ABSTRACT_FROM' => 'File.pm' ) + ), + 'postamble' => { IMPORT_LIST => [qw(/._/ !/[a-z]/ :MEDIA_TYPE)], + IFDEF => "!/[a-z\\d]/", + CPLUSPLUS => 1, + WRITE_PERL => 1, + # Comment out next line to rebuild constants defs: + NO_REBUILD => 1, + }, + ( ! $Config{libperl} ? () : ( LIBPERL_A => $Config{libperl} ) ), +); + +# Replacement for MakeMaker's "const2perl section" for versions +# of MakeMaker prior to the addition of this functionality: +sub MY::postamble +{ + my( $self, %attribs )= @_; + + # Don't do anything if MakeMaker has const2perl + # that already took care of all of this: + return unless %attribs; + + # Don't require these here if we just C<return> above: + eval "use ExtUtils::Myconst2perl qw(ParseAttribs); 1" or die "$@"; + eval "use ExtUtils::MakeMaker qw(neatvalue); 1" or die "$@"; + + # If only one module, can skip one level of indirection: + my $hvAttr= \%attribs; + if( $attribs{IMPORT_LIST} ) { + $hvAttr= { $self->{NAME} => \%attribs }; + } + + my( $module, @m, $_final, @clean, @realclean ); + foreach $module ( keys %$hvAttr ) { + my( $outfile, @perlfiles, @cfiles, $bin, $obj, $final, $noreb ); + + # Translate user-friendly options into coder-friendly specifics: + ParseAttribs( $module, $hvAttr->{$module}, { OUTFILE => \$outfile, + C_FILE_LIST => \@perlfiles, PERL_FILE_LIST => \@cfiles, + OBJECT => \$obj, BINARY => \$bin, FINAL_PERL => \$final, + NO_REBUILD => \$noreb } ); + die "IFDEF option in Makefile.PL must be string, not code ref.\n" + if ref $hvAttr->{$module}->{IFDEF}; + die qq{IFDEF option in Makefile.PL must not contain quotes (").\n} + if ref $hvAttr->{$module}->{IFDEF}; + + # How to create F<$outfile> via ExtUtils::Myconst2perl::Myconst2perl: + push @m, " +$outfile: @perlfiles @cfiles Makefile" . ' + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Myconst2perl \\ + -e "my %attribs;" \\ + '; + $m[-1] =~ s/^/##/gm if $noreb; + my( $key, $value ); + while( ( $key, $value )= each %{$hvAttr->{$module}} ) { + push @m, '-e "$$attribs{' . $key . '}= ' + . neatvalue($value) . qq[;" \\\n\t ]; + $m[-1] =~ s/^/##/gm if $noreb; + } + push @m, '-e "Myconst2perl(' . neatvalue($module) . ",%attribs)\"\n"; + + # If requested extra work to generate Perl instead of XS code: + if( $bin ) { + my @path= split /::/, $module; + my $_final= $final; + $_final =~ s/\W/_/g; + + # How to compile F<$outfile> and then run it to produce F<$final>: + push @m, " +$bin: $outfile" . ' + $(CC) $(INC) $(CCFLAGS) $(OPTIMIZE) $(PERLTYPE) $(LARGE) \\ + $(SPLIT) $(DEFINE_VERSION) $(XS_DEFINE_VERSION) -I$(PERL_INC) \\ + $(DEFINE)' . $outfile . " " + . $self->catfile(qw[ $(PERL_INC) $(LIBPERL_A) ]) . " -o $bin + +$final: $bin + " . $self->catfile(".",$bin) . " >$final\n"; + $m[-1] =~ s/^/##/gm if $noreb; + + # Make sure the rarely-used $(INST_ARCHLIB) directory exists: + push @m, $self->dir_target('$(INST_ARCHLIB)'); + + ##warn qq{$path[-1].pm should C<require "}, + ## join("/",@path,$final), qq{">.\n}; + # Install F<$final> whenever regular pm_to_blib target is built: + push @m, " +pm_to_blib: ${_final}_to_blib + +${_final}_to_blib: $final + " . '@$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \\ + "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \\ + -e "pm_to_blib({ ',neatvalue($final),',', + neatvalue($self->catfile('$(INST_ARCHLIB)',@path,$final)), ' },', + neatvalue($self->catfile(qw[$(INST_LIB) auto])), ')" + @$(TOUCH) ', $_final, "_to_blib\n"; + + push( @clean, $outfile, $bin, $obj, $_final . "_to_blib" ); + push( @realclean, $final ) unless $noreb; + } else { + + ##my $name= ( split /::/, $module )[-1]; + ##warn qq{$name.xs should C<#include "$final"> }, + ## qq{in the C<BOOT:> section\n}; + push( @realclean, $outfile ) unless $noreb; + } + } + + push @m, " +clean :: + $self->{RM_F} @clean\n" if @clean; + push @m, " +realclean :: + $self->{RM_F} @realclean\n" if @realclean; + return join('',@m); +} diff --git a/win32/ext/Win32API/File/README b/win32/ext/Win32API/File/README new file mode 100644 index 0000000000..ead08d5080 --- /dev/null +++ b/win32/ext/Win32API/File/README @@ -0,0 +1,132 @@ +Win32API::File v0.08 -- Low-level access to Win32 API calls for files. + +New since v0.07: + + GetHandleInformation SetHandleInformation + HANDLE_FLAG_INHERIT HANDLE_FLAG_PROTECT_FROM_CLOSE + fileConstant fileLastError + +Low-level and full-power access to the following routines are provided: + + CloseHandle CopyFile CreateFile + DefineDosDevice DeleteFile DeviceIoControl + GetDriveType GetFileType GetHandleInformation + GetLogicalDrives GetLogicalDriveStrings GetVolumeInformation + IsRecognizedPartition IsContainerPartition MoveFile + MoveFileEx QueryDosDevice ReadFile + SetFilePointer SetErrorMode SetHandleInformation + WriteFile + +Plus the Unicode versions: + + CopyFileW CreateFileW DefineDosDeviceW + DeleteFileW GetDriveTypeW GetLogicalDriveStringsW + GetVolumeInformationW MoveFileW MoveFileExW + QueryDosDeviceW + +Full conversion between Win32-native file handles and Perl file handles is +also supported. Access to the following C run-time library routines [or at +least the Perl run-time library wrappers for them] is provided: + + _get_osfhandle or win32_get_osfhandle as FdGetOsFHandle + _open_osfhandle or win32_open_osfhandle as OsFHandleOpenFd + +The following Perl-friendly wrappers and helper functions are also provided: + + OsFHandleOpen GetOsFHandle attrLetsToBits + createFile fileConstant fileLastError + getLogicalDrives + +Plus the following constants: + + CREATE_ALWAYS CREATE_NEW FILE_BEGIN + FILE_CURRENT FILE_END INVALID_HANDLE_VALUE + OPEN_ALWAYS OPEN_EXISTING TRUNCATE_EXISTING + + DDD_EXACT_MATCH_ON_REMOVE DDD_RAW_TARGET_PATH + DDD_REMOVE_DEFINITION + + DRIVE_UNKNOWN DRIVE_NO_ROOT_DIR DRIVE_REMOVABLE + DRIVE_FIXED DRIVE_REMOTE DRIVE_CDROM + DRIVE_RAMDISK + + FILE_READ_DATA FILE_LIST_DIRECTORY + FILE_WRITE_DATA FILE_ADD_FILE + FILE_APPEND_DATA FILE_ADD_SUBDIRECTORY + FILE_CREATE_PIPE_INSTANCE FILE_READ_EA + FILE_WRITE_EA FILE_EXECUTE + FILE_TRAVERSE FILE_DELETE_CHILD + FILE_READ_ATTRIBUTES FILE_WRITE_ATTRIBUTES + FILE_ALL_ACCESS FILE_GENERIC_READ + FILE_GENERIC_WRITE FILE_GENERIC_EXECUTE + + FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_COMPRESSED + FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL + FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY + FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY + + FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_DELETE_ON_CLOSE + FILE_FLAG_NO_BUFFERING FILE_FLAG_OVERLAPPED + FILE_FLAG_POSIX_SEMANTICS FILE_FLAG_RANDOM_ACCESS + FILE_FLAG_SEQUENTIAL_SCAN FILE_FLAG_WRITE_THROUGH + + FILE_SHARE_DELETE FILE_SHARE_READ FILE_SHARE_WRITE + + FILE_TYPE_CHAR FILE_TYPE_DISK FILE_TYPE_PIPE + FILE_TYPE_UNKNOWN + + FS_CASE_IS_PRESERVED FS_CASE_SENSITIVE + FS_UNICODE_STORED_ON_DISK FS_PERSISTENT_ACLS + FS_FILE_COMPRESSION FS_VOL_IS_COMPRESSED + + HANDLE_FLAG_INHERIT HANDLE_FLAG_PROTECT_FROM_CLOSE + + IOCTL_STORAGE_CHECK_VERIFY IOCTL_STORAGE_MEDIA_REMOVAL + IOCTL_STORAGE_EJECT_MEDIA IOCTL_STORAGE_LOAD_MEDIA + IOCTL_STORAGE_RESERVE IOCTL_STORAGE_RELEASE + IOCTL_STORAGE_FIND_NEW_DEVICES IOCTL_STORAGE_GET_MEDIA_TYPES + + IOCTL_DISK_GET_DRIVE_GEOMETRY IOCTL_DISK_GET_PARTITION_INFO + IOCTL_DISK_SET_PARTITION_INFO IOCTL_DISK_GET_DRIVE_LAYOUT + IOCTL_DISK_SET_DRIVE_LAYOUT IOCTL_DISK_VERIFY + IOCTL_DISK_FORMAT_TRACKS IOCTL_DISK_REASSIGN_BLOCKS + IOCTL_DISK_PERFORMANCE IOCTL_DISK_IS_WRITABLE + IOCTL_DISK_LOGGING IOCTL_DISK_FORMAT_TRACKS_EX + IOCTL_DISK_HISTOGRAM_STRUCTURE IOCTL_DISK_HISTOGRAM_DATA + IOCTL_DISK_HISTOGRAM_RESET IOCTL_DISK_REQUEST_STRUCTURE + IOCTL_DISK_REQUEST_DATA + + GENERIC_ALL GENERIC_EXECUTE + GENERIC_READ GENERIC_WRITE + + Unknown F5_1Pt2_512 F3_1Pt44_512 + F3_2Pt88_512 F3_20Pt8_512 F3_720_512 + F5_360_512 F5_320_512 F5_320_1024 + F5_180_512 F5_160_512 RemovableMedia + FixedMedia F3_120M_512 + + MOVEFILE_COPY_ALLOWED MOVEFILE_DELAY_UNTIL_REBOOT + MOVEFILE_REPLACE_EXISTING MOVEFILE_WRITE_THROUGH + + SECURITY_ANONYMOUS SECURITY_CONTEXT_TRACKING + SECURITY_DELEGATION SECURITY_EFFECTIVE_ONLY + SECURITY_IDENTIFICATION SECURITY_IMPERSONATION + SECURITY_SQOS_PRESENT + + SEM_FAILCRITICALERRORS SEM_NOGPFAULTERRORBOX + SEM_NOALIGNMENTFAULTEXCEPT SEM_NOOPENFILEERRORBOX + + PARTITION_ENTRY_UNUSED PARTITION_FAT_12 + PARTITION_XENIX_1 PARTITION_XENIX_2 + PARTITION_FAT_16 PARTITION_EXTENDED + PARTITION_HUGE PARTITION_IFS + PARTITION_FAT32 PARTITION_FAT32_XINT13 + PARTITION_XINT13 PARTITION_XINT13_EXTENDED + PARTITION_PREP PARTITION_UNIX + VALID_NTFT PARTITION_NTFT + +Comments, additions, and bug reports are welcomed. Please address +technical questions that are not full bug reports to one of the Usenet +newsgroups comp.lang.perl.modules or comp.lang.perl.moderated. + +Tye McQueen, tye@metronet.com, http://www.metronet.com/~tye/. diff --git a/win32/ext/Win32API/File/buffers.h b/win32/ext/Win32API/File/buffers.h new file mode 100644 index 0000000000..2ae74e690b --- /dev/null +++ b/win32/ext/Win32API/File/buffers.h @@ -0,0 +1,423 @@ +/* buffers.h -- Version 1.11 */ + +/* The following abbreviations are used at start of parameter names + * to indicate the type of data: + * s string (char * or WCHAR *) [PV] + * sw wide string (WCHAR *) [PV] + * p pointer (usually to some structure) [PV] + * a array (packed array as in C) (usually of some structure) [PV] + * called a "vector" or "vect" in some places. + * n generic number [IV, UV, or NV] + * iv signed integral value [IV] + * u unsigned integral value [UV] + * d floating-point number (double) [NV] + * b boolean (bool) [IV] + * c count of items [UV] + * l length (in bytes) [UV] + * lw length in WCHARs [UV] + * h a handle [IV] + * r record (structure) [PV] + * sv Perl scalar (s, i, u, d, n, or rv) [SV] + * rv Perl reference (usually to scalar) [RV] + * hv reference to Perl hash [HV] + * av reference to Perl array [AV] + * cv Perl code reference [PVCV] + * + * Unusual combined types: + * pp single pointer (to non-Perl data) packed into string [PV] + * pap vector of pointers (to non-Perl data) packed into string [PV] + * + * Whether a parameter is for input data, output data, or both is usually + * not reflected by the data type prefix. In cases where this is not + * obvious nor reflected in the variable name proper, you can use + * the following in front of the data type prefix: + * i an input parameter given to API (usually omitted) + * o an Output parameter taken from API + * io Input given to API then overwritten with Output taken from API + */ + +/* Buffer arguments are usually followed by an argument (or two) specifying + * their size and/or returning the size of data written. The size can be + * measured in bytes ["lSize"] or in characters [for (char *) buffers such as + * for *A() routines, these sizes are also called "lSize", but are called + * "lwSize" for (WCHAR *) buffers, UNICODE strings, such as for *W() routines]. + * + * Before calling the actual C function, you must make sure the Perl variable + * actually has a big enough buffer allocated, and, if the user didn't want + * to specify a buffer size, set the buffer size to be correct. This is what + * the grow_*() macros are for. They also handle special meanings of the + * buffer size argument [described below]. + * + * Once the actual C function returns, you must set the Perl variable to know + * the size of the written data. This is what the trunc_*() macros are for. + * + * The size sometimes does and sometimes doesn't include the trailing '\0' + * [or L'\0'], so we always add or substract 1 in the appropriate places so + * we don't care about this detail. + * + * A call may 1) request a pointer to the buffer size which means that + * the buffer size will be overwritten with the size of the data written; + * 2) have an extra argument which is a pointer to the place to write the + * size of the written data; 3) provide the size of the written data in + * the function's return value; 4) format the data so that the length + * can be determined by examining the data [such as with '\0'-terminated + * strings]; or 5) write fixed-length data [usually sizeof(STRUCT)]. + * This obviously determines what you should use in the trunc_*() macro + # to specify the size of the output value. + * + * The user can pass in an empty list reference, C<[]>, to indicate C<NULL> + * for the pointer to the buffer which means that they don't want that data. + * + * The user can pass in C<[]> or C<0> to indicate that they don't care about + * the buffer size [we aren't programming in C here, after all] and just try + * to get the data. This will work if either the buffer already alloated for + * the SV [scalar value] is large enough to hold the data or the API provides + * an easy way to determine the required size [and the XS code uses it]. + * + * If the user passes in a numeric value for a buffer size, then the XS + * code makes sure that the buffer is at least large enough to hold a value + * of that size and then passes in how large the buffer is. So the buffer + * size passed to the API call is the larger of the size requested by the + * user and the size of the buffer aleady allocated to the SV. + * + * The user can also pass in a string consisting of a leading "=" followed + * by digits for a buffer size. This means just use the size specified after + * the equals sign, even if the allocated buffer is larger. The XS code will + * still allocate a large enough buffer before the first call. + * + * If the function is nice enough to tell us that a buffer was too small + * [usually via ERROR_MORE_DATA] _and_ how large the buffer needs to be, + * then the XS code should enlarge the buffer(s) and repeat the call [once]. + * This resizing is _not_ done for buffers whose size was specified with a + * leading "=". + * + * Only grow_buf() and perhaps trunc_buf() can be used in a typemap file. + * The other macros would be used in the parameter declarations or INPUT: + * section [grow_*()], the INIT: section [init_*()], or the OUTPUT: section + * [trunc_*()]. + * + * Buffer arguments should be initialied with C<= NO_INIT> [or C<= NULL;>]. + * + * See also the F<typemap> file. C<oDWORD>, for example, is for an output- + * only parameter of type C<DWORD> and you should simply C<#define> it to be + * C<DWORD>. In F<typemap>, C<oDWORD> is treated differently than C<DWORD> + * in two ways. + * + * First, if C<undef> is passed in, a C<DWORD> could generate a warning + * when it gets converted to 0 while C<oDWORD> will never generate such a + * warning for C<undef>. This first difference doesn't apply if specific + * initialization is specified for the variable, as in C<= init_buf_l($var);>. + * In particular, the init_*() macros also convert C<undef> to 0 without + * ever producing a warning. + * + * Second, passing in a read-only SV for a C<oDWORD> parameter will generate + * a fatal error on output when we try to update the SV. For C<DWORD>, we + * won't update a read-only SV since passing in a literal constant for a + * buffer size is a useful thing to do even though it prevents us from + * returning the size of data written via that SV. Since we should use a + * trunc_*() macro to output the actual data, the user should be able to + * determine the size of data written based on the size of the scalar we + * output anyway. + * + * This second difference doesn't apply unless the paremter is listed in + * the OUTPUT: section without specific output instructions. We define + * no macros for outputing buffer length parameters so be careful to use + * C<oDWORD> [for example] for them if and only if they are output-only. + * + * Note that C<oDWORD> is the same as C<DWORD> in that, if a defined value + * is passed in, it is used [and can generate a warning if the value is + * "not numeric"]. So although C<oDWORD> is for output-only parameters, + * we still initialize the C variable before calling the API. This is good + * in case the parameter isn't always strictly output-only due to upgrades, + * bugs, etc. + * + * Here is a made-up example that shows several cases: + * + * # Actual GetDataW() returns length of data written to ioswName, not bool. + * bool + * GetDataW( ioswName, ilwName, oswText, iolwText, opJunk, opRec, ilRec, olRec ) + * WCHAR * ioswName = NO_INIT + * DWORD ilwName = NO_INIT + * WCHAR * oswText = NO_INIT + * DWORD &iolwText = init_buf_l($arg); + * void * opJunk = NO_INIT + * BYTE * opRec = NO_INIT + * DWORD ilRec = init_buf_l($arg); + * oDWORD &olRec + * PREINIT: + * DWORD olwName; + * INIT: + * grow_buf_lw( ioswName,ST(0), ilwName,ST(1) ); + * grow_buf_lw( oswText,ST(2), iolwText,ST(3) ); + * grow_buf_typ( opJunk,ST(4),void *, LONG_STRUCT_TYPEDEF ); + * grow_buf_l( opRec,ST(5),BYTE *, ilRec,ST(6) ); + * CODE: + * olwName= GetDataW( ioswName, ilwName, oswText, &iolwText, + * (LONG_STRUCT_TYPEDEF *)opJunk, opRec, &iolRec ); + * if( 0 == olwName && ERROR_MORE_DATA == GetLastError() + * && ( autosize(ST(1)) || autosize(ST(3)) || autosize(ST(6)) ) ) { + * if( autosize(ST(1)) ) + * grow_buf_lw( ioswName,ST(0), ilwName,ST(1) ); + * if( autosize(ST(3)) ) + * grow_buf_lw( oswText,ST(2), iolwText,ST(3) ); + * if( autosize(ST(6)) ) + * grow_buf_l( opRec,ST(5),BYTE *, iolRec,ST(6) ); + * olwName= GetDataW( ioswName, ilwName, oswText, &iolwText, + * (LONG_STRUCT_TYPEDEF *)opJunk, opRec, &iolRec ); + * } + * RETVAL= 0 != olwName; + * OUTPUT: + * RETVAL + * ioswName trunc_buf_lw( RETVAL, ioswName,ST(0), olwName ); + * oswText trunc_buf_lw( RETVAL, oswText,ST(2), iolwText ); + * iolwText + * opJunk trunc_buf_typ(RETVAL,opJunk,ST(4),LONG_STRUCT_TYPEDEF); + * opRec trunc_buf_l( RETVAL, opRec,ST(5), olRec ); + * olRec + * + * The above example would be more complex and less efficient if we used + * C<DWORD * iolwText> in place of C<DWORD &iolwText>. The only possible + * advantage would be that C<NULL> would be passed in for C<iolwText> if + * _both_ C<$oswText> and C<$iolwText> were specified as C<[]>. The *_pl*() + * macros are defined [and C<DWORD *> specified in F<typemap>] so we can + * handle those cases but it is usually better to use the *_l*() macros + * instead by specifying C<&> instead of C<*>. Using C<&> instead of C<*> + * is usually better when dealing with scalars, even if they aren't buffer + * sizes. But you must use C<*> if it is important for that parameter to + * be able to pass C<NULL> to the underlying API. + * + * In Win32API::, we try to use C<*> for buffer sizes of optional buffers + * and C<&> for buffer sizes of required buffers. + * + * For parameters that are pointers to things other than buffers or buffer + * sizes, we use C<*> for "important" parameters [so that using C<[]> + * generates an error rather than fetching the value and just throwing it + * away], and for optional parameters [in case specifying C<NULL> is or + * becomes important]. Otherwise we use C<&> [for "unimportant" but + * required parameters] so the user can specify C<[]> if they don't care + * about it. The output handle of an "open" routine is "important". + */ + +#ifndef Debug +# define Debug(list) /*Nothing*/ +#endif + +/*#ifndef CAST + *# ifdef __cplusplus + *# define CAST(type,expr) static_cast<type>(expr) + *# else*/ +# define CAST(type,expr) (type)(expr) +/*# endif + *#endif*/ + +/* Is an argument C<[]>, meaning we should pass C<NULL>? */ +#define null_arg(sv) ( SvROK(sv) && SVt_PVAV == SvTYPE(SvRV(sv)) \ + && -1 == av_len((AV*)SvRV(sv)) ) + +#define PV_or_null(sv) ( null_arg(sv) ? NULL : SvPV(sv,PL_na) ) + +/* Minimum buffer size to use when no buffer existed: */ +#define MIN_GROW_SIZE 128 + +#ifdef Debug +/* Used in Debug() messages to show which macro call is involved: */ +#define string(arg) #arg +#endif + +/* Simplify using SvGROW() for byte-sized buffers: */ +#define lSvGROW(sv,n) SvGROW( sv, 0==(n) ? MIN_GROW_SIZE : (n)+1 ) + +/* Simplify using SvGROW() for WCHAR-sized buffers: */ +#define lwSvGROW(sv,n) CAST( WCHAR *, \ + SvGROW( sv, sizeof(WCHAR)*( 0==(n) ? MIN_GROW_SIZE : (n)+1 ) ) ) + +/* Whether the buffer size we got lets us change what buffer size we use: */ +#define autosize(sv) (!( SvOK(sv) && ! SvROK(sv) \ + && SvPV(sv,PL_na) && '=' == *SvPV(sv,PL_na) )) + +/* Get the IV/UV for a parameter that might be C<[]> or C<undef>: */ +#define optIV(sv) ( null_arg(sv) ? 0 : !SvOK(sv) ? 0 : SvIV(sv) ) +#define optUV(sv) ( null_arg(sv) ? 0 : !SvOK(sv) ? 0 : SvUV(sv) ) + +/* Allocate temporary storage that will automatically be freed later: */ +#ifndef TempAlloc /* Can be C<#define>d to be C<_alloca>, for example */ +# define TempAlloc( size ) sv_grow( sv_newmortal(), size ) +#endif + +/* Initialize a buffer size argument of type (DWORD *): */ +#define init_buf_pl( plSize, svSize, tpSize ) STMT_START { \ + if( null_arg(svSize) ) \ + plSize= NULL; \ + else { \ + STRLEN n_a; \ + *( plSize= CAST( tpSize, TempAlloc(sizeof(*plSize)) ) )= \ + autosize(svSize) ? optUV(svSize) \ + : strtoul( 1+SvPV(svSize,n_a), NULL, 10 ); \ + } } STMT_END +/* In INPUT section put ": init_buf_pl($var,$arg,$type);" after var name. */ + +/* Initialize a buffer size argument of type DWORD: */ +#define init_buf_l( svSize ) \ + ( null_arg(svSize) ? 0 : autosize(svSize) ? optUV(svSize) \ + : strtoul( 1+SvPV(svSize,PL_na), NULL, 10 ) ) +/* In INPUT section put "= init_buf_l($arg);" after variable name. */ + +/* Lengths in WCHARs are initialized the same as lengths in bytes: */ +#define init_buf_plw init_buf_pl +#define init_buf_lw init_buf_l + +/* grow_buf_pl() and grow_buf_plw() are included so you can define + * parameters of type C<DWORD *>, for example. In practice, it is + * usually better to define such parameters as "DWORD &". */ + +/* Grow a buffer where we have a pointer to its size in bytes: */ +#define grow_buf_pl( sBuf,svBuf,tpBuf, plSize,svSize,tpSize ) STMT_START { \ + Debug(("grow_buf_pl( %s==0x%lX,[%s:%ld/%ld, %s==0x%lX:%ld,[%s )\n",\ + string(sBuf),sBuf,strchr(string(svBuf),'('),SvPOK(svBuf)? \ + SvCUR(svBuf):-1,SvPOK(svBuf)?SvLEN(svBuf):-1,string(plSize), \ + plSize,plSize?*plSize:-1,strchr(string(svSize),'('))); \ + if( null_arg(svBuf) ) { \ + sBuf= NULL; \ + } else { \ + STRLEN n_a; \ + if( NULL == plSize ) \ + *( plSize= CAST(tpSize,TempAlloc(sizeof(*plSize))) )= 0;\ + if( ! SvOK(svBuf) ) sv_setpvn(svBuf,"",0); \ + (void) SvPV_force( svBuf, n_a ); \ + sBuf= CAST( tpBuf, lSvGROW( svBuf, *plSize ) ); \ + if( autosize(svSize) ) *plSize= SvLEN(svBuf) - 1; \ + Debug(("more buf_pl( %s==0x%lX,[%s:%ld/%ld, %s==0x%lX:%ld,[%s )\n",\ + string(sBuf),sBuf,strchr(string(svBuf),'('),SvPOK(svBuf)? \ + SvCUR(svBuf):-1,SvPOK(svBuf)?SvLEN(svBuf):-1,string(plSize),\ + plSize,plSize?*plSize:-1,strchr(string(svSize),'('))); \ + } } STMT_END + +/* Grow a buffer where we have a pointer to its size in WCHARs: */ +#define grow_buf_plw( sBuf,svBuf, plwSize,svSize,tpSize ) STMT_START { \ + if( null_arg(svBuf) ) { \ + sBuf= NULL; \ + } else { \ + STRLEN n_a; \ + if( NULL == plwSize ) \ + *( plwSize= CAST(tpSize,TempAlloc(sizeof(*plwSize))) )= 0;\ + if( ! SvOK(svBuf) ) sv_setpvn(svBuf,"",0); \ + (void) SvPV_force( svBuf, n_a ); \ + sBuf= lwSvGROW( svBuf, *plwSize ); \ + if( autosize(svSize) ) \ + *plwSize= SvLEN(svBuf)/sizeof(WCHAR) - 1; \ + } } STMT_END + +/* Grow a buffer where we have its size in bytes: */ +#define grow_buf_l( sBuf,svBuf,tpBuf, lSize,svSize ) STMT_START { \ + if( null_arg(svBuf) ) { \ + sBuf= NULL; \ + } else { \ + STRLEN n_a; \ + if( ! SvOK(svBuf) ) sv_setpvn(svBuf,"",0); \ + (void) SvPV_force( svBuf, n_a ); \ + sBuf= CAST( tpBuf, lSvGROW( svBuf, lSize ) ); \ + if( autosize(svSize) ) lSize= SvLEN(svBuf) - 1; \ + } } STMT_END + +/* Grow a buffer where we have its size in WCHARs: */ +#define grow_buf_lw( swBuf,svBuf, lwSize,svSize ) STMT_START { \ + if( null_arg(svBuf) ) { \ + swBuf= NULL; \ + } else { \ + STRLEN n_a; \ + if( ! SvOK(svBuf) ) sv_setpvn(svBuf,"",0); \ + (void) SvPV_force( svBuf, n_a ); \ + swBuf= lwSvGROW( svBuf, lwSize ); \ + if( autosize(svSize) ) \ + lwSize= SvLEN(svBuf)/sizeof(WCHAR) - 1; \ + } } STMT_END + +/* Grow a buffer that contains the declared fixed data type: */ +#define grow_buf( pBuf,svBuf, tpBuf ) STMT_START { \ + if( null_arg(svBuf) ) { \ + pBuf= NULL; \ + } else { \ + STRLEN n_a; \ + if( ! SvOK(svBuf) ) sv_setpvn(svBuf,"",0); \ + (void) SvPV_force( svBuf, n_a ); \ + pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(*pBuf) ) ); \ + } } STMT_END + +/* Grow a buffer that contains a fixed data type other than that declared: */ +#define grow_buf_typ( pBuf,svBuf,tpBuf, Type ) STMT_START { \ + if( null_arg(svBuf) ) { \ + pBuf= NULL; \ + } else { \ + STRLEN n_a; \ + if( ! SvOK(svBuf) ) sv_setpvn(svBuf,"",0); \ + (void) SvPV_force( svBuf, n_a ); \ + pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(Type) ) ); \ + } } STMT_END + +/* Grow a buffer that contains a list of items of the declared data type: */ +#define grow_vect( pBuf,svBuf,tpBuf, cItems ) STMT_START { \ + if( null_arg(svBuf) ) { \ + pBuf= NULL; \ + } else { \ + STRLEN n_a; \ + if( ! SvOK(svBuf) ) sv_setpvn(svBuf,"",0); \ + (void) SvPV_force( svBuf, n_a ); \ + pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(*pBuf)*cItems ) ); \ + } } STMT_END + +/* If call succeeded, set data length to returned length (in bytes): */ +#define trunc_buf_l( bOkay, sBuf,svBuf, lSize ) STMT_START { \ + if( bOkay && NULL != sBuf ) { \ + SvPOK_only( svBuf ); \ + SvCUR_set( svBuf, lSize ); \ + } } STMT_END + +/* Same as above except we have a poitner to the returned length: */ +#define trunc_buf_pl( bOkay, sBuf,svBuf, plSize ) \ + trunc_buf_l( bOkay, sBuf,svBuf, *plSize ) + +/* If call succeeded, set data length to returned length (in WCHARs): */ +#define trunc_buf_lw( bOkay, sBuf,svBuf, lwSize ) STMT_START { \ + if( bOkay && NULL != sBuf ) { \ + SvPOK_only( svBuf ); \ + SvCUR_set( svBuf, (lwSize)*sizeof(WCHAR) ); \ + } } STMT_END + +/* Same as above except we have a poitner to the returned length: */ +#define trunc_buf_plw( bOkay, swBuf,svBuf, plwSize ) \ + trunc_buf_lw( bOkay, swBuf,svBuf, *plwSize ) + +/* Set data length for a buffer that contains the declared fixed data type: */ +#define trunc_buf( bOkay, pBuf,svBuf ) STMT_START { \ + if( bOkay && NULL != pBuf ) { \ + SvPOK_only( svBuf ); \ + SvCUR_set( svBuf, sizeof(*pBuf) ); \ + } } STMT_END + +/* Set data length for a buffer that contains some other fixed data type: */ +#define trunc_buf_typ( bOkay, pBuf,svBuf, Type ) STMT_START { \ + if( bOkay && NULL != pBuf ) { \ + SvPOK_only( svBuf ); \ + SvCUR_set( svBuf, sizeof(Type) ); \ + } } STMT_END + +/* Set length for buffer that contains list of items of the declared type: */ +#define trunc_vect( bOkay, pBuf,svBuf, cItems ) STMT_START { \ + if( bOkay && NULL != pBuf ) { \ + SvPOK_only( svBuf ); \ + SvCUR_set( svBuf, sizeof(*pBuf)*cItems ); \ + } } STMT_END + +/* Set data length for a buffer where a '\0'-terminate string was stored: */ +#define trunc_buf_z( bOkay, sBuf,svBuf ) STMT_START { \ + if( bOkay && NULL != sBuf ) { \ + SvPOK_only( svBuf ); \ + SvCUR_set( svBuf, strlen(sBuf) ); \ + } } STMT_END + +/* Set data length for a buffer where a L'\0'-terminate string was stored: */ +#define trunc_buf_zw( bOkay, sBuf,svBuf ) STMT_START { \ + if( bOkay && NULL != sBuf ) { \ + SvPOK_only( svBuf ); \ + SvCUR_set( svBuf, wcslen(sBuf)*sizeof(WCHAR) ); \ + } } STMT_END diff --git a/win32/ext/Win32API/File/cFile.h b/win32/ext/Win32API/File/cFile.h new file mode 100644 index 0000000000..23e7ed89f5 --- /dev/null +++ b/win32/ext/Win32API/File/cFile.h @@ -0,0 +1 @@ +/* Would contain C code to generate Perl constants if not using cFile.pc */ diff --git a/win32/ext/Win32API/File/cFile.pc b/win32/ext/Win32API/File/cFile.pc new file mode 100644 index 0000000000..da00f413aa --- /dev/null +++ b/win32/ext/Win32API/File/cFile.pc @@ -0,0 +1,165 @@ +# Generated by cFile_pc.cxx. +# Package Win32API::File with options: +# CPLUSPLUS => q[1] +# IFDEF => q[!/[a-z\d]/] +# IMPORT_LIST => [q[/._/], q[!/[a-z]/], q[:MEDIA_TYPE]] +# WRITE_PERL => q[1] +# Perl files eval'd: +# File.pm => last if /^\s*(bootstrap|XSLoader::load)\b/ +# C files included: +# File.xs => last if m#/[/*]\s*CONSTS_DEFINED\b|^\s*MODULE\b# +sub CREATE_ALWAYS () { 2 } +sub CREATE_NEW () { 1 } +sub DDD_EXACT_MATCH_ON_REMOVE () { 4 } +sub DDD_RAW_TARGET_PATH () { 1 } +sub DDD_REMOVE_DEFINITION () { 2 } +sub DRIVE_CDROM () { 5 } +sub DRIVE_FIXED () { 3 } +sub DRIVE_NO_ROOT_DIR () { 1 } +sub DRIVE_RAMDISK () { 6 } +sub DRIVE_REMOTE () { 4 } +sub DRIVE_REMOVABLE () { 2 } +sub DRIVE_UNKNOWN () { 0 } +sub F3_120M_512 () { 13 } +sub F3_1Pt44_512 () { 2 } +sub F3_20Pt8_512 () { 4 } +sub F3_2Pt88_512 () { 3 } +sub F3_720_512 () { 5 } +sub F5_160_512 () { 10 } +sub F5_180_512 () { 9 } +sub F5_1Pt2_512 () { 1 } +sub F5_320_1024 () { 8 } +sub F5_320_512 () { 7 } +sub F5_360_512 () { 6 } +sub FILE_ADD_FILE () { 2 } +sub FILE_ADD_SUBDIRECTORY () { 4 } +sub FILE_ALL_ACCESS () { 2032127 } +sub FILE_APPEND_DATA () { 4 } +sub FILE_ATTRIBUTE_ARCHIVE () { 32 } +sub FILE_ATTRIBUTE_COMPRESSED () { 2048 } +sub FILE_ATTRIBUTE_DEVICE () { 0x00000040 } +sub FILE_ATTRIBUTE_DIRECTORY () { 0x00000010 } +sub FILE_ATTRIBUTE_ENCRYPTED () { 0x00004000 } +sub FILE_ATTRIBUTE_HIDDEN () { 2 } +sub FILE_ATTRIBUTE_NORMAL () { 128 } +sub FILE_ATTRIBUTE_NOT_CONTENT_INDEXED () { 0x00002000 } +sub FILE_ATTRIBUTE_OFFLINE () { 4096 } +sub FILE_ATTRIBUTE_READONLY () { 1 } +sub FILE_ATTRIBUTE_REPARSE_POINT () { 0x00000400 } +sub FILE_ATTRIBUTE_SPARSE_FILE () { 0x00000200 } +sub FILE_ATTRIBUTE_SYSTEM () { 4 } +sub FILE_ATTRIBUTE_TEMPORARY () { 256 } +sub FILE_BEGIN () { 0 } +sub FILE_CREATE_PIPE_INSTANCE () { 4 } +sub FILE_CURRENT () { 1 } +sub FILE_DELETE_CHILD () { 64 } +sub FILE_END () { 2 } +sub FILE_EXECUTE () { 32 } +sub FILE_FLAG_BACKUP_SEMANTICS () { 33554432 } +sub FILE_FLAG_DELETE_ON_CLOSE () { 67108864 } +sub FILE_FLAG_NO_BUFFERING () { 536870912 } +sub FILE_FLAG_OPEN_REPARSE_POINT () { 0x200000 } +sub FILE_FLAG_OVERLAPPED () { 1073741824 } +sub FILE_FLAG_POSIX_SEMANTICS () { 16777216 } +sub FILE_FLAG_RANDOM_ACCESS () { 268435456 } +sub FILE_FLAG_SEQUENTIAL_SCAN () { 134217728 } +sub FILE_FLAG_WRITE_THROUGH () { 0x80000000 } +sub FILE_GENERIC_EXECUTE () { 1179808 } +sub FILE_GENERIC_READ () { 1179785 } +sub FILE_GENERIC_WRITE () { 1179926 } +sub FILE_LIST_DIRECTORY () { 1 } +sub FILE_READ_ATTRIBUTES () { 128 } +sub FILE_READ_DATA () { 1 } +sub FILE_READ_EA () { 8 } +sub FILE_SHARE_DELETE () { 4 } +sub FILE_SHARE_READ () { 1 } +sub FILE_SHARE_WRITE () { 2 } +sub FILE_TRAVERSE () { 32 } +sub FILE_TYPE_CHAR () { 2 } +sub FILE_TYPE_DISK () { 1 } +sub FILE_TYPE_PIPE () { 3 } +sub FILE_TYPE_UNKNOWN () { 0 } +sub FILE_WRITE_ATTRIBUTES () { 256 } +sub FILE_WRITE_DATA () { 2 } +sub FILE_WRITE_EA () { 16 } +sub FS_CASE_IS_PRESERVED () { 2 } +sub FS_CASE_SENSITIVE () { 1 } +sub FS_FILE_COMPRESSION () { 16 } +sub FS_PERSISTENT_ACLS () { 8 } +sub FS_UNICODE_STORED_ON_DISK () { 4 } +sub FS_VOL_IS_COMPRESSED () { 32768 } +sub FSCTL_SET_REPARSE_POINT () { (9 << 16 | 0 << 14 | 41 << 2 | 0) } +sub FSCTL_GET_REPARSE_POINT () { (9 << 16 | 0 << 14 | 42 << 2 | 0) } +sub FSCTL_DELETE_REPARSE_POINT () { (9 << 16 | 0 << 14 | 43 << 2 | 0) } +sub FixedMedia () { 12 } +sub GENERIC_ALL () { 268435456 } +sub GENERIC_EXECUTE () { 536870912 } +sub GENERIC_READ () { 0x80000000 } +sub GENERIC_WRITE () { 1073741824 } +sub HANDLE_FLAG_INHERIT () { 1 } +sub HANDLE_FLAG_PROTECT_FROM_CLOSE () { 2 } +sub INVALID_FILE_ATTRIBUTES () { 0xFFFFFFFF } +sub INVALID_HANDLE_VALUE () { 0xffffffff } +sub IOCTL_DISK_FORMAT_TRACKS () { 507928 } +sub IOCTL_DISK_FORMAT_TRACKS_EX () { 507948 } +sub IOCTL_DISK_GET_DRIVE_GEOMETRY () { 458752 } +sub IOCTL_DISK_GET_DRIVE_LAYOUT () { 475148 } +sub IOCTL_DISK_GET_MEDIA_TYPES () { 461824 } +sub IOCTL_DISK_GET_PARTITION_INFO () { 475140 } +sub IOCTL_DISK_HISTOGRAM_DATA () { 458804 } +sub IOCTL_DISK_HISTOGRAM_RESET () { 458808 } +sub IOCTL_DISK_HISTOGRAM_STRUCTURE () { 458800 } +sub IOCTL_DISK_IS_WRITABLE () { 458788 } +sub IOCTL_DISK_LOGGING () { 458792 } +sub IOCTL_DISK_PERFORMANCE () { 458784 } +sub IOCTL_DISK_REASSIGN_BLOCKS () { 507932 } +sub IOCTL_DISK_REQUEST_DATA () { 458816 } +sub IOCTL_DISK_REQUEST_STRUCTURE () { 458812 } +sub IOCTL_DISK_SET_DRIVE_LAYOUT () { 507920 } +sub IOCTL_DISK_SET_PARTITION_INFO () { 507912 } +sub IOCTL_DISK_VERIFY () { 458772 } +sub IOCTL_STORAGE_CHECK_VERIFY () { 2967552 } +sub IOCTL_STORAGE_EJECT_MEDIA () { 2967560 } +sub IOCTL_STORAGE_FIND_NEW_DEVICES () { 2967576 } +sub IOCTL_STORAGE_GET_MEDIA_TYPES () { 2952192 } +sub IOCTL_STORAGE_LOAD_MEDIA () { 2967564 } +sub IOCTL_STORAGE_MEDIA_REMOVAL () { 2967556 } +sub IOCTL_STORAGE_RELEASE () { 2967572 } +sub IOCTL_STORAGE_RESERVE () { 2967568 } +sub MOVEFILE_COPY_ALLOWED () { 2 } +sub MOVEFILE_DELAY_UNTIL_REBOOT () { 4 } +sub MOVEFILE_REPLACE_EXISTING () { 1 } +sub MOVEFILE_WRITE_THROUGH () { 8 } +sub OPEN_ALWAYS () { 4 } +sub OPEN_EXISTING () { 3 } +sub PARTITION_ENTRY_UNUSED () { 0 } +sub PARTITION_EXTENDED () { 5 } +sub PARTITION_FAT32 () { 11 } +sub PARTITION_FAT32_XINT13 () { 12 } +sub PARTITION_FAT_12 () { 1 } +sub PARTITION_FAT_16 () { 4 } +sub PARTITION_HUGE () { 6 } +sub PARTITION_IFS () { 7 } +sub PARTITION_NTFT () { 128 } +sub PARTITION_PREP () { 65 } +sub PARTITION_UNIX () { 99 } +sub PARTITION_XENIX_1 () { 2 } +sub PARTITION_XENIX_2 () { 3 } +sub PARTITION_XINT13 () { 14 } +sub PARTITION_XINT13_EXTENDED () { 15 } +sub RemovableMedia () { 11 } +sub SECURITY_ANONYMOUS () { 0 } +sub SECURITY_CONTEXT_TRACKING () { 262144 } +sub SECURITY_DELEGATION () { 196608 } +sub SECURITY_EFFECTIVE_ONLY () { 524288 } +sub SECURITY_IDENTIFICATION () { 65536 } +sub SECURITY_IMPERSONATION () { 131072 } +sub SECURITY_SQOS_PRESENT () { 1048576 } +sub SEM_FAILCRITICALERRORS () { 1 } +sub SEM_NOALIGNMENTFAULTEXCEPT () { 4 } +sub SEM_NOGPFAULTERRORBOX () { 2 } +sub SEM_NOOPENFILEERRORBOX () { 32768 } +sub TRUNCATE_EXISTING () { 5 } +sub Unknown () { 0 } +sub VALID_NTFT () { 192 } +1; diff --git a/win32/ext/Win32API/File/const2perl.h b/win32/ext/Win32API/File/const2perl.h new file mode 100644 index 0000000000..dbd94c10a8 --- /dev/null +++ b/win32/ext/Win32API/File/const2perl.h @@ -0,0 +1,193 @@ +/* const2perl.h -- For converting C constants into Perl constant subs + * (usually via XS code but can just write Perl code to stdout). */ + + +/* #ifndef _INCLUDE_CONST2PERL_H + * #define _INCLUDE_CONST2PERL_H 1 */ + +#ifndef CONST2WRITE_PERL /* Default is "const to .xs": */ + +# define newconst( sName, sFmt, xValue, newSV ) \ + newCONSTSUB( mHvStash, sName, newSV ) + +# define noconst( const ) av_push( mAvExportFail, newSVpv(#const,0) ) + +# define setuv(u) do { \ + mpSvNew= newSViv(0); sv_setuv(mpSvNew,u); \ + } while( 0 ) + +#else + +/* #ifdef __cplusplus + * # undef printf + * # undef fprintf + * # undef stderr + * # define stderr (&_iob[2]) + * # undef iobuf + * # undef malloc + * #endif */ + +# include <stdio.h> /* Probably already included, but shouldn't hurt */ +# include <errno.h> /* Possibly already included, but shouldn't hurt */ + +# define newconst( sName, sFmt, xValue, newSV ) \ + printf( "sub %s () { " sFmt " }\n", sName, xValue ) + +# define noconst( const ) printf( "push @EXPORT_FAIL, '%s';\n", #const ) + +# define setuv(u) /* Nothing */ + +# ifndef IVdf +# define IVdf "ld" +# endif +# ifndef UVuf +# define UVuf "lu" +# endif +# ifndef UVxf +# define UVxf "lX" +# endif +# ifndef NV_DIG +# define NV_DIG 15 +# endif + +static char * +escquote( const char *sValue ) +{ + Size_t lLen= 1+2*strlen(sValue); + char *sEscaped= (char *) malloc( lLen ); + char *sNext= sEscaped; + if( NULL == sEscaped ) { + fprintf( stderr, "Can't allocate %"UVuf"-byte buffer (errno=%d)\n", + U_V(lLen), _errno ); + exit( 1 ); + } + while( '\0' != *sValue ) { + switch( *sValue ) { + case '\'': + case '\\': + *(sNext++)= '\\'; + } + *(sNext++)= *(sValue++); + } + *sNext= *sValue; + return( sEscaped ); +} + +#endif + + +#ifdef __cplusplus + +class _const2perl { + public: + char msBuf[64]; /* Must fit sprintf of longest NV */ +#ifndef CONST2WRITE_PERL + HV *mHvStash; + AV *mAvExportFail; + SV *mpSvNew; + _const2perl::_const2perl( char *sModName ) { + mHvStash= gv_stashpv( sModName, TRUE ); + SV **pSv= hv_fetch( mHvStash, "EXPORT_FAIL", 11, TRUE ); + GV *gv; + char *sVarName= (char *) malloc( 15+strlen(sModName) ); + strcpy( sVarName, sModName ); + strcat( sVarName, "::EXPORT_FAIL" ); + gv= gv_fetchpv( sVarName, 1, SVt_PVAV ); + mAvExportFail= GvAVn( gv ); + } +#else + _const2perl::_const2perl( char *sModName ) { + ; /* Nothing to do */ + } +#endif /* CONST2WRITE_PERL */ + void mkconst( char *sName, unsigned long uValue ) { + setuv(uValue); + newconst( sName, "0x%"UVxf, uValue, mpSvNew ); + } + void mkconst( char *sName, unsigned int uValue ) { + setuv(uValue); + newconst( sName, "0x%"UVxf, uValue, mpSvNew ); + } + void mkconst( char *sName, unsigned short uValue ) { + setuv(uValue); + newconst( sName, "0x%"UVxf, uValue, mpSvNew ); + } + void mkconst( char *sName, long iValue ) { + newconst( sName, "%"IVdf, iValue, newSViv(iValue) ); + } + void mkconst( char *sName, int iValue ) { + newconst( sName, "%"IVdf, iValue, newSViv(iValue) ); + } + void mkconst( char *sName, short iValue ) { + newconst( sName, "%"IVdf, iValue, newSViv(iValue) ); + } + void mkconst( char *sName, double nValue ) { + newconst( sName, "%s", + Gconvert(nValue,NV_DIG,0,msBuf), newSVnv(nValue) ); + } + void mkconst( char *sName, char *sValue ) { + newconst( sName, "'%s'", escquote(sValue), newSVpv(sValue,0) ); + } + void mkconst( char *sName, const void *pValue ) { + setuv((UV)pValue); + newconst( sName, "0x%"UVxf, (UV)(pValue), mpSvNew ); + } +/*#ifdef HAS_QUAD + * HAS_QUAD only means pack/unpack deal with them, not that SVs can. + * void mkconst( char *sName, Quad_t *qValue ) { + * newconst( sName, "0x%"QVxf, qValue, newSVqv(qValue) ); + * } + *#endif / * HAS_QUAD */ +}; + +#define START_CONSTS( sModName ) _const2perl const2( sModName ); +#define const2perl( const ) const2.mkconst( #const, const ) + +#else /* __cplusplus */ + +# ifndef CONST2WRITE_PERL +# define START_CONSTS( sModName ) \ + HV *mHvStash= gv_stashpv( sModName, TRUE ); \ + AV *mAvExportFail; \ + SV *mpSvNew; \ + { char *sVarName= malloc( 15+strlen(sModName) ); \ + GV *gv; \ + strcpy( sVarName, sModName ); \ + strcat( sVarName, "::EXPORT_FAIL" ); \ + gv= gv_fetchpv( sVarName, 1, SVt_PVAV ); \ + mAvExportFail= GvAVn( gv ); \ + } +# else +# define START_CONSTS( sModName ) /* Nothing */ +# endif + +#define const2perl( const ) do { \ + if( const < 0 ) { \ + newconst( #const, "%"IVdf, const, newSViv((IV)const) ); \ + } else { \ + setuv( (UV)const ); \ + newconst( #const, "0x%"UVxf, const, mpSvNew ); \ + } \ + } while( 0 ) + +#endif /* __cplusplus */ + + +//Example use: +//#include <const2perl.h> +// { +// START_CONSTS( "Package::Name" ) /* No ";" */ +//#ifdef $const +// const2perl( $const ); +//#else +// noconst( $const ); +//#endif +// } +// sub ? { my( $sConstName )= @_; +// return $sConstName; # "#ifdef $sConstName" +// return FALSE; # Same as above +// return "HAS_QUAD"; # "#ifdef HAS_QUAD" +// return "#if 5.04 <= VERSION"; +// return "#if 0"; +// return 1; # No #ifdef +/* #endif / * _INCLUDE_CONST2PERL_H */ diff --git a/win32/ext/Win32API/File/ppport.h b/win32/ext/Win32API/File/ppport.h new file mode 100644 index 0000000000..68147571f6 --- /dev/null +++ b/win32/ext/Win32API/File/ppport.h @@ -0,0 +1,283 @@ + +#ifndef _P_P_PORTABILITY_H_ +#define _P_P_PORTABILITY_H_ + +/* Perl/Pollution/Portability Version 1.0007etm */ + +/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and + distributed under the same license as any version of Perl. */ + +/* For the latest version of this code, please retreive the Devel::PPPort + module from CPAN, contact the author at <kjahds@kjahds.com>, or check + with the Perl maintainers. */ + +/* If you needed to customize this file for your project, please mention + your changes, and visible alter the version number. */ + + +/* + In order for a Perl extension module to be as portable as possible + across differing versions of Perl itself, certain steps need to be taken. + Including this header is the first major one, then using dTHR is all the + appropriate places and using a PL_ prefix to refer to global Perl + variables is the second. +*/ + + +/* If you use one of a few functions that were not present in earlier + versions of Perl, please add a define before the inclusion of ppport.h + for a static include, or use the GLOBAL request in a single module to + produce a global definition that can be referenced from the other + modules. + + Function: Static define: Extern define: + newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL + +*/ + + +/* To verify whether ppport.h is needed for your module, and whether any + special defines should be used, ppport.h can be run through Perl to check + your source code. Simply say: + + perl -x ppport.h *.c *.h *.xs foo/*.c [etc] + + The result will be a list of patches suggesting changes that should at + least be acceptable, if not necessarily the most efficient solution, or a + fix for all possible problems. It won't catch where dTHR is needed, and + doesn't attempt to account for global macro or function definitions, + nested includes, typemaps, etc. + + In order to test for the need of dTHR, please try your module under a + recent version of Perl that has threading compiled-in. + +*/ + + +/* +#!/usr/bin/perl +@ARGV = ("*.xs") if !@ARGV; +%badmacros = %funcs = %macros = (); $replace = 0; +foreach (<DATA>) { + $funcs{$1} = 1 if /Provide:\s+(\S+)/; + $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; + $replace = $1 if /Replace:\s+(\d+)/; + $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; + $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; +} +foreach $filename (map(glob($_),@ARGV)) { + unless (open(IN, "<$filename")) { + warn "Unable to read from $file: $!\n"; + next; + } + print "Scanning $filename...\n"; + $c = ""; while (<IN>) { $c .= $_; } close(IN); + $need_include = 0; %add_func = (); $changes = 0; + $has_include = ($c =~ /#.*include.*ppport/m); + + foreach $func (keys %funcs) { + if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { + if ($c !~ /\b$func\b/m) { + print "If $func isn't needed, you don't need to request it.\n" if + $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); + } else { + print "Uses $func\n"; + $need_include = 1; + } + } else { + if ($c =~ /\b$func\b/m) { + $add_func{$func} =1 ; + print "Uses $func\n"; + $need_include = 1; + } + } + } + + if (not $need_include) { + foreach $macro (keys %macros) { + if ($c =~ /\b$macro\b/m) { + print "Uses $macro\n"; + $need_include = 1; + } + } + } + + foreach $badmacro (keys %badmacros) { + if ($c =~ /\b$badmacro\b/m) { + $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); + print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; + $need_include = 1; + } + } + + if (scalar(keys %add_func) or $need_include != $has_include) { + if (!$has_include) { + $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). + "#include \"ppport.h\"\n"; + $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; + } elsif (keys %add_func) { + $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); + $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; + } + if (!$need_include) { + print "Doesn't seem to need ppport.h.\n"; + $c =~ s/^.*#.*include.*ppport.*\n//m; + } + $changes++; + } + + if ($changes) { + open(OUT,">/tmp/ppport.h.$$"); + print OUT $c; + close(OUT); + open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); + while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } + close(DIFF); + unlink("/tmp/ppport.h.$$"); + } else { + print "Looks OK\n"; + } +} +__DATA__ +*/ + +#ifndef PERL_REVISION +# ifndef __PATCHLEVEL_H_INCLUDED__ +# include "patchlevel.h" +# endif +# ifndef PERL_REVISION +# define PERL_REVISION (5) + /* Replace: 1 */ +# define PERL_VERSION PATCHLEVEL +# define PERL_SUBVERSION SUBVERSION + /* Replace PERL_PATCHLEVEL with PERL_VERSION */ + /* Replace: 0 */ +# endif +#endif + +#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) + +#ifndef ERRSV +# define ERRSV perl_get_sv("@",FALSE) +#endif + +#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) +/* Replace: 1 */ +# define PL_sv_undef sv_undef +# define PL_sv_yes sv_yes +# define PL_sv_no sv_no +# define PL_na na +# define PL_stdingv stdingv +# define PL_hints hints +# define PL_curcop curcop +# define PL_curstash curstash +# define PL_copline copline +# define PL_Sv Sv +/* Replace: 0 */ +#endif + +#ifndef dTHR +# ifdef WIN32 +# define dTHR extern int Perl___notused +# else +# define dTHR extern int errno +# endif +#endif + +#ifndef boolSV +# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) +#endif + +#ifndef gv_stashpvn +# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) +#endif + +#ifndef newSVpvn +# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) +#endif + +#ifndef newRV_inc +/* Replace: 1 */ +# define newRV_inc(sv) newRV(sv) +/* Replace: 0 */ +#endif + +#ifndef newRV_noinc +# ifdef __GNUC__ +# define newRV_noinc(sv) \ + ({ \ + SV *nsv = (SV*)newRV(sv); \ + SvREFCNT_dec(sv); \ + nsv; \ + }) +# else +# if defined(CRIPPLED_CC) || defined(USE_THREADS) +static SV * newRV_noinc (SV * sv) +{ + SV *nsv = (SV*)newRV(sv); + SvREFCNT_dec(sv); + return nsv; +} +# else +# define newRV_noinc(sv) \ + ((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) +# endif +# endif +#endif + +/* Provide: newCONSTSUB */ + +/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ +#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) + +#if defined(NEED_newCONSTSUB) +static +#else +extern void newCONSTSUB _((HV * stash, char * name, SV *sv)); +#endif + +#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) +void +newCONSTSUB( HV *stash, char *name, SV *sv ) +{ + U32 oldhints = PL_hints; + HV *old_cop_stash = PL_curcop->cop_stash; + HV *old_curstash = PL_curstash; + line_t oldline = PL_curcop->cop_line; + PL_curcop->cop_line = PL_copline; + + PL_hints &= ~HINT_BLOCK_SCOPE; + if (stash) + PL_curstash = PL_curcop->cop_stash = stash; + + newSUB( + +#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) + /* before 5.003_22 */ + start_subparse(), +#else +# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) + /* 5.003_22 */ + start_subparse(0), +# else + /* 5.003_23 onwards */ + start_subparse(FALSE, 0), +# endif +#endif + + newSVOP(OP_CONST, 0, newSVpv(name,0)), + newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ + newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) + ); + + PL_hints = oldhints; + PL_curcop->cop_stash = old_cop_stash; + PL_curstash = old_curstash; + PL_curcop->cop_line = oldline; +} +#endif + +#endif /* newCONSTSUB */ + + +#endif /* _P_P_PORTABILITY_H_ */ diff --git a/win32/ext/Win32API/File/t/file.t b/win32/ext/Win32API/File/t/file.t new file mode 100644 index 0000000000..739b773ad0 --- /dev/null +++ b/win32/ext/Win32API/File/t/file.t @@ -0,0 +1,402 @@ +#!/usr/bin/perl -w +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +BEGIN { $|= 1; print "1..267\n"; } +END {print "not ok 1\n" unless $loaded;} +use Win32API::File qw(:ALL); +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +$test= 1; + +use strict qw(subs); + +$temp= $ENV{"TMP"}; +$temp= $ENV{"TEMP"} unless -d $temp; +$temp= "C:/Temp" unless -d $temp; +$temp= "." unless -d $temp; +$dir= "W32ApiF.tmp"; + +$ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR}; + +chdir( $temp ) + or die "# Can't cd to temp directory, $temp: $!\n"; + +if( -d $dir ) { + print "# deleting $temp\\$dir\\*\n" if glob "$dir/*"; + + for (glob "$dir/*") { + chmod 0777, $_; + unlink $_; + } + rmdir $dir or die "Could not rmdir $dir: $!"; +} +mkdir( $dir, 0777 ) + or die "# Can't create temp dir, $temp/$dir: $!\n"; +print "# chdir $temp\\$dir\n"; +chdir( $dir ) + or die "# Can't cd to my dir, $temp/$dir: $!\n"; + +$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } ); +$ok= ! $h1 && fileLastError() =~ /not find the file?/i; +$ok or print "# ","".fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 2 +if( ! $ok ) { CloseHandle($h1); unlink("ReadOnly.txt"); } + +$ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 3 + +$ok= WriteFile( $h1, "Original text\n", 0, [], [] ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 4 + +$h2= createFile( "ReadOnly.txt", "rcn" ); +$ok= ! $h2 && fileLastError() =~ /file exists?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5 +if( ! $ok ) { CloseHandle($h2); } + +$h2= createFile( "ReadOnly.txt", "rwke" ); +$ok= ! $h2 && fileLastError() =~ /access is denied?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 6 +if( ! $ok ) { CloseHandle($h2); } + +$ok= $h2= createFile( "ReadOnly.txt", "r" ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 7 + +$ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 8 + +$ok= WriteFile( $h1, "ly was other text\n", 0, $len, [] ) + && $len == length("ly was other text\n"); +$ok or print "# <$len> should be <", + length("ly was other text\n"),">: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 9 + +$ok= ReadFile( $h2, $text, 80, $len, [] ) + && $len == length($text); +$ok or print "# <$len> should be <",length($text), + ">: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 10 + +$ok= $text eq "Originally was other text\n"; +if( !$ok ) { + $text =~ s/\r/\\r/g; $text =~ s/\n/\\n/g; + print "# <$text> should be <Originally was other text\\n>.\n"; +} +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 11 + +$ok= CloseHandle($h2); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 12 + +$ok= ! ReadFile( $h2, $text, 80, $len, [] ) + && fileLastError() =~ /handle is invalid?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 13 + +CloseHandle($h1); + +$ok= $h1= createFile( "CanWrite.txt", "rw", FILE_SHARE_WRITE, + { Create=>CREATE_ALWAYS } ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 14 + +$ok= WriteFile( $h1, "Just this and not this", 10, [], [] ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 15 + +$ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 16 + +$ok= OsFHandleOpen( "APP", $h2, "wat" ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 17 + +$ok= $h2 == GetOsFHandle( "APP" ); +$ok or print "# $h2 != ",GetOsFHandle("APP"),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 18 + +{ my $save= select(APP); $|= 1; select($save); } +$ok= print APP "is enough\n"; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 19 + +SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin'; + +$ok= ReadFile( $h1, $text, 0, [], [] ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 20 + +$ok= $text eq "is enough\r\n"; +if( !$ok ) { + $text =~ s/\r/\\r/g; + $text =~ s/\n/\\n/g; + print "# <$text> should be <is enough\\r\\n>\n"; +} +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 21 + +$skip = ""; +if ($^O eq 'cygwin') { + $ok = 1; + $skip = " # skip cygwin can delete open files"; +} +else { + unlink("CanWrite.txt"); + $ok= -e "CanWrite.txt" && $! =~ /permission denied/i; + $ok or print "# $!\n"; +} +print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22 + +close(APP); # Also does C<CloseHandle($h2)> +## CloseHandle( $h2 ); +CloseHandle( $h1 ); + +$ok= ! DeleteFile( "ReadOnly.txt" ) + && fileLastError() =~ /access is denied?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23 + +$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 ) + && fileLastError() =~ /file exists?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24 + +$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 ) + && fileLastError() =~ /access is denied?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25 + +$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" ) + && fileLastError() =~ /not find the file/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26 + +$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 ) + && fileLastError() =~ /not find the file/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27 + +$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" ) + && fileLastError() =~ /file already exists?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28 + +$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 ) + && fileLastError() =~ /file already exists?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 29 + +$ok= CopyFile( "ReadOnly.txt", "ReadOnly.cp", 1 ) + && CopyFile( "CanWrite.txt", "CanWrite.cp", 1 ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 30 + +$ok= ! MoveFileEx( "CanWrite.txt", "ReadOnly.cp", MOVEFILE_REPLACE_EXISTING ) + && fileLastError() =~ /access is denied?|cannot create/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31 + +$ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 32 + +$ok= MoveFile( "CanWrite.cp", "Moved.cp" ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 33 + +$ok= ! unlink( "ReadOnly.cp" ) + && $! =~ /no such file/i + && ! unlink( "CanWrite.cp" ) + && $! =~ /no such file/i; +$ok or print "# $!\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 34 + +$ok= ! DeleteFile( "Moved.cp" ) + && fileLastError() =~ /access is denied?/i; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35 + +system( "attrib -r Moved.cp" ); + +$ok= DeleteFile( "Moved.cp" ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 36 + +$new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX; +$old= SetErrorMode( $new ); +$renew= SetErrorMode( $old ); +$reold= SetErrorMode( $old ); + +$ok= $old == $reold; +$ok or print "# $old != $reold: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 37 + +$ok= ($renew&$new) == $new; +$ok or print "# $new != $renew: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 38 + +$ok= @drives= getLogicalDrives(); +$ok && print "# @drives\n"; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 39 + +$ok= $drives[0] !~ /^[ab]/ || DRIVE_REMOVABLE == GetDriveType($drives[0]); +$ok or print "# ",DRIVE_REMOVABLE," != ",GetDriveType($drives[0]), + ": ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 40 + +$drive= substr( $ENV{WINDIR}, 0, 3 ); + +$ok= 1 == grep /^\Q$drive\E/i, @drives; +$ok or print "# No $drive found in list of drives.\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 41 + +$ok= DRIVE_FIXED == GetDriveType( $drive ); +$ok or print + "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 42 + +$ok= GetVolumeInformation( $drive, $vol, 64, $ser, $max, $flag, $fs, 16 ); +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 43 +$vol= $ser= $max= $flag= $fs= ""; # Prevent warnings. + +chop($drive); +$ok= QueryDosDevice( $drive, $dev, 80 ); +$ok or print "# $drive: ",fileLastError(),"\n"; +if( $ok ) { + ( $text= $dev ) =~ s/\0/\\0/g; + print "# $drive => $text\n"; +} +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 44 + +$bits= GetLogicalDrives(); +$let= 25; +$bit= 1<<$let; +while( $bit & $bits ) { + $let--; + $bit >>= 1; +} +$let= pack( "C", $let + unpack("C","A") ) . ":"; +print "# Querying undefined $let.\n"; + +$ok= DefineDosDevice( 0, $let, $ENV{WINDIR} ); +$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 45 + +$ok= -s $let."/Win.ini" == -s $ENV{WINDIR}."/Win.ini"; +$ok or print "# ", -s $let."/Win.ini", " vs. ", + -s $ENV{WINDIR}."/Win.ini", ": ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 46 + +$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE, + $let, $ENV{WINDIR} ); +$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 47 + +$ok= ! -f $let."/Win.ini" + && $! =~ /no such file/i; +$ok or print "# $!\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 48 + +$ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev ); +if( !$ok ) { + ( $text= $dev ) =~ s/\0/\\0/g; + print "# $let,$text: ",fileLastError(),"\n"; +} +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 49 + +$ok= -f $let.substr($ENV{WINDIR},3)."/win.ini"; +$ok or print "# ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 50 + +$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE + |DDD_RAW_TARGET_PATH, $let, $dev ); +$ok or print "# $let,$dev: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 51 + +my $path = $ENV{WINDIR}; +my $attrs = GetFileAttributes( $path ); +$ok= $attrs != INVALID_FILE_ATTRIBUTES; +$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 52 + +$ok= ($attrs & FILE_ATTRIBUTE_DIRECTORY); +$ok or print "# $path not a directory, attrs=$attrs: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 53 + +$path .= "/win.ini"; +$attrs = GetFileAttributes( $path ); +$ok= $attrs != INVALID_FILE_ATTRIBUTES; +$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 54 + +$ok= !($attrs & FILE_ATTRIBUTE_DIRECTORY); +$ok or print "# $path is a directory, attrs=$attrs: ",fileLastError(),"\n"; +print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 55 + +# DefineDosDevice +# GetFileType +# GetVolumeInformation +# QueryDosDevice +#Add a drive letter that points to our temp directory +#Add a drive letter that points to the drive our directory is in + +#winnt.t: +# get first drive letters and use to test disk and storage IOCTLs +# "//./PhysicalDrive0" +# DeviceIoControl + +my %consts; +my @consts= @Win32API::File::EXPORT_OK; +@consts{@consts}= @consts; + +my( @noargs, %noargs )= qw( + attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives ); +@noargs{@noargs}= @noargs; + +foreach $func ( @{$Win32API::File::EXPORT_TAGS{Func}} ) { + delete $consts{$func}; + if( defined( $noargs{$func} ) ) { + $ok= ! eval("$func(0,0)") && $@ =~ /(::|\s)_?${func}A?[(:\s]/; + } else { + $ok= ! eval("$func()") && $@ =~ /(::|\s)_?${func}A?[(:\s]/; + } + $ok or print "# $func: $@\n"; + print $ok ? "" : "not ", "ok ", ++$test, "\n"; +} + +foreach $func ( @{$Win32API::File::EXPORT_TAGS{FuncA}}, + @{$Win32API::File::EXPORT_TAGS{FuncW}} ) { + $ok= ! eval("$func()") && $@ =~ /::_?${func}\(/; + delete $consts{$func}; + $ok or print "# $func: $@\n"; + print $ok ? "" : "not ", "ok ", ++$test, "\n"; +} + +foreach $const ( keys(%consts) ) { + $ok= eval("my \$x= $const(); 1"); + $ok or print "# Constant $const: $@\n"; + print $ok ? "" : "not ", "ok ", ++$test, "\n"; +} + +chdir( $temp ); +if (-e "$dir/ReadOnly.txt") { + chmod 0777, "$dir/ReadOnly.txt"; + unlink "$dir/ReadOnly.txt"; +} +unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt"; +rmdir $dir; + +__END__ diff --git a/win32/ext/Win32API/File/t/tie.t b/win32/ext/Win32API/File/t/tie.t new file mode 100644 index 0000000000..ec2f7c2cf9 --- /dev/null +++ b/win32/ext/Win32API/File/t/tie.t @@ -0,0 +1,79 @@ +#!perl +# vim:syntax=perl: + +BEGIN { $|= 1; print "1..10\n"; } +END { print "not ok 1\n" unless $main::loaded; } + +use strict; +use warnings; +use Win32API::File qw(:ALL); +use IO::File; + +$main::loaded = 1; + +print "ok 1\n"; + +unlink "foo.txt"; + +my $fh = new Win32API::File "+> foo.txt" + or die fileLastError(); + +my $tell = tell $fh; +print "# tell \$fh == '$tell'\n"; +print "not " unless + tell $fh == 0; +print "ok 2\n"; + +my $text = "some text\n"; + +print "not " unless + print $fh $text; +print "ok 3\n"; + +$tell = tell $fh; +print "# after printing 'some text\\n', tell is: '$tell'\n"; +print "not " unless + $tell == length($text) + 1; +print "ok 4\n"; + +print "not " unless + seek($fh, 0, 0) == 0; +print "ok 5\n"; + +print "not " unless + not eof $fh; +print "ok 6\n"; + +my $readline = <$fh>; + +my $pretty_readline = $readline; +$pretty_readline =~ s/\r/\\r/g; $pretty_readline =~ s/\n/\\n/g; +print "# read line is '$pretty_readline'\n"; + +print "not " unless + $readline eq "some text\r\n"; +print "ok 7\n"; + +print "not " unless + eof $fh; +print "ok 8\n"; + +print "not " unless + close $fh; +print "ok 9\n"; + +# Test out binmode (should be only LF with print, no CR). + +$fh = new Win32API::File "+> foo.txt" + or die fileLastError(); +binmode $fh; +print $fh "hello there\n"; +seek $fh, 0, 0; + +print "not " unless + <$fh> eq "hello there\n"; +print "ok 10\n"; + +close $fh; + +unlink "foo.txt"; diff --git a/win32/ext/Win32API/File/typemap b/win32/ext/Win32API/File/typemap new file mode 100644 index 0000000000..d5957652f9 --- /dev/null +++ b/win32/ext/Win32API/File/typemap @@ -0,0 +1,140 @@ +BOOL T_BOOL +LONG T_IV +HKEY T_UV +HANDLE T_UV +DWORD T_UV +oDWORD O_UV +UINT T_UV +REGSAM T_UV +SECURITY_INFORMATION T_UV +char * T_BUF +WCHAR * T_BUF +BYTE * T_BUF +void * T_BUF +ValEntA * T_BUF +ValEntW * T_BUF +SECURITY_DESCRIPTOR * T_BUF +SECURITY_ATTRIBUTES * T_BUF +LPOVERLAPPED T_BUF +LONG * T_IVBUF +DWORD * T_UVBUF +LPDWORD T_UVBUF +oDWORD * O_UVBUF +HKEY * T_UVBUFP +oHKEY * O_UVBUFP +FILETIME * T_SBUF + +############################################################################# +INPUT +T_BOOL + $var= null_arg($arg)||!SvTRUE($arg) ? ($type)0 : looks_like_number($arg) ? ($type)SvIV($arg) : ($type)1 +T_BUF + if( null_arg($arg) ) + $var= NULL; + else + $var= ($type) SvPV( $arg, PL_na ) +T_SBUF + grow_buf( $var,$arg, $type ) +T_IV + $var= null_arg($arg) ? ($type)0 : INT2PTR($type,SvIV($arg)) +T_UV + $var= null_arg($arg) ? ($type)0 : INT2PTR($type,SvUV($arg)) +O_IV + $var= optIV($arg) +O_UV + $var= optUV($arg) +T_IVBUF + if( null_arg($arg) ) + $var= NULL; + else + *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= SvIV($arg) +T_UVBUF + if( null_arg($arg) ) + $var= NULL; + else + *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= SvUV($arg) +O_IVBUF + if( null_arg($arg) ) + $var= NULL; + else + *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= + SvOK($arg) ? SvIV($arg) : 0; +O_UVBUF + if( null_arg($arg) ) + $var= NULL; + else + *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= + SvOK($arg) ? SvUV($arg) : 0; +T_IVBUFP + if( null_arg($arg) ) + $var= NULL; + else + *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= (void *)SvIV($arg) +T_UVBUFP + if( null_arg($arg) ) + $var= NULL; + else + *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= (void *)SvUV($arg) +O_IVBUFP + if( null_arg($arg) ) + $var= NULL; + else + *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= + SvOK($arg) ? (void *)SvIV($arg) : 0; +O_UVBUFP + if( null_arg($arg) ) + $var= NULL; + else + *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= + SvOK($arg) ? (void *)SvUV($arg) : 0; + +############################################################################# +OUTPUT +T_BOOL + if( ! null_arg($arg) && ! SvREADONLY($arg) ) { + if( $var ) { + sv_setiv( $arg, (IV)$var ); + } else { + sv_setsv( $arg, &PL_sv_no ); + } + } +T_BUF + ; +T_SBUF + trunc_buf( RETVAL, $var,$arg ); +T_IV + if( ! null_arg($arg) && ! SvREADONLY($arg) ) + sv_setiv( $arg, PTR2IV($var) ); +T_UV + if( ! null_arg($arg) && ! SvREADONLY($arg) ) + sv_setuv( $arg, PTR2UV($var) ); +O_IV + if( ! null_arg($arg) ) + sv_setiv( $arg, PTR2IV($var) ); +O_UV + if( ! null_arg($arg) ) + sv_setuv( $arg, PTR2UV($var) ); +T_IVBUF + if( ! null_arg($arg) && ! SvREADONLY($arg) ) + sv_setiv( $arg, (IV)*($var) ); +T_UVBUF + if( ! null_arg($arg) && ! SvREADONLY($arg) ) + sv_setuv( $arg, (UV)*($var) ); +O_IVBUF + if( ! null_arg($arg) ) + sv_setiv( $arg, (IV)*($var) ); +O_UVBUF + if( ! null_arg($arg) ) + sv_setuv( $arg, (UV)*($var) ); +T_IVBUFP + if( ! null_arg($arg) && ! SvREADONLY($arg) ) + sv_setiv( $arg, (IV)*($var) ); +T_UVBUFP + if( ! null_arg($arg) && ! SvREADONLY($arg) ) + sv_setuv( $arg, (UV)*($var) ); +O_IVBUFP + if( ! null_arg($arg) ) + sv_setiv( $arg, (IV)*($var) ); +O_UVBUFP + if( ! null_arg($arg) ) + sv_setuv( $arg, (UV)*($var) ); |