суббота, 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.

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.

Получение списка адресов электронной почты из Active Directory в Delphi 7

Под этим способом подразумевается получение списка адресов электронной почты из Active Directory с использованием скрипта VBScript и передача этого списка в Delphi программу для дальнейшей обработки.

Теперь приступим к реализации этого способа.

Нам необходимо разработать 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.

Получаем версию операционной системы Windows в Delphi 7

Есть такая известная функция получения версии операционной системы Windows – GetVersionEx, но начиная с версии Windows 8 и выше данная функция работает должным образом только совместно с файлом манифеста.

Создайте новый проект. Сохраните проект с именем p21.dpr. Основной модуль назовите p21_unit1.pas. В каталоге проекта создайте файл манифеста Windows.manifest. Содержимое файла должно быть следующее:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <assemblyIdentity type="win32" name="App" version="3.1.0.0" processorArchitecture="*"/>
  <dependency>
    <dependentAssembly>
      <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="*"/>
    </dependentAssembly>
  </dependency>
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
    <security>
      <requestedPrivileges>
        <requestedExecutionLevel level="asInvoker" uiAccess="false"/>
        </requestedPrivileges>
    </security>
  </trustInfo>
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
    <application>
      <!--The ID below indicates application support for Windows Vista -->
      <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
      <!--The ID below indicates application support for Windows 7 -->
      <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
      <!--The ID below indicates application support for Windows 8 -->
      <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> 
      <!--The ID below indicates application support for Windows 8.1 -->
      <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> 
      <!--The ID below indicates application support for Windows 10 --> 
      <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
    </application>
  </compatibility></assembly>

Далее нам необходимо в каталоге проекта создать файл ресурсов компиляции с именем Windows.rc. Содержимое файла компиляции будет следующее:

1 24 "Windows.manifest"

То есть мы в качестве ресурсов нашего приложения указываем наш файл манифеста.

Файл ресурсов компиляции Windows.rc необходимо скомпилировать при помощи компилятора ресурсов brcc32.exe, этот компилятор ресурсов расположен в каталоге, где расположены бинарные файлы Delphi, у меня это каталог D:\Programs\Delphi7\Files\Delphi7\Bin. Убедитесь, что данный каталог добавлен в переменную окружения Path. Запустите командную строку Windows, перейдите в каталог проекта и выполните команду компиляции ресурсов (Смотрите рисунок 1).

brcc32.exe Windows.rc

В качестве результата в каталоге проекта вы получите файл ресурсов Windows.RES, который необходимо в файле проекта p21.dpr подключить. Смотрите код ниже:

Рисунок 1. Создание файла ресурсов

program p21;

uses
  Forms,
  p21_unit1 in 'p21_unit1.pas' {Form1};

