view release on metacpan or  search on metacpan

lib/Archive/Unrar.pm  view on Meta::CPAN

read_registry() unless ($ANSI_CP && $OEM_CP) ; 

################ PRIVATE METHODS ################ 

sub read_registry { ##Get system wide default encoding values 
	my $key;
	my $type;
	RegOpenKeyEx( HKEY_LOCAL_MACHINE,"SYSTEM\\CurrentControlSet\\Control\\Nls\\CodePage",0,KEY_READ,$key);
	RegQueryValueEx( $key, "ACP", [], $type, $ANSI_CP, [] ) or $ANSI_CP="1252";
	RegQueryValueEx( $key, "OEMCP", [], $type, $OEM_CP, [] ) or $OEM_CP="437";
	RegCloseKey($key);
	
	$ANSI_CP="cp".$ANSI_CP;
	$OEM_CP="cp".$OEM_CP;
}

sub declare_win32_functions {
	
	my $RAR_functions_ref = shift;
	
#fill hash byref
 %$RAR_functions_ref = (   
			RAROpenArchiveEx => new Win32::API( 'unrar.dll', 'RAROpenArchiveEx', 'P', 'N' ),
			RARCloseArchive =>  new Win32::API( 'unrar.dll', 'RARCloseArchive', 'N', 'N' ),
			RAROpenArchive => new Win32::API( 'unrar.dll', 'RAROpenArchive', 'P', 'N' ),
			RARReadHeader => new Win32::API( 'unrar.dll', 'RARReadHeader', 'NP', 'N' ),
			RARProcessFile => new Win32::API( 'unrar.dll', 'RARProcessFile', 'NNPP', 'N' ),
			RARSetPassword => new Win32::API( 'unrar.dll', 'RARSetPassword', 'NP', 'V' )
			);
		
		 
		 while ((undef, my $value) = each(%$RAR_functions_ref)){
                die "Cannot load function.Is unrar.dll in System32 directory?" if !defined($value) ;
		   }		       		 
		
		return 1;
}



sub extract_headers {

    my ($file,$password) = @_;
	die "Fatal error $! : $file" if (!-e $file);
	
    my $CmtBuf = pack('x'.COMMENTS_BUFFER_SIZE);
    my $continue;
	
	
	my %RAR_functions;
	declare_win32_functions(\%RAR_functions);
		
    my $RAROpenArchiveDataEx_struct =
      pack( 'pLLLPLLLLL32', $file, 0, 2, 0, $CmtBuf, COMMENTS_BUFFER_SIZE, 0, 0, 0,0 );
	
	
    my $handle = $RAR_functions{RAROpenArchiveEx}->Call($RAROpenArchiveDataEx_struct);

   my ( $CmtBuf1, $CmtSize, $CmtState, $flagsEX ) = 
						(unpack( 'pLLLP'.COMMENTS_BUFFER_SIZE.'LLLLL32', $RAROpenArchiveDataEx_struct ))[4,6,7,8];


	#is it really a RAR file? maybe it is a ZIP disguised as a RAR
	if ($handle == 0) {
	   return (undef,undef,ERAR_WRONG_FORMAT);
	}
	 else {
		!$RAR_functions{RARCloseArchive}->Call($handle) || die "Fatal error $!";
	 }

	my $RAROpenArchiveData_struct = pack( 'pLLPLLL', $file, 2, 0, undef, 0, 0, 0 );
	
    my $handle = $RAR_functions{RAROpenArchive}->Call($RAROpenArchiveData_struct);
	
	if ($handle == 0) {
	   return (undef,undef,ERAR_WRONG_FORMAT);
	}
	 
		
	my $RARHeaderData_struct = pack( 'x260x260LLLLLLLLLLPLLL',
			0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );

    my ( $arcname, $filename, $flags);

	unless ($flagsEX & 128){
		if ($RAR_functions{RARReadHeader}->Call( $handle, $RARHeaderData_struct )) {
				!$RAR_functions{RARCloseArchive}->Call($handle) || die "Fatal error $!";		
				return (undef,undef,ERAR_READ_HEADER);
		}
		else
		{	 
			( $arcname, $filename, $flags ) =  unpack( 'Z260Z260L', $RARHeaderData_struct );
			$arcname  =~s/\0//g;
			$filename =~s/\0//g;
		}
	}
	
	printf( "\nFile:    %s\n", $file );
	printf( "\nArchive: %s\n", $arcname );
		
		#transcoding
		my $filename=decode($OEM_CP,$filename);	
		my $filename=encode($ANSI_CP,$filename);	
		printf( "\n(First)Internal Filename: %s\n", $filename );
		
	printf( "\nPassword?:\t%s", 
	      ($flagsEX & 128)? "yes" :( $flags & 4 )     ? "yes" : "no" ); 
    printf( "\nVolume:\t\t%s",     ( $flagsEX & 1 )   ? "yes" : "no" );
    printf( "\nComment:\t%s",      ( $flagsEX & 2 )   ? "yes" : "no" );
    printf( "\nLocked:\t\t%s",     ( $flagsEX & 4 )   ? "yes" : "no" );
    printf( "\nSolid:\t\t%s",      ( $flagsEX & 8 )   ? "yes" : "no" );
    printf( "\nNew naming:\t%s",   ( $flagsEX & 16 )  ? "yes" : "no" );
    printf( "\nAuthenticity:\t%s", ( $flagsEX & 32 )  ? "yes" : "no" );
    printf( "\nRecovery:\t%s",     ( $flagsEX & 64 )  ? "yes" : "no" );
    printf( "\nEncr.headers:\t%s", ( $flagsEX & 128 ) ? "yes" : "no" );
    printf( "\nFirst volume:\t%s\n\n",
        ( $flagsEX & 256 ) ? "yes" : "no or older than 3.0" );

	if ($CmtState==1) {
			$CmtBuf1 = unpack( 'A' . $CmtSize, $CmtBuf1 );