Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

Win32 Directory Sync/Briefcase

by runrig (Abbot)
on Nov 08, 2005 at 23:56 UTC ( #506942=sourcecode: print w/ replies, xml ) Need Help??

Category: Win32 Stuff
Author/Contact Info runrig
Description: I needed a replacement for Windows "briefcase" directories, and only needed to sync from a remote directory to a local directory (never the other way as MS briefcases let you do). Should work recursively on sub-directories, but not very tested in that regard (update: I believe there is a bug in this regard when more than one level of sub-directory needs to be created, and no files exist in the higher level). Perl's file stat (and thus '-s' and '-M') are very slow over a VPN connection, so I needed to use the Windows API for getting that information. Also, a real MS briefcase uses a hidden database file which, if corrupted, trashes your briefcase...which I have been bitten by more than once. Thanks to ikegami and others for pointing me in the right direction.

Updated: Check for error when getting directory handle.

Updated: Check for error when reading directory.


# Replacement for Windows "briefcase"
# Will sync files one way from sync directory
# to "briefcase" directory (hardcoded below)

use strict;
use warnings;
use File::Find;
use File::Copy;
use Tk;
use Win32::API;
use Win32::WinError qw( ERROR_NO_MORE_FILES );

# Make sure we see console output

# Get Win32 directory listing functions
my ($find_first_file, $find_nxt_file, $find_close) = import_win32();

# Global variables for "briefcase" and
# the directory to sync it to
# ( TODO: make these into data fields and save as defaults later )
my $brief_dir = "C:\\Briefcase";
my $sync_dir = "O:";

# Make this big enough for directory names
my $chk_wid = 40;

my $mw = MainWindow->new;
$mw->title("Sync Briefcase");

my $frame = $mw->Frame;

  ->Label( -text=>"Sync from $sync_dir to $brief_dir" )->pack;

# Get list of subdirectories
my @dirs = get_dirs( $brief_dir );

# Keep track of which subdirectories are selected
my %sync;

# Just view needed changes or actually copy
  -text=>"Do the copying",
  -variable=>\my $do_copy,
# Default to checked
$do_copy = 1;

# Create a checkbox for every directory
my $all_dirs = 1;
for my $dir (@dirs) {
    -command => sub { $all_dirs = 0 if $sync{$dir} },

# One checkbox to select all directories
  -text=>"All directories",

  ->Button( -text=>"Sync",-command=>\&sync_dirs )

# For status messages
my $msg = $frame
  ->Message( -width => '80c', -textvariable => \my $message )->pack;


# Get list of directories in a directory
sub get_dirs {
  my $dir = shift;
  chdir $dir or die "Dir $dir: $!";
  return grep -d, glob("*");

# Sync a list of directories
sub sync_dirs {

  my @dirs = $all_dirs ? @dirs : grep $sync{$_}, @dirs;
  sync_dir($_) for @dirs;
  dsp_msg( "Done!" );

# Sync the files from a remote to a local directory
sub sync_dir {
  my $dir = shift;
  dsp_msg( "Getting file info for $dir" );
  my $lcl_dir = "$brief_dir\\$dir";
  my $rem_dir = "$sync_dir\\$dir";
  my $lcl_stat = dir_list( $lcl_dir );
  my $rem_stat = dir_list( $rem_dir );
  my %seen;
  my (@copy_files, @create_files, @del_files);
  dsp_msg( "Comparing files in $dir" );
  for my $file ( sort keys %$lcl_stat ) {
    my $stat = $lcl_stat->{$file};
    if ( !exists $rem_stat->{$file} ) {
      print "Delete file $file\n";
      push @del_files, $file;
    } elsif ( $stat ne $rem_stat->{$file} ) {
      print "Copy file $file\n";
      push @copy_files, $file;
  for my $file ( grep !$seen{$_}, sort keys %$rem_stat ) {
    print "Create file $file\n";
    push @create_files, $file;

  if ($do_copy) {
    dsp_msg( "Synching $dir" );
    chdir $rem_dir or die "Can't cd to $rem_dir: $!";
    chdir $lcl_dir or die "Can't cd to $lcl_dir: $!";
    unlink or warn "Error deleting file $_: $^E"
      for sort @copy_files, @del_files;
    my %sub_dirs;
    for my $file ( sort @copy_files, @create_files ) {
      print "Copying $file\n";
      if ( $file =~ /^(.*)\\/ ) {
        my $sub_dir = $1;
        if ( ! $sub_dirs{$sub_dir} ) {
          #  Create non-existant sub-directories
          # '-d' is on local directory, so speed should be ok,
          # If it's a problem, then we should save directory
          # info from the Win32 API calls and work from that
          # BUG HERE: need to create one directory level at a time
          # if file is more than one level deep.
          if ( ! -d $sub_dir ) {
            mkdir $sub_dir or die "Can't create $sub_dir: $^E";
      copy( "$rem_dir\\$file", $file ) or warn "Error copying $file: $
    # Remove empty directories
    # (this is "good enough" for me, I synch files, not
    # neccessarily directory structures)
    finddepth( sub { rmdir }, "." );


# Display message in both the message window
# and on the console
sub dsp_msg {
  my $msg_txt = shift;
  print "$msg_txt\n";
  # Wipe out previous message to avoid odd redraw effects
  $message = " " x (3 * length($msg_txt));
  $message = $msg_txt;

# Import Windows Directory Listing functions
sub import_win32 {

  Win32::API::Struct->typedef( 'FILETIME', qw(
    DWORD LowDateTime;
    DWORD HighDateTime;

  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 tFileName[260];
    TCHAR tAlternateFileName[14];
  my $first_file = Win32::API->new('kernel32', 'FindFirstFile', 'PS', 
  if ( !defined($first_file) ) {
    die "Can't import FindFirstFile: $^E";
  my $nxt_file = Win32::API->new('kernel32', 'FindNextFile', 'NS', 'I'
  if ( !defined($nxt_file) ) {
    die "Can't import FindNextFile: $^E";
  my $close_file = Win32::API->new('kernel32', 'FindClose', 'N', 'I');
  if ( !defined($close_file) ) {
    die "Can't import FindClose: $^E";

  return $first_file, $nxt_file;

# Get directory listing of files and their
# size and modification times from Windows API
sub dir_list {
  my @dirs = my $top_dir = shift;
  my %filestat;
  my $data = Win32::API::Struct->new( 'WIN32_FIND_DATA' );
  while( my $dir = shift @dirs ) {
    ( my $rel_dir = $dir ) =~ s/^\Q$top_dir\E\\?//;
    $rel_dir .= "\\" if $rel_dir;
    my $h = $find_first_file->Call( "$dir\\*", $data );
    if ( defined($h) and $h > 0 ) {
      DIRLOOP: {
        my $file = $data->{tFileName};
        if ( $file !~ /^\.\.?$/ ) {
          # Check if file is really a directory
          if ( $data->{dwFileAttributes} & 16 ) {
            push @dirs, "$dir\\$file";
          } else {
            $filestat{ $rel_dir . $file } = 
              $data->{ftLastWriteTime}->{HighDateTime} . '-' .
              $data->{ftLastWriteTime}->{LowDateTime} . '-' .
              $data->{nFileSizeHigh} . '-' .
        redo DIRLOOP if $find_nxt_file->Call( $h, $data );
    } else {
      die "Error reading $dir: $^E";

  die "Error reading $top_dir: $^E\n" unless $^E + 0 == ERROR_NO_MORE_
  $find_close->Call( $h ) if defined($h);
  return \%filestat;

Comment on Win32 Directory Sync/Briefcase
Download Code

Back to Code Catacombs

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://506942]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (10)
As of 2014-12-26 12:35 GMT
Find Nodes?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?

    Results (171 votes), past polls