При разработке отчетов или обработок рано или поздно приходится сталкиваться с необходимостью определения имени локального диска, сменного накопителя (флешки), сетевого диска. В данной статье представлены 3 способа получения списка дисков компьютера:
Примеры для 8-ой версии, для того чтобы заработало в 7-ой замените:
Код 1C v 8.х Новый COMОбъект(
на
Код 1C v 7.x СоздатьОбъект(
1-вый способ:
Код 1C v 8.х FSO = Новый COMОбъект("Scripting .FileSystemObject");
// Выборка объектов из коллекции Drives
Для каждого Диск Из FSO.Drives Цикл
// Диск.DriveLetter - буква диска
Стр = Диск.DriveLetter;
// Диск.DriveType = 1 - Flash накопитель
// Диск.DriveType = 2 - Локальный жесткий диск
// Диск.DriveType = 3 - Сетевой диск
// Диск.DriveType = 4 - CD/DVD дисковод
Если Диск.DriveType = 3 Тогда // если это сетевой диск, то укажем сетевой путь
Стр = Стр + " - " + Диск.ShareName;
ИначеЕсли Диск.IsReady Тогда
Стр = Стр + " - " + Диск.VolumeName;
Иначе
Стр = Стр + " - [Диск не найден]";
КонецЕсли;
Сообщить(Стр);
КонецЦикла;
2-ой способ:
Код 1C v 8.х
Попытка
ScrptCtrl = Новый COMОбъект( "MSScriptControl.ScriptControl" ) ;
ScrptCtrl. Language= "vbscript" ;
ScrptCtrl. addcode( "
|Function GetComputers()
| Set objWMIService = GetObject("" winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2"" )
| Set colDisks = objWMIService.ExecQuery ("" Select * from Win32_LogicalDisk"" )
| For Each objDisk in colDisks
| disk = disk & objDisk.DeviceID & "" ;"" & objDisk.DriveType& "" ;""
| Next
| GetComputers = disk
|End Function
|" ) ;
Текст= СокрЛП( ScrptCtrl. Run( "GetComputers" ) ) ;
Исключение
Предупреждение( ОписаниеОшибки( ) ) ;
КонецПопытки ;
ТабДисков = Новый ТаблицаЗначений;
ТабДисков. Колонки. Добавить( "Диск" ) ;
ТабДисков. Колонки. Добавить( "Описание" ) ;
Пока СтрДлина ( Текст) > 0 Цикл
Строка = ТабДисков. Добавить( ) ;
Строка. Диск = Лев( Текст, 2 ) ;
Строка. Описание = Сред( Текст, 4 , 1 ) ;
Текст = Сред( Текст, 6 , СтрДлина ( Текст) - 5 ) ;
КонецЦикла ;
Сообщить( "Флешки:" ) ;
Для Каждого Элемента Из ТабДисков Цикл
Если Элемента. Описание = "2" Тогда
Сообщить( Элемента. Диск) ;
КонецЕсли ;
КонецЦикла ;
3-ий способ:
Код 1C v 8.х //Попытка подключения к WMI на локальном компьютере
Попытка
Locator = Новый COMОбъект("WbemScripting .SWbemLocator");
Исключение
Сообщить(ОписаниеОшибки());
Возврат;
КонецПопытки;
ServicesSet = Locator.ConnectServer(".");
//Извлечение экземпляров класса Win32_LogicalDisk
ObjectSet = ServicesSet.InstancesOf("Win32_LogicalDisk");
Для каждого Item Из ObjectSet Цикл
Сообщить("Имя: " + Item.Caption);
Сообщить("Описание: " + Item.Description); // здесь выводится тип диска
Сообщить("Файловая система: " + Item.FileSystem);
Сообщить("Свободное место: " + Item.FreeSpace);
Сообщить("Метка диска: " + Item.VolumeName);
Сообщить ("=======================") ;
КонецЦикла;
Автор:
Мигачев Евгений Ниже приведено несколько способов получения списка баз 1С 7.7 из реестра:
Код получения списка баз 1С 7.7 из 8.х
Код 1C v 8.х функция сзПолучитьСписокБаз()
попытка
олеСкрипт = новый COMОбъект( "MSScriptControl.ScriptControl" ) ;
олеСкрипт. Language = "VBScript" ;
стрКод =
"function strGetListBase()
| const RootKey = &H80000001
| set Reg = GetObject("" winmgmts:{impersonationLevel=impersonate}!\\."" &_
| "" \root\default:StdRegProv"" )
| PathKey = "" Software\1C\1Cv7\7.7\Titles""
| Reg.EnumValues RootKey, PathKey, Arr
| Answer = "" {"" "" #"" "" ,4772b3b4-f4a3-49c0-a1a5-8cb5961511a3,"" & chr(10)
| Answer = Answer & "" {3,1e512aab-1b41-4ef6-9375-f0137be9dd91,0,0,"" & chr(10)
| Answer = Answer & "" {"" & (UBound(Arr) + 1) & "" ,"" & chr(10)
| for x = LBound(Arr) to UBound(Arr)
| call Reg.GetStringValue(RootKey, PathKey, Arr(x), Value)
| Answer = Answer & "" {1e512aab-1b41-4ef6-9375-f0137be9dd91,"" & chr(10) &_
| "" {"" "" "" & replace(Value, "" "" "" "" , "" "" "" "" "" "" ) & "" "" "" ,0,"" &_
| chr(10) & "" {"" "" S"" "" ,"" "" "" & Arr(x)& "" "" "" },"" &_
| chr(10) & "" {3,0,"" & chr(10) & "" {0},"" "" "" "" ,-1,-1,0,0}"" &_
| chr(10) & "" }"" & chr(10) & "" }""
| if x <> UBound(Arr) then Answer = Answer & "" ,""
| Answer = Answer & chr(10)
| next
| Answer = Answer & "" },"" & chr(10) & "" {"" "" Pattern"" "" }"" & chr(10) &_
| "" }"" & chr(10) & "" }""
| strGetListBase = Answer
|end function" ;
олеСкрипт. AddCode( стрКод) ;
стрОтвет = олеСкрипт. Run( "strGetListBase" ) ;
Ответ = ЗначениеИзСтрокиВнутр( стрОтвет) ;
Ответ. СортироватьПоПредставлению( ) ;
исключение
Ответ = новый СписокЗначений;
Ответ. Добавить( "Базы 1С:Передприятия 7.7 не обнаруженны!" ) ;
конецпопытки ;
возврат Ответ;
конецфункции
Код для 1С 7.7
Код 1C v 7.x
Функция ПолучитьСписокБаз1()
Перем Value,arrValues;
Scr = CreateObject("MSScriptControl.ScriptControl");
Scr.Language = "vbscript";
Scr.Timeout=-1;
HKEY_CURRENT_USER = 2147483649;
strKeyPath = "Software\1C\1Cv7\7.7\Titles";
Locator=СоздатьОбъект("WbemScripting .SWbemLocator");
ServiceDef=Locator.ConnectServer(".","root\default");
oReg = ServiceDef.Get("StdRegProv");
Dict=СоздатьОбъект("Scripting .Dictionary");
Scr.AddObject("Dict",Dict);
Scr.AddObject("oReg",oReg);
Scr.ExecuteStatement("dim arrValues,Value:");
Scr.ExecuteStatement("oReg.EnumValues "+HKEY_CURRENT_USER+","""+strKeyPath+""",arrValues:");
Scr.ExecuteStatement("for i=lbound(arrValues) to ubound(arrValues):Dict.add ""pj"" & i, arrValues(i):next");
ТЗБаз=СоздатьОбъект("ТаблицаЗначений");
ТЗБаз.НоваяКолонка("Путь");
ТЗБаз.НоваяКолонка("Описание");
Для к=0 По Dict.count Цикл
Д=Dict.Item("pj"+к);
Scr.ExecuteStatement("oReg.GetStringValue "+HKEY_CURRENT_USER+","""+strKeyPath+""","""+Д+""",Value");
ТЗБаз.НоваяСтрока();
ТЗБаз.Путь = Д;
ТЗБаз.Описание = Scr.eval("Value");
КонецЦикла;
//Посмотрим что в ТЗ
//ТЗБаз.ВыбратьСтроку();
Возврат ТЗБаз;
КонецФункции
Процедура ПолучитьСписокБаз2()
Попытка
scrptCtrl=createobject("MSScriptControl.ScriptControl");
scrptCtrl.language="vbscript";
scrptCtrl.addcode("Function Get1CV77Titles()
|const HKEY_CURRENT_USER = &H80000001
|Set oReg=GetObject(""winmgmts:{impersonationLevel=impersonate}!\\."" &_
|""\root\default:StdRegProv"")
|strKeyPath = ""Software\1C\1Cv7\7.7\Titles""
|oReg.EnumValues HKEY_CURRENT_USER, strKeyPath, arrValues
|strInfo=vbNullString
|For i = LBound(arrValues) To UBound(arrValues)
| call oReg.GetStringValue(HKEY_CURRENT_USER,strKeyPath,arrValues(i),Value)
| strInfo=strInfo & arrValues(i) & ""="" & Value & vbCrLF
|Next
|Get1CV77Titles = strInfo
|End Function");
Сообщить(scrptCtrl.run("Get1CV77Titles"));
Исключение
Сообщить(ОписаниеОшибки());
КонецПопытки;
КонецПроцедуры
<Сообщил Gloom>
Процедура ПолучитьСписокБаз3()
Ключ="HKEY_CURRENT_USER\Software\1C\1Cv7\7.7\Titles";
ИмяКаталога=СокрЛП(КаталогПользователя());
ИмяБазы=СокрЛП(каталогИБ());
Если прав(ИмяКаталога,1)<>"\" Тогда ИмяКаталога=ИмяКаталога+"\" КонецЕсли;
Если прав(ИмяБазы,1)<>"\" Тогда ИмяБазы=ИмяБазы+"\" КонецЕсли;
ИмяБазыСтр=Симв(34)+СтрЗаменить(ИмяБазы,"\","\\")+Симв(34);
ИмяФайла="USER.TXT";
Команда="Regedit /ea "+Симв(34)+ИмяКаталога+ИмяФайла+Симв(34)+" "+Симв(34)+Ключ+Симв(34);
КомандаСистемы(Команда);
Текст=СоздатьОбъект("Текст");
Текст.КодоваяСтраница(0);
Текст.Открыть(ИмяКаталога+ИмяФайла);
Текст.Показать();
Стр=""; Нашли=0;
Для сч=1 по Текст.КоличествоСтрок() Цикл
Стр=СокрЛП(Текст.ПолучитьСтроку(сч));
Сообщить(Стр);
Если Найти(стр,ИмяБазыСтр)<>0 Тогда
Нашли=1;
прервать;
КонецЕсли;
КонецЦикла;
КонецПроцедуры