Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Вопросы по Delphi (до версии 2009) - часть 5

Автор: Grande
Дата сообщения: 29.10.2009 11:29
И еще вопрос в тему: при приеме оконного сообщения создается ли отдельный поток для его обработки?
Автор: psa1974
Дата сообщения: 29.10.2009 11:57
Grande

Цитата:
при приеме оконного сообщения создается ли отдельный поток для его обработки?

Нет.
Все оконные сообщения обрабатываются оконной процедурой в той нити (потоком я называю потомков TStream ), которой эти окна созданы, и в порядке поступления. А поскольку VCL Дельфи принципиально однонитиевая библиотека, то, если скажем в обработчике нажатия кнопера делается что-то долго, то интерфейс "замораживается": прием сообщения и его обработка ведутся в основной и единственной (по-умолчанию) нити, и пока не будет обработано сообщение клика по кнопке, из очереди сообщений не будет извлекаться следующее сообщение, в том числе и сообщения отрисовки окон.
Но это не мешает в то время, пока выполняется длительная обработка какогото сообщения, организовывать локальные петли сообщений для их выборки и обработки. В дельфи для этого надо вызвать Application.ProcessMessages.
Надо только понимать, что все равно все делается последовательно и в одной нити.

Добавлено:
Grande
Рекомендую почитать книгу "О чем не пишут в книгах по Delphi" Григорьева... Там этот вопрос очень тщательно изложен. Вообще мегаинтересная книга. Отпадет масса вопросов.
Автор: Grande
Дата сообщения: 29.10.2009 12:12
psa1974
Спасибо, сейчас поищу на просторах инета
Автор: mdid
Дата сообщения: 29.10.2009 12:15
народ поздскажите плз такую беду...есть форма с менюхой из которой вызываются еще формы..так вот когда показываешь форму типа form5.show то она становится сзади основной...тоесть за ней...ни bringToFront новой формы ни sendtoback менюшной формы - эффекта не дают..только showmodal..но так нельзя в силу надобности программы..что это может быть?
Автор: psa1974
Дата сообщения: 29.10.2009 12:16
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 - тупо фотиком нащелканная книга... Лучше ПДФ...
Автор: data man
Дата сообщения: 29.10.2009 12:26
Grande
Обратите внимание на OmniThreadLibrary http://otl.17slon.com/ и http://code.google.com/p/omnithreadlibrary/
С ее помощью работа с потоками и их взаимодействием друг с другом делается очень просто.
А на днях автор обещал выпустить новую версию.
Ну еще и библиотека Gala http://gurin.tomsknet.ru/gala.html заслуживает внимания.
Автор: psa1974
Дата сообщения: 29.10.2009 12:28
mdid
попробовал воспроизвести твою беду... не получилось... Скинь примерчик, посмотрим...
Автор: Grande
Дата сообщения: 29.10.2009 12:31
data man
Да, эта штука у меня есть, весьма удобный инструмент.

psa1974
И еще раз спасибо - скачал в pdf.
Автор: mdid
Дата сообщения: 29.10.2009 12:35
psa1974
пример не скину ибо это толстый проект..фигня в том что все было норм а неделю назад началось..хз че это такое никогда не сталкивался за 7 лет с таким..немного деталей..делфя 2010 форма 1 используется как авторизация...форма 2 основаная рабочая форма
borderstyle - single
formstyle - normal
position - designed

у всех остальных форм то же самое..и все прячутся за форм2
передача фокуса тоже не помогла
просто думал может кто сталкивался
Автор: psa1974
Дата сообщения: 29.10.2009 13:39
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;
Автор: Grande
Дата сообщения: 29.10.2009 14:26
psa1974
Вот блин... Вы правы, сударь, действительно не работает в одном процессе, только в разных.
ОК, еще поэкспериментирую...

Так-с... Экпериментировать бессмысленно, т.к. ReplyMessage действительно работает только при посылке сообщения окну в другом процессе и, соответственно,
Цитата:
явно не решает задачу распараллеливания.
.
Автор: Maximus777
Дата сообщения: 29.10.2009 14:35
Люди добрые, научите уму разуму. Перешёл с Delphi 10 на RAD Studio 2009 и теперь idhttp из индей возвращает пургу вместо русских символов. Перерыл всю сеть, но так и не понял как лечить данное заболевание. На Delphi 10 вопрос решался очень просто, UTF8ToAnsi и всё замечательно. Сейчас же такой трюк не прокатывает. Сайт использует utf-8. Вот что выплёвывает запрос hxxp://pic.ipicture.ru/uploads/091029/8UGUQTQRV9.png
Автор: psa1974
Дата сообщения: 29.10.2009 16:11
Maximus777
насчет компаноидов Indy... В поставке Дельфи 2009 идут глючные Indy именно в плане кодировки.
В свое время с столкнулся с этим при отправке писем... Не помню где, скачал пофиксенную библиотеку Indy, с которой у меня проблем не было. Сейчас попробовал тестовый проект IdHttpDemoVCL.exe, загрузил страницу http://www.microsoft.com/rus/info/copyright/ (кодировка utf-8, русские символы в наличии) - все пучком. Если надо - выложу патченую Indy, скажи только куда...
Автор: data man
Дата сообщения: 29.10.2009 16:33
Maximus777

Цитата:
Не помню где, скачал пофиксенную библиотеку Indy, с которой у меня проблем не было.

