http://qs321.pair.com?node_id=423356
Category: Win32 Stuff
Author/Contact Info ZlR
Description:

This is a perl 5.6 function that will do a SystemTimeToFileTime conversion, without using Win32::API.

The FileTime is an internal win32 date format described by microsoft as "a 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (UTC)" .

This function takes for argument a time in the form of a ($sec,$min,$hour,$mday,$mon,$year) list and returns the equivalent date in the Filetime format.

In my case this was usefull to write computed times into the registry, which allowed to control start and stop times of some windows functions and services . For this reason the result is a coma separated list which was expected by the registry. Join the result if you need the "raw" Fileformat

Note that this code works for Perl 5.6 , which Math::BigInt lacks proper hex conversion functions : thanks a lot to ysth for the 5.6 equivalent as the as_hex() . Also thanks to this post for the as_int :)


use Time::Local ;
use Math::BigInt ;

sub SysToHex {

    my ($sec,$min,$hour,$mday,$mon,$year)= @_ ;
    my $sectime = timegm($sec,$min,$hour,$mday,$mon,$year) ;
    
    my @hexReg1601  ;  # Result
    
    # Conversion to intervals of 100 nanosecondes since 1970 
    my $secsystime = Math::BigInt -> new( $sectime )  ;
    my $nano100= Math::BigInt -> new(10000000)  ;
    my$nanosecsys = $secsystime -> bmul ( $nano100 ) ;
    
    # 100 ns intervals since 1601 and 1970
    # obtained within windows by manualy
    # entering the date 01/01/1970
    my $hex1970 = '0x019DB1DED53E8000' ;
    my $nano1970 = X2I ( $hex1970 ) ;
    
    # Total number of 100ns intervals
    my $sec1601 = $nano1970 + $nanosecsys ; 
    my $hex1601 = I2X ( $sec1601) ;
    
    # This coma separated format is expected by the registry
    my @liste1601 = split ( "", $hex1601 ) ;
    unshift (@liste1601, "0" ) unless ( @liste1601 % 2 == 0 )  ;
    while (@liste1601)  { 
    push ( @hexReg1601, splice (  @liste1601, -2 ), "," ) 
    }
    pop @hexReg1601 ; # Gets rid of the last coma
    
    return join ( "", @hexReg1601 ) ;

} 

sub X2I {
    my $n = shift;
    $n = '0' x (4 - (length($n) % 4)) . $n;
    my $m = Math::BigInt->new(0);
    while ( my $o = substr($n, 0, 4, '') ) {
        $m = $m * 65536 + hex $o;
    } 
    $m;
}


sub I2X {
    my $i = shift;
    my $hex = '';
        do {
        my $mod = $i % 16;
        $hex .= sprintf("%x", $mod);
        } while $i = $i / 16;
        scalar reverse $hex;
}