{$R *.res}
{$R Windows.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Разместите на форме Form1 текстовую метку Lable1. В метке Label1 мы будем отображать версию операционной системы Windows (Смотрите рисунок 2).

Рисунок 2. Создание формы приложения

Переходим к написанию кода. Рассмотрим обработчик показа формы Form1, это следующий код:

procedure TForm1.FormShow(Sender: TObject);
begin
  Label1.Caption := WinName;
end;

В обработчике показа формы Form1 мы метке Label1 присваиваем результат возврата функции WinName.

Рассмотрим две функции, которые получают версию операционной системы Windows.

function WinVerNum: integer;
var
  ver: TOSVersionInfo;
begin
  ver.dwOSVersionInfoSize := SizeOf(ver);
  if GetVersionEx(ver) then
    with ver do
      result := StrToInt(IntToStr(dwMajorVersion) + '' + IntToStr(dwMinorVersion));
end;

При помощи функции GetVersionEx мы получаем номер основной и второстепенный для нашей операционной системы Windows. Преобразуем основной и второстепенный номер в строку, выполняем соединение этих строк в одну и возвращаем результат выполнения функции WinVerNum.

function WinName: String;
begin
  if WinVerNum = 51 then result := 'Windows XP';
  if WinVerNum = 60 then result := 'Windows Vista';
  if WinVerNum = 61 then result := 'Windows 7';
  if WinVerNum = 62 then result := 'Windows 8';
  if WinVerNum = 63 then result := 'Windows 8.1';
  if WinVerNum = 100 then result := 'Windows 10';
end;

При помощи функции WinName мы получаем версию операционной системы Windows и возвращаем ее в виде строки.

Результат работы программы (Смотрите рисунок 3).

Рисунок 3. Результат работы программы

Код полностью:

unit p21_unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function WinVerNum: integer;
var
  ver: TOSVersionInfo;
begin
  ver.dwOSVersionInfoSize := SizeOf(ver);
  if GetVersionEx(ver) then
    with ver do
      result := StrToInt(IntToStr(dwMajorVersion) + '' + IntToStr(dwMinorVersion));
end;

function WinName: String;
begin
  if WinVerNum = 51 then result := 'Windows XP';
  if WinVerNum = 60 then result := 'Windows Vista';
  if WinVerNum = 61 then result := 'Windows 7';
  if WinVerNum = 62 then result := 'Windows 8';
  if WinVerNum = 63 then result := 'Windows 8.1';
  if WinVerNum = 100 then result := 'Windows 10';
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Label1.Caption := WinName;
end;

end.

Задействуем UAC в приложениях написанных на Delphi 7

UAC – это Контроль Учетных Записей (Wikipedia), используется для повышения привилегий в том случае если вашему приложению это необходимо. Появился в Windows Vista и присутствует Windows 7, 8, 10. Необходимо убедится в том, что UAC включен. В Windows 7 это можно проверить, открыв «Панель управления» - «Учетные записи пользователей» - «Изменение параметров контроля учетных записей» - убедится, что установлен уровень «По умолчанию» (Смотрите рисунок 1).

 Рисунок 1. Включение UAC в Windows 7

Создадим тестовое приложение, которое будет писать в реестр Windows выбираемые из списка значения, правда путь куда мы будем записывать значения требуют повышения привилегий. Откроем Delphi 7 и создадим новый проект. Присвоим ему имя p12.dpr. Сохраним основной модуль под именем p12_unit.pas. Чтобы научить наше приложение работать с UAC, необходимо создать в папке проекта файл манифеста, назовём его Win7UAC.manifest. Содержимое файла следующее:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <assemblyIdentity type="win32" name="App" version="3.1.0.0" processorArchitecture="*"/>
  <dependency>
    <dependentAssembly>
      <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="*"/>
    </dependentAssembly>
  </dependency>
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
    <security>
      <requestedPrivileges>
        <requestedExecutionLevel level="requireAdministrator" uiAccess="false"/>
        </requestedPrivileges>
    </security>
  </trustInfo>
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
    <application>
      <!--The ID below indicates application support for Windows Vista -->
      <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
      <!--The ID below indicates application support for Windows 7 -->
      <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
      <!--The ID below indicates application support for Windows 8 -->
      <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> 
      <!--The ID below indicates application support for Windows 8.1 -->
      <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> 
      <!--The ID below indicates application support for Windows 10 --> 
      <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
    </application>
  </compatibility></assembly>

Основным, важным моментом в файле манифеста является строчка кода:

 <requestedPrivileges>
        <requestedExecutionLevel level="requireAdministrator" uiAccess="false"/>
 </requestedPrivileges>

Параметр level со значением requireAdministrator указывает на то, что нашему приложению для работы требуются права администратора.  Следующими строчками кода мы указываем с какими операционными системами наше приложение будет совместимо:

<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
    <application>
      <!--The ID below indicates application support for Windows Vista -->
      <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
      <!--The ID below indicates application support for Windows 7 -->
      <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
      <!--The ID below indicates application support for Windows 8 -->
      <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> 
      <!--The ID below indicates application support for Windows 8.1 -->
      <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> 
      <!--The ID below indicates application support for Windows 10 --> 
      <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
    </application>
 </compatibility>

Далее нам необходимо в каталоге проекта создать файл ресурсов компиляции с именем Win7UAC.rc. Содержимое файла компиляции будет следующее:

1 24 "Win7UAC.manifest"

То есть мы в качестве ресурсов нашего приложения указываем наш файл манифеста.

Файл ресурсов компиляции Win7UAC.rc необходимо скомпилировать при помощи компилятора ресурсов brcc32.exe, этот компилятор ресурсов расположен в каталоге, где расположены бинарные файлы Delphi, у меня это каталог D:\Programs\Delphi7\Files\Delphi7\Bin. Убедитесь, что данный каталог добавлен в переменную окружения Path. Запустите командную строку Windows, перейдите в каталог проекта и выполните команду компиляции ресурсов (Смотрите рисунок 2).

Рисунок 2. Запуск компилятора ресурсов

brcc32.exe Win7UAC.rc

В качестве результата в каталоге проекта вы получите файл ресурсов Win7UAC.RES, который необходимо в файле проекта p12.dpr подключить. Смотрите код ниже:

program p12;

uses
  Forms,
  p12_unit1 in 'p12_unit1.pas' {Form1};

{$R 'Win7UAC.RES'}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Вынесите на форму с именем Form1 одну кнопку Button1 и один список ComboBox1 (Смотрите рисунок 3).

 Рисунок 3. Создания формы приложения

Добавьте в свойства Items списка ComboBox1 две строки DOMAIN\User1 и DOMAIN\User2 (Смотрите рисунок 4). Эти строки у нас будут выбираться в ComboBox1. Также поменяйте свойства Style для списка ComboBox1 на csOwnerDraw.

Рисунок 4. Формирование списка ComboBox

Переходим к написанию кода. Рассмотрим обработчик показа формы Form1, это следующий код:

procedure TForm1.FormShow(Sender: TObject);
begin
  Combobox1.ItemIndex := Combobox1.Items.IndexOf('DOMAIN\User1');
end;

В данном обработчике мы присваиваем списку ComboBox1 значение по умолчанию значение DOMAIN\User1. 

Рассмотрим обработчик нажатия кнопки Button1, это следующий код:

procedure TForm1.Button1Click(Sender: TObject);
var
  R: TRegistry;
  openResult: Boolean;
const
  SubKey : String = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI';

begin
  strSetRegValue := ComboBox1.Text;
  if (strSetRegValue <> '') then
  begin
    R := TRegistry.Create(KEY_READ);
    R.RootKey := HKEY_LOCAL_MACHINE;
    if (R.KeyExists(SubKey)) then
    begin
      With R do
      begin
        Access := KEY_WRITE OR $0100;
        openResult := OpenKey(SubKey, False);
        if (not openResult = True) Then
        begin
          MessageDlg('Unable to create key! Exiting.', mtError, mbOKCancel, 0);
        end;
        WriteString('LastLoggedOnSAMUser', strSetRegValue);
        WriteString('LastLoggedOnUser', strSetRegValue);

        CloseKey();
        Free;
      end;
    end;
    ShowMessage('Done! Recorded in the registry.');
    strSetRegValue := '';
  end;
end;

В данном обработчике мы указываем путь в реестре Windows куда будем писать значения, это переменная типа String c именем SubKey. Смотрите код:

SubKey : String = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI';

Далее берем выбранное значение ComboBox1 и присваиваем его переменной strSetRegValue. Смотрите код:

strSetRegValue := ComboBox1.Text;

Если переменная strSetRegValue не пуста, то начинаем писать в реестр Windows. Работать будем в корневом разделе HKEY_LOCAL_MACHINE. Смотрите код:

  if (strSetRegValue <> '') then
  begin
    R := TRegistry.Create(KEY_READ);
    R.RootKey := HKEY_LOCAL_MACHINE;


Далее проверяем существует ли путь в реестре SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI. Также открываем подраздел реестра на запись для Windows 7 32 bit и 64 bit, следующая строчка: 

Access := KEY_WRITE OR $0100;


Смотрите следующий код:

if (R.KeyExists(SubKey)) then
    begin
      With R do
      begin
        Access := KEY_WRITE OR $0100;
        openResult := OpenKey(SubKey, False);
        if (not openResult = True) Then
        begin
          MessageDlg('Unable to create key! Exiting.', mtError, mbOKCancel, 0);
        end;


Далее пишем в реестр параметры LastLoggedOnSAMUser, LastLoggedOnUser и закрываем ветку реестра и освобождаем память. Следующие строчки:

        WriteString('LastLoggedOnSAMUser', strSetRegValue);
        WriteString('LastLoggedOnUser', strSetRegValue);

        CloseKey();
        Free;


Ниже показан снимок рабочей программы (Смотрите рисунок 5) и код полностью. При запуске приложения, оно спросит повышения привилегий, если вы имеете права админа (Смотрите рисунок 6) или повышения привилегий путем ввода логина и пароля администратора (Смотрите рисунок 7).

Рисунок 5. Запущенная программа

Рисунок 6. Окно разрешения запуска вашей программы, если вы имеете права администратора

Рисунок 7. Запрос прав администратора, если они у вас отсутствуют

unit p12_unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Registry;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  strSetRegValue: String;

procedure TForm1.Button1Click(Sender: TObject);
var
  R: TRegistry;
  openResult: Boolean;
const
  SubKey : String = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI';

begin
  strSetRegValue := ComboBox1.Text;
  if (strSetRegValue <> '') then
  begin
    R := TRegistry.Create(KEY_READ);
    R.RootKey := HKEY_LOCAL_MACHINE;
    if (R.KeyExists(SubKey)) then
    begin
      With R do
      begin
        Access := KEY_WRITE OR $0100;
        openResult := OpenKey(SubKey, False);
        if (not openResult = True) Then
        begin
          MessageDlg('Unable to create key! Exiting.', mtError, mbOKCancel, 0);
        end;
        WriteString('LastLoggedOnSAMUser', strSetRegValue);
        WriteString('LastLoggedOnUser', strSetRegValue);

        CloseKey();
        Free;
      end;
    end;
    ShowMessage('Done! Recorded in the registry.');
    strSetRegValue := '';
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Combobox1.ItemIndex := Combobox1.Items.IndexOf('DOMAIN\User1');
end;

end.