При разработке отчетов или обработок рано или поздно приходится сталкиваться с необходимостью определения имени локального диска, сменного накопителя (флешки), сетевого диска. В данной статье представлены 3 способа получения списка дисков компьютера:
Примеры для 8-ой версии, для того чтобы заработало в 7-ой замените:
Код 1C v 8.х Новый COMОбъект(
на
Код 1C v 7.x СоздатьОбъект(
1-вый способ:
Код 1C v 8.х FSO = Новый COMОбъект("Script ing.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Объект("MSScript Control.Script Control");
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);
// Далее определим тип диска:
// 1 - Дисковод
// 2 - Flash накопитель
// 3 - Локальный жесткий диск
// 4 - Сетевой диск
// 5 - CD/DVD дисковод
Строка.Описание = Сред(Текст,4,1);
Текст = Сред(Текст,6,СтрДлина (Текст)-5);
КонецЦикла;
// Далее переберая элементы таблицы выведем флешки в окно сообщений
Сообщить("Флешки:");
Для Каждого Элемента Из ТабДисков Цикл
Если Элемента.Описание = "2" Тогда
Сообщить(Элемента.Диск);
КонецЕсли;
КонецЦикла;
3-ий способ:
Код 1C v 8.х //Попытка подключения к WMI на локальном компьютере
Попытка
Locator = Новый COMОбъект("WbemScript ing.SWbemLocator");
Исключение
Сообщить(ОписаниеОшибки());
Возврат;
КонецПопытки;
ServicesSet = Locator.ConnectServer(".");
//Извлечение экземпляров класса Win32_LogicalDisk
ObjectSet = ServicesSet.InstancesOf("Win32_LogicalDisk");
Для каждого Item Из ObjectSet Цикл
Сообщить("Имя: " + Item.Caption);
Сообщить("Описание: " + Item.Descript ion); // здесь выводится тип диска
Сообщить("Файловая система: " + Item.FileSystem);
Сообщить("Свободное место: " + Item.FreeSpace);
Сообщить("Метка диска: " + Item.VolumeName);
Сообщить ("=======================") ;
КонецЦикла;
Автор:
Мигачев Евгений Код 1C v 8.х Процедура ЗапуститьПриложениеShell(Команда)
Попытка
Shell = Новый COMОбъект("Shell.Application");
Shell.ShellExecute(Команда, "", "", "open", 1);
Исключение
Сообщить(ОписаниеОшибки());
КонецПопытки;
КонецПроцедуры
//Пример обращения к процедуре
//Запустить Открытие файла
ЗапуститьПриложениеShell("d:\primer.xls");
//Запустить Веб-сайт
ЗапуститьПриложениеShell("https://helpf.pro");
//Запустить Веб-сайт ICQ c информацией о контакте 12345
ЗапуститьПриложениеShell("http://wwp.icq.com/script s/contact.dll?msgto=12345");
//Запустить Отправление письма на Info@helpf.pro и в теме указать "Вопрос!" и в тексте "Здравствуй, уважаемый Веб-мастер!"
ЗапуститьПриложениеShell("mailto:Info@helpf.pro?Subject=Вопрос!&body=Здравствуй, уважаемый Веб-мастер!");
Ниже приведено несколько способов получения списка баз 1С 7.7 из реестра:
Код получения списка баз 1С 7.7 из 8.х
Код 1C v 8.х функция сзПолучитьСписокБаз()
попытка
олеСкрипт = новый COMОбъект("MSScript Control.Script Control");
олеСкрипт.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("MSScript Control.Script Control");
Scr.Language = "vbscript ";
Scr.Timeout=-1;
HKEY_CURRENT_USER = 2147483649;
strKeyPath = "Software\1C\1Cv7\7.7\Titles";
Locator=СоздатьОбъект("WbemScript ing.SWbemLocator");
ServiceDef=Locator.ConnectServer(".","root\default");
oReg = ServiceDef.Get("StdRegProv");
Dict=СоздатьОбъект("Script ing.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("MSScript Control.Script Control");
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;
прервать;
КонецЕсли;
КонецЦикла;
КонецПроцедуры
Код 1C v 7.x
спКомп = СоздатьОбъект("СписокЗначений");
Попытка
ScrptCtrl=СоздатьОбъект("MSScript Control.Script Control");
ScrptCtrl.Language="vbscript ";
ScrptCtrl.AddCode("
|Function GetComputers()
| Set WinNT = GetObject(""WinNT:"")
| WinNT.Filter = Array(""domain"")
| For Each Domain In WinNT
| Set ADSI = GetObject(""WinNT://"" & Domain.Name)
| ADSI.Filter = Array(""computer"")
| For Each Comp In ADSI
| strInfo=strInfo & Domain.Name & "";"" & Comp.Name & vbCrLf
| Next
| Next
| GetComputers = strInfo
|End Function
|");
Текст=СокрЛП(ScrptCtrl.Run("GetComputers"));
ScrptCtrl = "";
Исключение
Предупреждение(ОписаниеОшибки());
Возврат;
КонецПопытки;
Для Индекс=1 по СтрКоличествоСтрок(Текст) Цикл
СтрТекста=СтрПолучитьСтроку(Текст,Индекс);
Разделитель=Найти(СтрТекста,";");
Домен=Лев(СтрТекста,Разделитель-1);
Компьютер=Прав(СтрТекста,СтрДлина(СтрТекста)-Разделитель);
спКомп.ДобавитьЗначение(Компьютер,Домен+""+Компьютер);
КонецЦикла;
спКомп.Сортировать();
Код 1C v 8.х
спКомп = Новый СписокЗначений;
Попытка
ScrptCtrl= Новый COMОбъект("MSScript Control.Script Control");
ScrptCtrl.Language="vbscript ";
ScrptCtrl.AddCode("
|Function GetComputers()
| Set WinNT = GetObject(""WinNT:"")
| WinNT.Filter = Array(""domain"")
| For Each Domain In WinNT
| Set ADSI = GetObject(""WinNT://"" & Domain.Name)
| ADSI.Filter = Array(""computer"")
| For Each Comp In ADSI
| strInfo=strInfo & Domain.Name & "";"" & Comp.Name & vbCrLf
| Next
| Next
| GetComputers = strInfo
|End Function
|");
Текст=СокрЛП(ScrptCtrl.Run("GetComputers"));
ScrptCtrl = "";
Исключение
Предупреждение(ОписаниеОшибки());
Возврат;
КонецПопытки;
Для Индекс=1 по СтрЧислоСтрок(Текст) Цикл
СтрТекста=СтрПолучитьСтроку(Текст,Индекс);
Разделитель=Найти(СтрТекста,";");
Домен=Лев(СтрТекста,Разделитель-1);
Компьютер=Прав(СтрТекста,СтрДлина(СтрТекста)-Разделитель);
спКомп.Добавить(Компьютер,Домен+""+Компьютер);
КонецЦикла;
спКомп.СортироватьПоПредставлению();
//Выберем комп
спКомп.ВыбратьЭлемент();
Наиболее эффективно это можно сделать с помощью объектов OLE Automation , работа с которыми осуществляется при помощи:
sp_OACreate, sp_OAGetProperty, sp_OASetProperty, sp_OAMethod, sp_OAGetErrorInfo, sp_OADestroy (подробное описание есть в http://technet.microsoft.com/ru-ru/library/ms203721(sql.90).aspx).
Рабочий пример процедуры (была написана для сохранения zip-архивов, хранящихся в базе):
Код CREATE PROCEDURE dbo.SaveRequestDataAsFile (
@FileName varchar(1024) --имя файла
,@FilePath varchar(1024) --путь файла
,@ReqID --некое условие на таблицу
)
AS
BEGIN
DECLARE
@Stream integer,
@Buffer varbinary(4096),
@Size integer,
@Pos integer,
@BufSize integer,
@FileNameLocal varchar(1024),
@HR integer
if RIGHT(@FilePath, 1)<>'&# 092;' begin set @FilePath=@FilePath+'&# 092;' end
set @FileNameLocal = @FilePath + @FileName
SET @BufSize = 4096
EXEC @HR = sp_OACreate 'ADODB.Stream',@Stream OUT
if @HR<>0
begin
--обработка ошибки создания объекта
EXEC [dbo].[sp_displayoaerrorinfo] @Stream ,@HR
end
EXEC @HR = sp_OASetProperty @Stream,'Type',1 -- binary
EXEC @HR = sp_OASetProperty @Stream,'Mode',3 -- write|read
EXEC @HR = sp_OAMethod @Stream,'Open'
S_elect
@Size = DATALENGTH(SrvRequests.RequestData)
FROM SrvRequests WHERE SrvRequests.RequestID = @ReqID
Set @Pos=0
WHILE @Pos < @Size BEGIN
SET @BufSize = CASE WHEN @Size - @Pos < 4096 THEN @Size - @Pos ELSE 4096 END
S_elect @Buffer = substring(SrvRequests.RequestData ,@Pos+1, @BufSize)
from SrvRequests where SrvRequests.RequestID = @ReqID
EXEC @HR = sp_OAMethod @Stream, 'Write', NULL, @Buffer
SET @Pos = @Pos + @BufSize
END
EXEC @HR = sp_OAMethod @Stream,'SaveToFile',null, @FileNameLocal,2
EXEC @HR = sp_OAMethod @Stream,'Close'
EXEC @HR = sp_OADestroy @Stream
END
Рекомендуется создать еще пару процедур для внятного описания ошибок в случае их возникновения
Код CREATE PROCEDURE sp_hexadecimal
@binvalue varbinary(255),
@hexvalue varchar(255) OUTPUT
AS
DECLARE @charvalue varchar(255)
DECLARE @i int
DECLARE @length int
DECLARE @hexstring char(16)
S_elect @charvalue = '0x'
S_elect @i = 1
S_elect @length = DATALENGTH(@binvalue)
S_elect @hexstring = '0123456789abcdef'
WHILE (@i <= @length)
BEGIN
DECLARE @tempint int
DECLARE @firstint int
DECLARE @secondint int
S_elect @tempint = CONVERT(int, SUBSTRING(@binvalue,@i,1))
S_elect @firstint = FLOOR(@tempint/16)
S_elect @secondint = @tempint - (@firstint* 16)
S_elect @charvalue = @charvalue +
SUBSTRING(@hexstring, @firstint+1, 1) +
SUBSTRING(@hexstring, @secondint+1, 1)
S_elect @i = @i + 1
END
----------------------------------------------------------------------
CREATE PROCEDURE sp_displayoaerrorinfo
@object int,
@hresult int
AS
DECLARE @output varchar(255)
DECLARE @hrhex char(10)
DECLARE @hr int
DECLARE @source varchar(255)
DECLARE @descript ion varchar(255)
PRINT 'OLE Automation Error Information'
EXEC sp_hexadecimal @hresult, @hrhex OUT
S_elect @output = ' HRESULT: ' + @hrhex
PRINT @output
EXEC @hr = sp_OAGetErrorInfo @object, @source OUT, @descript ion OUT
IF @hr = 0
BEGIN
S_elect @output = ' Source: ' + @source
PRINT @output
S_elect @output = ' Descript ion: ' + @descript ion
PRINT @output
END
ELSE
BEGIN
PRINT ' sp_OAGetErrorInfo failed.'
RETURN
END