专家坐堂-怎么读取相片的拍摄时间Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  怎么读取相片的拍摄时间  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=141548)

--  作者：恒隆君
--  发布时间：2019/10/3 22:47:00
--  怎么读取相片的拍摄时间

请指教，谢谢~

怎么读取相片的拍摄时间

不是文件的创建时间

[此贴子已经被作者于2019/10/3 23:01:30编辑过]

--  作者：恒隆君
--  发布时间：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

--  作者：狐狸爸爸
--  发布时间：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)

--  作者：恒隆君
--  发布时间：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编辑过]

--  作者：狐狸爸爸
--  发布时间：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)

--  作者：恒隆君
--  发布时间：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编辑过]

--  作者：恒隆君
--  发布时间：2019/10/4 12:03:00
--

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

--  作者：有点酸
--  发布时间：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)