| |
|
|
| | Сталкнулся с такой ситуацией:
после поездки нужно было закатать фотографии от всех участников на один диск 
Решение - в одну директорию в хронологическом порядке (переименовывание фоток через Picasa в формате времени съемки).
НО, у врех на фотиках разное время  - и опять мешанина 
Поэтому наваял процедурку которая эту проблемку решает.
Мож кому пригодится еще 
Public Sub RetimeFoto(sPathInput As String)
'=======================================================================================
'Приведение фотографий из различных источников к одному формату
'
'Вход:
' sPathInput - Путь к директории с файлами
'Remark:
' Предварительно необходимо выяснить время смещения каждого фотоаппарата от эталона
' и заполнить его.
'---------------------------------------------------------------------------------------
'Crete:
' Date: 2008-03-31
' By: Dekhtyar Konstantin
'=======================================================================================
Dim objShellApp As Variant
Dim objFolder As Variant
Dim objItem As Variant
Dim sFileOutput As String
Dim iCount As Long
On Error GoTo Err_Debug
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(CStr(sPathInput)) ' взять директорию
For Each objItem In objFolder.Items() ' пробег по всей директории (без учета вложенных)
If Right(objItem.Path, 4) = ".jpg" Then ' если фото, то работаем
Select Case objFolder.GetDetailsOf(objItem, 24) 'смотрим марку фотоаппарата
Case "Canon PowerShot S80"
' берем дату (без секунд) из 25 свойства и последние 2 цифры (секунды) из 31
' плюс необходимое смещение в зависимости от конкретного фотика
' и представляем в виде год-месяц-число часы-минуты-секунды
sFileOutput = Format(CDate(objFolder.GetDetailsOf(objItem, 25)) + 1 + (4 / 24), "yyyy-mm-dd hh-nn") & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)
Case "Canon PowerShot A620"
sFileOutput = Format(CDate(objFolder.GetDetailsOf(objItem, 25)) + (4 / 24), "yyyy-mm-dd hh-nn") & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)
Case "PENTAX Optio W30"
sFileOutput = Format(CDate(objFolder.GetDetailsOf(objItem, 25)) + (3 / 24), "yyyy-mm-dd hh-nn") & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)
Case "Canon DIGITAL IXUS 50"
sFileOutput = Format(CDate(objFolder.GetDetailsOf(objItem, 25)) + (2 / 24), "yyyy-mm-dd hh-nn") & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)
End Select
If Not (objItem.Name = sFileOutput) Then ' если новое имя не равно старому
iCount = 0
' проверка на наличие файла с таким именем в данной директории
' при наличии добавлям в конец (порядковый №)
Do Until objFolder.ParseName(CStr(sFileOutput & IIf(iCount > 0, "(" & iCount & ")", vbNullString) & ".jpg")) Is Nothing
iCount = iCount + 1
Loop
sFileOutput = sFileOutput & IIf(iCount > 0, "(" & iCount & ")", vbNullString)
objItem.Name = sFileOutput ' меняем имя файла
End If
End If
Next objItem
MsgBox "Процедура выполнена!", vbInformation + vbOKOnly, "Выполнено!"
Exit_Here:
Set objItem = Nothing
Set objFolder = Nothing
Set objShellApp = Nothing
Exit Sub
Err_Debug:
MsgBox Err.Description
Resume Exit_Here
End Sub
|
ЗЫ. Временные смещения здесь даны для моего конкретного случая. Берутся путем нехитрых манипуляций: найти фотографии сделанные в одно время , но разными фотиками. Смотрим их время съемки и находим смещение относительно друг друга.
А дальше два варианта: известно точное время одной из фотографий (от нее и пляшем), или один из фотиков принимаем за эталон. | |
| |
| |
| |
|
|
| | А ты империческим путем определил смещение? А смещение оно из-за типа аппарата или оно везде по разному указанного владельцам времени? | |
| |
| |
| |
|
|
| | просто на фотиках разное время установлено. Кто-то живет в другом временном поясе, у кого-то дата сбита и т.д.
Да и скопом привести ко времени места отдыха нормально, а в уме проводить вычисления типа фотография от 6:00 по Москве, значит там было уже 10:00
ЗЫ. Щас пытаюсь в простой VBScript перевести, запустить и не парится. | |
| |
| |
| |
|
|
| | Щас пытаюсь в простой VBScript перевести, запустить и не парится.
Димы убери и все  | |
| |
| |
| |
|
|
| | не все так просто, попробуй сам.
Плюс я там хочу чуть доделать-подкрутить. | |
| |
| |
| |
|
|
| | Ну это я так... 
непомню Cdate и format вроде нет... | |
| |
| |
| |
|
|
| | Ну вроде так,
в простом текстовом редакторе вставить и сохранить с разрешением .VBS
call RetimeFoto()
Function IIf(bTest, vTrue, vFalse)
If Eval(strIF) Then
IIf = vTrue
Else
IIf = vFalse
End If
End Function
Sub RetimeFoto()
'=======================================================================================
'Приведение фотографий из различных источников к одному формату
'
'Вход:
'
'Remark:
' Предварительно необходимо выяснить время смещения каждого фотоаппарата от эталона
' и заполнить его.
'---------------------------------------------------------------------------------------
'Crete:
' Date: 2008-03-31
' By: Dekhtyar Konstantin
'=======================================================================================
Set objShellApp = CreateObject("Shell.Application")
' выбор директории
Set objFolder = objShellApp.BrowseForFolder(0, "Выберите папку с фотографиями.", &H200 + &H10 + &H40)
For Each objItem In objFolder.Items() ' пробег по всей директории (без учета вложенных)
If lCase(Right(objItem.Path, 4)) = ".jpg" Then ' если фото, то работаем
Select Case objFolder.GetDetailsOf(objItem, 24) 'смотрим марку фотоаппарата
Case "Canon PowerShot S80"
' берем дату (без секунд) из 25 свойства и последние 2 цифры (секунды) из 31
' плюс необходимое смещение в зависимости от конкретного фотика
' и представляем в виде год-месяц-число часы-минуты-секунды
FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + 1 + (4 / 24)
Case "Canon PowerShot A620"
FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + (4 / 24)
' Case "Canon PowerShot A620"
' FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + (4 / 24)
Case "PENTAX Optio W30"
FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + (3 / 24)
Case "Canon DIGITAL IXUS 50"
FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + (2 / 24)
Case Else
FileDate = CDate(objFolder.GetDetailsOf(objItem, 25))
End Select
sFileOutput = Year(FileDate) _
& "-" & Right("00" & Month(FileDate), 2) _
& "-" & Right("00" & Day(FileDate), 2) _
& " " & Right("00" & Hour(FileDate), 2) _
& "-" & Right("00" & Minute(FileDate), 2) _
& "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)
If Not (objItem.Name = sFileOutput) Then ' если новое имя не равно старому
iCount = 0
' проверка на наличие файла с таким именем в данной директории
' при наличии добавлям в конец (порядковый №)
bTest = objFolder.ParseName(CStr(sFileOutput & IIf(iCount = 0,"","(" & cStr(iCount) & ")") & ".jpg")) Is Nothing
Do Until bTest
iCount = iCount + 1
Loop
sFileOutput = sFileOutput & IIf(iCount > 0, "(" & iCount & ")", vbNullString)
If lCase(Right(objItem.Name, 4)) = ".jpg" Then ' если в оригинале прописано расширение то добавляем
sFileOutput = sFileOutput & ".jpg"
End If
objItem.Name = sFileOutput ' меняем имя файла
End If
End If
Next
MsgBox "Процедура выполнена!", vbInformation + vbOKOnly, "Выполнено!"
End Sub
|
| |
| |
| |
| |
|
|
| | а где сам отчет то обещанный :)))???? | |
| |
| |
| |
|
|
| |  ну дык это, готовится вобщем
| |
| |
| |
| |
|
|
| | знакомая ситуация :) летний отчек готов к зиме, а зимний к лету :))
успехов! ждёмся! | |
| |
| |
