И еще вопрос в тему: при приеме оконного сообщения создается ли отдельный поток для его обработки?
» Вопросы по Delphi (до версии 2009) - часть 5
Grande
Цитата:
Нет.
Все оконные сообщения обрабатываются оконной процедурой в той нити (потоком я называю потомков TStream ), которой эти окна созданы, и в порядке поступления. А поскольку VCL Дельфи принципиально однонитиевая библиотека, то, если скажем в обработчике нажатия кнопера делается что-то долго, то интерфейс "замораживается": прием сообщения и его обработка ведутся в основной и единственной (по-умолчанию) нити, и пока не будет обработано сообщение клика по кнопке, из очереди сообщений не будет извлекаться следующее сообщение, в том числе и сообщения отрисовки окон.
Но это не мешает в то время, пока выполняется длительная обработка какогото сообщения, организовывать локальные петли сообщений для их выборки и обработки. В дельфи для этого надо вызвать Application.ProcessMessages.
Надо только понимать, что все равно все делается последовательно и в одной нити.
Добавлено:
Grande
Рекомендую почитать книгу "О чем не пишут в книгах по Delphi" Григорьева... Там этот вопрос очень тщательно изложен. Вообще мегаинтересная книга. Отпадет масса вопросов.
Цитата:
при приеме оконного сообщения создается ли отдельный поток для его обработки?
Нет.
Все оконные сообщения обрабатываются оконной процедурой в той нити (потоком я называю потомков TStream ), которой эти окна созданы, и в порядке поступления. А поскольку VCL Дельфи принципиально однонитиевая библиотека, то, если скажем в обработчике нажатия кнопера делается что-то долго, то интерфейс "замораживается": прием сообщения и его обработка ведутся в основной и единственной (по-умолчанию) нити, и пока не будет обработано сообщение клика по кнопке, из очереди сообщений не будет извлекаться следующее сообщение, в том числе и сообщения отрисовки окон.
Но это не мешает в то время, пока выполняется длительная обработка какогото сообщения, организовывать локальные петли сообщений для их выборки и обработки. В дельфи для этого надо вызвать Application.ProcessMessages.
Надо только понимать, что все равно все делается последовательно и в одной нити.
Добавлено:
Grande
Рекомендую почитать книгу "О чем не пишут в книгах по Delphi" Григорьева... Там этот вопрос очень тщательно изложен. Вообще мегаинтересная книга. Отпадет масса вопросов.
psa1974
Спасибо, сейчас поищу на просторах инета
Спасибо, сейчас поищу на просторах инета
народ поздскажите плз такую беду...есть форма с менюхой из которой вызываются еще формы..так вот когда показываешь форму типа form5.show то она становится сзади основной...тоесть за ней...ни bringToFront новой формы ни sendtoback менюшной формы - эффекта не дают..только showmodal..но так нельзя в силу надобности программы..что это может быть?
Grande
На torrents.ru:
_http://torrents.ru/forum/viewtopic.php?t=1842567
_http://torrents.ru/forum/viewtopic.php?t=1666940 (Формат: DjVu)
_http://torrents.ru/forum/viewtopic.php?t=1025802
Вариант с DjVu - тупо фотиком нащелканная книга... Лучше ПДФ...
На torrents.ru:
_http://torrents.ru/forum/viewtopic.php?t=1842567
_http://torrents.ru/forum/viewtopic.php?t=1666940 (Формат: DjVu)
_http://torrents.ru/forum/viewtopic.php?t=1025802
Вариант с DjVu - тупо фотиком нащелканная книга... Лучше ПДФ...
Grande
Обратите внимание на OmniThreadLibrary http://otl.17slon.com/ и http://code.google.com/p/omnithreadlibrary/
С ее помощью работа с потоками и их взаимодействием друг с другом делается очень просто.
А на днях автор обещал выпустить новую версию.
Ну еще и библиотека Gala http://gurin.tomsknet.ru/gala.html заслуживает внимания.
Обратите внимание на OmniThreadLibrary http://otl.17slon.com/ и http://code.google.com/p/omnithreadlibrary/
С ее помощью работа с потоками и их взаимодействием друг с другом делается очень просто.
А на днях автор обещал выпустить новую версию.
Ну еще и библиотека Gala http://gurin.tomsknet.ru/gala.html заслуживает внимания.
mdid
попробовал воспроизвести твою беду... не получилось... Скинь примерчик, посмотрим...
попробовал воспроизвести твою беду... не получилось... Скинь примерчик, посмотрим...
data man
Да, эта штука у меня есть, весьма удобный инструмент.
psa1974
И еще раз спасибо - скачал в pdf.
Да, эта штука у меня есть, весьма удобный инструмент.
psa1974
И еще раз спасибо - скачал в pdf.
psa1974
пример не скину ибо это толстый проект..фигня в том что все было норм а неделю назад началось..хз че это такое никогда не сталкивался за 7 лет с таким..немного деталей..делфя 2010 форма 1 используется как авторизация...форма 2 основаная рабочая форма
borderstyle - single
formstyle - normal
position - designed
у всех остальных форм то же самое..и все прячутся за форм2
передача фокуса тоже не помогла
просто думал может кто сталкивался
пример не скину ибо это толстый проект..фигня в том что все было норм а неделю назад началось..хз че это такое никогда не сталкивался за 7 лет с таким..немного деталей..делфя 2010 форма 1 используется как авторизация...форма 2 основаная рабочая форма
borderstyle - single
formstyle - normal
position - designed
у всех остальных форм то же самое..и все прячутся за форм2
передача фокуса тоже не помогла
просто думал может кто сталкивался
Grande
Насчет SendMessage и ReplyMessage...
Вот сбацал тест:
Код:
const WM_PSA = WM_APP+ 1;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure WMPsa(var MSg: TMessage); message WM_PSA;
end;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Self.Handle, WM_PSA, 0, 0); //шлем сообщение
ShowMessage('*'); // после возврата из сообщения должна вылести мессага "*"
end;
procedure TForm1.WMPsa(var MSg: TMessage);
begin
ReplyMessage(0); // возвращаем результат
while True do ; //продолжаем до бесконечности обрабатывать сообщение
end;
Насчет SendMessage и ReplyMessage...
Вот сбацал тест:
Код:
const WM_PSA = WM_APP+ 1;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure WMPsa(var MSg: TMessage); message WM_PSA;
end;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Self.Handle, WM_PSA, 0, 0); //шлем сообщение
ShowMessage('*'); // после возврата из сообщения должна вылести мессага "*"
end;
procedure TForm1.WMPsa(var MSg: TMessage);
begin
ReplyMessage(0); // возвращаем результат
while True do ; //продолжаем до бесконечности обрабатывать сообщение
end;
psa1974
Вот блин... Вы правы, сударь, действительно не работает в одном процессе, только в разных.
ОК, еще поэкспериментирую...
Так-с... Экпериментировать бессмысленно, т.к. ReplyMessage действительно работает только при посылке сообщения окну в другом процессе и, соответственно,
Цитата:
Вот блин... Вы правы, сударь, действительно не работает в одном процессе, только в разных.
ОК, еще поэкспериментирую...
Так-с... Экпериментировать бессмысленно, т.к. ReplyMessage действительно работает только при посылке сообщения окну в другом процессе и, соответственно,
Цитата:
явно не решает задачу распараллеливания..
Люди добрые, научите уму разуму. Перешёл с Delphi 10 на RAD Studio 2009 и теперь idhttp из индей возвращает пургу вместо русских символов. Перерыл всю сеть, но так и не понял как лечить данное заболевание. На Delphi 10 вопрос решался очень просто, UTF8ToAnsi и всё замечательно. Сейчас же такой трюк не прокатывает. Сайт использует utf-8. Вот что выплёвывает запрос hxxp://pic.ipicture.ru/uploads/091029/8UGUQTQRV9.png
Maximus777
насчет компаноидов Indy... В поставке Дельфи 2009 идут глючные Indy именно в плане кодировки.
В свое время с столкнулся с этим при отправке писем... Не помню где, скачал пофиксенную библиотеку Indy, с которой у меня проблем не было. Сейчас попробовал тестовый проект IdHttpDemoVCL.exe, загрузил страницу http://www.microsoft.com/rus/info/copyright/ (кодировка utf-8, русские символы в наличии) - все пучком. Если надо - выложу патченую Indy, скажи только куда...
насчет компаноидов Indy... В поставке Дельфи 2009 идут глючные Indy именно в плане кодировки.
В свое время с столкнулся с этим при отправке писем... Не помню где, скачал пофиксенную библиотеку Indy, с которой у меня проблем не было. Сейчас попробовал тестовый проект IdHttpDemoVCL.exe, загрузил страницу http://www.microsoft.com/rus/info/copyright/ (кодировка utf-8, русские символы в наличии) - все пучком. Если надо - выложу патченую Indy, скажи только куда...
Maximus777
Цитата:
А потом можно сравнить фикс с этим официальным DevSnapshot ftp://indy.fulgan.com/zip/IndyTiburon.zip
Может там уже, помимо прочих, пофиксены и баги с кодировкой.
Цитата:
Не помню где, скачал пофиксенную библиотеку Indy, с которой у меня проблем не было.
А потом можно сравнить фикс с этим официальным DevSnapshot ftp://indy.fulgan.com/zip/IndyTiburon.zip
Может там уже, помимо прочих, пофиксены и баги с кодировкой.
data man
Я уж не буду сравнивать, поскольку у меня все работает, и я не раз убеждался, что правило "работает - не трогай", в отношении Indy работает, как часы, что печально, на самом деле (хотя себе в кучу забрал официальный IndyTiburon на всякий...). Предоставим заняться сравнением Maximus777 - он все равно на распутье
Maximus777
нашел сцылку !
Вот ветка форума:
_http://www.sql.ru/forum/actualthread.aspx?bid=20&tid=669703
там если по ссылкам походить, рано или поздно найдешь такую:
Ссылка
Это то, о чем я говорил. Нужно полностью снести Indy, идущие в комплекте (в той ветке, что я дал написано как это сделать так чтобы ничего не осталось). Ну и вообще почитай эту ветку... как раз тема кодировок там обсуждается...
Я уж не буду сравнивать, поскольку у меня все работает, и я не раз убеждался, что правило "работает - не трогай", в отношении Indy работает, как часы, что печально, на самом деле (хотя себе в кучу забрал официальный IndyTiburon на всякий...). Предоставим заняться сравнением Maximus777 - он все равно на распутье
Maximus777
нашел сцылку !
Вот ветка форума:
_http://www.sql.ru/forum/actualthread.aspx?bid=20&tid=669703
там если по ссылкам походить, рано или поздно найдешь такую:
Ссылка
Это то, о чем я говорил. Нужно полностью снести Indy, идущие в комплекте (в той ветке, что я дал написано как это сделать так чтобы ничего не осталось). Ну и вообще почитай эту ветку... как раз тема кодировок там обсуждается...
Вот нарыл код по получению информации о пользователях, рабочих станциях и группах в домене - может кому пригодится:
[more]
Код:
////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Project : DomainInfo
// * Unit Name : uMain
// * Purpose : Демо получения информации о пользователях и группах домена
// * Author : Александр (Rouse_) Багель
// * Version : 1.00
// ****************************************************************************
//
// Спасибо милой девушке Ане и группе "Машина Времени" за моральную поддержку...
//
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls
{$IFDEF VER150}
, XPMan
{$ENDIF};
const
netapi32lib = 'netapi32.dll';
NERR_Success = NO_ERROR;
type
// Структура для получения информации о рабочей станции
PWkstaInfo100 = ^TWkstaInfo100;
TWkstaInfo100 = record
wki100_platform_id : DWORD;
wki100_computername : PWideChar;
wki100_langroup : PWideChar;
wki100_ver_major : DWORD;
wki100_ver_minor : DWORD;
end;
// Итруктура для определения DNS имени контролера домена
TDomainControllerInfoA = record
DomainControllerName: LPSTR;
DomainControllerAddress: LPSTR;
DomainControllerAddressType: ULONG;
DomainGuid: TGUID;
DomainName: LPSTR;
DnsForestName: LPSTR;
Flags: ULONG;
DcSiteName: LPSTR;
ClientSiteName: LPSTR;
end;
PDomainControllerInfoA = ^TDomainControllerInfoA;
// Структура для отображения пользователей
PNetDisplayUser = ^TNetDisplayUser;
TNetDisplayUser = record
usri1_name: LPWSTR;
usri1_comment: LPWSTR;
usri1_flags: DWORD;
usri1_full_name: LPWSTR;
usri1_user_id: DWORD;
usri1_next_index: DWORD;
end;
// Структура для отображения рабочих станций
PNetDisplayMachine = ^TNetDisplayMachine;
TNetDisplayMachine = record
usri2_name: LPWSTR;
usri2_comment: LPWSTR;
usri2_flags: DWORD;
usri2_user_id: DWORD;
usri2_next_index: DWORD;
end;
// Структура для отображения групп
PNetDisplayGroup = ^TNetDisplayGroup;
TNetDisplayGroup = record
grpi3_name: LPWSTR;
grpi3_comment: LPWSTR;
grpi3_group_id: DWORD;
grpi3_attributes: DWORD;
grpi3_next_index: DWORD;
end;
// Структура для отображения пользователей принадлежащих группе
// или групп в которые входит пользователь
PGroupUsersInfo0 = ^TGroupUsersInfo0;
TGroupUsersInfo0 = record
grui0_name: LPWSTR;
end;
TfrmDomainInfo = class(TForm)
Button1: TButton;
gbCurrent: TGroupBox;
gbDomainResList: TGroupBox;
ledCompName: TLabeledEdit;
ledUserName: TLabeledEdit;
ledDomainName: TLabeledEdit;
ledControllerName: TLabeledEdit;
lvUsers: TListView;
gbInfo: TGroupBox;
lbInfo: TListBox;
VSplitter: TSplitter;
pcRes: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
lvWorkStation: TListView;
lvGroups: TListView;
Label1: TLabel;
memTrustedDomains: TMemo;
ledDNSName: TLabeledEdit;
procedure FormCreate(Sender: TObject);
procedure lvGroupsClick(Sender: TObject);
private
CurrentDomainName: String;
function GetCurrentUserName: String;
function GetCurrentComputerName: String;
function GetDomainController(const DomainName: String): String;
function GetDNSDomainName(const DomainName: String): String;
function EnumAllTrustedDomains: Boolean;
function EnumAllUsers: Boolean;
function EnumAllGroups: Boolean;
function EnumAllWorkStation: Boolean;
function GetSID(const SecureObject: String): String;
function GetAllGroupUsers(const GroupName: String): Boolean;
function GetAllUserGroups(const UserName: String): Boolean;
end;
// Функции которые предоставят нам возможность получения информации
function NetApiBufferFree(Buffer: Pointer): DWORD; stdcall;
external netapi32lib;
function NetWkstaGetInfo(ServerName: PWideChar; Level: DWORD;
Bufptr: Pointer): DWORD; stdcall; external netapi32lib;
function NetGetDCName(ServerName: PWideChar; DomainName: PWideChar;
var Bufptr: PWideChar): DWORD; stdcall; external netapi32lib;
function DsGetDcName(ComputerName, DomainName: PChar; DomainGuid: PGUID;
SiteName: PChar; Flags: ULONG;
var DomainControllerInfo: PDomainControllerInfoA): DWORD; stdcall;
external netapi32lib name 'DsGetDcNameA';
function NetQueryDisplayInformation(ServerName: PWideChar; Level: DWORD;
Index: DWORD; EntriesRequested: DWORD; PreferredMaximumLength: DWORD;
var ReturnedEntryCount: DWORD; SortedBuffer: Pointer): DWORD; stdcall;
external netapi32lib;
function NetGroupGetUsers(ServerName: PWideChar; GroupName: PWideChar; Level: DWORD;
var Bufptr: Pointer; PrefMaxLen: DWORD; var EntriesRead: DWORD;
var TotalEntries: DWORD; ResumeHandle: PDWORD): DWORD; stdcall;
external netapi32lib;
function NetUserGetGroups(ServerName: PWideChar; UserName: PWideChar; Level: DWORD;
var Bufptr: Pointer; PrefMaxLen: DWORD; var EntriesRead: DWORD;
var TotalEntries: DWORD): DWORD; stdcall; external netapi32lib;
function NetEnumerateTrustedDomains(ServerName: PWideChar;
DomainNames: PWideChar): DWORD; stdcall; external netapi32lib;
procedure ConvertSidToStringSid(SID: PSID; var StringSid: LPSTR); stdcall;
external advapi32 name 'ConvertSidToStringSidA';
var
frmDomainInfo: TfrmDomainInfo;
implementation
{$R *.dfm}
// Данная функция получает информацию о всех группах присутствующих в домене
// =============================================================================
function TfrmDomainInfo.EnumAllGroups: Boolean;
var
Tmp, Info: PNetDisplayGroup;
I, CurrIndex, EntriesRequest,
PreferredMaximumLength,
ReturnedEntryCount: Cardinal;
Error: DWORD;
begin
CurrIndex := 0;
repeat
Info := nil;
// NetQueryDisplayInformation возвращает информацию только о 100-а записях
// для того чтобы получить всю информацию используется третий параметр,
// передаваемый функции, который определяет с какой записи продолжать
// вывод информации
EntriesRequest := 100;
PreferredMaximumLength := EntriesRequest * SizeOf(TNetDisplayGroup);
ReturnedEntryCount := 0;
// Для выполнения функции, в нее нужно передать DNS имя контролера домена
// (или его IP адрес), с которого мы хочем получить информацию
// Для получения информации о группах используется структура NetDisplayGroup
// и ее идентификатор 3 (тройка) во втором параметре
Error := NetQueryDisplayInformation(StringToOleStr(ledControllerName.Text), 3, CurrIndex,
EntriesRequest, PreferredMaximumLength, ReturnedEntryCount, @Info);
// При безошибочном выполнении фунции будет результат либо
// 1. NERR_Success - все записи возвращены
// 2. ERROR_MORE_DATA - записи возвращены, но остались еще и нужно вызывать функцию повторно
if Error in [NERR_Success, ERROR_MORE_DATA] then
try
Tmp := Info;
// Выводим информацию которую вернула функция в структуру
for I := 0 to ReturnedEntryCount - 1 do
begin
with lvGroups.Items.Add do
begin
Caption := Tmp^.grpi3_name; // Имя группы
SubItems.Add(Tmp^.grpi3_comment); // Комментарий
SubItems.Add(GetSID(Caption)); // SID группы
// Запоминаем индекс с которым будем вызывать повторно функцию (если нужно)
CurrIndex := Tmp^.grpi3_next_index;
end;
Inc(Tmp);
end;
finally
// Чтобы небыло утечки ресурсов, освобождаем память занятую функцией под структуру
NetApiBufferFree(Info);
end;
// Если результат выполнения функции ERROR_MORE_DATA - вызываем функцию повторно
until Error in [NERR_Success, ERROR_ACCESS_DENIED];
// Ну и возвращаем результат всего что мы тут накодили
Result := Error = NERR_Success;
end;
// Данная функция получает информацию о всех доверенных доменах
// =============================================================================
function TfrmDomainInfo.EnumAllTrustedDomains: Boolean;
var
Tmp, DomainList: PWideChar;
begin
// Используем недокументированную функцию NetEnumerateTrustedDomains
// (только не пойму, с какого перепуга она не документирована?)
// Тут все очень просто, на вход имя контролера домена, ны выход - список доверенных доменов
Result := NetEnumerateTrustedDomains(StringToOleStr(ledControllerName.Text),
@DomainList) = NERR_Success;
// Если вызов функции успешен, то...
if Result then
try
Tmp := DomainList;
while Length(Tmp) > 0 do
begin
memTrustedDomains.Lines.Add(Tmp); // Банально выводим список на экран
Tmp := Tmp + Length(Tmp) + 1;
end;
finally
// Не забываем про память
NetApiBufferFree(DomainList);
end;
end;
// Данная функция получает информацию о всех пользователях присутствующих в домене
// =============================================================================
function TfrmDomainInfo.EnumAllUsers: Boolean;
var
Tmp, Info: PNetDisplayUser;
I, CurrIndex, EntriesRequest,
PreferredMaximumLength,
ReturnedEntryCount: Cardinal;
Error: DWORD;
begin
CurrIndex := 0;
repeat
Info := nil;
// NetQueryDisplayInformation возвращает информацию только о 100-а записях
// для того чтобы получить всю информацию используется третий параметр,
// передаваемый функции, который определяет с какой записи продолжать
// вывод информации
EntriesRequest := 100;
PreferredMaximumLength := EntriesRequest * SizeOf(TNetDisplayUser);
ReturnedEntryCount := 0;
// Для выполнения функции, в нее нужно передать DNS имя контролера домена
// (или его IP адрес), с которого мы хочем получить информацию
// Для получения информации о пользователях используется структура NetDisplayUser
// и ее идентификатор 1 (единица) во втором параметре
Error := NetQueryDisplayInformation(StringToOleStr(ledControllerName.Text), 1, CurrIndex,
EntriesRequest, PreferredMaximumLength, ReturnedEntryCount, @Info);
// При безошибочном выполнении фунции будет результат либо
// 1. NERR_Success - все записи возвращены
// 2. ERROR_MORE_DATA - записи возвращены, но остались еще и нужно вызывать функцию повторно
if Error in [NERR_Success, ERROR_MORE_DATA] then
try
Tmp := Info;
// Выводим информацию которую вернула функция в структуру
for I := 0 to ReturnedEntryCount - 1 do
begin
with lvUsers.Items.Add do
begin
Caption := Tmp^.usri1_name; // Имя пользователя
SubItems.Add(Tmp^.usri1_comment); // Комментарий
SubItems.Add(GetSID(Caption)); // Его SID
// Запоминаем индекс с которым будем вызывать повторно функцию (если нужно)
CurrIndex := Tmp^.usri1_next_index;
end;
Inc(Tmp);
end;
finally
// Грохаем выделенную при вызове NetQueryDisplayInformation память
NetApiBufferFree(Info);
end;
// Если результат выполнения функции ERROR_MORE_DATA
// (т.е. есть еще данные) - вызываем функцию повторно
until Error in [NERR_Success, ERROR_ACCESS_DENIED];
// Ну и возвращаем результат всего что мы тут накодили
Result := Error = NERR_Success;
end;
// Данная функция получает информацию о всех рабочих станциях присутствующих в домене
// Вообщето так делать немного не верно, дело в том что рабочие станции могут
// присутствовать в списке не только те, которые завел сисадмин (но для демки сойдет и так)
// =============================================================================
function TfrmDomainInfo.EnumAllWorkStation: Boolean;
var
Tmp, Info: PNetDisplayMachine;
I, CurrIndex, EntriesRequest,
PreferredMaximumLength,
ReturnedEntryCount: Cardinal;
Error: DWORD;
begin
CurrIndex := 0;
repeat
Info := nil;
// NetQueryDisplayInformation возвращает информацию только о 100-а записях
// для того чтобы получить всю информацию используется третий параметр,
// передаваемый функции, который определяет с какой записи продолжать
// вывод информации
EntriesRequest := 100;
PreferredMaximumLength := EntriesRequest * SizeOf(TNetDisplayMachine);
ReturnedEntryCount := 0;
// Для выполнения функции, в нее нужно передать DNS имя контролера домена
// (или его IP адрес), с которого мы хочем получить информацию
// Для получения информации о рабочих станциях используется структура NetDisplayMachine
// и ее идентификатор 2 (двойка) во втором параметре
Error := NetQueryDisplayInformation(StringToOleStr(ledControllerName.Text), 2, CurrIndex,
EntriesRequest, PreferredMaximumLength, ReturnedEntryCount, @Info);
// При безошибочном выполнении фунции будет результат либо
// 1. NERR_Success - все записи возвращены
// 2. ERROR_MORE_DATA - записи возвращены, но остались еще и нужно вызывать функцию повторно
if Error in [NERR_Success, ERROR_MORE_DATA] then
try
Tmp := Info;
// Выводим информацию которую вернула функция в структуру
for I := 0 to ReturnedEntryCount - 1 do
begin
with lvWorkStation.Items.Add do
begin
Caption := Tmp^.usri2_name; // Имя рабочей станции
SubItems.Add(Tmp^.usri2_comment); // Комментарий
SubItems.Add(GetSID(Caption)); // Её SID
// Запоминаем индекс с которым будем вызывать повторно функцию (если нужно)
CurrIndex := Tmp^.usri2_next_index;
end;
Inc(Tmp);
end;
finally
// Дабы небыло утечек
NetApiBufferFree(Info);
end;
// Если результат выполнения функции ERROR_MORE_DATA
// (т.е. есть еще данные) - вызываем функцию повторно
until Error in [NERR_Success, ERROR_ACCESS_DENIED];
// Ну и возвращаем результат всего что мы тут накодили
Result := Error = NERR_Success;
end;
procedure TfrmDomainInfo.FormCreate(Sender: TObject);
begin
// Просто вызываем все функции подряд (не делал проверок на результат функций)
ledUserName.Text := GetCurrentUserName;
ledCompName.Text := GetCurrentComputerName;
ledDomainName.Text := CurrentDomainName;
ledControllerName.Text := GetDomainController(CurrentDomainName);
// Единственно, если нет контролера домена, то дальше определять бесполезно
if ledControllerName.Text = '' then Exit;
ledDNSName.Text := GetDNSDomainName(CurrentDomainName);
EnumAllTrustedDomains;
EnumAllUsers;
EnumAllWorkStation;
EnumAllGroups;
end;
// Довольно простая функция, возвращает только имена пользователей принадлезжащих группе
// =============================================================================
function TfrmDomainInfo.GetAllGroupUsers(const GroupName: String): Boolean;
var
Tmp, Info: PGroupUsersInfo0;
PrefMaxLen, EntriesRead,
TotalEntries, ResumeHandle: DWORD;
I: Integer;
begin
// На вход подается список который мы будем заполнять
lbInfo.Items.Clear;
// Обязательная инициализация
ResumeHandle := 0;
PrefMaxLen := DWORD(-1);
// Выполняем
Result := NetGroupGetUsers(StringToOleStr(ledControllerName.Text),
StringToOleStr(GroupName), 0, Pointer(Info), PrefMaxLen,
EntriesRead, TotalEntries, @ResumeHandle) = NERR_Success;
// Смотрим результат...
if Result then
try
Tmp := Info;
for I := 0 to EntriesRead - 1 do
begin
lbInfo.Items.Add(Tmp^.grui0_name); // Банально выводим результат из структуры
Inc(Tmp);
end;
finally
// Не забываем, ибо может быть склероз
NetApiBufferFree(Info);
end;
end;
// Аналогично предыдущей функции (заметьте - структура таже)
// =============================================================================
function TfrmDomainInfo.GetAllUserGroups(const UserName: String): Boolean;
var
Tmp, Info: PGroupUsersInfo0;
PrefMaxLen, EntriesRead,
TotalEntries: DWORD;
I: Integer;
begin
lbInfo.Items.Clear;
PrefMaxLen := DWORD(-1);
Result := NetUserGetGroups(StringToOleStr(ledControllerName.Text),
StringToOleStr(UserName), 0, Pointer(Info), PrefMaxLen,
EntriesRead, TotalEntries) = NERR_Success;
if Result then
try
Tmp := Info;
for I := 0 to EntriesRead - 1 do
begin
lbInfo.Items.Add(Tmp^.grui0_name);
Inc(Tmp);
end;
finally
NetApiBufferFree(Info);
end;
end;
// Получаем имя компьютера и имя домена
// =============================================================================
function TfrmDomainInfo.GetCurrentComputerName: String;
var
Info: PWkstaInfo100;
Error: DWORD;
begin
// А для этого мы воспользуемся следующей функцией
Error := NetWkstaGetInfo(nil, 100, @Info);
if Error <> 0 then
raise Exception.Create(SysErrorMessage(Error));
// Как видно, вызов который возвращает обычную структуру, из которой и прочитаем, все что нужно
// А именно имя компьютера в сети
Result := Info^.wki100_computername;
// И где он находиться
CurrentDomainName := info^.wki100_langroup;
end;
// Без комментариев
// =============================================================================
function TfrmDomainInfo.GetCurrentUserName: String;
var
Size: Cardinal;
begin
Size := MAXCHAR;
SetLength(Result, Size);
GetUserName(PChar(Result), Size);
SetLength(Result, Size);
end;
// Получаем DNS имя контроллера домена
// =============================================================================
function TfrmDomainInfo.GetDNSDomainName(const DomainName: String): String;
const
DS_IS_FLAT_NAME = $00010000;
DS_RETURN_DNS_NAME = $40000000;
var
GUID: PGUID;
DomainControllerInfo: PDomainControllerInfoA;
begin
GUID := nil;
// Для большинства операций нам потребуется IP адрес контроллера домена
// или его DNS имя, которое мы получим вот так:
if DsGetDcName(nil, PChar(CurrentDomainName), GUID, nil,
DS_IS_FLAT_NAME or DS_RETURN_DNS_NAME, DomainControllerInfo) = NERR_Success then
// Параметры которые мы передаем означают:
// DS_IS_FLAT_NAME - передаем просто имя домена
// DS_RETURN_DNS_NAME - ждем получения DNS имени
try
Result := DomainControllerInfo^.DomainControllerName; // Результат собсно тут...
finally
// Склероз это болезнь, ее нужно лечить...
NetApiBufferFree(DomainControllerInfo);
end;
end;
// Ну тут без комментариев - просто получаем имя контроллера домена
// =============================================================================
function TfrmDomainInfo.GetDomainController(const DomainName: String): String;
var
Domain: WideString;
Server: PWideChar;
begin
Domain := StringToOleStr(DomainName);
if NetGetDCName(nil, @Domain[1], Server) = NERR_Success then
try
Result := Server;
finally
NetApiBufferFree(Server);
end;
end;
// Не знаю зачем добавил это, ну раз добавил - получение SID объекта
// Без комментариев...
// =============================================================================
function TfrmDomainInfo.GetSID(const SecureObject: String): String;
var
SID: PSID;
StringSid: PChar;
ReferencedDomain: String;
cbSid, cbReferencedDomain:DWORD;
peUse: SID_NAME_USE;
begin
cbSID := 128;
cbReferencedDomain := 16;
GetMem(SID, cbSid);
try
SetLength(ReferencedDomain, cbReferencedDomain);
if LookupAccountName(PChar(ledDNSName.Text),
PChar(SecureObject), SID, cbSid,
@ReferencedDomain[1], cbReferencedDomain, peUse) then
begin
ConvertSidToStringSid(SID, StringSid);
Result := StringSid;
end;
finally
FreeMem(SID);
end;
end;
procedure TfrmDomainInfo.lvGroupsClick(Sender: TObject);
var
Value: String;
begin
if (Sender as TListView).Selected = nil then Exit;
Value := (Sender as TListView).Selected.Caption;
case (Sender as TListView).Tag of
0:
begin
gbInfo.Caption := Format('Группы в которые входит пользователь "%s"', [Value]);
GetAllUserGroups(Value);
end;
1:
begin
gbInfo.Caption := Format('Группы в которые входит рабочая станция "%s"', [Value]);
GetAllUserGroups(Value);
end;
2:
begin
gbInfo.Caption := Format('Объекты входящие в группу "%s"', [Value]);
GetAllGroupUsers(Value);
end;
end;
end;
end.
[more]
Код:
////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Project : DomainInfo
// * Unit Name : uMain
// * Purpose : Демо получения информации о пользователях и группах домена
// * Author : Александр (Rouse_) Багель
// * Version : 1.00
// ****************************************************************************
//
// Спасибо милой девушке Ане и группе "Машина Времени" за моральную поддержку...
//
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls
{$IFDEF VER150}
, XPMan
{$ENDIF};
const
netapi32lib = 'netapi32.dll';
NERR_Success = NO_ERROR;
type
// Структура для получения информации о рабочей станции
PWkstaInfo100 = ^TWkstaInfo100;
TWkstaInfo100 = record
wki100_platform_id : DWORD;
wki100_computername : PWideChar;
wki100_langroup : PWideChar;
wki100_ver_major : DWORD;
wki100_ver_minor : DWORD;
end;
// Итруктура для определения DNS имени контролера домена
TDomainControllerInfoA = record
DomainControllerName: LPSTR;
DomainControllerAddress: LPSTR;
DomainControllerAddressType: ULONG;
DomainGuid: TGUID;
DomainName: LPSTR;
DnsForestName: LPSTR;
Flags: ULONG;
DcSiteName: LPSTR;
ClientSiteName: LPSTR;
end;
PDomainControllerInfoA = ^TDomainControllerInfoA;
// Структура для отображения пользователей
PNetDisplayUser = ^TNetDisplayUser;
TNetDisplayUser = record
usri1_name: LPWSTR;
usri1_comment: LPWSTR;
usri1_flags: DWORD;
usri1_full_name: LPWSTR;
usri1_user_id: DWORD;
usri1_next_index: DWORD;
end;
// Структура для отображения рабочих станций
PNetDisplayMachine = ^TNetDisplayMachine;
TNetDisplayMachine = record
usri2_name: LPWSTR;
usri2_comment: LPWSTR;
usri2_flags: DWORD;
usri2_user_id: DWORD;
usri2_next_index: DWORD;
end;
// Структура для отображения групп
PNetDisplayGroup = ^TNetDisplayGroup;
TNetDisplayGroup = record
grpi3_name: LPWSTR;
grpi3_comment: LPWSTR;
grpi3_group_id: DWORD;
grpi3_attributes: DWORD;
grpi3_next_index: DWORD;
end;
// Структура для отображения пользователей принадлежащих группе
// или групп в которые входит пользователь
PGroupUsersInfo0 = ^TGroupUsersInfo0;
TGroupUsersInfo0 = record
grui0_name: LPWSTR;
end;
TfrmDomainInfo = class(TForm)
Button1: TButton;
gbCurrent: TGroupBox;
gbDomainResList: TGroupBox;
ledCompName: TLabeledEdit;
ledUserName: TLabeledEdit;
ledDomainName: TLabeledEdit;
ledControllerName: TLabeledEdit;
lvUsers: TListView;
gbInfo: TGroupBox;
lbInfo: TListBox;
VSplitter: TSplitter;
pcRes: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
lvWorkStation: TListView;
lvGroups: TListView;
Label1: TLabel;
memTrustedDomains: TMemo;
ledDNSName: TLabeledEdit;
procedure FormCreate(Sender: TObject);
procedure lvGroupsClick(Sender: TObject);
private
CurrentDomainName: String;
function GetCurrentUserName: String;
function GetCurrentComputerName: String;
function GetDomainController(const DomainName: String): String;
function GetDNSDomainName(const DomainName: String): String;
function EnumAllTrustedDomains: Boolean;
function EnumAllUsers: Boolean;
function EnumAllGroups: Boolean;
function EnumAllWorkStation: Boolean;
function GetSID(const SecureObject: String): String;
function GetAllGroupUsers(const GroupName: String): Boolean;
function GetAllUserGroups(const UserName: String): Boolean;
end;
// Функции которые предоставят нам возможность получения информации
function NetApiBufferFree(Buffer: Pointer): DWORD; stdcall;
external netapi32lib;
function NetWkstaGetInfo(ServerName: PWideChar; Level: DWORD;
Bufptr: Pointer): DWORD; stdcall; external netapi32lib;
function NetGetDCName(ServerName: PWideChar; DomainName: PWideChar;
var Bufptr: PWideChar): DWORD; stdcall; external netapi32lib;
function DsGetDcName(ComputerName, DomainName: PChar; DomainGuid: PGUID;
SiteName: PChar; Flags: ULONG;
var DomainControllerInfo: PDomainControllerInfoA): DWORD; stdcall;
external netapi32lib name 'DsGetDcNameA';
function NetQueryDisplayInformation(ServerName: PWideChar; Level: DWORD;
Index: DWORD; EntriesRequested: DWORD; PreferredMaximumLength: DWORD;
var ReturnedEntryCount: DWORD; SortedBuffer: Pointer): DWORD; stdcall;
external netapi32lib;
function NetGroupGetUsers(ServerName: PWideChar; GroupName: PWideChar; Level: DWORD;
var Bufptr: Pointer; PrefMaxLen: DWORD; var EntriesRead: DWORD;
var TotalEntries: DWORD; ResumeHandle: PDWORD): DWORD; stdcall;
external netapi32lib;
function NetUserGetGroups(ServerName: PWideChar; UserName: PWideChar; Level: DWORD;
var Bufptr: Pointer; PrefMaxLen: DWORD; var EntriesRead: DWORD;
var TotalEntries: DWORD): DWORD; stdcall; external netapi32lib;
function NetEnumerateTrustedDomains(ServerName: PWideChar;
DomainNames: PWideChar): DWORD; stdcall; external netapi32lib;
procedure ConvertSidToStringSid(SID: PSID; var StringSid: LPSTR); stdcall;
external advapi32 name 'ConvertSidToStringSidA';
var
frmDomainInfo: TfrmDomainInfo;
implementation
{$R *.dfm}
// Данная функция получает информацию о всех группах присутствующих в домене
// =============================================================================
function TfrmDomainInfo.EnumAllGroups: Boolean;
var
Tmp, Info: PNetDisplayGroup;
I, CurrIndex, EntriesRequest,
PreferredMaximumLength,
ReturnedEntryCount: Cardinal;
Error: DWORD;
begin
CurrIndex := 0;
repeat
Info := nil;
// NetQueryDisplayInformation возвращает информацию только о 100-а записях
// для того чтобы получить всю информацию используется третий параметр,
// передаваемый функции, который определяет с какой записи продолжать
// вывод информации
EntriesRequest := 100;
PreferredMaximumLength := EntriesRequest * SizeOf(TNetDisplayGroup);
ReturnedEntryCount := 0;
// Для выполнения функции, в нее нужно передать DNS имя контролера домена
// (или его IP адрес), с которого мы хочем получить информацию
// Для получения информации о группах используется структура NetDisplayGroup
// и ее идентификатор 3 (тройка) во втором параметре
Error := NetQueryDisplayInformation(StringToOleStr(ledControllerName.Text), 3, CurrIndex,
EntriesRequest, PreferredMaximumLength, ReturnedEntryCount, @Info);
// При безошибочном выполнении фунции будет результат либо
// 1. NERR_Success - все записи возвращены
// 2. ERROR_MORE_DATA - записи возвращены, но остались еще и нужно вызывать функцию повторно
if Error in [NERR_Success, ERROR_MORE_DATA] then
try
Tmp := Info;
// Выводим информацию которую вернула функция в структуру
for I := 0 to ReturnedEntryCount - 1 do
begin
with lvGroups.Items.Add do
begin
Caption := Tmp^.grpi3_name; // Имя группы
SubItems.Add(Tmp^.grpi3_comment); // Комментарий
SubItems.Add(GetSID(Caption)); // SID группы
// Запоминаем индекс с которым будем вызывать повторно функцию (если нужно)
CurrIndex := Tmp^.grpi3_next_index;
end;
Inc(Tmp);
end;
finally
// Чтобы небыло утечки ресурсов, освобождаем память занятую функцией под структуру
NetApiBufferFree(Info);
end;
// Если результат выполнения функции ERROR_MORE_DATA - вызываем функцию повторно
until Error in [NERR_Success, ERROR_ACCESS_DENIED];
// Ну и возвращаем результат всего что мы тут накодили
Result := Error = NERR_Success;
end;
// Данная функция получает информацию о всех доверенных доменах
// =============================================================================
function TfrmDomainInfo.EnumAllTrustedDomains: Boolean;
var
Tmp, DomainList: PWideChar;
begin
// Используем недокументированную функцию NetEnumerateTrustedDomains
// (только не пойму, с какого перепуга она не документирована?)
// Тут все очень просто, на вход имя контролера домена, ны выход - список доверенных доменов
Result := NetEnumerateTrustedDomains(StringToOleStr(ledControllerName.Text),
@DomainList) = NERR_Success;
// Если вызов функции успешен, то...
if Result then
try
Tmp := DomainList;
while Length(Tmp) > 0 do
begin
memTrustedDomains.Lines.Add(Tmp); // Банально выводим список на экран
Tmp := Tmp + Length(Tmp) + 1;
end;
finally
// Не забываем про память
NetApiBufferFree(DomainList);
end;
end;
// Данная функция получает информацию о всех пользователях присутствующих в домене
// =============================================================================
function TfrmDomainInfo.EnumAllUsers: Boolean;
var
Tmp, Info: PNetDisplayUser;
I, CurrIndex, EntriesRequest,
PreferredMaximumLength,
ReturnedEntryCount: Cardinal;
Error: DWORD;
begin
CurrIndex := 0;
repeat
Info := nil;
// NetQueryDisplayInformation возвращает информацию только о 100-а записях
// для того чтобы получить всю информацию используется третий параметр,
// передаваемый функции, который определяет с какой записи продолжать
// вывод информации
EntriesRequest := 100;
PreferredMaximumLength := EntriesRequest * SizeOf(TNetDisplayUser);
ReturnedEntryCount := 0;
// Для выполнения функции, в нее нужно передать DNS имя контролера домена
// (или его IP адрес), с которого мы хочем получить информацию
// Для получения информации о пользователях используется структура NetDisplayUser
// и ее идентификатор 1 (единица) во втором параметре
Error := NetQueryDisplayInformation(StringToOleStr(ledControllerName.Text), 1, CurrIndex,
EntriesRequest, PreferredMaximumLength, ReturnedEntryCount, @Info);
// При безошибочном выполнении фунции будет результат либо
// 1. NERR_Success - все записи возвращены
// 2. ERROR_MORE_DATA - записи возвращены, но остались еще и нужно вызывать функцию повторно
if Error in [NERR_Success, ERROR_MORE_DATA] then
try
Tmp := Info;
// Выводим информацию которую вернула функция в структуру
for I := 0 to ReturnedEntryCount - 1 do
begin
with lvUsers.Items.Add do
begin
Caption := Tmp^.usri1_name; // Имя пользователя
SubItems.Add(Tmp^.usri1_comment); // Комментарий
SubItems.Add(GetSID(Caption)); // Его SID
// Запоминаем индекс с которым будем вызывать повторно функцию (если нужно)
CurrIndex := Tmp^.usri1_next_index;
end;
Inc(Tmp);
end;
finally
// Грохаем выделенную при вызове NetQueryDisplayInformation память
NetApiBufferFree(Info);
end;
// Если результат выполнения функции ERROR_MORE_DATA
// (т.е. есть еще данные) - вызываем функцию повторно
until Error in [NERR_Success, ERROR_ACCESS_DENIED];
// Ну и возвращаем результат всего что мы тут накодили
Result := Error = NERR_Success;
end;
// Данная функция получает информацию о всех рабочих станциях присутствующих в домене
// Вообщето так делать немного не верно, дело в том что рабочие станции могут
// присутствовать в списке не только те, которые завел сисадмин (но для демки сойдет и так)
// =============================================================================
function TfrmDomainInfo.EnumAllWorkStation: Boolean;
var
Tmp, Info: PNetDisplayMachine;
I, CurrIndex, EntriesRequest,
PreferredMaximumLength,
ReturnedEntryCount: Cardinal;
Error: DWORD;
begin
CurrIndex := 0;
repeat
Info := nil;
// NetQueryDisplayInformation возвращает информацию только о 100-а записях
// для того чтобы получить всю информацию используется третий параметр,
// передаваемый функции, который определяет с какой записи продолжать
// вывод информации
EntriesRequest := 100;
PreferredMaximumLength := EntriesRequest * SizeOf(TNetDisplayMachine);
ReturnedEntryCount := 0;
// Для выполнения функции, в нее нужно передать DNS имя контролера домена
// (или его IP адрес), с которого мы хочем получить информацию
// Для получения информации о рабочих станциях используется структура NetDisplayMachine
// и ее идентификатор 2 (двойка) во втором параметре
Error := NetQueryDisplayInformation(StringToOleStr(ledControllerName.Text), 2, CurrIndex,
EntriesRequest, PreferredMaximumLength, ReturnedEntryCount, @Info);
// При безошибочном выполнении фунции будет результат либо
// 1. NERR_Success - все записи возвращены
// 2. ERROR_MORE_DATA - записи возвращены, но остались еще и нужно вызывать функцию повторно
if Error in [NERR_Success, ERROR_MORE_DATA] then
try
Tmp := Info;
// Выводим информацию которую вернула функция в структуру
for I := 0 to ReturnedEntryCount - 1 do
begin
with lvWorkStation.Items.Add do
begin
Caption := Tmp^.usri2_name; // Имя рабочей станции
SubItems.Add(Tmp^.usri2_comment); // Комментарий
SubItems.Add(GetSID(Caption)); // Её SID
// Запоминаем индекс с которым будем вызывать повторно функцию (если нужно)
CurrIndex := Tmp^.usri2_next_index;
end;
Inc(Tmp);
end;
finally
// Дабы небыло утечек
NetApiBufferFree(Info);
end;
// Если результат выполнения функции ERROR_MORE_DATA
// (т.е. есть еще данные) - вызываем функцию повторно
until Error in [NERR_Success, ERROR_ACCESS_DENIED];
// Ну и возвращаем результат всего что мы тут накодили
Result := Error = NERR_Success;
end;
procedure TfrmDomainInfo.FormCreate(Sender: TObject);
begin
// Просто вызываем все функции подряд (не делал проверок на результат функций)
ledUserName.Text := GetCurrentUserName;
ledCompName.Text := GetCurrentComputerName;
ledDomainName.Text := CurrentDomainName;
ledControllerName.Text := GetDomainController(CurrentDomainName);
// Единственно, если нет контролера домена, то дальше определять бесполезно
if ledControllerName.Text = '' then Exit;
ledDNSName.Text := GetDNSDomainName(CurrentDomainName);
EnumAllTrustedDomains;
EnumAllUsers;
EnumAllWorkStation;
EnumAllGroups;
end;
// Довольно простая функция, возвращает только имена пользователей принадлезжащих группе
// =============================================================================
function TfrmDomainInfo.GetAllGroupUsers(const GroupName: String): Boolean;
var
Tmp, Info: PGroupUsersInfo0;
PrefMaxLen, EntriesRead,
TotalEntries, ResumeHandle: DWORD;
I: Integer;
begin
// На вход подается список который мы будем заполнять
lbInfo.Items.Clear;
// Обязательная инициализация
ResumeHandle := 0;
PrefMaxLen := DWORD(-1);
// Выполняем
Result := NetGroupGetUsers(StringToOleStr(ledControllerName.Text),
StringToOleStr(GroupName), 0, Pointer(Info), PrefMaxLen,
EntriesRead, TotalEntries, @ResumeHandle) = NERR_Success;
// Смотрим результат...
if Result then
try
Tmp := Info;
for I := 0 to EntriesRead - 1 do
begin
lbInfo.Items.Add(Tmp^.grui0_name); // Банально выводим результат из структуры
Inc(Tmp);
end;
finally
// Не забываем, ибо может быть склероз
NetApiBufferFree(Info);
end;
end;
// Аналогично предыдущей функции (заметьте - структура таже)
// =============================================================================
function TfrmDomainInfo.GetAllUserGroups(const UserName: String): Boolean;
var
Tmp, Info: PGroupUsersInfo0;
PrefMaxLen, EntriesRead,
TotalEntries: DWORD;
I: Integer;
begin
lbInfo.Items.Clear;
PrefMaxLen := DWORD(-1);
Result := NetUserGetGroups(StringToOleStr(ledControllerName.Text),
StringToOleStr(UserName), 0, Pointer(Info), PrefMaxLen,
EntriesRead, TotalEntries) = NERR_Success;
if Result then
try
Tmp := Info;
for I := 0 to EntriesRead - 1 do
begin
lbInfo.Items.Add(Tmp^.grui0_name);
Inc(Tmp);
end;
finally
NetApiBufferFree(Info);
end;
end;
// Получаем имя компьютера и имя домена
// =============================================================================
function TfrmDomainInfo.GetCurrentComputerName: String;
var
Info: PWkstaInfo100;
Error: DWORD;
begin
// А для этого мы воспользуемся следующей функцией
Error := NetWkstaGetInfo(nil, 100, @Info);
if Error <> 0 then
raise Exception.Create(SysErrorMessage(Error));
// Как видно, вызов который возвращает обычную структуру, из которой и прочитаем, все что нужно
// А именно имя компьютера в сети
Result := Info^.wki100_computername;
// И где он находиться
CurrentDomainName := info^.wki100_langroup;
end;
// Без комментариев
// =============================================================================
function TfrmDomainInfo.GetCurrentUserName: String;
var
Size: Cardinal;
begin
Size := MAXCHAR;
SetLength(Result, Size);
GetUserName(PChar(Result), Size);
SetLength(Result, Size);
end;
// Получаем DNS имя контроллера домена
// =============================================================================
function TfrmDomainInfo.GetDNSDomainName(const DomainName: String): String;
const
DS_IS_FLAT_NAME = $00010000;
DS_RETURN_DNS_NAME = $40000000;
var
GUID: PGUID;
DomainControllerInfo: PDomainControllerInfoA;
begin
GUID := nil;
// Для большинства операций нам потребуется IP адрес контроллера домена
// или его DNS имя, которое мы получим вот так:
if DsGetDcName(nil, PChar(CurrentDomainName), GUID, nil,
DS_IS_FLAT_NAME or DS_RETURN_DNS_NAME, DomainControllerInfo) = NERR_Success then
// Параметры которые мы передаем означают:
// DS_IS_FLAT_NAME - передаем просто имя домена
// DS_RETURN_DNS_NAME - ждем получения DNS имени
try
Result := DomainControllerInfo^.DomainControllerName; // Результат собсно тут...
finally
// Склероз это болезнь, ее нужно лечить...
NetApiBufferFree(DomainControllerInfo);
end;
end;
// Ну тут без комментариев - просто получаем имя контроллера домена
// =============================================================================
function TfrmDomainInfo.GetDomainController(const DomainName: String): String;
var
Domain: WideString;
Server: PWideChar;
begin
Domain := StringToOleStr(DomainName);
if NetGetDCName(nil, @Domain[1], Server) = NERR_Success then
try
Result := Server;
finally
NetApiBufferFree(Server);
end;
end;
// Не знаю зачем добавил это, ну раз добавил - получение SID объекта
// Без комментариев...
// =============================================================================
function TfrmDomainInfo.GetSID(const SecureObject: String): String;
var
SID: PSID;
StringSid: PChar;
ReferencedDomain: String;
cbSid, cbReferencedDomain:DWORD;
peUse: SID_NAME_USE;
begin
cbSID := 128;
cbReferencedDomain := 16;
GetMem(SID, cbSid);
try
SetLength(ReferencedDomain, cbReferencedDomain);
if LookupAccountName(PChar(ledDNSName.Text),
PChar(SecureObject), SID, cbSid,
@ReferencedDomain[1], cbReferencedDomain, peUse) then
begin
ConvertSidToStringSid(SID, StringSid);
Result := StringSid;
end;
finally
FreeMem(SID);
end;
end;
procedure TfrmDomainInfo.lvGroupsClick(Sender: TObject);
var
Value: String;
begin
if (Sender as TListView).Selected = nil then Exit;
Value := (Sender as TListView).Selected.Caption;
case (Sender as TListView).Tag of
0:
begin
gbInfo.Caption := Format('Группы в которые входит пользователь "%s"', [Value]);
GetAllUserGroups(Value);
end;
1:
begin
gbInfo.Caption := Format('Группы в которые входит рабочая станция "%s"', [Value]);
GetAllUserGroups(Value);
end;
2:
begin
gbInfo.Caption := Format('Объекты входящие в группу "%s"', [Value]);
GetAllGroupUsers(Value);
end;
end;
end;
end.
psa1974, спасибо огромное, щаз буду процеживать инфу. О результатах обязательно отпишусь.
MaxYegorov
Как интересно... Спрашивал Maximus777, а поблагодарил MaxYegorov... Причем что-то общее в никах определенно есть
Ждем результатов - интересно будет узнать насчет того, порешана ли проблема кодировок в официальным DevSnapshot'е, ссылку на который дал data man Я бегло сравнил содержимое файлов патченного варианта и официального DevSnapshot'а - изменения коснулись доброй половины pas-файлов... Пошли ли они на пользу - это и хочется узнать.
Как интересно... Спрашивал Maximus777, а поблагодарил MaxYegorov... Причем что-то общее в никах определенно есть
Ждем результатов - интересно будет узнать насчет того, порешана ли проблема кодировок в официальным DevSnapshot'е, ссылку на который дал data man Я бегло сравнил содержимое файлов патченного варианта и официального DevSnapshot'а - изменения коснулись доброй половины pas-файлов... Пошли ли они на пользу - это и хочется узнать.
Добрый день!
Столкнулся с небольшой проблемой.
В стороннем приложении есть форма с label. Попытки считать текст этой надписи через API ни к чему не привели, т. к. handle она не имеет.
Как прочитать текст с label и изменить его?
Столкнулся с небольшой проблемой.
В стороннем приложении есть форма с label. Попытки считать текст этой надписи через API ни к чему не привели, т. к. handle она не имеет.
Как прочитать текст с label и изменить его?
Цитата:
Как интересно..., ага, есть такое. Вопрос задавал из дома, а коммент писал с работы. И сам уже не помню, то ли профиля, два, то ли ещё чего...
С индией засада. Снёс старую (вроде основательно), скомпилил и установил новую. Результат абсолютно идентичный, на выходе ловлю ответ типа
Где же там сабака зарыта? Раньше (вроде на 9-х индях) меня спасало Utf8ToAnsi(IdHTTP1.post ...), а сейчас при таком алгоритме просто вышеуказанные кракозяблы превращаюцца в ??????. Но хочется ведь увидеть наш великий и могучий.
Maximus777
Поставил патченую или официальную?
Дай ссылку, которую пытаешься загрузить, попробую у себя
Насчет Utf8ToAnsi - в Дельфи 2009 это не надо.
Берем урлу http://www.inf.ru/,
Делаем:
Код:
procedure TForm1.Button1Click(Sender: TObject);
var
LClient : TIdHTTP;
begin
LCLient := TIdHTTP.create(nil);
try
if Edit2.Text <> '' then
begin
LClient.ProxyParams.ProxyServer := copy(Edit2.Text, 1, pos(':', Edit2.Text)-1);
if pos(':', Edit2.Text) <> 0 then
LClient.ProxyParams.ProxyPort := StrToInt(copy(Edit2.Text, pos(':', Edit2.Text)+1, $FF))
else
LClient.ProxyParams.ProxyPort := 80;
end;
Memo1.Lines.Text := LClient.Get(Edit1.Text);
finally
LCLient.Free;
end;
end;
Поставил патченую или официальную?
Дай ссылку, которую пытаешься загрузить, попробую у себя
Насчет Utf8ToAnsi - в Дельфи 2009 это не надо.
Берем урлу http://www.inf.ru/,
Делаем:
Код:
procedure TForm1.Button1Click(Sender: TObject);
var
LClient : TIdHTTP;
begin
LCLient := TIdHTTP.create(nil);
try
if Edit2.Text <> '' then
begin
LClient.ProxyParams.ProxyServer := copy(Edit2.Text, 1, pos(':', Edit2.Text)-1);
if pos(':', Edit2.Text) <> 0 then
LClient.ProxyParams.ProxyPort := StrToInt(copy(Edit2.Text, pos(':', Edit2.Text)+1, $FF))
else
LClient.ProxyParams.ProxyPort := 80;
end;
Memo1.Lines.Text := LClient.Get(Edit1.Text);
finally
LCLient.Free;
end;
end;
DreamKHV
В VCL послав специальное сообщение окну, можно получить ссылку на его объект. Ну а там уже добраться до его чилда не проблема. Можно попробовать это сделать через RTTI, если работаем с нестандартным классом. НО:Нужно знать версию делфи, на которой написано приложение;
Нужно внедрится в процесс этого приложения (например через хуки);
Нужно добраться до его менеджера памяти, чтобы потом не хватать AV.Вот такие вот шаманства. Пример реализации: http://www.devrace.com/en/dap/features.php
В VCL послав специальное сообщение окну, можно получить ссылку на его объект. Ну а там уже добраться до его чилда не проблема. Можно попробовать это сделать через RTTI, если работаем с нестандартным классом. НО:Нужно знать версию делфи, на которой написано приложение;
Нужно внедрится в процесс этого приложения (например через хуки);
Нужно добраться до его менеджера памяти, чтобы потом не хватать AV.Вот такие вот шаманства. Пример реализации: http://www.devrace.com/en/dap/features.php
Frodo_Torbins
Спасибо.
Спасибо.
psa1974, я только вот такой код использую:
Код: procedure TForm1.Button1Click(Sender: TObject);
var
data: TIdMultiPartFormDataStream;
begin
data := TIdMultiPartFormDataStream.Create;
try
data.AddFile('fileData[]', Edit1.Text,'multipart/form-data');
data.AddFormField('action', 'upload');
data.AddFormField('galleries', '15');
data.AddFormField('preview','1');
data.AddFormField('preview_size','180');
Memo1.Lines.Text := IdHTTP1.Post('http://pics.kz', data);
finally
data.Free;
end;
end;
Код: procedure TForm1.Button1Click(Sender: TObject);
var
data: TIdMultiPartFormDataStream;
begin
data := TIdMultiPartFormDataStream.Create;
try
data.AddFile('fileData[]', Edit1.Text,'multipart/form-data');
data.AddFormField('action', 'upload');
data.AddFormField('galleries', '15');
data.AddFormField('preview','1');
data.AddFormField('preview_size','180');
Memo1.Lines.Text := IdHTTP1.Post('http://pics.kz', data);
finally
data.Free;
end;
end;
Maximus777
Поставь перед строкой
Memo1.Lines.Text := IdHTTP1.Post('http://pics.kz', data);
строку
IdHTTP1.Response.CharSet:= 'utf-8';
Это мне позволило с помощью метода IdHTTP1.Get в моем примере из предыдущего поста получить правильные букофки со страницы http://pics.kz
Поставь перед строкой
Memo1.Lines.Text := IdHTTP1.Post('http://pics.kz', data);
строку
IdHTTP1.Response.CharSet:= 'utf-8';
Это мне позволило с помощью метода IdHTTP1.Get в моем примере из предыдущего поста получить правильные букофки со страницы http://pics.kz
psa1974, земной поклон. Работает, чтоб его! Спасибо за помощь.
DymDym2
Это как-то относится к вопросам по Delphi ?
А "новости" этой уже 5 дней - подпишитесь на DelphiFeeds.
Это как-то относится к вопросам по Delphi ?
А "новости" этой уже 5 дней - подпишитесь на DelphiFeeds.
DymDym2
Ну и зачем было отвлекать на такую ерунду ? Что ценного из этой новости я должен был извлечь? (вопросы риторические).
Ну и зачем было отвлекать на такую ерунду ? Что ценного из этой новости я должен был извлечь? (вопросы риторические).
Вопрос по Indy - pop3
Забираю почту через свой самописный мини-клиент с ее дальнейшей обработкой. Но иногда случается необходимость забирать копию в Mozilla Thunderbird, но после забора или там или там повторно письма не забираются. Можно ли через pop3 присваивать письмам статус непрочитанный в Delphi (Indy)? Может в Imap!
Пожалуйста не посылайте читать документации pop, imap или каких-то там mime я не прогер и мне это как-то не идет
Спасибо за ответ
p.s. Почта от gmail
Забираю почту через свой самописный мини-клиент с ее дальнейшей обработкой. Но иногда случается необходимость забирать копию в Mozilla Thunderbird, но после забора или там или там повторно письма не забираются. Можно ли через pop3 присваивать письмам статус непрочитанный в Delphi (Indy)? Может в Imap!
Пожалуйста не посылайте читать документации pop, imap или каких-то там mime я не прогер и мне это как-то не идет
Спасибо за ответ
p.s. Почта от gmail
Страницы: 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
Предыдущая тема: Clipper 5
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.