根据照片文件的EXIF信息来分目录整理

unit FfrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls,FileCtrl, ComCtrls;

type
  TfrmMain = class(TForm)
    edtSrcDir: TLabeledEdit;
    SpeedButton1: TSpeedButton;
    edtDesDir: TLabeledEdit;
    SpeedButton2: TSpeedButton;
    chkIncludeSubDir: TCheckBox;
    rgCat: TRadioGroup;
    rgExist: TRadioGroup;
    cmbDirType: TComboBox;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Memo1: TMemo;
    Label2: TLabel;
    memLog: TMemo;
    prgMain: TProgressBar;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
    function ProcessFile(vFileName:String):Boolean;
    function GetFileExifDate(vFileName:String):TDateTime;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

procedure SearchFile(Path:string;MatchStr:string;var List:TStrings;IncludeSubDir:Boolean);

implementation

uses Exif;

{$R *.dfm}

procedure SearchFile(Path:string;MatchStr:string;var List:TStrings;IncludeSubDir:Boolean);
var
  i: Integer;
  bFound:boolean;
  LSrch: TSearchRec;
  SubPath:string;
  SubPaths:TStrings;
begin
  SubPaths:=TStringList.create;
  //找出当前目录下匹配文件
  i := FindFirst(Path +'\'+ MatchStr, faAnyFile, LSrch);
  try
    while i=0 do
    begin
      if (LSrch.Attr and faDirectory)=0 then
        List.Add(Path+'\'+LSrch.Name);
      i := FindNext(LSrch);
    end;
  finally
    FindClose(LSrch);
  end;

  if not IncludeSubDir then exit;

  //找出子目录
  i := FindFirst(Path +'\*.*', faDirectory, LSrch);
  try
    while i=0 do
    begin
      if (LSrch.Name<>'..') and (LSrch.Name<>'.')
        and ((LSrch.Attr and faDirectory)<>0) then
          SubPaths.Add(Path+'\'+LSrch.Name);
      i := FindNext(LSrch);
    end;
  finally
    FindClose(LSrch);
  end;

  try
    for i:=0 to SubPaths.Count-1 do
       SearchFile(SubPaths[i],MatchStr,List,True);
  finally
    SubPaths.free;
  end;
end;

procedure TfrmMain.BitBtn1Click(Sender: TObject);
var
  R:TStrings;
  i:Integer;
begin
  if cmbDirType.Text='' then
  begin
    MessageBox(handle,'请选择目录树样式!','提示窗口',mb_iconinformation);
    exit;
  end;
  try
    R:=TStringList.create;
    SearchFile(edtSrcDir.text,'*.jpg',R,chkIncludeSubDir.Checked);
    //写日志
    memLog.clear;
    memLog.Lines.Add('总共有'+inttostr(R.Count)+'张照片要处理!');
    prgMain.Max:=R.Count;
    for I := 0 to R.Count - 1 do
    begin
      if ProcessFile(R[i]) then
        memLog.Lines.Add('文件'+R[i]+'操作成功!')
      else
        memLog.Lines.Add('文件'+R[i]+'操作失败!');
      prgMain.StepIt;
    end;
  finally
    R.Free;
  end;
end;

function TfrmMain.GetFileExifDate(vFileName: String): TDateTime;
var
  ex : TExif;
  ExifDate:String;
begin
  ex:=TExif.Create;
  try
    ex.ReadFromFile(vFileName);
    if ex.Valid then
    begin
      ExifDate:=ex.DateTime;
      ExifDate[5]:='-';
      ExifDate[8]:='-';
      ExifDate:=Copy(ExifDate,1,10);
      Result:=strtodate(ExifDate);
    end
    else
      Result:=FileDateToDateTime(FileAge(vFileName));
  finally
    ex.Free;
  end;
end;

function TfrmMain.ProcessFile(vFileName: String): Boolean;
var
  DesFileName:String;
  Dir:String;
  DirIsExist,Over:Boolean;
  ExifDateInfo:TDateTime;
begin
  //操作文件
  //建立目标文件
  ExifDateInfo:=GetFileExifDate(vFileName);
  case cmbDirType.ItemIndex  of
    0://年-月-日
      DesFileName:=edtDesDir.text+'\'+FormatDateTime('yyyy',ExifDateInfo)+'\'
        +FormatDateTime('MM',ExifDateInfo)+'\'
        +FormatDateTime('YYYY-MM-DD',ExifDateInfo)+'\'+ExtractFileName(vFileName);
    1://年-日
      DesFileName:=edtDesDir.text+'\'+FormatDateTime('yyyy',ExifDateInfo)+'\'
        +FormatDateTime('yyyy-mm-DD',ExifDateInfo)+'\'+ExtractFileName(vFileName);
    2://年
      DesFileName:=edtDesDir.text+'\'+FormatDateTime('yyyy',ExifDateInfo)+'\'+ExtractFileName(vFileName);
  end;
  //判断是否已存在
  if FileExists(DesFileName) then
  case rgExist.ItemIndex  of
    0:Over:=True;
    1:Over:=False;
    2:DesFileName:=copy(DesFileName,1,length(DesFileName)-4)+FormatDateTime('yyyymmddhhmmss',now)+'.jpg';
  end;

  Dir:=ExtractFilePath(DesFileName);
  if not DirectoryExists(Dir) then
    ForceDirectories(Dir);
  case rgCat.ItemIndex  of
    0:CopyFile(PAnsiChar(vFileName),PAnsiChar(DesFileName),Over);
    1:MoveFile(PAnsiChar(vFileName),PAnsiChar(DesFileName));
  end;

  Result:=True;
end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject);
var
  strPath:String;
begin
  if SelectDirectory('请选择原文件路径:','', strPath) then
  begin
    edtSrcDir.Text :=strPath;
  end;
end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject);
var
  strPath:String;
begin
  if SelectDirectory('请选择目标路径:','', strPath) then
  begin
    edtDesDir.Text :=strPath;
  end;
end;

end.

 

附录：用到的EXIF信息分析文件

{==============================================================================
Component simple read Exif section in Jpeg/Jfif Files.
More information about Exif at www.exif.org

裲mponent written by SimBa aka Dimoniusis
You may use this component absolutely free.

You may talk with me via
e-mail: [email protected]
ICQ: 11152101
Web: http://dimonius.da.ru/

Changes:
Version 1.3
- some more ifd tags implemented
- some bugs fixes

Version 1.2 (Some code by Jim Wood,  e-mail: [email protected])
- some more ifd tags implemented
- corrected work with ReadOnly files

Version 1.1 (By Ive, e-mail: [email protected])
- works now with Motorola and Intel byte order tags
- better offset calculation
- some more ifd tags implemented
- some format functions for rational values
- naming convention changed a little

NOTE: far away from being complete but it seems to
      work with all example files from www.exif.org

- Ive (c) 2003

==============================================================================}

unit Exif;

interface

uses
  Classes, SysUtils;

type
  TIfdTag = packed record
    ID      : Word;       //Tag number
    Typ     : Word;       //Type tag
    Count   : Cardinal;   //tag length
    Offset  : Cardinal;   //Offset / Value
  end;

  TExif = class(TObject)
    private
      FImageDesc          : String;     //Picture description
      FMake               : String;     //Camera manufacturer
      FModel              : String;     //Camere model
      FOrientation        : Byte;       //Image orientation - 1 normal
      FOrientationDesc    : String;     //Image orientation description
      FCopyright          : String;     //Copyright
      FValid              : Boolean;    //Has valid Exif header
      FDateTime           : String;     //Date and Time of Change
      FDateTimeOriginal   : String;     //Original Date and Time
      FDateTimeDigitized  : String;     //Camshot Date and Time
      FUserComments       : String;     //User Comments

      FExposure           : String;     //Exposure
      FFstops             : String;
      FShutterSpeed       : string;
      FAperture           : string;
      FMaxAperture        : string;

      FExposureProgram    : Byte;
      FExposureProgramDesc: string;
      FPixelXDimension    : Cardinal;
      FPixelYDimension    : Cardinal;
      FXResolution        : Cardinal;
      FYResolution        : Cardinal;
      FMeteringMode       : byte;
      FMeteringMethod     : string;
      FLightSource        : Byte;
      FLightSourceDesc    : string;
      FFlash              : Byte;
      FFlashDesc          : string;
      FISO                : Word;
      FSoftware           : string;
      FArtist             : string;
      FCompressedBPP      : string;

      f                   : File;
      ifdp                : Cardinal;
      FSwap               : boolean;
      function  ReadAsci(const Offset, Count: Cardinal): String;
      function  ReadRatio(const Offset: Cardinal; frac: boolean): String; overload;
      function  ReadRatio(const Offset: Cardinal): single; overload;
      procedure ReadTag(var tag: TIfdTag);
      procedure Init;
    function ReadLongIntValue(const Offset: Cardinal): LongInt;
    public
      constructor Create;
      procedure ReadFromFile(const FileName: AnsiString);

      property Valid: Boolean read FValid;
      property ImageDesc: String read FImageDesc;
      property Make: String read FMake;
      property Model: String read FModel;
      property Orientation: Byte read FOrientation;
      property OrientationDesc: String read FOrientationDesc;
      property Copyright: String read FCopyright;
      property DateTime: String read FDateTime;
      property DateTimeOriginal: String read FDateTimeOriginal;
      property DateTimeDigitized: String read FDateTimeDigitized;
      property UserComments: String read FUserComments;
      property Software: String read FSoftware;
      property Artist: String read FArtist;

      property Exposure: String read FExposure;
      property ExposureProgram: byte read FExposureProgram;
      property ExposureProgramDesc: string read FExposureProgramDesc;
      property FStops: String read FFStops;
      property ShutterSpeed: String read FShutterSpeed;
      property Aperture: String read FAperture;
      property MaxAperture: String read FMaxAperture;
      property CompressedBPP: String read FCompressedBPP;

      property PixelXDimension: Cardinal read FPixelXDimension;
      property PixelYDimension: Cardinal read FPixelYDimension;
      property XResolution: Cardinal read FXResolution;
      property YResolution: Cardinal read FYResolution;
      property MeteringMode: byte read FMeteringMode;
      property MeteringMethod: string read FMeteringMethod;
      property LightSource: byte read FLightSource;
      property LightSourceDesc: string read FLightSourceDesc;
      property Flash: byte read FFlash;
      property FlashDesc: string read FFlashDesc;
      property ISO: Word read FISO;
  end;

implementation

uses
  Math;

type
  TMarker = packed record
    Marker  : Word;      //Section marker
    Len     : Word;      //Length Section
    Indefin : Array [0..4] of Char; //Indefiner - "Exif" 00, "JFIF" 00 and ets
    Pad     : Char;      //0x00
  end;

  TIFDHeader = packed record
    pad       : Byte; //00h
    ByteOrder : Word; //II (4D4D) or MM
    i42       : Word; //2A00 (magic number from the 'Hitchhikers Guide'
    Offset    : Cardinal; //0th offset IFD
    Count     : Word;     // number of IFD entries
  end;

function SwapLong(Value: Cardinal): Cardinal;
asm bswap eax end;

procedure TExif.ReadTag(var tag: TIfdTag);
begin
  BlockRead(f,tag,12);
  if FSwap then with tag do begin // motorola or intel byte order ?
    ID  := Swap(ID);
    Typ := Swap(Typ);
    Count := SwapLong(Count);
    if (Typ=1) or (Typ=3) then
      Offset := (Offset shr 8) and $FF
    else
      Offset  := SwapLong(Offset);
    end
  else with tag do begin
    if ID<>$8827 then  //ISO Metering Mode not need conversion
      if (Typ=1) or (Typ=3) then
        Offset := Offset and $FF; // other bytes are undefined but maybe not zero
  end;
end;

function TExif.ReadAsci(const Offset, Count: Cardinal): String;
var
  fp: LongInt;
  i: Word;
begin
  SetLength(Result,Count);
  fp:=FilePos(f); //Save file offset
  Seek(f, Offset);
  try
    i:=1;
    repeat
      BlockRead(f,Result[i],1);
      inc(i);
    until (i>=Count) or (Result[i-1]=#0);
    if i<=Count then Result:=Copy(Result,1,i-1);
  except
    Result:='';
  end;
  Result:=TrimRight(Result);
  Seek(f,fp);     //Restore file offset
end;

function TExif.ReadLongIntValue(const Offset: Cardinal): LongInt;
var
  fp: LongInt;
begin
  fp:=FilePos(f); //Save file offset
  Seek(f, Offset);
  try
    BlockRead(f, Result, sizeof(Result));
    if FSwap then Result:=SwapLong(Result);
  except
    Result:=0;
  end;
  Seek(f, fp); //Restore file offset
end;

function TExif.ReadRatio(const Offset: Cardinal; frac: boolean): String;
var
  fp: LongInt;
  nom,denom: cardinal;
begin
  fp:=FilePos(f); //Save file offset
  Seek(f, Offset);
  try
    BlockRead(f,nom,4);
    BlockRead(f,denom,4);
    if FSwap then begin     // !!!
      nom := SwapLong(nom);
      denom := SwapLong(denom);
    end;
    if frac then begin
      str((nom/denom):1:2, result);
      if (length(result)>0) and (result[length(result)]='0') then Result:=copy(Result,1,length(Result)-1);
    end else
      if denom<>1000000 then
        Result:=inttostr(nom)+'/'+inttostr(denom)
      else Result:='0';
  except
    Result:='';
  end;
  Seek(f,fp);     //Restore file offset
end;

function TExif.ReadRatio(const Offset: Cardinal): single;
var
  fp: LongInt;
  nom,denom: cardinal;
begin
  fp:=FilePos(f); //Save file offset
  Seek(f, Offset);
  try
    BlockRead(f,nom,4);
    BlockRead(f,denom,4);
    if FSwap then begin     // !!!
      nom := SwapLong(nom);
      denom := SwapLong(denom);
    end;
    Result:=nom/denom;
  except
    Result:=0.0;
  end;
  Seek(f,fp);     //Restore file offset
end;

procedure TExif.Init;
begin
  ifdp:=0;

  FImageDesc:='';
  FMake:='';
  FModel:='';
  FOrientation:=0;
  FOrientationDesc:='';
  FDateTime:='';
  FCopyright:='';
  FValid:=False;
  FDateTimeOriginal:='';
  FDateTimeDigitized:='';
  FUserComments:='';
  FExposure:='';
  FFstops:='';
  FShutterSpeed := '';
  FAperture := '';
  FExposureProgram:=0;
  FExposureProgramDesc:='';
  FPixelXDimension:=0;
  FPixelYDimension:=0;
  FMeteringMode:=0;
  FMeteringMethod:='';
  FLightSource:=0;
  FLightSourceDesc:='';
  FFlash:=0;
  FFlashDesc:='';
  FISO:=0;
  FCompressedBPP:='';
  FArtist:='';
  FSoftware:='';
  FMaxAperture:='';
  FXResolution:=0;
  FYResolution:=0;
end;

constructor TExif.Create;
begin
  Init;
end;

procedure TExif.ReadFromFile(const FileName: AnsiString);
const
  orient   : Array[1..9] of String=('Normal','Mirrored','Rotated 180','Rotated 180, mirrored','Rotated 90 left, mirrored','Rotated 90 right','Rotated 90 right, mirrored','Rotated 90 left','Unknown');
  ExplType : Array[1..9] of String=('Unknown','Manual Control','Normal Program','Aperture Priority', 'Shutter Priority', 'Creative Program','Action Program','Portrait Mode','Landscape Mode');
  Meter    : Array[0..7] of String=('Unknown','Average','Center Weighted Average','Spot','Multi Spot','Pattern','Partial','Other');
var
  j:      TMarker;
  ifd:    TIFDHeader;
  off0:   Cardinal; //Null Exif Offset
  tag:    TIfdTag;
  i:      Integer;
  n:      Single;
  SOI:    Word; //2 bytes SOI marker. FF D8 (Start Of Image)
  IfdCnt: Word;
  Tmp   : string;

begin
  if not FileExists(FileName) then exit;
  Init;

  System.FileMode:=0; //Read Only open
  AssignFile(f,FileName);
  reset(f,1);

  BlockRead(f,SOI,2);
  if SOI=$D8FF then begin //Is this Jpeg
    BlockRead(f,j,9);

    if j.Marker=$E0FF then begin //JFIF Marker Found
      Seek(f,20); //Skip JFIF Header
      BlockRead(f,j,9);
    end;

    //Search Exif start marker;
    if j.Marker<>$E1FF then begin
      i:=0;
      repeat
        BlockRead(f,SOI,2); //Read bytes.
        inc(i);
      until (EOF(f) or (i>1000) or (SOI=$E1FF));
      //If we find maker
      if SOI=$E1FF then begin
        Seek(f,FilePos(f)-2); //return Back on 2 bytes
        BlockRead(f,j,9);     //read Exif header
      end;
    end;

    if j.Marker=$E1FF then begin //If we found Exif Section. j.Indefin='Exif'.
      FValid:=True;
      off0:=FilePos(f)+1;   //0'th offset Exif header
      BlockRead(f,ifd,11);  //Read IDF Header
      FSwap := ifd.ByteOrder=$4D4D; // II or MM  - if MM we have to swap
      if FSwap then begin
        ifd.Offset := SwapLong(ifd.Offset);
        ifd.Count  := Swap(ifd.Count);
      end;
      if ifd.Offset <> 8 then begin
        Seek(f, FilePos(f)+abs(ifd.Offset)-8);
      end;

      if (ifd.Count=0) then ifd.Count:=100;

      for i := 1 to ifd.Count do begin
        ReadTag(tag);
        case tag.ID of
              0: break;
  // ImageDescription
          $010E: FImageDesc:=ReadAsci(tag.Offset+off0, tag.Count);
  // Make
          $010F: FMake:=ReadAsci(tag.Offset+off0, tag.Count);
  // Model
          $0110: FModel:=ReadAsci(tag.Offset+off0, tag.Count);
  // Orientation
          $0112: begin
                   FOrientation:= tag.Offset;
                   if FOrientation in [1..8] then
                     FOrientationDesc:=orient[FOrientation]
                   else
                     FOrientationDesc:=orient[9];//Unknown
                 end;
  // DateTime
          $0132: FDateTime:=ReadAsci(tag.Offset+off0, tag.Count);
  // CopyRight
          $8298: FCopyright:=ReadAsci(tag.Offset+off0, tag.Count);
  // Software
          $0131: FSoftware:=ReadAsci(tag.Offset+off0, tag.Count);
  // Artist
          $013B: FArtist:=ReadAsci(tag.Offset+off0, tag.Count);
  // Exif IFD Pointer
          $8769: ifdp:=Tag.Offset; //Read Exif IFD offset
  //XResolution
          $011A: FXResolution := ReadLongIntValue(Tag.Offset+off0);
  //YResolution
          $011B: FYResolution := ReadLongIntValue(Tag.Offset+off0);
        end;
      end;

      if ifdp>0 then begin
        Seek(f,ifdp+off0);
        BlockRead(f,IfdCnt,2);
        if FSwap then IfdCnt := swap(IfdCnt);
        for i := 1 to IfdCnt do begin
          ReadTag(tag);
  {
          You may simple realize read this info:

          Tag |Name of Tag

          9000 ExifVersion
          0191 ComponentsConfiguration
          0392 BrightnessValue
          0492 ExposureBiasValue
          0692 SubjectDistance
          0A92 FocalLength
          9092 SubSecTime
          9192 SubSecTimeOriginal
          9292 SubSecTimeDigitized
          A000 FlashPixVersion
          A001 Colorspace
  }
          case tag.ID of
                0: break;
  // ExposureTime
            $829A: FExposure:=ReadRatio(tag.Offset+off0, false)+' seconds';
  // Compressed Bits Per Pixel
            $9102: FCompressedBPP:=ReadRatio(tag.Offset+off0, true);
  // F-Stop
            $829D: FFStops:=ReadRatio(tag.Offset+off0, true);
  // FDateTimeOriginal
            $9003: FDateTimeOriginal:=ReadAsci(tag.OffSet+off0,tag.Count);
  // DateTimeDigitized
            $9004: FDateTimeDigitized:=ReadAsci(tag.OffSet+off0,tag.Count);
  // ShutterSpeed
            $9201: try
                     n:=ReadRatio(tag.Offset+off0);
                     if n<65535 then begin
                       str(power(2,n):1:0,tmp);
                       FShutterSpeed:='1/'+tmp+' seconds';
                     end else FShutterSpeed:='1 seconds';
                   except
                     FShutterSpeed:='';
                   end;
  //ISO Speed
            $8827: FISO:=Tag.Offset;
  // Aperture
            $9202: FAperture:=ReadRatio(tag.Offset+off0, true);
  // Max Aperture
            $9205: FMaxAperture:=ReadRatio(tag.Offset+off0, true);
  // UserComments
            $9286: FUserComments:=ReadAsci(tag.OffSet+off0,tag.Count);
  // Metering Mode
            $9207: begin
                     FMeteringMode := Tag.OffSet;
                     if Tag.OffSet in [0..6] then
                       FMeteringMethod := Meter[Tag.OffSet]
                     else
                       if Tag.OffSet=7 then
                         FMeteringMethod := Meter[7]  //Other
                       else
                         FMeteringMethod := Meter[0]; //Unknown
                   end;
  // Light Source
             $9208: begin
                     FLightSource:=Tag.OffSet;
                     case Tag.OffSet of
                        0: FLightSourceDesc := 'Unknown';
                        1: FLightSourceDesc := 'Daylight';
                        2: FLightSourceDesc := 'Flourescent';
                        3: FLightSourceDesc := 'Tungsten';
                       10: FLightSourceDesc := 'Flash';
                       17: FLightSourceDesc := 'Standard Light A';
                       18: FLightSourceDesc := 'Standard Light B';
                       19: FLightSourceDesc := 'Standard Light C';
                       20: FLightSourceDesc := 'D55';
                       21: FLightSourceDesc := 'D65';
                       22: FLightSourceDesc := 'D75';
                      255: FLightSourceDesc := 'Other';
                     else
                       FLightSourceDesc := 'Unknown';
                     end;
                   end; 
  //Flash
            $9209: begin
                     FFlash:=Tag.OffSet;
                     case Tag.OffSet of
                       0: FFlashDesc := 'No Flash';
                       1: FFlashDesc := 'Flash';
                       5: FFlashDesc := 'Flash No Strobe';
                       7: FFlashDesc := 'Flash Strobe';
                      25: FFlashDesc := 'Flash (Auto)';
                     else
                       FFlashDesc := 'No Flash';
                     end;
                   end;
  //Exposure
            $8822: begin
                     FExposureProgram:=Tag.OffSet;
                     if Tag.OffSet in [1..8] then
                       FExposureProgramDesc := ExplType[Tag.OffSet]
                     else
                       FExposureProgramDesc := ExplType[9];
                   end;
  //PixelXDimension
             $A002: FPixelXDimension := Tag.Offset;
  //PixelYDimension
             $A003: FPixelYDimension := Tag.Offset;
          end;
        end;
      end;
    end;
  end;
  CloseFile(f);
end;

end.