From: Likavcan, Alexander (Alexander.Likavcan@volkswagen.sk)
Date: 13. 02. 2003, 10:24 CET
Zdar a silu Mirex, dna 13.02.2003 si napisal(a):
> na mojej stranke :-) je recenzia programu PIE ktory je presne o tom.
> ak to mas, sem s tym, hned to zpropagujeme.
>
> Mirex.
>
PIE je za peniaze :-( ale vie toho dost
tu je to ten vbs:
vie dokopy h. ale je sadarmo :-))
1. vystrihnut a ulozit najlepsie do adresara SendTo
2. budem rad ak pod nazvom date2name.vbs
3. oznacit subory kliknut na SendTo a vybrat vbs
4. snazit sa zachranit zvysky vasho hardweru vytrhavanim sucasti :-))
-----cut--------------------
'*********************************************************************
'*********create new files from the exif date in jpg files************
'***Created by AleXXX SpPes 2003 in 2 days(kua to trvalo!!)***********
'*********************************************************************
'adresar kam sa to bude vkladat
'ak chcete prepiste tu cestu "D:\Temp\a\" na Vami pozadovanu a mozte
'to len odkliknut. Alebo miesto inputboxu dajte do uvodzoviek cestu
'a nebude sa Vas uz nikdy nic pytat
myTo=inputbox("Napiste adresar kam sa maju fotky ulozit," & vblf & _
"alebo sa pouzije default cesta." & vblf & _
"PS:cesta musi existovat a koncit '\'",_
"EXIF_Date2Name from SpPes","D:\Temp\a\")
'tak na toto potrebujete MSADO min 2.5 a vyššie
Set s = CreateObject("ADODB.Stream")
s.Open
s.Type = 1
'toto je moj oblubeny command
Set objArgs = WScript.Arguments
Set fso = CreateObject("Scripting.FileSystemObject")
for i = 0 to objArgs.count-1
s.LoadFromFile ObjArgs(i)
myLine_a = s.read
for m=year(now) to 1970 step -1
myPosition = instrB(myLine_a,String2Binary(m & ":"))
if myPosition > 0 then exit for
next
myLine = Binary2String(midB(myLine_a,myPosition,19))
myName =replace(myLine,":","_")& ".jpg"
fso.CopyFile objArgs(i),myTo & myName, TRUE
fileToKonv=fileToKonv & objArgs(i) & vblf
next
s.close
Set s = Nothing
MsgBox "Subory: " & vbcrlf & fileToKonv & vbcrlf & _
" skonvertovane.",64,"EXIF_Date2Name from SpPes"
'Toto su funkcie na prevod medzi textom a binarnymi datami
Function Binary2String(B)
Dim Z, S
For Z = 1 To LenB(B)
S =s& chr(AscB(MidB(B, Z, 1)))
Next
Binary2String = S
End Function
Function String2Binary(S)
Dim I, B
For I = 1 To Len(S)
B = B & ChrB(Asc(Mid(S, I, 1)))
Next
String2Binary = B
End Function
----------end cut ---------------------------------
s pozdravom
AleXXX
--
Remember: there are no strangers in the world,
only friends who have not yet met.
This archive was generated by hypermail 2.1.6 : 13. 02. 2003, 10:24 CET