Миникамера

[zepete]

Сейчас существует маса камер и видеорегистраторов на микросхеме syntetic Syntek STK2365.
Чаще всего они не имеют экрана, для установки времени на них, чаще всего, требуется создавать в корневой папке этой камеры текстовый файл с текущим временем.

По просьбе товарища, туго соображающего в компьютерах, я создал скрипт, который синхронизирует часы камеры с часами компьютера.



'********************************************************************************
'* скрипт для установки времени на миникамере syntetic
'* zepete.livejournal.com
'********************************************************************************
Option Explicit
dim objArgs   : set objArgs=WScript.Arguments
dim FSO    : Set FSO = CreateObject("Scripting.FileSystemObject")
dim WshShell  : set WshShell=WScript.CreateObject("Wscript.Shell")
const namescrpt="Program for set time on mini camera syntetic Syntek STK2365"
const nametimefile="time.txt"
const timeshift=2
dim objWMIService : Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

dim var

sub ErrorExit(str)
 WScript.Echo str
 WScript.Quit
end sub

function fmt( str, args )
 dim res  ' the result string.
 dim val,justification,prnpls,prnsys,width,spcchar,precision
 res = ""

 dim pos  ' the current position in the args array.
 pos = 0

 dim i
 for i = 1 to Len(str)
  ' found a fmt char.
  if Mid(str,i,1)="%" then
   val="":justification="r":prnpls="":prnsys=false:width=0:precision=0:spcchar=" "
   i=i+1
   if Mid(str,i,1)="%" then
    res = res & "%"
   else
'поиск флагов
    do while true
     select case Mid(str,i,1)
      case "-"
       i=i+1 : justification="l"
      case "+"
       i=i+1 : prnpls="+"
      case " "
       i=i+1 : prnpls=" "
      case "#"
       i=i+1 : prnsys=true
      case "0"
       i=i+1 : spcchar="0"
      case else
       exit do
     end select
    loop
'ширина поля, если цифра
    if Mid(str,i,1)="*" then
     width=args(pos):pos = pos+1:i = i + 1
    else
     while (Asc(Mid(str,i,1))-asc("0"))<=9 and (Asc(Mid(str,i,1))-asc("0"))>=0
      width=width*10+Asc(Mid(str,i,1))-asc("0")
      i=i+1
     wend
    end if
'точность
    if Mid(str,i,1)="." then
     i=i+1
     precision=0
     if Mid(str,i,1)="*" then
      precision=args(pos):pos = pos+1:i = i + 1
     else
      while (Asc(Mid(str,i,1))-asc("0"))<=9 and (Asc(Mid(str,i,1))-asc("0"))>=0
       precision=precision*10+Asc(Mid(str,i,1))-asc("0")
       i=i+1
      WEND
     end if
     if precision=0 then precision=-1
    end if
'тип значения
    select case Mid(str,i,1)
     case "d"
'целое со знаком
      val=FormatNumber(abs(args(pos)),0,,false,false)
      if args(pos)<0 then prnpls="-"
      if spcchar="0" then precision=width-len(prnpls)
      if len(val)<precision then val=String(precision-len(val),"0")&val
      val=prnpls&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
     case "i"
      val=FormatNumber(abs(args(pos)),0,,false,false)
      if args(pos)<0 then prnpls="-"
      if spcchar="0" then precision=width-len(prnpls)
      if len(val)<precision then val=String(precision-len(val),"0")&val
      val=prnpls&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
'целое без знака
     case "u"
      val=FormatNumber(abs(args(pos)),0,,false,false)
      if spcchar="0" then precision=width-len(prnpls)
      if len(val)<precision then val=String(precision-len(val),"0")&val
      val=prnpls&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
'восьмиричное
     case "o"
      val=Oct(args(pos))
      if prnsys=true then
       prnsys="0"
      else
       prnsys=""
      end if
      if spcchar="0" then precision=width-len(prnsys)
      if len(val)<precision then val=String(precision-len(val),"0")&val    
      val=prnsys&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
     case "x"
'шестнадцетиричное
      val=LCase(Hex(args(pos)))
      if prnsys=true then
       prnsys="0x"
      else
       prnsys=""
      end if
      if spcchar="0" then precision=width-len(prnsys)
      if len(val)<precision then val=String(precision-len(val),"0")&val    
      val=prnsys&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
     case "X"
'шестнадцетиричное
      val=UCase(Hex(args(pos)))
      if prnsys=true then
       prnsys="0X"
      else
       prnsys=""
      end if
      if spcchar="0" then precision=width-len(prnsys)
      if len(val)<precision then val=String(precision-len(val),"0")&val    
      val=prnsys&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
'с точкой
     case "f"
      if precision=-1 then
       val=FormatNumber(abs(args(pos)),0,,false,false)
      elseif precision=0 then
       val=FormatNumber(abs(args(pos)),,,false,false)
      else
       val=FormatNumber(abs(args(pos)),precision,,false,false)
      end if
      if prnsys=true then
       if InStr(val,".")=0 then val=val&"."
      else
       if mid(val,len(val),1)="." then val=mid(val,1,len(val)-1)
      end if
      if args(pos)<0 then prnpls="-"
      if spcchar="0" then
       if width>(len(val)+len(prnpls)) then
        val=String(width-len(val)-len(prnpls),"0")&val
       end if
      end if
      val=prnpls&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
     case "F"
      if precision=-1 then
       val=FormatNumber(abs(args(pos)),0,,false,false)
      elseif precision=0 then
       val=FormatNumber(abs(args(pos)),,,false,false)
      else
       val=FormatNumber(abs(args(pos)),precision,,false,false)
      end if
      if prnsys=true then
       if InStr(val,".")=0 then val=val&"."
      else
       if mid(val,len(val),1)="." then val=mid(val,1,len(val)-1)
      end if
      if args(pos)<0 then prnpls="-"
      if spcchar="0" then
       if width>(len(val)+len(prnpls)) then
        val=String(width-len(val)-len(prnpls),"0")&val
       end if
      end if
      val=prnpls&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
'научное представление
     case "e"
      exponent=int(log(args(pos))/log(10))
      mantissa=args(pos)/10^exponent    
      if precision=-1 then
       val=FormatNumber(abs(mantissa),0,,false,false)
      elseif precision=0 then
       val=FormatNumber(abs(mantissa),,,false,false)
      else
       val=FormatNumber(abs(mantissa),precision,,false,false)
      end if
      if prnsys=true then
       if InStr(val,".")=0 then val=val&"."
      else
       if mid(val,len(val),1)="." then val=mid(val,1,len(val)-1)
      end if
      val=val&"e"
      if exponent>=0 then val=val&"+"
      val=val&exponent
      if mantissa<0 then prnpls="-"
      if spcchar="0" then
       if width>(len(val)+len(prnpls)) then
        val=String(width-len(val)-len(prnpls),"0")&val
       end if
      end if
      val=prnpls&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if

     case "E"
      exponent=int(log(args(pos))/log(10))
      mantissa=args(pos)/10^exponent    
      if precision=-1 then
       val=FormatNumber(abs(mantissa),0,,false,false)
      elseif precision=0 then
       val=FormatNumber(abs(mantissa),,false,false)
      else
       val=FormatNumber(abs(mantissa),precision,,false,false)
      end if
      if prnsys=true then
       if InStr(val,".")=0 then val=val&"."
      else
       if mid(val,len(val),1)="." then val=mid(val,1,len(val)-1)
      end if
      val=val&"E"
      if exponent>=0 then val=val&"+"
      val=val&exponent
      if mantissa<0 then prnpls="-"
      if spcchar="0" then
       if width>(len(val)+len(prnpls)) then
        val=String(width-len(val)-len(prnpls),"0")&val
       end if
      end if
      val=prnpls&val
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
'символ
     case "c"
      val=Left(args(pos),1)   
'строка
     case "s"
      val=mid(args(pos),1,precision)
      if len(val)<width then
       if justification="r" then
        val=String(width-len(val)," ")&val
       else
        val=val&String(width-len(val)," ")
       end if   
      end if
     case else
      val=0 : val=val/val 'исключение по ошибке
    end select
    res=res&val
    pos=pos+1
   end if

  ' found a normal char.
  else
   res = res & Mid(str,i,1)
  end if
 next
 fmt = res
end function

function VolumeToPartition(Volume)
 dim objPartitions, i, objPart
 Set objPartitions = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID="""  & Volume.DeviceID & """} WHERE AssocClass=Win32_LogicalDiskToPartition")
 i=0
 For Each objPart In objPartitions
  i=i+1
  Set VolumeToPartition = objPart
 next
 if i <> 1 then  ErrorExit namescrpt&vbCrLf&"Error WMI"
end function

