Here's my filetime to epoch conversion code (it is a bit shorter):

sub vtfiletime {
        my $vt = shift;

        $vt = substr($vt, 0, 11);               # strip off anything
past seconds
        $vt -= 11644473600;                     # change offset to jan
1, 1970
        return $vt;
}



-----Original Message-----
From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of
Paul Sobey
Sent: Wednesday, November 17, 2004 10:59 AM
To: [EMAIL PROTECTED]
Subject: FW: Remote Stat -> Slow??


For those interested, I ended up with this. I have no idea whether it
will be threadsafe (need to have a few running in parallel!), but
standalone it's really quick - back down to 1s on that WAN link I
mentioned. No idea why stat would be so much slower - presumably wading
down through perl and C runtime IO layers slows it all down a bit!

Hope it's useful to someone.

P.


use Win32::API;

# $Win32::API::DEBUG = 1;
# Set up structs
Win32::API::Struct->typedef("FILETIME", qw(
        DWORD dwLowDateTime;
        DWORD dwHighDateTime;
));

Win32::API::Struct->typedef("WIN32_FIND_DATA", qw(
        DWORD dwFileAttributes;
        FILETIME ftCreationTime;
        FILETIME ftLastAccessTime;
        FILETIME ftLastWriteTime;
        DWORD nFileSizeHigh;
        DWORD nFileSizeLow;
        DWORD dwReserved0;
        DWORD dwReserved1;
        TCHAR cFileName[260];
        TCHAR cAlternateFileName[14];
));

# Func definitions
my $FindFirstFile = Win32::API->new("kernel32.dll", "FindFirstFile",
"PS", "N") or die; my $FindNextFile  = Win32::API->new("kernel32.dll",
"FindNextFile", "NS", "I") or die;


DirList("C:\\WINNT");



sub DirList {
        my $searchDir = shift;
        my %dir;
        my $FileInfo = Win32::API::Struct->new("WIN32_FIND_DATA");
        my $searchHandle = $FindFirstFile->Call("$searchDir\\*.*",
$FileInfo);
        do {
                my $mTime =
ConvertTime($FileInfo->{ftLastWriteTime}->{dwHighDateTime},$FileInfo->{f
tLastWriteTime}->{dwLowDateTime});
                my $fType = $FileInfo->{dwFileAttributes} & 0x10 ? "1" :
"0";
                my $fName = $FileInfo->{cFileName};
                $dir{$fName} = [ $mTime, $fType ];
        } while (my $result = $FindNextFile->Call($searchHandle,
$FileInfo));
        
        
        return (\%dir);
}




# The following unashamedly pinched from
http://search.cpan.org/src/GAAS/libwww-perl-5.800/lib/HTTP/Cookies/Micro
soft.pm
# was epoch_time_offset_from_win32_filetime
sub ConvertTime {
        my ($high, $low) = @_;

        #--------------------------------------------------------
        # USEFUL CONSTANT
        #--------------------------------------------------------
        # 0x019db1de 0xd53e8000 is 1970 Jan 01 00:00:00 in Win32
FILETIME
        #
        # 100 nanosecond intervals == 0.1 microsecond intervals
        
        my $filetime_low32_1970 = 0xd53e8000;
        my $filetime_high32_1970 = 0x019db1de;

        #------------------------------------
        # ALGORITHM
        #------------------------------------
        # To go from 100 nanosecond intervals to seconds since 00:00 Jan
01 1970:
        #
        # 1. Adjust 100 nanosecond intervals to Jan 01 1970 base
        # 2. Divide by 10 to get to microseconds (1/millionth second)
        # 3. Divide by 1000000 (10 ^ 6) to get to seconds
        #
        # We can combine Step 2 & 3 into one divide.
        #
        # After much trial and error, I came up with the following code
which
        # avoids using Math::BigInt or floating pt, but still gives
correct answers

        # If the filetime is before the epoch, return 0
        if (($high < $filetime_high32_1970) ||
            (($high == $filetime_high32_1970) && ($low <
$filetime_low32_1970)))
        {
                return 0;
        }

        # Can't multiply by 0x100000000, (1 << 32),
        # without Perl issuing an integer overflow warning
        #
        # So use two multiplies by 0x10000 instead of one multiply by
0x100000000
        #
        # The result is the same.
        #
        my $date1970 = (($filetime_high32_1970 * 0x10000) * 0x10000) +
$filetime_low32_1970;
        my $time = (($high * 0x10000) * 0x10000) + $low;

        $time -= $date1970;
        $time /= 10000000;

        return $time;
}




 

________________________________

From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of
Paul Sobey
Sent: 16 November 2004 15:59
To: [EMAIL PROTECTED]
Subject: Remote Stat -> Slow??


I have a routine which takes a directory name and returns a hash keyed
on filename, with arrayrefs containing two values resulting from a stat
of each file. I've found that the routine runs incredibly slowly over a
UNC, particularly if over a WAN link. All I want to get is the filename,
file age, and whether or not it's a directory. I'm confused because the
equivalent DOS dir command on the same UNC runs very quickly - under a
second even across the WAN (vs. around 30 secs for my code!). Is there a
way I could write the following differently to speed it up? It seems a
but nasty to shell out to cmd /c dir and parse the output, but the
relative speed input might outweigh any elegance considerations I have
:)
 
Cheers,
Paul
 
sub DirList {
 my $dir = shift;
 my %dir;
 my $count;
 
 logprint("\t\tSTAT: $dir");
 
 opendir DIR, $dir;
 %dir = map { $_, [ (stat("$dir/$_"))[9], -d _ ] }  # Return hash
entries - names as keys, mtime and -d result as anon array for value
        grep { ! /^\.{1,2}/ }     # Dump . and .. dir entries
        readdir DIR;      # Read directory listing
        
 closedir DIR;
 
 logprint("\t\tSTAT: Done");
 
 return (\%dir);
}



*****************************************************************
Gloucester Research Limited believes the information 
provided herein is reliable. While every care has been 
taken to ensure accuracy, the information is furnished 
to the recipients with no warranty as to the completeness 
and accuracy of its contents and on condition that any 
errors or omissions shall not be made the basis for any 
claim, demand or cause for action.
*****************************************************************


_______________________________________________
Perl-Win32-Users mailing list [EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs

_______________________________________________
Perl-Win32-Users mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs

Reply via email to