Работа с переменными окружения Windows, Использование переменных окружения Windows для передачи данных между приложениями и возникающие проблемы
Пользователь
Сообщений: Регистрация: 22.12.2012
На лицо ужасный, добрый внутри
06.12.2016 10:05:07
Привет, народ! Давненько я на Планете не появлялся. Всё не до программирования было, да и на Андроид подсел. А тут понадобилось обеспечить передачу небольших текстовых массивов (несколько десятков элементов) для заполнения ListBox между разными приложениями. Использовать создание/удаление текстового файла, а уж тем более использование именованного диапазона памяти на компе для такой простой задачи мне показалось избыточным. Вот я на переменные окружения и посмотрел. Стандартная функция Environ для этой цели не подходит, т.к. только читает переменные окружения, да и то далеко не все. А вот в CreateObject("WScript.Shell").Environment("USER") можно как добавлять собственные, так и удалять не нужные переменные. (Переменные типов "SYSTEM", "VOLATILE","PROCESS" доступны только для чтения). По ходу дела для сравнения переменных, доступных через Environ и Environment написал две процедурки, создающие в текущей книге листы со списками переменных окружения и их значениями
ENVIRION_Excel_Sheet
Код
Sub ENVIRION_Excel_Sheet() ' создать в текущей книге лист со списоком переменных окружения
On Error Resume Next
Dim sh As Worksheet, i%, sEnvName$, sHeader()
Dim sLastName$: sLastName = "windows_tracing_logfile"
sHeader = Array("index", "Environment Value", "Value @ " & Environ("COMPUTERNAME") & " [" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "]")
Application.ScreenUpdating = False: Set sh = ThisWorkbook.Worksheets.Add
With Cells(1, 1).Resize(1, UBound(sHeader) + 1)
.Value = sHeader
For i = 1 To 63
sEnvName$ = Split(Environ(i), "=")(0) ' Environ(i) возвращает текст типа OS=Windows_NT
.Offset(i).Value = Array(i, sEnvName$, Environ(sEnvName$))
If sEnvName = sLastName Then Exit For
Next
End With
Rows("2:2").Select: ActiveWindow.FreezePanes = True: Rows("1:1").Font.Bold = True
With Cells: .EntireColumn.AutoFit: .HorizontalAlignment = xlLeft: .VerticalAlignment = xlBottom: End With
Application.ScreenUpdating = True
End Sub
ENVIROMENTS_Excel_Sheet
Код
Sub ENVIROMENTS_Excel_Sheet() ' создать в текущей книге лист со списоком переменных окружения, их типами и значениями
' On Error Resume Next
Dim oSheet As Worksheet, sEnvName$, sEnvVal$, xArr, xItem, iNdex%
Dim sHeader(): sHeader = Array("Environment Name", "Type", "Value @ " & Environ("COMPUTERNAME") & " [" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "]")
Dim Arr(): Arr = Array("SYSTEM", "VOLATILE", "PROCESS", "USER") ' все возможные типы переменных окружения
Dim oDict: Set oDict = CreateObject("Scripting.Dictionary"): oDict.CompareMode = vbTextCompare ' словарь для сбора данных
Dim oShell: Set oShell = CreateObject("WScript.Shell") ' ссылка на объект WScript.Shell
iNdex = iNdex + 1 ' т.к. sEnvName не уникальны и могут повторяться в разных типах, то как ключ приходится использовать iNdex
oDict.Add Key:=iNdex, Item:=Array(sHeader(0), sHeader(1), sHeader(2)) ' заголовки таблицы занесены в словарь под ключом iNdex=0
'Debug.Print iNdex & vbTab & oDict.Item(iNdex)(0) & vbTab & oDict.Item(iNdex)(1) & vbTab & oDict.Item(iNdex)(2)
For Each xArr In Arr ' цикл по всем типам переменных
For Each xItem In oShell.Environment(xArr) ' цикл по всем переменным данного типа
sEnvName = Left(xItem, 1) & Split(Mid(xItem, 2), "=")(0) ' выделить Имя из записи типа Имя=Значение с учётом наличия имён, начинающихся с =
sEnvName = IIf(Left(sEnvName, 1) = "=", "'", "") & sEnvName ' патч для предотвращения вычисления формул на листе Excel
sEnvVal = Split(Mid(xItem, 2), "=", 2)(1) ' выделить Значение из записи типа Имя=Значение с учётом наличия имён, начинающихся с =
sEnvVal = IIf(Left(sEnvVal, 1) = "=", "'", "") & sEnvVal ' патч для предотвращения вычисления формул на листе Excel
iNdex = iNdex + 1 ' очередной ключ для записи в словарь
oDict.Add Key:=iNdex, Item:=Array(sEnvName, xArr, sEnvVal)
'Debug.Print iNdex & vbTab & oDict.Item(iNdex)(0) & vbTab & oDict.Item(iNdex)(1) & vbTab & oDict.Item(iNdex)(2)
Next xItem
Next xArr
With Application.WorksheetFunction ' функция листа ТРАНСП при транспонировании преобразует массив массивов в 2D-массив
Arr = .Transpose(.Transpose(oDict.Items)) ' двойное транспонирование вернёт 2D-массив, пригодный к прямой передаче в диапазон на листе
End With
Application.ScreenUpdating = False: Application.EnableEvents = False
Set oSheet = ThisWorkbook.Worksheets.Add
Cells(1, 1).Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr ' запись 2D-массива на лист
Rows("2:2").Select: ActiveWindow.FreezePanes = True: Rows("1:1").Font.Bold = True ' красота на листе
With Cells: .EntireColumn.AutoFit: .HorizontalAlignment = xlLeft: .VerticalAlignment = xlBottom: End With
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub
Если возникнет ошибка при обращении к функции листа ТРАНСП (у некоторых это бывает), то можно использовать и чуть более сложный вариант с обработкой массива циклом:
ENVIROMENTS2_Excel_Sheet
Код
Sub ENVIROMENTS2_Excel_Sheet() ' создать в текущей книге лист со списоком переменных окружения, их типами и значениями
' On Error Resume Next
Dim oSheet As Worksheet, sEnvName$, sEnvVal$, xArr, xItem, iNdex%
Dim sHeader(): sHeader = Array("Environment Name", "Type", "Value @ " & Environ("COMPUTERNAME") & " [" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "]")
Dim Arr(): Arr = Array("SYSTEM", "VOLATILE", "PROCESS", "USER") ' все возможные типы переменных окружения
Dim oDict: Set oDict = CreateObject("Scripting.Dictionary"): oDict.CompareMode = vbTextCompare ' словарь для сбора данных
Dim oShell: Set oShell = CreateObject("WScript.Shell") ' ссылка на объект WScript.Shell
iNdex = iNdex + 1 ' т.к. sEnvName не уникальны и могут повторяться в разных типах, то как ключ приходится использовать iNdex
oDict.Add Key:=iNdex, Item:=Array(sHeader(0), sHeader(1), sHeader(2)) ' заголовки таблицы занесены в словарь под ключом iNdex=0
'Debug.Print iNdex & vbTab & oDict.Item(iNdex)(0) & vbTab & oDict.Item(iNdex)(1) & vbTab & oDict.Item(iNdex)(2)
For Each xArr In Arr ' цикл по всем типам переменных
For Each xItem In oShell.Environment(xArr) ' цикл по всем переменным данного типа
sEnvName = Left(xItem, 1) & Split(Mid(xItem, 2), "=")(0) ' выделить Имя из записи типа Имя=Значение с учётом наличия имён, начинающихся с =
sEnvName = IIf(Left(sEnvName, 1) = "=", "'", "") & sEnvName ' патч для предотвращения вычисления формул на листе Excel
sEnvVal = Split(Mid(xItem, 2), "=", 2)(1) ' выделить Значение из записи типа Имя=Значение с учётом наличия имён, начинающихся с =
sEnvVal = IIf(Left(sEnvVal, 1) = "=", "'", "") & sEnvVal ' патч для предотвращения вычисления формул на листе Excel
iNdex = iNdex + 1 ' очередной ключ для записи в словарь
oDict.Add Key:=iNdex, Item:=Array(sEnvName, xArr, sEnvVal)
'Debug.Print iNdex & vbTab & oDict.Item(iNdex)(0) & vbTab & oDict.Item(iNdex)(1) & vbTab & oDict.Item(iNdex)(2)
Next xItem
Next xArr
xItem = oDict.Items ' массив значений копируем в массив (напрямую читать из oDict.Items нельзя)
ReDim Arr(0 To oDict.Count - 1, 0 To 2) ' для вывода на лист массив массивов необходимо преобразовать в 2D-массив
For iNdex = 0 To oDict.Count - 1
Arr(iNdex, 0) = xItem(iNdex)(0)
Arr(iNdex, 1) = xItem(iNdex)(1)
Arr(iNdex, 2) = xItem(iNdex)(2)
Next iNdex
Application.ScreenUpdating = False: Application.EnableEvents = False
Set oSheet = ThisWorkbook.Worksheets.Add
Cells(1, 1).Resize(UBound(Arr, 1) + 1, UBound(Arr, 2) + 1).Value = Arr ' запись 2D-массива на лист
Rows("2:2").Select: ActiveWindow.FreezePanes = True: Rows("1:1").Font.Bold = True ' красота на листе
With Cells: .EntireColumn.AutoFit: .HorizontalAlignment = xlLeft: .VerticalAlignment = xlBottom: End With
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub
Ну а теперь о возникшей странной проблеме при использовании Environment("USER"). Передача стрингов через них получается не сложно и устойчиво работает. Вот только удивляют большие задержки при создании переменной и её последующем удалении. Стал анализировать. При счёте времени по Timer получил не только не повторяющиеся, но и вообще странные результаты. Мало того, что длительность процедур сильно плавает от теста к тесту, но при чтении она каким-то образом вообще иногда получается отрицательной! Для проверки прицепил ещё и счёт времени через API Длительности процессов, полученных через Timer и GetTickCount получаются разные! Отрицательных значений GetTickCount, правда не даёт, но и нулевые как-то напрягают. Вот код, который я использовал для проверки длительности:
Environment("USER").Count = 4 Create Duration (by Timer) = 0,96875 s Create Duration (by Ticker) = 1,294 s Environment("USER").Count = 5 Read Duration (by Timer) = -0,03125 s Value = test-test-test Read Duration (by Ticker) = 0 s Delete Duration (by Timer) = 2,28515625 s Delete Duration (by Ticker) = 2,325 s Environment("USER").Count = 4
Ничего не понимаю! Неделю назад в Миру создал топик для обсуждения данного вопроса. Но что-то никто из знатоков этот феномен так и не объяснил. P.S. Файл с процедурами, к сожалению, с работы выложить не могу: собаки-сисадмины, маньяки, макросы из интранета наружу не выпускают.
С уважением, Алексей(ИМХО: Excel-2003 - THE BEST!!!)
Пользователь
Сообщений: Регистрация: 11.01.2013
06.12.2016 10:28:43
Привет! Timer дает число типа Single, а ты присваиваешь его переменной типа Long. Если происходит округление в бОльшую сторону, потом возможна отрицательная разность. Объяви Dim lTimer! , и странность исчезнет. Windows - не ОС реального времени, длительность обращения к системным переменным никто не регламентирует
Изменено: - 06.12.2016 10:31:40
Пользователь
Сообщений: Регистрация: 22.12.2012
На лицо ужасный, добрый внутри
06.12.2016 10:49:43
Привет, Андрей! (память на имена меня ещё не подвела или уже пора лечиться?) Да, с лонг для таймера - это я, конечно, лоханулся немного. Спасибо за подсказку. Теперь значения GetTickCount и Timer практически совпадают и отрицательные значения, возникающие из-за округления, глаза не мозолят. Практически мгновенное чтение - это, конечно, отлично. Но вот то, что переменная так долго создаётся и удаляется - это не есть хорошо. Надо будет попробовать Process Monitor'ом посмотреть, что там в системе происходит.
С уважением, Алексей(ИМХО: Excel-2003 - THE BEST!!!)
Пользователь
Сообщений: Регистрация: 22.12.2012
На лицо ужасный, добрый внутри
06.12.2016 14:53:04
Тут , как используя API можно добавлять собственные переменные типа PROCESS. Большое достоинство этого метода - то, что отличная получается скорость создания/записи/чтения, да ещё и бонус есть - переменные этого типа умирают вместе с закрытием процесса, т.е. не надо заботиться об их удалении с целью незасирания со временем списка. Только боюсь, что они могут оказаться не доступны из других процессов. А мне нужно было данные из Excel в Visio и обратно передавать... Надо будет попробовать. (На Visio я пока с переменными окружения не пробовал работать, уж больно там дебильная объектная модель приложения!)
test_ENVIROMENT_READ_WRITE_API
Код
Private Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName$, ByVal lpValue$) As Long
Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName$, ByVal lpBuffer$, ByVal lSize&) As Long
Sub test_ENVIROMENT_READ_WRITE_API()
Dim sEnvName$: sEnvName = "myEnvName"
Dim sEnvData$: sEnvData = "test-test-test"
Dim lTimer!: lTimer = Timer
SetEnvironmentVariable sEnvName, sEnvData 'установка переменной
Debug.Print GetEnvVar(sEnvName) ' чтение переменной
Debug.Print "Duration = " & (Timer - lTimer) * 1000 & " ms"
End Sub
Function GetEnvVar$(sName$)
Const lSize& = 2 ^ 15 - 1 ' максимально возможная длина переменной окружения 32 767 (2^15-1) символа
GetEnvVar = String(lSize, 0) ' переменная-буфер для записи результата функцией GetEnvironmentVariable
Call GetEnvironmentVariable(sName, GetEnvVar, lSize)
' GetEnvironmentVariable заменит первые символы в буфере на значение переменной и вернёт значение длины строки значения
' ищем в GetEnvVar конец записи - символ Chr(0) - и отбрасываем его и всё, что правее
If InStr(1, GetEnvVar, Chr(0)) > 0 Then GetEnvVar = Left(GetEnvVar, InStr(1, GetEnvVar, Chr(0)) - 1)
GetEnvVar = sName & ": " & GetEnvVar
End Function
Но до чего же не люблю я API Их в отличие от VBA запомнить невозможно, а нужно тупо как иероглифы из справочника дёргать. Да и процедуры с их использованием получаются размазанными по всему модулю: сама процедура в одном месте листинга, а API-шки для неё - в декларациях. Копирнёшь куда-нибудь процедуру, а про декларации забудешь...
С уважением, Алексей(ИМХО: Excel-2003 - THE BEST!!!)
Пользователь
Сообщений: Регистрация: 21.12.2012
06.12.2016 15:35:40
Цитата
Alex_ST написал: Да и процедуры с их использованием получаются размазанными по всему модулю: сама процедура в одном месте листинга, а API-шки для неё - в декларациях. Копирнёшь куда-нибудь процедуру, а про декларации забудешь...
Создай класс.
There is no knowledge that is not power
Пользователь
Сообщений: Регистрация: 11.01.2013
06.12.2016 16:32:26
Цитата
Alex_ST написал: Использовать создание/удаление текстового файла, а уж тем более использование именованного диапазона памяти на компе для такой простой задачи мне показалось избыточным.
Текстовый файл в специально отведенной для этого временной папке (environ("temp")) - почему бы и нет? А как насчет реестра? В VBA/VB6 есть операторы и функции для работы со специально отведенной веткой реестра: F1 - Registry Keyword Summary В других языках средства доступа к реестру тоже должны быть, например в VBS CreateObject("WScript.Shell").RegRead и т.д.
Пользователь
Сообщений: Регистрация: 18.02.2013
06.12.2016 21:27:12
Цитата
Alex_ST написал: боюсь, что они могут оказаться не доступны из других процессов
Здравствуйте. Есть чтения/записи переменных чужого процесса на плюсах, на VBA как-то не встречалось
Пользователь
Сообщений: Регистрация: 22.12.2012
На лицо ужасный, добрый внутри
06.12.2016 22:03:23
Ну, вообще-то тормозят только процессы создания/убиения переменной. А чтение/запись идут очень быстро. Так что в принципе же никто не мешает создавать переменную (или даже сразу несколько, про запас) один раз, например, при запуске Excel. Ну удлинится ОДИН РАЗ его открытие на 1,5-2 секунды. Да и Бог с ним. Зато потом никаких тормозов при чтении/записи не будет и делается это достаточно просто. А т.к. при каждом запуске будет обращение к одной и той же (одним и тем же) переменной (-ым), то и множиться их число не будет, а один раз возрастёт, а потом будет неизменным. Так что даже ни к чему убивать созданные переменные. Пусть висят.
С уважением, Алексей(ИМХО: Excel-2003 - THE BEST!!!)
Их в отличие от VBA запомнить невозможно, а нужно тупо как иероглифы из справочника дёргать. Да и процедуры с их использованием получаются размазанными по всему модулю: сама процедура в одном месте листинга, а API-шки для неё - в декларациях. Копирнёшь куда-нибудь процедуру, а про декларации забудешь...