function PartitionToDevice(objPart)
 dim objDevices, i, objDev
 Set objDevices = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & objPart.DeviceID & """} WHERE AssocClass=Win32_DiskDriveToDiskPartition")
 i=0
 For Each objDev In objDevices
  i=i+1
  Set PartitionToDevice = objDev
 next
 if i <> 1 then  ErrorExit namescrpt&vbCrLf&"Error WMI"
end function

function IsUSBFlash(Drive)
 dim ts, objVolume,objDev
 IsUSBFlash = false
 if (Drive.DriveType <> 1) and (Drive.DriveType <> 2) then exit function
 if Drive.IsReady=false         then exit function
 if Drive.FreeSpace=0         then exit function
 if Drive.AvailableSpace=0        then exit function
 ts=Round(Drive.TotalSize/1000000000,0)
 if ts = 0            then exit function
 if ts > 32            then exit function
 if (ts and (ts-1)) <> 0         then exit function
 'проверка на тип usb
 Set objVolume=objWMIService.Get("Win32_LogicalDisk.DeviceID="""& Drive.DriveLetter &":""")
 Set objDev=PartitionToDevice(VolumeToPartition(objVolume))
 if objDev.InterfaceType <> "USB" then exit function
 IsUSBFlash = true
end function

dim Drive, Drives() : redim drives(0)
dim fRunFromCamera : fRunFromCamera = true
dim vbsFile,str,i,objs,obj
dim ie
dim root

'0 проверка аргументов
if objArgs.Length <> 0 then
 ErrorExit namescrpt&vbCrLf&"Cmd line must do not have any key"
end if

Set vbsFile = FSO.GetFile(WScript.ScriptFullName)
if IsUSBFlash(vbsFile.Drive) = false   then fRunFromCamera=false
if vbsFile.ParentFolder.IsRootFolder = false then fRunFromCamera=false
if fRunFromCamera=false then
 ' получение списка вынимаемых дисков
 For Each Drive In FSO.Drives
  if IsUSBFlash(Drive) = true then
   redim preserve Drives(ubound(Drives)+1)
   Set Drives(ubound(Drives)-1)=Drive
  end if
 Next
 ' Если их нет, то вывод сообщения о ошибке
 if  ubound(Drives) = 0 then ErrorExit namescrpt&vbCrLf&"No usb flash drive"
 
 ' если таких дисков несколько, то вывод окна с предложением выбрать нужный.
 if  ubound(Drives)>1 then
  set ie=wscript.createobject("internetexplorer.application")
'  set ie=nothing
  if (not ie is nothing) then
'если есть интернет эксплорер
   ie.addressbar=0:ie.menubar=0:ie.toolbar=0:ie.statusbar=0':ie.Resizable=0
   ie.width=500
   ie.height=100
   ie.navigate2 "about:blank"
   ie.document.title=namescrpt
   With ie.Document.parentWindow.screen
    ie.Left = (.availWidth  - ie.Width ) \ 2
    ie.Top  = (.availHeight - ie.Height) \ 2
   End With
  ' While ie.Busy : Wscript.Sleep 200 : Wend
   str="name drive of camera: <select size='1' name='Listbox1'>"
   for i=1 to ubound(Drives)
    str=str&"<option value='"&i&"'>"&Drives(i-1).DriveLetter&"</option>"
   next
   str=str&"</select>" & _
    "  " & _
    "<input type=hidden id=selected value=0>" & _
    "<input type=submit onclick='vbscript:selected.value=listbox1.value'>"
   ie.document.body.innerHtml=str
   'While ie.Busy : Wscript.Sleep 200 : Wend
   ie.visible=true
   while ie.document.getelementbyid("selected").value=0:wsh.sleep 200:wend
   i=ie.document.getelementbyid("selected").value-1
   ie.quit:set ie=nothing
   root=Drives(i).RootFolder
  else
   ' попытка использовать net
   'для работы необходимо выполнить команду "%WINDIR%\Microsoft.NET\Framework\v2.0.50727\RegAsm.exe System.Windows.Forms.dll /codebase"
   dim form : set form=wscript.createobject("System.Windows.Forms.Form")
