51

Re: VBS: хитрости/особенности

Xameleon
Ну, так очевидно, что в подобном случае Right("0" & DateT, 2) пришлось бы писать 5 раз вместо одного.

52

Re: VBS: хитрости/особенности

Flasher, понял. Тогда наверное имеет смысл.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

53

Re: VBS: хитрости/особенности

В рамках последнего обсуждения множественного вызова функции с двумя переменными ранее вертелась мысль избавления от сущностей, когда значением (или его частью) переменной может выступать имя самой переменной. Делается это простым присвоением через Execute:

Execute Var & "=""Var"""

Что это даёт? Ну, во-первых, в ряде случаев избавление от необходимости задействовать коллекцию или опять же вызывать процедуру/функцию для динамического присвоения (пример c GetRef см. ниже в одном и кодов).
Т.е. вместо того, чтобы придумывать переменные с присвоением им значений можно в цикле имплантировать значения в имена и там же обработать:

Вот простой пример экономии. Привычное представление

' Запись в 139 символов:
C  = " класс"
C1 = "1" & C
C2 = "2" & C
C3 = "3" & C
C4 = "4" & C
C5 = "5" & C
C6 = "6" & C
C7 = "7" & C
C8 = "8" & C
C9 = "9" & C

переводим в

' Запись в 59 символов (полный аналог предыдущего):
For i = 1 To 9: Execute "C" & i & " = i & "" класс""" :Next

' Теперь у нас на руках все переменные C1-9 c данными. Т.е. их можно
' сравнивать, обрабатывать, вставлять в текст, перетасовывать и т.п.
' Пример:
MsgBox "Маша пошла в " & C5 & "." & vbCr & _
"Миша из " & C9 & "а решил сложную задачу по алгебре."

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

+ Возвращаем пути спецпапок по их именам:
Set FSO = CreateObject("Scripting.FileSystemObject")
With CreateObject("WScript.Shell")
  For i = 0 To .SpecialFolders.Count - 1
  	Path = .SpecialFolders(i)
  	Execute Replace(FSO.GetFileName(Path), " ", "") & " = Path" 
  Next
End With
WScript.Echo "делаем дела с папкой " & Fonts
WScript.Echo "делаем дела с папкой " & SendTo
+ Выделяем из списка частоту процессора и оперативную память:
Set Shell = CreateObject("Shell.Application")
GetVar("DirectoryServiceAvailable")("DoubleClickTime")("ProcessorLevel")_
  ("ProcessorSpeed")("ProcessorArchitecture")("PhysicalMemoryInstalled")

MsgBox "Частота процессора: " & vbTab & ProcessorSpeed & " MHz" & vbCr &_
     "Физическая память: " & vbTab & PhysicalMemoryInstalled & " байт(а)"

Function GetVar(Var)
  Execute Var & "= Shell.GetSystemInformation(Var)"
  Set GetVar = GetRef("GetVar")
End Function
+ Отобразим некоторые теги композиции:
Set Track = CreateObject("WMPlayer.OCX")._
NewMedia("C:\Windows\winsxs\X80C99~1.163\SLEEPA~1.MP3")

For i = 0 To Track.AttributeCount - 1
	Attr = Track.GetAttributeName(i)
	Execute "i" & Replace(Attr, "WM/", "") & "= Track.GetItemInfo(Attr)"
Next

MsgBox  "Номер: "  & vbTab & iTrackNumber & vbCr & _
		"Имя: "    & vbTab & iTitle       & vbCr & _
		"Альбом: " & vbTab & iAlbumTitle  & vbCr & _
		"Автор: "  & vbTab & iAuthor      & vbCr & _
		"Жанр: "   & vbTab & iGenre       & vbCr & _
		"Год: "    & vbTab & iYear, 4160, " MP3-теги"
+ Выведем свойства фотографии:
File = "C:\Windows\winsxs\X828C9~1.163\RU-wp5.jpg"

Set Img = WScript.CreateObject("WIA.ImageFile")
Img.LoadFile File

With Img.Properties
  For i = 1 To .Count
    FN = .Item(i).Name : If Not .Item(i).IsVector _
    And Not IsNumeric(FN) Then Execute FN & " = .Item(i).Value"
  Next
End With

Sr = InStrRev(File, "\") : FN = Mid(File, Sr + 1) : T = vbTab
Set Folder = CreateObject("Shell.Application").NameSpace(Left(File, Sr))
For Each P In Split("Name Directory DocTitle Owner Attributes " &_
                    "Copyright Dimensions Type Create Write Access")
  Execute "i" & P & " = Folder.ParseName(FN).ExtendedProperty(P)"
Next

MsgBox "Имя файла:"      & T & iName       & vbCr & _
       "Тип файла:"      & T & iType       & vbCr & _
       "Название:"       & T & iDocTitle   & vbCr & _
       "Разрешение:"     & T & XResolution & " x " & YResolution & " dpi" & vbCr & _
       "Размер кадра:"   & T & iDimensions & " пкс" & vbCr & _
       "Ширина кадра:"   & T & ExifPixXDim & " пкс" & vbCr & _
       "Высота кадра:"   & T & ExifPixYDim & " пкс" & vbCr & _
       "Дата съёмки:"    & T & DateTime    & vbCr & _
       "Дата создания:"  & T & iAccess     & vbCr & _
       "Дата изменения:" & T & iCreate     & vbCr & _
       "Автор съёмки:"   & T & Artist      & vbCr & _
       "Владелец:"       & T & iOwner      & vbCr & _
       "Автор. права:"   & T & Copyright

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

54 (изменено: Xameleon, 2017-01-29 21:37:56)

Re: VBS: хитрости/особенности

Решил добавить сюда. Это не заготовка полезного инструмента, а только "сэмпл" ещё одного использования вложенных вызовов.


Option Explicit

'Sample 1
MsgBox New [$].add("[").add("      no spaces      ").trim.add("]")

'Sample 2
MsgBox New [$].add("      test [1] [2] [3]").replace("/\d/g","!").replace("/test/gi","->").trim

'Sample 3
MsgBox New [$].add("     IT WAS UPCASE TEXT WITH SPACES ") _
			  .trim() _
			  .toLowerCase() _
			  .add("    and lower case text") _
			  .toUpperCase()

Class [$]
	Dim [b$],[s$]

	Function toUpperCase()
		[b$] = UCase([b$])
		Set toUpperCase = Me
	End Function

	Function toLowerCase()
		[b$] = LCase([b$])
		Set toLowerCase = Me
	End Function

	Function trim()
		[b$] = re("/^\s+|\s+$/g").replace([b$],"")
		Set [trim] = Me
	End Function
	
	Public Default Function text()
		text = [s$] & [b$]
	End Function
	
	Function add(text)
		[s$] = [s$] & [b$]
		[b$] = text
		Set add = Me
	End Function
	
	Function replace(pat, rep)
		[b$] = re(pat).replace([b$],rep)
		Set replace = Me
	End Function
	
	Function match(pat)
		Set match = re(pat).execute([b$])
	End Function
	
	Private Function re(pat)
		Set re = New RegExp
		re.Pattern = "^\/(.+)\/([igm]*)$"
		Dim matches: Set matches = re.Execute(pat)
		If matches.Count < 1 Then re.Pattern = pat: Exit Function
		Set matches = matches(0).subMatches
		re.Pattern = matches(0)
		re.Global = InStr(1,matches(1),"g",1)
		re.IgnoreCase = InStr(1,matches(1),"i",1)
		re.MultiLine = InStr(1,matches(1),"m",1)
	End Function
	
End Class
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !