######################################################  LEO SuperCool BBS / LeoBBS X / 雷傲極酷超級論壇  ####################################################### 基于山鷹(糊)、花無缺制作的 LB5000 XP 2.30 免費版  ##   新版程序制作 & 版權所有: 雷傲科技 (C)(R)2004    #######################################################      主頁地址： http://www.LeoBBS.com/            ##      論壇地址： http://bbs.LeoBBS.com/            ######################################################package ExifTool;use strict;require 5.002;require Exporter;use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);$VERSION = '2.3.6';@ISA = qw(Exporter);@EXPORT_OK = qw(ImageInfo LoadAllTables GetDescriptions GetShortcuts                SetVerbose SetDateFormat EnablePrintConversion                EnableCompositeTags WarnDuplicateTags                SetByteOrder Get16u Get16s Get32u Get32s);sub JpgInfo($);sub TiffInfo($);sub GifInfo($);sub ProcessExif($$);sub ProcessExifDir($$$$$$;$);sub BuildCompositeTags();sub FoundTag($$;$$);sub GetTagInfo($$);sub SaveDescriptions($);sub GetTagTable($);sub TagTableKeys($);sub ExpandShortcuts($);sub ExtractBinary($$;$);sub AddCompositeTags($);sub HexDump($;$%);sub HexDumpTag($$;$%);# extra tags that aren't truly EXIF tags, but are generated by the script%ExifTool::extraTags = (    'Comment'   => { 'Name'=>'Comment'  },    'FileName'  => { 'Name'=>'FileName' },    'FileSize'  => { 'Name'=>'FileSize',  'PrintConv'=>'sprintf("%.0fKB",$val/1024)' },    'ExifData'  => { 'Name'=>'ExifData',  'PrintConv'=>'"(Exif data block)"' },);# public ExifTool variables$ExifTool::verbose = 0;     # flag for verbose printing (1=verbose, 2=very verbose)# byte sizes for the various EXIF format typesmy @formatSize = (0,1,1,2,4,8,1,1,2,4,8,4,8);# other variablesmy %allTables;              # list of all tables loadedmy $swap_bytes;             # set if EXIF header is not native byte orderingmy $native_byte_order;      # native (CPU) byte ordering (0=big endian, 1=little)my %tagValueConv;           # tag values saved after valueConvmy %tagPrintConv;           # tag values saved after printConvmy %compositeTags;          # composite tagsmy %tagDescriptions;        # descriptions for all tagsmy %fileOrder;              # order that tags were found in the filemy $numTagsFound;           # number of tags foundmy $doPrintConversion = 1;  # flag to enable print conversion (PrintConv)my $warnDuplicates;         # flag to warn about duplicate tag namesmy $filename;               # image file namemy $exifData;               # EXIF data blockmy $verbose = 0;            # flag for verbose printing (1=verbose, 2=very verbose)my $doComposite = 1;        # flag to enable composite tagsmy $file_size;              # size of filemy $file_pointer;           # pointer to filemy $requestedTags;          # reference to list of requested tag names (case insensitive)my $date_format;            # format for printed dates (strftime format string)# special tag names (not used for tag info)my %specialTags = ( 'TableType'=>1, 'Format'=>1  ); #------------------------------------------------------------------------------# ImageInfo - return specified information from image file# Inputs: 0) filename#         1-N) list of tag names to find (or tag list reference or options reference)# Returns: reference to hash of tag/value pairs (with "Error" entry on error)# Notes:#   - if no tags names are specified, the values of all tags are returned#   - can pass a reference to list of tags to find, in which case the list#     will be updated with the tags found in the proper case and in the specified#     order.#   - case pass reference to hash specifying options# Options:#   SORT - sort order of returned tags: (INPUT [default], FILE or ALPHA)# Examples:#   my $tags = ExifTool::ImageInfo($file, 'DateTimeOriginal', 'ImageSize');#   my $tags = ExifTool::ImageInfo($file, \@tag_list, { SORT=>'FILE'} );sub ImageInfo($;){    $filename = shift;    my $sortOrder;    # must load our main tag tables to get shortcuts, etc    GetTagTable("TagTables::Exif::Main");    # handle our input arguments    my $arg;    my @tag_args;    while (defined ($arg = shift)) {        if (ref $arg eq 'ARRAY') {            $requestedTags = $arg;        } elsif (ref $arg eq 'HASH') {            $sortOrder = $$arg{'SORT'};        } else {            push @tag_args, $arg;        }    }    if ($requestedTags) {        push @$requestedTags, @tag_args;    } else {        $requestedTags = \@tag_args;    }    # initialize global variables    undef %tagValueConv;    undef %tagPrintConv;    undef %fileOrder;    $numTagsFound = 0;    # expand shortcuts    ExpandShortcuts($requestedTags);    $file_size = -s $filename;    unless (defined $file_size) {        warn "Error opening file $filename\n";        return { Error => 'Error opening file' };    }    my $name = $filename;    $name =~ s/.*\///;  # remove path    FoundTag('FileName', $name);    FoundTag('FileSize', $file_size);    undef $exifData;        # clear current EXIF data    # read tags from the file    if (open(EXIFTOOL_FILE,$filename)) {        $file_pointer = \*EXIFTOOL_FILE;        binmode(EXIFTOOL_FILE);        if ($filename =~ /\.(jpg|jpeg|thm)$/i) {            JpgInfo(\*EXIFTOOL_FILE);        } elsif ($filename =~ /\.gif$/i) {            GifInfo(\*EXIFTOOL_FILE);        } elsif ($filename =~ /\.tiff{0,1}$/i) {            TiffInfo(\*EXIFTOOL_FILE);        } elsif ($filename =~ /\.crw$/i) {            GetTagTable('TagTables::CanonRaw::Main'); # load the raw tables            TagTables::CanonRaw::RawInfo(\*EXIFTOOL_FILE, $requestedTags);        } else {            warn "Unknown image file type $filename\n";        }    } else {        warn "Error opening file $filename\n";        return { Error => 'Error opening file' };    }    # return binary EXIF data block only if requested    FoundTag('ExifData',$exifData) if grep /^ExifData$/i, @$requestedTags;    # calculate composite tags    BuildCompositeTags() if $doComposite;    close(EXIFTOOL_FILE);   # close the file after building composite tags    # generate the return list and assign values to the input hash    my @tags;    if (@$requestedTags) {        # scan through the requested tags and generate list tags we found        my $tag;        foreach $tag (@$requestedTags) {            unless (defined $fileOrder{$tag}) {                # do case-insensitive check                my @matches = (grep /^$tag$/i, keys %fileOrder);                if (@matches) {                    $tag = $matches[0]; # take first match                } else {                    # bogus file order entry to avoid warning if sorting in file order                    $fileOrder{$tag} = 999;                 }            }            push @tags, $tag;        }    } else {        # return all tags since the input hash is empty        @tags = keys %fileOrder;        # use file order by default if no tags specified        # (no such thing as 'INPUT' order in this case)        $sortOrder = 'FILE' unless $sortOrder and $sortOrder eq 'ALPHA';    }    if ($sortOrder and $sortOrder ne 'INPUT') {        my $order;        if ($sortOrder eq 'ALPHA') {            $order = sub { $a cmp $b };        } else {            $order = sub { $fileOrder{$a} <=> $fileOrder{$b} };        }        @$requestedTags = sort $order @tags;    } else {        @$requestedTags = @tags;    }    # build hash of return values    my %returnedTagHash;    foreach (@$requestedTags) {        $returnedTagHash{$_} = $tagPrintConv{$_} if defined $tagPrintConv{$_};    }    return \%returnedTagHash;}#------------------------------------------------------------------------------# load all TagTablessub LoadAllTables(){    # load all of our non-referenced tables    GetTagTable('TagTables::Exif::Main');    GetTagTable('TagTables::CanonRaw::Main');    GetTagTable('TagTables::XMP::Main');    GetTagTable('TagTables::IPTC::Main');    my @tableNames = keys %allTables;    # recursively load all tables referenced by the current tables    while (@tableNames) {        my $tableName = pop @tableNames;        my $table = GetTagTable($tableName);        # look for any SubDirectory tables        foreach (TagTableKeys($table)) {            my @infoArray = GetTagInfoArray($table,$_);            my $tagInfo;            foreach $tagInfo (@infoArray) {                my $subdir = $$tagInfo{'SubDirectory'} or next;                my $tableName = $$subdir{'TagTable'} or next;                next if $allTables{$tableName}; # next if table already loaded                push @tableNames, $tableName;   # must scan this one too            }        }    }}#------------------------------------------------------------------------------# Expand shortcuts# Inputs: 0) reference to list of tagssub ExpandShortcuts($){    my $tagList = shift || return;    # expand shortcuts    my @expandedTags;    my $tag;EXPAND_TAG:    foreach $tag (@$tagList) {        foreach (keys %TagTables::Exif::Shortcuts) {            /^$tag$/i or next;            push @expandedTags, @{$TagTables::Exif::Shortcuts{$_}};            next EXPAND_TAG;        }        push @expandedTags, $tag;    }    @$tagList = @expandedTags;}#------------------------------------------------------------------------------# Access functions# Set verbose messagessub SetVerbose { ++$verbose; ++$ExifTool::verbose; }# Enable warnings about duplicate tagssub WarnDuplicateTags() { $warnDuplicates = 1; }# Get reference to hash of tag descriptionssub GetDescriptions() { return \%tagDescriptions; }# Get reference to shortcuts hashsub GetShortcuts() { return \%TagTables::Exif::Shortcuts; }# Set time formatsub SetDateFormat($) { $date_format = shift; }#------------------------------------------------------------------------------# Enable/Disable print conversion# Inputs: 0) undefined or non-zero to enable print conversion, 0 to disable# Returns: old value of print conversion flagsub EnablePrintConversion{    my $oldVal = $doPrintConversion;    $doPrintConversion = shift;    $doPrintConversion = 1 unless defined $doPrintConversion;    return $oldVal;}#------------------------------------------------------------------------------# Enable/Disable calculation of composite tags# Inputs: 0) undefined or non-zero to enable composite tags, 0 to disable# Returns: old value of composite flagsub EnableCompositeTags{    my $oldVal = $doComposite;    $doComposite = shift;    $doComposite = 1 unless defined $doComposite;    return $oldVal;}#------------------------------------------------------------------------------# Utility routines to for reading binary data values from file# - uses value of $swap_bytes to determine byte ordering#sub Get16(@){    my $template = shift;    my $dataPt = shift;    my $pos = shift || 0;    my $val;    if ($swap_bytes) {        $val = substr($$dataPt,$pos+1,1) . substr($$dataPt,$pos,1);    } else {        $val = substr($$dataPt,$pos,2);    }    defined($val) or return undef;    return unpack($template,$val);}sub Get32(@){    my $template = shift;    my $dataPt = shift;    my $pos = shift || 0;    my $val;    if ($swap_bytes) {        $val = substr($$dataPt,$pos+3,1) . substr($$dataPt,$pos+2,1) .                substr($$dataPt,$pos+1,1) . substr($$dataPt,$pos,1);    } else {        $val = substr($$dataPt,$pos,4);    }    defined($val) or return undef;    return unpack($template,$val);}sub Get64(@){    my $template = shift;    my $dataPt = shift;    my $pos = shift || 0;    my $val;    if ($swap_bytes) {        $val = substr($$dataPt,$pos+7,1) . substr($$dataPt,$pos+6,1) .