|
PERL那段手上倒有- #
- # Parse a DBPF (Sims etc) file
- #
- use strict;
- my $i;
- my @cparray;
- if (@ARGV!=1) {
- print <<"EOD";
- usage: sdat [whatever.package or whatever]
- Parses the given DBPF file, and says stuff about it.
- EOD
- exit 100;
- }
- my $fn = $ARGV[0];
- print "Reading $fn.\n";
- open FH, "<$fn" or die "Error opening $fn; $!";
- binmode FH;
- my $fs = (stat FH)[7];
- print "$fn is $fs long.\n";
- my $data;
- my $dbpf;
- read FH,$dbpf,4;
- print qq#Magic number is "$dbpf".\n#;
- if ($dbpf ne "DBPF") {
- print " This is probably not a Maxis DBPF file.\n";
- exit 29;
- } else {
- print " This is correct.\n";
- }
- read FH,$data,4;
- my $versionmajor = unpack "V", $data;
- print "Major version is: $versionmajor \n";
- read FH,$data,4;
- my $versionminor = unpack "V", $data;
- print "Minor version is: $versionminor \n";
- print "Unused: ";
- for (1..3) {
- read FH,$data,4;
- my $v = unpack "V", $data;
- printf "%08x ", $v;
- }
- print "\n";
- read FH,$data,4;
- my $created = unpack "V", $data;
- printf "Created: %08x \n", $created;
- read FH,$data,4;
- my $modified = unpack "V", $data;
- printf "Modified: %08x \n", $modified;
- read FH,$data,4;
- my $iversion = unpack "V", $data;
- printf "Index version: %08x \n", $iversion;
- read FH,$data,4;
- my $ientries = unpack "V", $data;
- printf "Index entries: %08x \n", $ientries;
- read FH,$data,4;
- my $ioffset = unpack "V", $data;
- printf "Index offset: %08x \n", $ioffset;
- read FH,$data,4;
- my $isize = unpack "V", $data;
- printf "Index length: %08x \n", $isize;
- my $ientrylength = $isize / $ientries;
- printf "Index entry length: $ientrylength \n";
- read FH,$data,4;
- my $hrentries = unpack "V", $data;
- printf "Hold record entries: %08x \n", $hrentries;
- read FH,$data,4;
- my $hroffset = unpack "V", $data;
- printf "Hole record offset: %08x \n", $hroffset;
- read FH,$data,4;
- my $hrsize = unpack "V", $data;
- printf "Hole record length: %08x \n", $hrsize;
- #my $hrentrylength = $hrsize / $hrentries;
- #printf "Hole record entry length: $hrentrylength \n";
- read FH,$data,4;
- my $unk = unpack "V", $data;
- printf "Unknown: %08x \n", $unk;
- print "Unused: ";
- for (1..32) {
- read FH,$data,1;
- my $v = unpack "c", $data;
- printf "%02x ", $v;
- }
- print "\n";
- seek FH,$ioffset,0;
- for (1..$ientries) {
- printf "Index entry %08x: \n",$_;
- my $typename;
- my $typestring;
- if ($ientrylength==24) {
- read FH,$data,4;
- $typename = unpack "V", $data;
- $typestring = $data;
- }
- read FH,$data,4;
- my $typeid = unpack "V", $data;
- read FH,$data,4;
- my $groupid = unpack "V", $data;
- read FH,$data,4;
- my $instid = unpack "V", $data;
- if ($ientrylength==24) {
- printf " Type/group/instance IDs: %08x (%s) / %08x / %08x / %08x \n", $typename,$typestring,$typeid,$groupid,$instid;
- } else {
- printf " Type/group/instance IDs: %08x / %08x / %08x / %08x \n", $typeid,$groupid,$instid;
- }
- read FH,$data,4;
- my $offset = unpack "V", $data;
- printf " Offset: %08x \n", $offset;
- read FH,$data,4;
- my $size = unpack "V", $data;
- printf " Size: %08x \n", $size;
- my $savepointer = tell FH;
- my $decompressed_data;
- seek FH,$offset,0;
- read FH,$data,4;
- my $bytes = unpack "N", $data;
- printf " First four bytes at offset: %08x \n", $bytes;
- my $dword = unpack "V", $data;
- if ($dword==$size) {
- printf " Probably a compressed file.\n";
- print " Next five bytes: ";
- for (1..5) {
- read FH,$data,1;
- my $v = unpack "C", $data;
- printf "%02x ", $v;
- }
- print "\n";
- $decompressed_data = try_decompress($dword-9);
- } else {
- printf " Probably NOT a compressed file.\n";
- $decompressed_data = $data;
- read FH,$data,$size-4;
- $decompressed_data .= $data;
- }
- open FHOUT,">f:\".$_.".out" or die "Failed to open output.";
- binmode FHOUT;
- print FHOUT $decompressed_data;
- close FHOUT;
- process_file($typeid,$decompressed_data,$ientrylength);
- seek FH,$savepointer,0;
- }
- sub process_file {
- my $ftype = shift;
- my $indata = shift;
- my $magicnumber = shift;
- my $offsetbump = ($magicnumber==24) ? 20 : 16;
- if ($ftype == 0xe86b1eef) {
- print " DIR file \n";
- for (my $offset=0;$offset<length($indata);$offset+=$offsetbump) {
- printf " > Type ID: %08x\n",unpack "V",substr($indata,$offset);
- printf " Group ID: %08x\n",unpack "V",substr($indata,$offset+4);
- printf " Instance ID: %08x\n",unpack "V",substr($indata,$offset+8);
- if ($magicnumber==24) {
- printf " Unknown ID: %08x\n",unpack "V",substr($indata,$offset+12);
- printf " Size: %08x\n",unpack "V",substr($indata,$offset+16);
- } else {
- printf " Size: %08x\n",unpack "V",substr($indata,$offset+12);
- }
- }
- }
- }
- sub try_decompress {
- my $len = shift;
- my $buf;
- my $answer = "";
- my $answerlen = 0;
- my ($numplain,$numcopy,$offset);
- my $sp = tell FH;
- for (;$len>0;) {
- read FH,$buf,1;
- $len -= 1;
- my $cc = unpack "C", $buf;
- # printf " Control char is %02x, len remaining is %08x. \n",$cc,$len;
- if ($cc >= 0xfc) {
- $numplain = $cc & 0x03;
- $numplain = $len if ($numplain > $len);
- $numcopy = 0;
- $offset = 0;
- } elsif ($cc >= 0xe0) {
- $numplain = ($cc - 0xdf) << 2;
- $numcopy = 0;
- $offset = 0;
- } elsif ($cc >= 0xc0) {
- $len -= 3;
- read FH,$buf,1;
- my $byte1 = unpack "C", $buf;
- read FH,$buf,1;
- my $byte2 = unpack "C", $buf;
- read FH,$buf,1;
- my $byte3 = unpack "C", $buf;
- $numplain = $cc & 0x03;
- $numcopy = (($cc & 0x0c) <<6) + 5 + $byte3;
- $offset = (($cc & 0x10) << 12 ) + ($byte1 << 8) + $byte2;
- } elsif ($cc>=0x80) {
- $len -= 2;
- read FH,$buf,1;
- my $byte1 = unpack "C", $buf;
- read FH,$buf,1;
- my $byte2 = unpack "C", $buf;
- $numplain = ($byte1 & 0xc0) >> 6;
- $numcopy = ($cc & 0x3f) + 4;
- $offset = (($byte1 & 0x3f) << 8) + $byte2;
- } else {
- read FH,$buf,1;
- $len -= 1;
- my $byte1 = unpack "C", $buf;
- $numplain = ($cc & 0x03);
- $numcopy = (($cc & 0x1c) >> 2) + 3;
- $offset = (($cc & 0x60) << 3) + $byte1;
- }
- # printf " plain, copy, offset: $numplain, $numcopy, $offset \n";
- $len -= $numplain;
- read FH,$buf,$numplain;
- $answer = $answer.$buf;
- my $fromoffset = length($answer) - ($offset + 1); # 0 == last char
- for ($i=0;$i<$numcopy;$i++) {
- $answer = $answer.substr($answer,$fromoffset+$i,1);
- }
- $answerlen += $numplain;
- $answerlen += $numcopy;
- if ($len<0) { printf " UNDERFLOW \n"; }
- }
- printf " Answer length is %08x (%08x). \n",$answerlen,length($answer);
- seek FH,$sp,0;
- return $answer;
- }
复制代码 |
评分
-
查看全部评分
|