How can I edit a binary file under Windows by scripting

Question

I've got some technical files produced by a scientific device. From time to time, these recorded files get corrupted and we have to do some hexadecimal modification by hand.

I'm wondering how I could automate it. I was thinking of Perl, as I've got some knowledge in that, but even if I manage to read the offset of interest, I don't know how to write the new value.

I've got two things to do:

1. Write at offset 4 the size of the file minus 8
2. Count the number of "TRCKfmt" pattern, which is 5452434B666D74 in hex, then write it down at offset 5C (92) in hex value.

I've tried to use sysread and syswrite on a filehandle, but I can't get through the different steps.

Maybe Perl is not a good option, I don't know how to sort it out.

Here is my actual script:

use warnings;
use strict;
use diagnostics;

use Fcntl qw(:seek);

my($fh, $filename, $byte_position, $byte_value);

$filename      = "MYFILE.tac";
$byte_position = 4;
my $filesize = -s $filename;
    print "Size: $filesize\n";
    
    
open($fh, "<", $filename)
  || die "can't open $filename: $!";

binmode($fh)
  || die "can't binmode $filename";

sysseek($fh, $byte_position, SEEK_CUR)  # NB: 0-based
  || die "couldn't see to byte $byte_position in $filename: $!";

sysread($fh, $byte_value, 1) == 1
  || die "couldn't read byte from $filename: $!";

printf "read byte with ordinal value %#02x at position %d\n",
     ord($byte_value), $byte_position;

Answer 1

Here is the working code based on Ikegami's answer:

#!c:/Perl64/bin/perl.exe
use warnings;
use strict;
use diagnostics;


my $dir = 'MYDIRECTORY';

opendir DIR, $dir or die "cannot open dir $dir: $!";
my @files = glob "$dir/*.tac";
closedir(DIR);

foreach(@files){
  my $qfn = $_;

my $file;
{
   open(my $fh, '<:raw', $qfn)
      or die("Can't open \"$qfn\": $!\n");

   local $/;
   $file = <$fh>;
}

{
   my $packed_length = pack('V', length($file) - 8);

   substr($file, 0x0004, length($packed_length), $packed_length);
}

{
   my $num_blocks;
   ++$num_blocks while $file =~ /TRCKfmt/g;
   my $packed_num_blocks = pack('V', $num_blocks);
   substr($file, 0x005C, length($packed_num_blocks), $packed_num_blocks);
}

{
   open(my $fh, '>:raw', $qfn)
      or die("Can't create \"$qfn\": $!\n");

   print($fh $file);
}
}

Answer 2

Let's create a file full of 0 bytes:

C:\...\> perl -E "binmode STDOUT; say qq{\0} x 32 for 1 .. 4" > test
C:\...\> xxd test
00000000: 0000 0000 0000 0000 0000 0000 0000 0000  ................
00000010: 0000 0000 0000 0000 0000 0000 0000 0000  ................
00000020: 0a00 0000 0000 0000 0000 0000 0000 0000  ................
00000030: 0000 0000 0000 0000 0000 0000 0000 0000  ................
00000040: 000a 0000 0000 0000 0000 0000 0000 0000  ................
00000050: 0000 0000 0000 0000 0000 0000 0000 0000  ................
00000060: 0000 0a00 0000 0000 0000 0000 0000 0000  ................
00000070: 0000 0000 0000 0000 0000 0000 0000 0000  ................
00000080: 0000 000a                                ....

The program below reads offsets and replacement bytes from the DATA section. You might want to put those in an external file:

#!/usr/bin/env perl

use strict;
use warnings;

use Fcntl qw(:seek);

@ARGV or die "Need filename\n";
my ($file) = @ARGV;

open my $fh, '+<:raw', $file
    or die "Cannot open '$file': $!";

while (my $edit = <DATA>) {
    next unless $edit =~ /\S/;
    my ($offset, $value) = map hex, split ' ', $edit;
    seek $fh, $offset, SEEK_SET
        or die "Failed to seek to '$offset': $!";
    print $fh chr($value)
        or die "Failed to write new byte '$value' at offset '$offset': $!";
}

close $fh
    or die "Failed to close '$file': $!";

__DATA__
0 64
8 65
10 61
18 64
20 62
28 65
30 65
38 66
40 20

After running the program:

C:\...\> xxd test
00000000: 6400 0000 0000 0000 6500 0000 0000 0000  d.......e.......
00000010: 6100 0000 0000 0000 6400 0000 0000 0000  a.......d.......
00000020: 6200 0000 0000 0000 6500 0000 0000 0000  b.......e.......
00000030: 6500 0000 0000 0000 6600 0000 0000 0000  e.......f.......
00000040: 200a 0000 0000 0000 0000 0000 0000 0000   ...............
00000050: 0000 0000 0000 0000 0000 0000 0000 0000  ................
00000060: 0000 0a00 0000 0000 0000 0000 0000 0000  ................
00000070: 0000 0000 0000 0000 0000 0000 0000 0000  ................
00000080: 0000 000a                                ....

Answer 3

Make it easy on yourself and just load the whole file in memory.

my $qfn = "MYFILE.tac";

my $file;
{
   open(my $fh, '<:raw', $qfn)
      or die("Can't open \"$qfn\": $!\n");

   local $/;
   $file = <$fh>;
}

{
   my $packed_length = pack('N', length($file) - 8);
   substr($file, 0x0004, length($packed_length), $packed_length);
}

{
   my $num_blocks;
   ++$num_blocks while $file =~ /TRCKfmt/g;
   my $packed_num_blocks = pack('N', $num_blocks);
   substr($file, 0x005C, length($packed_num_blocks), $packed_num_blocks);
}

{
   open(my $fh, '>:raw', $qfn)
      or die("Can't create \"$qfn\": $!\n");

   print($fh $file);
}

You didn't say in what format the number should be stored. I assumed they are 32-bit unsigned integers in big-endian byte order.