Foxtable(狐表)用户栏目专家坐堂 → 怎么读取相片的拍摄时间


  共有2184人关注过本帖树形打印复制链接

主题:怎么读取相片的拍摄时间

帅哥哟,离线,有人找我吗?
恒隆君
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:二尾狐 帖子:496 积分:4055 威望:0 精华:0 注册:2017/7/5 16:15:00
怎么读取相片的拍摄时间  发帖心情 Post By:2019/10/3 22:47:00 [只看该作者]

请指教,谢谢~

怎么读取相片的拍摄时间

不是文件的创建时间
[此贴子已经被作者于2019/10/3 23:01:30编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
恒隆君
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:二尾狐 帖子:496 积分:4055 威望:0 精华:0 注册:2017/7/5 16:15:00
  发帖心情 Post By:2019/10/3 23:17:00 [只看该作者]

想实现以下功能,
根据相片的拍摄时间重命名,并移到年月命名的文件夹。

比如拍摄时间2018-08-01 18:10:09
则相片重命名为:20180801181009
移至文件夹:201808

Dim lj As String = FileSys.GetParentPath(FileSys.GetParentPath(ProjectPath))
'Output.Show(lj)
For Each File As String In FileSys.GetFiles(lj)
    Dim ifo As new FileInfo(File)
    Dim rq As Date = ifo.CreationTime
    Dim mm As String
    mm = format(rq,"yyyyMM")
    '   Output.Show(file)
    '  Output.Show(rq)
    Dim fn = FileSys.GetName(File)
    Dim lj2 As String = lj &"\" & mm &"\" & fn
    '  Output.Show(lj2)
    If FileSys.DirectoryExists(lj &"\"& mm) Then '如果目录存在
        FileSys.MoveFile(File, lj &"\" & mm &"\" & fn)
    Else
        FileSys.CreateDirectory(lj &"\"& mm)
        
        FileSys.MoveFile(File, lj &"\" & mm &"\" & fn)
    End If
Next

 回到顶部
帅哥哟,离线,有人找我吗?
狐狸爸爸
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:管理员 帖子:47448 积分:251060 威望:0 精华:91 注册:2008/6/17 17:14:00
  发帖心情 Post By:2019/10/4 9:45:00 [只看该作者]

测试通过:

Dim theImage As Image  = Image.FromFile("c:\aaa\IMG_20170625_142200.jpg")
Dim propItems()  As System.Drawing.Imaging.PropertyItem  = theImage.PropertyItems
Dim propItem  As System.Drawing.Imaging.PropertyItem = theImage.GetPropertyItem(36867)
Dim propItemValue() As Byte = propItem.Value
Dim dateTimeStr As String = System.Text.Encoding.ASCII.GetString(propItemValue).Trim(chr(0))
Dim dt As Date = DateTime.ParseExact(dateTimeStr, "yyyy:MM:dd HH:mm:ss",System.Globalization.CultureInfo.InvariantCulture)
MessageBox.show(dt)

 回到顶部
帅哥哟,离线,有人找我吗?
恒隆君
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:二尾狐 帖子:496 积分:4055 威望:0 精华:0 注册:2017/7/5 16:15:00
  发帖心情 Post By:2019/10/4 10:35:00 [只看该作者]

每次只能建好文件夹,移动图片时,就报错
另一个进程已占用。



Dim lj As String = FileSys.GetParentPath(FileSys.GetParentPath(ProjectPath))
'Output.Show(lj)
For Each File As String In FileSys.GetFiles(lj)
'读取相片拍摄日期
Dim theImage As Image  = Image.FromFile(file)
Dim propItems()  As System.Drawing.Imaging.PropertyItem  = theImage.PropertyItems
Dim propItem  As System.Drawing.Imaging.PropertyItem = theImage.GetPropertyItem(36867)
Dim propItemValue() As Byte = propItem.Value
Dim dateTimeStr As String = System.Text.Encoding.ASCII.GetString(propItemValue).Trim(chr(0))
Dim rq As Date = DateTime.ParseExact(dateTimeStr, "yyyy:MM:dd HH:mm:ss",System.Globalization.CultureInfo.InvariantCulture)
  

MessageBox.Show("已完成")
[此贴子已经被作者于2019/10/4 10:52:07编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
狐狸爸爸
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:管理员 帖子:47448 积分:251060 威望:0 精华:91 注册:2008/6/17 17:14:00
  发帖心情 Post By:2019/10/4 10:51:00 [只看该作者]

Dim theImage As Image  = Image.FromFile("c:\aaa\IMG_20170625_142200.jpg")
Dim propItems()  As System.Drawing.Imaging.PropertyItem  = theImage.PropertyItems
Dim propItem  As System.Drawing.Imaging.PropertyItem = theImage.GetPropertyItem(36867)
Dim propItemValue() As Byte = propItem.Value
Dim dateTimeStr As String = System.Text.Encoding.ASCII.GetString(propItemValue).Trim(chr(0))
Dim dt As Date = DateTime.ParseExact(dateTimeStr, "yyyy:MM:dd HH:mm:ss",System.Globalization.CultureInfo.InvariantCulture)
theImage.Dispose
MessageBox.show(dt)

 回到顶部
帅哥哟,离线,有人找我吗?
恒隆君
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:二尾狐 帖子:496 积分:4055 威望:0 精华:0 注册:2017/7/5 16:15:00
  发帖心情 Post By:2019/10/4 11:59:00 [只看该作者]

如果全部移完之后,怎么增加一个提示?

Dim xplj As String = e.Form.Controls("相片地址").text
Dim cflj As String = e.Form.Controls("存放地址").text
For Each File As String In FileSys.GetFiles(xplj)
    If file.EndsWith("jpg") Then  ' 不加这句就出现"内存不足"报错;加了就是出现 "无相关属性"报错,并且完全没有移到相片命名
        '读取相片拍摄日期
        Dim theImage As Image  = Image.FromFile(file)
        Dim propItems()  As System.Drawing.Imaging.PropertyItem  = theImage.PropertyItems
        Dim propItem  As System.Drawing.Imaging.PropertyItem = theImage.GetPropertyItem(36867)
        Dim propItemValue() As Byte = propItem.Value
        Dim dateTimeStr As String = System.Text.Encoding.ASCII.GetString(propItemValue).Trim(chr(0))
        Dim rq As Date = DateTime.ParseExact(dateTimeStr, "yyyy:MM:dd HH:mm:ss",System.Globalization.CultureInfo.InvariantCulture)
        theImage.Dispose
        Dim mm As String
        mm = format(rq,"yyyyMM")
        Dim fn = FileSys.GetName(File)
        
        If FileSys.DirectoryExists(cflj &"\"& mm) Then '如果目录存在
            FileSys.MoveFile(File, cflj &"\" & mm &"\" & fn)
            FileSys.RenameFile(cflj &"\" & mm &"\" & fn, rq)
        Else
            FileSys.CreateDirectory(cflj &"\"& mm)
            FileSys.MoveFile(File, cflj &"\" & mm &"\" & fn)
            FileSys.RenameFile(cflj &"\" & mm &"\" & fn, rq)
        End If
    End If
Next

已上传附件,默认密码。
请帮忙改一下。谢谢
[此贴子已经被作者于2019/10/4 12:02:19编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
恒隆君
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:二尾狐 帖子:496 积分:4055 威望:0 精华:0 注册:2017/7/5 16:15:00
  发帖心情 Post By:2019/10/4 12:03:00 [只看该作者]

已上传附件,默认密码。
请帮忙改一下。谢谢

 回到顶部
帅哥哟,离线,有人找我吗?
有点酸
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1093 积分:6682 威望:0 精华:0 注册:2013/7/1 9:05:00
  发帖心情 Post By:2019/10/4 16:27:00 [只看该作者]

Dim theImage As Image  = Image.FromFile("c:\aaa\abc.jpg")
Dim propItems()  As System.Drawing.Imaging.PropertyItem  = theImage.PropertyItems
If array.Indexof(theImage.PropertyIdList,"36867") <0 Then
   MessageBox.show("此图片没日期属性")
   Return Nothing
End If
Dim propItem  As System.Drawing.Imaging.PropertyItem = theImage.GetPropertyItem(36867)
Dim propItemValue() As Byte = propItem.Value
Dim dateTimeStr As String = System.Text.Encoding.ASCII.GetString(propItemValue).Trim(chr(0))
Dim dt As Date = DateTime.ParseExact(dateTimeStr, "yyyy:MM:dd HH:mm:ss",System.Globalization.CultureInfo.InvariantCulture)
theImage.Dispose
MessageBox.show(dt)

 回到顶部