Столкнулся с такой проблемой, что «Диспетчер печати» под управлением Windows 10 64 bit самопроизвольно останавливался. Как следствие все принтера и виртуальные принтера становились недоступны. Решение данной проблемы удалось найти в интернете на этом ресурсе http://setupwindows.ru/setup/sluzhba-dispetcher-pechati. В статье описывается несколько методов решения проблемы. Способ, который помог мне решить проблему, это произвести очистку папки «Диспетчера печати». Эта папка расположена C:\Windows\System32\spool\PRINTERS. Каким-то образом пользователь умудрился отправить на печать файл объемом 125 Мб и имеющий формат Shockwave Flash Object (SWF). По этой причине «Диспетчер печати» прекращал свою работу и останавливался.
вторник, 20 августа 2019 г.
четверг, 8 августа 2019 г.
Автоматический вход на рабочий стол под доменной учетной записью в Windows 7, 10
Иногда бывает необходимость настроить на Windows 7, 10 автоматический вход на рабочий стол под доменной учетной записью. Для этого откройте реестр Windows, перейдите в раздел реестра HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\Currentversion\Winlogon и изменить значения следующих строковых параметров:
"AutoAdminLogon"="1"
"DefaultDomainName"="DOMAIN"
"DefaultUserName"="User"
"DefaultPassword"="Password"
Строковые параметры DefaultUserName и DefaultPassword по умолчанию отсутствуют, их необходимо создать вручную. Потом необходимо перезагрузить компьютер.
"AutoAdminLogon"="1"
"DefaultDomainName"="DOMAIN"
"DefaultUserName"="User"
"DefaultPassword"="Password"
Строковые параметры DefaultUserName и DefaultPassword по умолчанию отсутствуют, их необходимо создать вручную. Потом необходимо перезагрузить компьютер.
суббота, 27 июля 2019 г.
Прячем VBS-скрипты в ресурсном файле Windows в приложениях на Delphi 7
Внимание! Данный пример был разработан в среде программирования Delphi 7 и под управлением Windows XP.
Я уже писал про совместное использование Delphi 7 и VBScripts, для чего это связка нужна и как ее использовать (http://notidealrunner.blogspot.com/2019/05/vbscripts-delphi.html). Возможно, вы тоже нашли в этом пользу использования. Единственное что мне не понравилось это то, что наши VBS-скрипты всегда необходимо таскать вместе с исполняемой частью программы. А что будет, если при выполнение программы, необходимых скриптов не окажется? Программа откажется работать или будет работать не так как вы задумывали. Или, если вы не хотите демонстрировать программный код VBS-скриптов, распространяемые вместе с исполняемой программой, то вам понадобится спрятать, каким-то образом, это код. Долго я пытался я найти решение как лучше спрятать VBS-скрипты. Единственным решением которое я нашел, это засунуть VBS-скрипт в ресурсный файл Windows и скомпоновать его с исполняемой программой. Единственный минус данного способа, это увеличение объема исполняемой программы, но и это можно обойти, я так предполагаю, скомпоновав данный ресурсный файл с динамической линкуемой dll – библиотекой, но в этом посте мы не будем рассматривать это способ.
Давайте приступим к созданию нового проекта. Создайте в среде Delphi 7 проект с именем p6.dpr. Основной модуль программы сохраните под именем p6_unit1.pas. Файл скрипта назовите sum.vbs и сохраните его в корне папки проекта p6. Код скрипта будет такой-же как и в проекте по этому посту http://notidealrunner.blogspot.com/2019/05/vbscripts-delphi.html.
Далее нам необходимо в каталоге проекта p6 создать файл ресурсов компиляции с именем sum.rc. Содержимое файла компиляции будет следующее:
VBSCRIPTS RCDATA sum.vbs
То есть мы в качестве ресурсов нашего приложения указываем наш файл VBS-скрипта.
Файл ресурсов компиляции sum.rc необходимо скомпилировать при помощи компилятора ресурсов brcc32.exe, этот компилятор ресурсов расположен в каталоге, где расположены бинарные файлы Delphi, у меня это каталог c:\Program Files\BORLAND\Delphi7\Bin\. Убедитесь, что данный каталог добавлен в переменную окружения Path. Запустите командную строку Windows, перейдите в каталог проекта и выполните команду компиляции ресурсов.
brcc32.exe sum.rc
В качестве результата в каталоге проекта вы получите файл ресурсов sum.RES, который необходимо в файле модуля p6_unit1.pas подключить. Смотрите код ниже:
var
Form1: TForm1;
ScriptString: String;
implementation
{$R *.dfm}
{$R sum.res}
На форму с именем Form1 необходимо перетащить компонент ScriptControl. Я уже писал, как установить данный компонент и задействовать его в проекте (Смотрите статью http://notidealrunner.blogspot.com/2019/05/vbscripts-delphi.html).
Перейдем к описанию кода проекта Delphi.
1. В обработчике создания формы мы обращаемся к потоку ресурсов нашего приложения типа TResourceStream с целью получить доступ к нашему пользовательскому ресурсу данных в формате RCDATA с именем VBSCRIPTS. Потом создаем пустой строковый поток типа TStringStream, в который мы будем копировать данные из потока ресурсов типа TResourceStream. Далее сохраняем данные из строкового потока в глобальную строковую переменную типа String с именем ScriptString. В конце работы обработчика мы освобождаем используемые потоки типа TResourceStream и типа TStringStream.
procedure TForm1.FormCreate(Sender: TObject);
var
RS: TResourceStream;
SS: TStringStream;
begin
RS := TResourceStream.Create(hInstance, 'VBSCRIPTS', RT_RCDATA);
SS := TStringStream.Create('');
try
SS.CopyFrom(RS, RS.Size);
ScriptString := SS.DataString;
finally
FreeAndNil(SS);
FreeAndNil(RS);
end;
end;
2. Далее в обработчике нажатия кнопки мы загружаем скрипт из глобальной строковой переменной типа String с именем ScriptString и запускаем функцию Sum на исполнение.
procedure TForm1.Button1Click(Sender: TObject);
var
varr, res:Variant;
pPar:PSafeArray;
SA : TSafeArrayBound;
a: Integer;
b: Integer;
ValErrorCode: Integer;
begin
Val(Edit1.Text, a, ValErrorCode);
Val(Edit2.Text, b, ValErrorCode);
try
ScriptControl1.Language := 'VBScript';
ScriptControl1.AddCode(ScriptString);
SA.cElements := 2;
pPar := SafeArrayCreate(varVariant, 1, SA);
varr := VarArrayCreate([0, 1], varVariant);
varr[0]:=a;
varr[1]:=b;
pPar:=PSafeArray(TVarData(varr).VArray);
res:=ScriptControl1.Run('Sum',pPar);
Label5.Caption := VarToStr(res);
except
on E: Exception do
MessageDlg(PWideChar(E.Message), mtError, [mbOK], 0);
end;
end;
3. Вот и все. Теперь исполняемый файл программы можно будет перемещать без VBS-скриптов.
Код модуля p6_unit1.pas
Код проекта p6.dpr
Код VBS-скрипта sum.vbs
Я уже писал про совместное использование Delphi 7 и VBScripts, для чего это связка нужна и как ее использовать (http://notidealrunner.blogspot.com/2019/05/vbscripts-delphi.html). Возможно, вы тоже нашли в этом пользу использования. Единственное что мне не понравилось это то, что наши VBS-скрипты всегда необходимо таскать вместе с исполняемой частью программы. А что будет, если при выполнение программы, необходимых скриптов не окажется? Программа откажется работать или будет работать не так как вы задумывали. Или, если вы не хотите демонстрировать программный код VBS-скриптов, распространяемые вместе с исполняемой программой, то вам понадобится спрятать, каким-то образом, это код. Долго я пытался я найти решение как лучше спрятать VBS-скрипты. Единственным решением которое я нашел, это засунуть VBS-скрипт в ресурсный файл Windows и скомпоновать его с исполняемой программой. Единственный минус данного способа, это увеличение объема исполняемой программы, но и это можно обойти, я так предполагаю, скомпоновав данный ресурсный файл с динамической линкуемой dll – библиотекой, но в этом посте мы не будем рассматривать это способ.
Давайте приступим к созданию нового проекта. Создайте в среде Delphi 7 проект с именем p6.dpr. Основной модуль программы сохраните под именем p6_unit1.pas. Файл скрипта назовите sum.vbs и сохраните его в корне папки проекта p6. Код скрипта будет такой-же как и в проекте по этому посту http://notidealrunner.blogspot.com/2019/05/vbscripts-delphi.html.
On Error Resume Next Function Sum(a,b) Sum = a + b End function
Далее нам необходимо в каталоге проекта p6 создать файл ресурсов компиляции с именем sum.rc. Содержимое файла компиляции будет следующее:
VBSCRIPTS RCDATA sum.vbs
То есть мы в качестве ресурсов нашего приложения указываем наш файл VBS-скрипта.
Файл ресурсов компиляции sum.rc необходимо скомпилировать при помощи компилятора ресурсов brcc32.exe, этот компилятор ресурсов расположен в каталоге, где расположены бинарные файлы Delphi, у меня это каталог c:\Program Files\BORLAND\Delphi7\Bin\. Убедитесь, что данный каталог добавлен в переменную окружения Path. Запустите командную строку Windows, перейдите в каталог проекта и выполните команду компиляции ресурсов.
brcc32.exe sum.rc
В качестве результата в каталоге проекта вы получите файл ресурсов sum.RES, который необходимо в файле модуля p6_unit1.pas подключить. Смотрите код ниже:
var
Form1: TForm1;
ScriptString: String;
implementation
{$R *.dfm}
{$R sum.res}
На форму с именем Form1 необходимо перетащить компонент ScriptControl. Я уже писал, как установить данный компонент и задействовать его в проекте (Смотрите статью http://notidealrunner.blogspot.com/2019/05/vbscripts-delphi.html).
Перейдем к описанию кода проекта Delphi.
1. В обработчике создания формы мы обращаемся к потоку ресурсов нашего приложения типа TResourceStream с целью получить доступ к нашему пользовательскому ресурсу данных в формате RCDATA с именем VBSCRIPTS. Потом создаем пустой строковый поток типа TStringStream, в который мы будем копировать данные из потока ресурсов типа TResourceStream. Далее сохраняем данные из строкового потока в глобальную строковую переменную типа String с именем ScriptString. В конце работы обработчика мы освобождаем используемые потоки типа TResourceStream и типа TStringStream.
procedure TForm1.FormCreate(Sender: TObject);
var
RS: TResourceStream;
SS: TStringStream;
begin
RS := TResourceStream.Create(hInstance, 'VBSCRIPTS', RT_RCDATA);
SS := TStringStream.Create('');
try
SS.CopyFrom(RS, RS.Size);
ScriptString := SS.DataString;
finally
FreeAndNil(SS);
FreeAndNil(RS);
end;
end;
2. Далее в обработчике нажатия кнопки мы загружаем скрипт из глобальной строковой переменной типа String с именем ScriptString и запускаем функцию Sum на исполнение.
procedure TForm1.Button1Click(Sender: TObject);
var
varr, res:Variant;
pPar:PSafeArray;
SA : TSafeArrayBound;
a: Integer;
b: Integer;
ValErrorCode: Integer;
begin
Val(Edit1.Text, a, ValErrorCode);
Val(Edit2.Text, b, ValErrorCode);
try
ScriptControl1.Language := 'VBScript';
ScriptControl1.AddCode(ScriptString);
SA.cElements := 2;
pPar := SafeArrayCreate(varVariant, 1, SA);
varr := VarArrayCreate([0, 1], varVariant);
varr[0]:=a;
varr[1]:=b;
pPar:=PSafeArray(TVarData(varr).VArray);
res:=ScriptControl1.Run('Sum',pPar);
Label5.Caption := VarToStr(res);
except
on E: Exception do
MessageDlg(PWideChar(E.Message), mtError, [mbOK], 0);
end;
end;
3. Вот и все. Теперь исполняемый файл программы можно будет перемещать без VBS-скриптов.
Код модуля p6_unit1.pas
unit p6_unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, MSScriptControl_TLB;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Button1: TButton;
ScriptControl1: TScriptControl;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ScriptString: String;
implementation
{$R *.dfm}
{$R sum.res}
uses ActiveX;
procedure TForm1.FormCreate(Sender: TObject);
var
RS: TResourceStream;
SS: TStringStream;
begin
RS := TResourceStream.Create(hInstance, 'VBSCRIPTS', RT_RCDATA);
SS := TStringStream.Create('');
try
SS.CopyFrom(RS, RS.Size);
ScriptString := SS.DataString;
finally
FreeAndNil(SS);
FreeAndNil(RS);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
varr, res:Variant;
pPar:PSafeArray;
SA : TSafeArrayBound;
a: Integer;
b: Integer;
ValErrorCode: Integer;
begin
Val(Edit1.Text, a, ValErrorCode);
Val(Edit2.Text, b, ValErrorCode);
try
ScriptControl1.Language := 'VBScript';
ScriptControl1.AddCode(ScriptString);
SA.cElements := 2;
pPar := SafeArrayCreate(varVariant, 1, SA);
varr := VarArrayCreate([0, 1], varVariant);
varr[0]:=a;
varr[1]:=b;
pPar:=PSafeArray(TVarData(varr).VArray);
res:=ScriptControl1.Run('Sum',pPar);
Label5.Caption := VarToStr(res);
except
on E: Exception do
MessageDlg(PWideChar(E.Message), mtError, [mbOK], 0);
end;
end;
end.
Код проекта p6.dpr
program p6;
uses
Forms,
p6_unit1 in 'p6_unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Код VBS-скрипта sum.vbs
On Error Resume Next Function Sum(a,b) Sum = a + b End function
вторник, 23 июля 2019 г.
Ошибка BSOD 0x0000006B: PROCESS1_INITIALIZATION_FAILED
Методов решения ошибки BSOD 0x0000006B в Интернет я нашел множество. Здесь я отмечу метод, который мне помог решить проблему. Данная проблема возникла на Windows 7 Corporate 32 bit. На сайте Microsoft (https://support.microsoft.com/ru-ru/help/981833/stop-error-code-0x0000006b-process1-initialization-failed-error-messag) пишут, что причина возникновения данной проблемы связана с повреждением файла Bootcat.cache или с изменением его размера. Как написано в статье по ссылке выше, решить проблему удалось путем загрузки c LiveDVD и удалением файла Bootcat.cache расположенный в папке %SystemRoot%\system32\codeintegrity и дальнейшей перезагрузки компьютера.
среда, 3 июля 2019 г.
Настройка общего доступа и доступа по админским шарам с Windows XP на Windows 10
Недавно решил попробовать перекинуть файлы из (comp1) Windows XP на (comp2) Windows 10, ввел на comp1 в адресной строке проводника ip адрес comp2 (192.168.1.3) и получил сообщение об ошибке «Указанное сетевое имя более недоступно» (смотрите рисунок 1).
Рисунок 1. Сообщение об ошибке "Указанное сетевое имя более недоступно" в Windows XP
При этом сам ip адрес 192.168.1.3 пингуется. На форуме oszone.net нашел решение, что необходимо на Windows 10 включить протокол SMB 1.0. Для этого необходимо запустить «Панель управления», отобразить «Все элементы панели управления», запустить «Программы и компоненты» (смотрите цифру 1 на рисунке 2). Потом нажать на кнопку «Включение или отключение компонентов Windows» (смотрите цифру 2 на рисунке 2).
Рисунок 2. Открытие окна "Компоненты Windows" в Windows 10
В окне «Компоненты Windows» найти и выбрать опции «Поддержка общего доступа к файлам SMB 1.0/CIFS», «Клиент SMB 1.0/CIFS», «Сервер SMB 1.0/CIFS» (смотрите рисунок 3).
Рисунок 3. Включение поддержки SMB 1.0 в Windows 10
После этого необходимо перезагрузить компьютеры comp1 и comp2. Пробуем еще раз на компьютере comp1 ввести в адресной строке проводника ip адрес comp2 (192.168.1.3). Видим, что данное сообщение не появилось и открылось окно с общими папками, общими принтерами на компьютере comp2 с Windows 10, или пустое окно как у меня, если общих папок и общих принтеров нет (смотрите рисунок 4).
Рисунок 4. Доступ к сетевым ресурсам Windows 10 из Windows XP
Мы рассмотрели настройку, касающуюся общего доступа на Windows 10.
Теперь рассмотрим настройку доступа по админским шарам. Пробуем ввести на comp1 в адресной строке проводника ip адрес comp2 (\\192.168.1.3) вместе с админской шарой C$ (\\192.168.1.3\C$) и получим окно ввода логина и пароля (например: логин user, пароль user) пользователя (смотрите рисунок 5).
Рисунок 5. Запрос логина и пароля при заходе на Windows 10 по админской шаре
Данный пользователь должен быть заведен на компьютере comp2 и иметь на данном компьютере права локального администратора, т.е. учетная запись должна находиться в группе «Администраторы». Пробуем ввести логин user и пароль user и получим сообщение о том что доступ запрещен. Почему так вышло, спросите вы? Ответ я нашел на этих сайтах ссылка 1, ссылка 2. Вкратце расскажу своими словами. Это потому-что Microsoft придумали новую развлекаловку под названием Remote UAC. Для учетных записей входящих в группу локальных администраторов доступ в Windows 10 закрыт и его необходимо открывать через реестр (То есть через реестр мы должны отключить этот Remote UAC). Правда для встроенной учетной записи локального администратора (Администратор) в Windows 10 доступ к админским шарам есть. Данная учетная запись по умолчанию отключена, поэтому ее нужно включить и задать пароль. Чтобы открыть доступ для учетных записей входящих в группу локальных администраторов (например, логин user) необходимо в Windows 10 запустить редактор реестра (редактор реестра запускается с правами администратора). Перейти в раздел реестра HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System (смотрите цифры 1,2 рисунка 6).
Рисунок 6. Отключаем Remote UAC через создания ключа реестра
В этом разделе создать параметр типа DWORD (32-бита) (смотрите цифру 3 рисунка 6) назвать его LocalAccountTokenFilterPolicy и присвоить ему значение 1 (смотрите цифру 4 рисунка 6). После этого необходимо перезагрузить компьютеры comp1 и comp2. Пробуем
еще раз на компьютере comp1 ввести
в адресной строке проводника ip адрес comp2 (\\192.168.1.3)
вместе с админской шарой C$ (\\192.168.1.3\C$). В возникшем окне ввода логина и
пароля вбиваем, например логин user, пароль user,
видим, что доступ работает и нам открылся в проводнике список папок диска C на Windows 10
(смотрите рисунок 7).
Рисунок 7. Открытая админская шара диска C$ Windows 10 из Windows XP
пятница, 21 июня 2019 г.
Команда Power Shell для сохранения списка электронных адресов из Active Directory
1. Убедитесь что у вас к Power Shell подключен модуль для работы с Active Directory.
2. Выполните команду Power Shell
PS C:\Users\User> Get-ADUser -Filter * -Properties EmailAddress |
select EmailAddress | Export-CSV "D:\Email_Addresses.csv"
3. После выполнения команду список электронных адресов у вас будет сохранен в файле Email_Addresses.csv на разделе D.
2. Выполните команду Power Shell
PS C:\Users\User> Get-ADUser -Filter * -Properties EmailAddress |
select EmailAddress | Export-CSV "D:\Email_Addresses.csv"
3. После выполнения команду список электронных адресов у вас будет сохранен в файле Email_Addresses.csv на разделе D.
Получение списка адресов электронной почты из Active Directory в Delphi 7
Под этим способом подразумевается получение списка адресов электронной почты из Active Directory с использованием скрипта VBScript и передача этого списка в Delphi программу для дальнейшей обработки.
Теперь приступим к реализации этого способа.
Нам необходимо разработать VBScript для получения списка адресов электронной почты из Active Directory. Назовём этот скрипт main.vbs.
Ниже показан код скрипта main.vbs:
Теперь пройдемся вкратце по коду скрипта main.vbs и функции GetADMailString
1. Объявляем необходимые переменные для работы скрипта, смотрите часть кода ниже:
On Error Resume Next
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strMail
Dim strResult
2. Осуществляем подключение к Active Directory
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
3. Получаем домен по умолчанию
' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
If Err.Number <> 0 Then
GetADMailString = ""
Else
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
4. Формируем запрос и выполняем его для получения строки со всеми почтовыми адресами из Active Directory
' Filter on user objects.
strFilter = "(&(objectCategory=person)(objectClass=user) (mail=*))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "mail"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
5. Формируем строку из всех почтовых адресов
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strMail = adoRecordset.Fields("mail").Value
If strMail <> "" Then
strResult = strResult & strMail & vbCrLf
End if
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
6. Закрываем соединение с Active Directory и возвращаем результат выполнения скрипта main.vbs
' Clean up.
adoRecordset.Close
adoConnection.Close
GetADMailString = strResult
end if
end function
Так со скриптом main.vbs мы разобрались. Теперь нам необходимо передать результат выполнения скрипта в нашу программу и сохранить все почтовые адреса в текстовый файл.
Создайте проект на в среде Delphi 7 и сохраните его под именем p22.dpr. Основной модуль программы сохраните под именем p22_unit1.pas. Файл скрипта main.vbs должен лежать в той же директории, что и файл проекта, и исполняемый файл программы.
На форму с именем Form1 необходимо перетащить компонент ScriptControl. Я уже писал, как установить данный компонент и задействовать его в проекте (Смотрите статью http://notidealrunner.blogspot.com/2019/05/vbscripts-delphi.html). Вкратце опишу основные моменты работы программы.
1. В обработчике показа формы мы проверяем существует ли скрипт main.vbs, открываем его на чтение, считываем его построчно.
procedure TForm1.FormShow(Sender: TObject);
var
ScriptFile: TextFile;
Script, LineScript: String;
SA : TSafeArrayBound;
pPar:PSafeArray;
res:Variant;
begin
AssignFile(ScriptFile,'main.vbs');
Reset(ScriptFile);
if IOResult <> 0 then
begin
MessageBox(0,'File access error.','Error',0);
exit;
end;
while not EOF(ScriptFile) do
begin
readln(ScriptFile, LineScript);
Script := Script + LineScript+#13+#10;
end;
CloseFile(ScriptFile);
2. Далее выполняем скрипт mian.vbs и функцию GetADMailString. Получаем результат выполнения скрипта и сохраняем в строковую переменную strTemp.
try
ScriptControl1.Language := 'VBScript';
ScriptControl1.AddCode(Script);
SA.cElements := 0;
pPar := SafeArrayCreate(varVariant, 1, SA);
res:=ScriptControl1.Run('GetADMailString',pPar);
strTemp := VarToStr(res);
except
on E: Exception do
MessageDlg(PWideChar(E.Message), mtError, [mbOK], 0);
end;
3. Далее передаем строковую переменную strTemp в процедуру сохранения в текстовый файл.
StrToFile('Mail.txt', strTemp);
Ниже код процедуры сохранения строки в файл (Код процедуры взят с сайта https://stackoverflow.com/questions/7752273/how-to-save-a-string-to-a-txt-file-in-delphi).
procedure StrToFile(const FileName, SourceString : string);
var
Stream : TFileStream;
begin
Stream:= TFileStream.Create(FileName, fmCreate);
try
Stream.WriteBuffer(Pointer(SourceString)^, Length(SourceString));
finally
Stream.Free;
end;
end;
Вот и все. Список всех электронных почтовых адресов будет сохранен в файл Mail.txt в директории проекта. Ниже показан код проекта полностью.
Теперь приступим к реализации этого способа.
Нам необходимо разработать VBScript для получения списка адресов электронной почты из Active Directory. Назовём этот скрипт main.vbs.
Ниже показан код скрипта main.vbs:
function GetADMailString()
On Error Resume Next
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strMail
Dim strResult
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
If Err.Number <> 0 Then
GetADMailString = ""
Else
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on user objects.
strFilter = "(&(objectCategory=person)(objectClass=user) (mail=*))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "mail"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strMail = adoRecordset.Fields("mail").Value
If strMail <> "" Then
strResult = strResult & strMail & vbCrLf
End if
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
adoConnection.Close
GetADMailString = strResult
end if
end function
Теперь пройдемся вкратце по коду скрипта main.vbs и функции GetADMailString
1. Объявляем необходимые переменные для работы скрипта, смотрите часть кода ниже:
On Error Resume Next
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strMail
Dim strResult
2. Осуществляем подключение к Active Directory
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
3. Получаем домен по умолчанию
' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
If Err.Number <> 0 Then
GetADMailString = ""
Else
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
4. Формируем запрос и выполняем его для получения строки со всеми почтовыми адресами из Active Directory
' Filter on user objects.
strFilter = "(&(objectCategory=person)(objectClass=user) (mail=*))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "mail"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
5. Формируем строку из всех почтовых адресов
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strMail = adoRecordset.Fields("mail").Value
If strMail <> "" Then
strResult = strResult & strMail & vbCrLf
End if
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
6. Закрываем соединение с Active Directory и возвращаем результат выполнения скрипта main.vbs
' Clean up.
adoRecordset.Close
adoConnection.Close
GetADMailString = strResult
end if
end function
Так со скриптом main.vbs мы разобрались. Теперь нам необходимо передать результат выполнения скрипта в нашу программу и сохранить все почтовые адреса в текстовый файл.
Создайте проект на в среде Delphi 7 и сохраните его под именем p22.dpr. Основной модуль программы сохраните под именем p22_unit1.pas. Файл скрипта main.vbs должен лежать в той же директории, что и файл проекта, и исполняемый файл программы.
На форму с именем Form1 необходимо перетащить компонент ScriptControl. Я уже писал, как установить данный компонент и задействовать его в проекте (Смотрите статью http://notidealrunner.blogspot.com/2019/05/vbscripts-delphi.html). Вкратце опишу основные моменты работы программы.
1. В обработчике показа формы мы проверяем существует ли скрипт main.vbs, открываем его на чтение, считываем его построчно.
procedure TForm1.FormShow(Sender: TObject);
var
ScriptFile: TextFile;
Script, LineScript: String;
SA : TSafeArrayBound;
pPar:PSafeArray;
res:Variant;
begin
AssignFile(ScriptFile,'main.vbs');
Reset(ScriptFile);
if IOResult <> 0 then
begin
MessageBox(0,'File access error.','Error',0);
exit;
end;
while not EOF(ScriptFile) do
begin
readln(ScriptFile, LineScript);
Script := Script + LineScript+#13+#10;
end;
CloseFile(ScriptFile);
2. Далее выполняем скрипт mian.vbs и функцию GetADMailString. Получаем результат выполнения скрипта и сохраняем в строковую переменную strTemp.
try
ScriptControl1.Language := 'VBScript';
ScriptControl1.AddCode(Script);
SA.cElements := 0;
pPar := SafeArrayCreate(varVariant, 1, SA);
res:=ScriptControl1.Run('GetADMailString',pPar);
strTemp := VarToStr(res);
except
on E: Exception do
MessageDlg(PWideChar(E.Message), mtError, [mbOK], 0);
end;
3. Далее передаем строковую переменную strTemp в процедуру сохранения в текстовый файл.
StrToFile('Mail.txt', strTemp);
Ниже код процедуры сохранения строки в файл (Код процедуры взят с сайта https://stackoverflow.com/questions/7752273/how-to-save-a-string-to-a-txt-file-in-delphi).
procedure StrToFile(const FileName, SourceString : string);
var
Stream : TFileStream;
begin
Stream:= TFileStream.Create(FileName, fmCreate);
try
Stream.WriteBuffer(Pointer(SourceString)^, Length(SourceString));
finally
Stream.Free;
end;
end;
Вот и все. Список всех электронных почтовых адресов будет сохранен в файл Mail.txt в директории проекта. Ниже показан код проекта полностью.
unit p22_unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, MSScriptControl_TLB, ActiveX;
type
TForm1 = class(TForm)
ScriptControl1: TScriptControl;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure StrToFile(const FileName, SourceString : string);
var
Stream : TFileStream;
begin
Stream:= TFileStream.Create(FileName, fmCreate);
try
Stream.WriteBuffer(Pointer(SourceString)^, Length(SourceString));
finally
Stream.Free;
end;
end;
var
strTemp: String;
procedure TForm1.FormShow(Sender: TObject);
var
ScriptFile: TextFile;
Script, LineScript: String;
SA : TSafeArrayBound;
pPar:PSafeArray;
res:Variant;
begin
AssignFile(ScriptFile,'main.vbs');
Reset(ScriptFile);
if IOResult <> 0 then
begin
MessageBox(0,'File access error.','Error',0);
exit;
end;
while not EOF(ScriptFile) do
begin
readln(ScriptFile, LineScript);
Script := Script + LineScript+#13+#10;
end;
CloseFile(ScriptFile);
try
ScriptControl1.Language := 'VBScript';
ScriptControl1.AddCode(Script);
SA.cElements := 0;
pPar := SafeArrayCreate(varVariant, 1, SA);
res:=ScriptControl1.Run('GetADMailString',pPar);
strTemp := VarToStr(res);
except
on E: Exception do
MessageDlg(PWideChar(E.Message), mtError, [mbOK], 0);
end;
StrToFile('Mail.txt', strTemp);
end;
end.
Подписаться на:
Сообщения (Atom)