А потом можно сравнить фикс с этим официальным DevSnapshot ftp://indy.fulgan.com/zip/IndyTiburon.zip
Может там уже, помимо прочих, пофиксены и баги с кодировкой.
Автор: psa1974
Дата сообщения: 29.10.2009 16:46
data man
Я уж не буду сравнивать, поскольку у меня все работает, и я не раз убеждался, что правило "работает - не трогай", в отношении Indy работает, как часы, что печально, на самом деле (хотя себе в кучу забрал официальный IndyTiburon на всякий...). Предоставим заняться сравнением Maximus777 - он все равно на распутье

Maximus777
нашел сцылку !
Вот ветка форума:
_http://www.sql.ru/forum/actualthread.aspx?bid=20&tid=669703
там если по ссылкам походить, рано или поздно найдешь такую:
Ссылка
Это то, о чем я говорил. Нужно полностью снести Indy, идущие в комплекте (в той ветке, что я дал написано как это сделать так чтобы ничего не осталось). Ну и вообще почитай эту ветку... как раз тема кодировок там обсуждается...
Автор: SerBUser
Дата сообщения: 30.10.2009 05:42
Вот нарыл код по получению информации о пользователях, рабочих станциях и группах в домене - может кому пригодится:
[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.

Автор: MaxYegorov
Дата сообщения: 30.10.2009 05:46
psa1974, спасибо огромное, щаз буду процеживать инфу. О результатах обязательно отпишусь.
Автор: psa1974
Дата сообщения: 30.10.2009 08:59
MaxYegorov
Как интересно... Спрашивал Maximus777, а поблагодарил MaxYegorov... Причем что-то общее в никах определенно есть
Ждем результатов - интересно будет узнать насчет того, порешана ли проблема кодировок в официальным DevSnapshot'е, ссылку на который дал data man Я бегло сравнил содержимое файлов патченного варианта и официального DevSnapshot'а - изменения коснулись доброй половины pas-файлов... Пошли ли они на пользу - это и хочется узнать.
Автор: DreamKHV
Дата сообщения: 30.10.2009 09:30
Добрый день!
Столкнулся с небольшой проблемой.
В стороннем приложении есть форма с label. Попытки считать текст этой надписи через API ни к чему не привели, т. к. handle она не имеет.
Как прочитать текст с label и изменить его?
Автор: Maximus777
Дата сообщения: 30.10.2009 09:30

Цитата:
Как интересно...
, ага, есть такое. Вопрос задавал из дома, а коммент писал с работы. И сам уже не помню, то ли профиля, два, то ли ещё чего...
С индией засада. Снёс старую (вроде основательно), скомпилил и установил новую. Результат абсолютно идентичный, на выходе ловлю ответ типа

Где же там сабака зарыта? Раньше (вроде на 9-х индях) меня спасало Utf8ToAnsi(IdHTTP1.post ...), а сейчас при таком алгоритме просто вышеуказанные кракозяблы превращаюцца в ??????. Но хочется ведь увидеть наш великий и могучий.
Автор: psa1974
Дата сообщения: 30.10.2009 10:44
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;
Автор: Frodo_Torbins
Дата сообщения: 30.10.2009 11:11
DreamKHV
В VCL послав специальное сообщение окну, можно получить ссылку на его объект. Ну а там уже добраться до его чилда не проблема. Можно попробовать это сделать через RTTI, если работаем с нестандартным классом. НО:Нужно знать версию делфи, на которой написано приложение;
Нужно внедрится в процесс этого приложения (например через хуки);
Нужно добраться до его менеджера памяти, чтобы потом не хватать AV.Вот такие вот шаманства. Пример реализации: http://www.devrace.com/en/dap/features.php
Автор: Maximus777
Дата сообщения: 30.10.2009 11:38
psa1974
pics.kz

Добавлено:

Цитата:
Поставил патченую или официальную?

Ставил ту, которую по Ссылке
Автор: DreamKHV
Дата сообщения: 30.10.2009 13:36
Frodo_Torbins
Спасибо.
Автор: Maximus777
Дата сообщения: 30.10.2009 13:54
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;
Автор: psa1974
Дата сообщения: 30.10.2009 15:45
Maximus777

Поставь перед строкой
Memo1.Lines.Text := IdHTTP1.Post('http://pics.kz', data);
строку
IdHTTP1.Response.CharSet:= 'utf-8';
Это мне позволило с помощью метода IdHTTP1.Get в моем примере из предыдущего поста получить правильные букофки со страницы http://pics.kz
Автор: Maximus777
Дата сообщения: 31.10.2009 15:13
psa1974, земной поклон. Работает, чтоб его! Спасибо за помощь.
Автор: data man
Дата сообщения: 31.10.2009 20:32
DymDym2
Это как-то относится к вопросам по Delphi ?
А "новости" этой уже 5 дней - подпишитесь на DelphiFeeds.
Автор: psa1974
Дата сообщения: 31.10.2009 22:45
DymDym2
Ну и зачем было отвлекать на такую ерунду ? Что ценного из этой новости я должен был извлечь? (вопросы риторические).
Автор: bruteALEX
Дата сообщения: 01.11.2009 16:08
Вопрос по Indy - pop3
Забираю почту через свой самописный мини-клиент с ее дальнейшей обработкой. Но иногда случается необходимость забирать копию в Mozilla Thunderbird, но после забора или там или там повторно письма не забираются. Можно ли через pop3 присваивать письмам статус непрочитанный в Delphi (Indy)? Может в Imap!
Пожалуйста не посылайте читать документации pop, imap или каких-то там mime я не прогер и мне это как-то не идет

Спасибо за ответ
p.s. Почта от gmail

Страницы: 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768

Предыдущая тема: Clipper 5


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.