'   set form=nothing
   if (not form is nothing) then
    dim buttons(),btncancel : ReDim buttons(ubound(Drives))
    set btncancel=WScript.CreateObject("System.Windows.Forms.Button")
    btncancel.Parent=form
    btncancel.Left=12
    btncancel.Top = 12+25*ubound(Drives)
    btncancel.Width=85
    btncancel.Height=23
    btncancel.Text = "cancel"
    btncancel.DialogResult=ubound(Drives)+1

    for i=0 to ubound(Drives)-1
     set buttons(i)=WScript.CreateObject("System.Windows.Forms.Button")
     buttons(i).Parent=form
     buttons(i).Left=btncancel.Left
     buttons(i).Top = 12+25*i
     buttons(i).Width=btncancel.Width
     buttons(i).Height=btncancel.Height
     buttons(i).Text = Drives(i).DriveLetter&" ("& _
      Drives(i).VolumeName&")"
     buttons(i).DialogResult=i+1
    next
    
    form.Width = 12*2 + btncancel.Width
    form.Height = 12*2 + 25*(ubound(Drives)+1)
    form.Text = namescrpt
    form.AutoSize = true
    form.FormBorderStyle = 5
    form.ShowDialog()
    i=form.DialogResult-1
    if i=ubound(Drives) then ErrorExit namescrpt&vbCrLf&"User cancel"
    root=Drives(i).RootFolder
   else
'вывод при помощи wsh
    str="Choice flash drive of camera ( "
    for i=0 to (ubound(Drives)-1)
     str=str&Drives(i).DriveLetter&","
    next
    str=left(str,len(str)-1)&" ):"
    str=InputBox (str,namescrpt)
    dim result : result=false
    for i=0 to (ubound(Drives)-1)
     if UCase(str)=UCase(Drives(i).DriveLetter) then result = true : root=Drives(i).RootFolder : exit for
    next
    if result=false then ErrorExit namescrpt&vbCrLf&"User cancel"
   end if
  end if
 else
  root=Drives(0).RootFolder
 end if
else
 root=vbsFile.Drive.RootFolder
end if
set objs=FSO.GetFolder(root)
For Each obj In objs.SubFolders
 if StrComp(UCase(obj.Name),UCase(nametimefile))=0 then ErrorExit namescrpt&vbCrLf&_
  "Directory """ & nametimefile & """ already exist on "& root
next

For Each obj In objs.Files
 if StrComp(UCase(obj.Name),UCase(nametimefile))=0 then ErrorExit namescrpt&vbCrLf&_
  "File """ & nametimefile & """ already exist on "& root
next

'Запрос необходимости записывать дату на видео
 if vbYes=MsgBox("Write text with time in video?", vbQuestion+vbYesNo, namescrpt) then
  var="Y"
 else
  var="N"
 end if
'получение текущего времени
 str=DateAdd("n",timeshift,now())
 str = fmt ("%04u.%02u.%02u %02u.%02u.%02u", _
  Array(Year(str),Month(str),Day(str),Hour(str),Minute(str),Second(str)))
 str=str&" "&var

'запись файла
set obj=fso.OpenTextFile(root&nametimefile,2,true)
obj.WriteLine str
set obj=nothing
MsgBox "Remove/insert camera"


Comments

[talgaton.livejournal.com]

уверен что это "скрипт, который синхронизирует часы камеры с часами компьютера" - а не операционная система?

:)

[zepete.livejournal.com]

Операционная система этот скрипт выполняет.

Этот скрипт автоматизирует эту инструкцию.

http://chinascrap.ru/blog/buysku/12591.html

Дата и время устанавливаются путем копирования на карту памяти файла с именем TIMERSET.TXT, в котором в специальном формате указывается дата и время вплоть до секунд, а так же устанавливается флаг — писать ли поверх фото и видео временной штамп. Формат задания таков:

20130104152630 Y — 4 января 2013 года, 15 часов, 26 минут, 30 секунд, записывать время.
20130104152630 N — то же самое, но время не фиксируется.

Не очень удобно, но учитывая аскетичность устройства, вполне годится.


Должно подходить к множеству китайских видеорегистраторов, шпионских часов и миникамер, только значение константы nametimefile, содержащей имя файла, менять надо.

[talgaton.livejournal.com]

да я просто в программировании не бубубубу

но кажется очень много, по сравнению с текстовым описанием действия.

просто - восхищен!

[zepete.livejournal.com]

В ней много лишнего: есть полная реализация функции sprintfб которая используется только на 10%.

Потом предлагает выбрать нужный диск из нескольких usb в диалоговых окнах, а не требует вытащить все usb диски.

Если это все убрать, то будет типа такого.

'получение текущего времени
str=DateAdd("n",timeshift,now())
str = fmt ("%04u.%02u.%02u %02u.%02u.%02u", _
Array(Year(str),Month(str),Day(str),Hour(str),Minute(str),Second(str)))
str=str&" "&var

'запись файла
set obj=fso.OpenTextFile(root&nametimefile,2,true)
obj.WriteLine str
set obj=nothing
MsgBox "Remove/insert camera"