/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 1109
от 02.04.2008, 11:05

Вопрос № 129.271

Привет Ексрерти. Как мне узнать под каким пользователем запущен какойто процес в системе(System, User1,User2.). Спасибо.

Отправлен: 27.03.2008, 10:50 Вопрос задал: Мельник Виктор (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Gladiator Здравствуйте, Мельник Виктор ! Вот как я реализовывал ту же задачу. Приложение: Выдержка кода основной программы <code> uses ..., tlHelp32; .... var Hnd, hProcess: THandle; Needed: DWORD; hMod: HMODULE; ModuleName: array [0..300] of Char; PIDs: array [0..3024] of DWORD; ProcStruct : PROCESSENTRY32; LocalUserName: string; LocalDomainName: string; begin if <b>IsWinNT4</b> then begin Result := EnumProcesses(@PIDs, SizeOf(PIDs), Needed); for I := 0 to (Needed div SizeOf(DWORD)) - 1 do begin hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PIDs[I]); if (hProcess <> 0) then begin EnumProcessModules(hProcess, @hMod, SizeOf(hMod), Needed); GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName)); if LowerCase(ExtractFileName(String(ModuleName))) = 'explorer.exe' then <b>GetUserAndDomainFromPID(PIDs[I], LocalUserName, LocalDomainName);</b> CloseHandle(hProcess); end; end; end; if <b>IsWinXP or IsWin2K</b> then begin Hnd := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 ); if Hnd = INVALID_HANDLE_VALUE then Exit; ProcStruct.dwSize := SizeOf( PROCESSENTRY32 ); if Process32First( Hnd, ProcStruct ) then begin repeat hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcStruct.th32ProcessID); if (hProcess <> 0) then begin if LowerCase(StrPas(ProcStruct.szExeFile)) = 'explorer.exe' then GetUserAndDomainFromPID(ProcStruct.th32ProcessID, LocalUserName, LocalDomainName); CloseHandle(hProcess); end; until not Process32Next( Hnd, ProcStruct ); CloseHandle( Hnd ); end; end; end; </code> А здесь дополнительный модуль с описанием функции GetUserAndDomainFromPID: <code> unit UserFunc; interface uses TlHelp32, Windows, SysUtils; type PSID_IDENTIFIER_AUTHORITY = ^SID_IDENTIFIER_AUTHORITY; {$EXTERNALSYM PSID_IDENTIFIER_AUTHORITY} _SID_IDENTIFIER_AUTHORITY = record Value: array [0..5] of Byte; end; {$EXTERNALSYM _SID_IDENTIFIER_AUTHORITY} SID_IDENTIFIER_AUTHORITY = _SID_IDENTIFIER_AUTHORITY; {$EXTERNALSYM SID_IDENTIFIER_AUTHORITY} TSidIdentifierAuthority = SID_IDENTIFIER_AUTHORITY; PSidIdentifierAuthority = PSID_IDENTIFIER_AUTHORITY; PSid = ^SID; _SID = record Revision: Byte; SubAuthorityCount: Byte; IdentifierAuthority: SID_IDENTIFIER_AUTHORITY; SubAuthority: array [0..0] of DWORD; end; {$EXTERNALSYM _SID} SID = _SID; {$EXTERNALSYM SID} PPSID = ^PSID; {$NODEFINE PPSID} TSid = SID; PSID_AND_ATTRIBUTES = ^SID_AND_ATTRIBUTES; {$EXTERNALSYM PSID_AND_ATTRIBUTES} _SID_AND_ATTRIBUTES = record Sid: PSID; Attributes: DWORD; end; {$EXTERNALSYM _SID_AND_ATTRIBUTES} SID_AND_ATTRIBUTES = _SID_AND_ATTRIBUTES; {$EXTERNALSYM SID_AND_ATTRIBUTES} TSidAndAttributes = SID_AND_ATTRIBUTES; PSidAndAttributes = PSID_AND_ATTRIBUTES; PTOKEN_USER = ^TOKEN_USER; {$EXTERNALSYM PTOKEN_USER} _TOKEN_USER = record User: SID_AND_ATTRIBUTES; end; {$EXTERNALSYM _TOKEN_USER} TOKEN_USER = _TOKEN_USER; {$EXTERNALSYM TOKEN_USER} TTokenUser = TOKEN_USER; PTokenUser = PTOKEN_USER; function GetUserAndDomainFromPID(ProcessId: DWORD; var User, Domain: string): Boolean; implementation function GetUserAndDomainFromPID(ProcessId: DWORD; var User, Domain: string): Boolean; var hToken: THandle; cbBuf: Cardinal; ptiUser: PTOKEN_USER; snu: SID_NAME_USE; ProcessHandle: THandle; UserSize, DomainSize: DWORD; bSuccess: Boolean; begin Result := False; ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId); if ProcessHandle <> 0 then begin // EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True); if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then begin bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf); ptiUser := nil; while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do begin ReallocMem(ptiUser, cbBuf); bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf); end; CloseHandle(hToken); if not bSuccess then begin Exit; end; UserSize := 0; DomainSize := 0; LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu); if (UserSize <> 0) and (DomainSize <> 0) then begin SetLength(User, UserSize); SetLength(Domain, DomainSize); if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize, PChar(Domain), DomainSize, snu) then begin Result := True; User := StrPas(PChar(User)); Domain := StrPas(PChar(Domain)); end; end; if bSuccess then begin FreeMem(ptiUser); end; end; CloseHandle(ProcessHandle); end; end; end. </code>

Ответ отправил: Gladiator (статус: Студент) Ответ отправлен: 31.03.2008, 08:35

Вопрос № 129.364

Здравствуйте,эксперты!! Помогите пожалуйста! Не найти в интернете, как в Делфи нарисовать обычную цветную точку??

Отправлен: 27.03.2008, 21:27 Вопрос задала: Диана Мал (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Диана Мал! Для рисования используется объект Canvas. Для рисования одной точки надо вызвать метод Canvas.Pixels[X,Y] := Цвет; где X,Y - координаты (относительно левого верхнего угла), Цвет - цвет точки заданный в формате clBlack (название цвета) или $00000000; Рисуют обычно на TImage (вкладка Additional). апример, чтобы покрасить точку с координатой (10,10) в красный цвет надо написать следующий код: Image1.Canvas.Pixels[10,10] := clRed; Также свойство canvas есть у многих других объектов. Удачи!

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 27.03.2008, 21:38

Отвечает: Marked One Здравствуйте, Диана Мал! Положите на форму кнопку. Вот обработчик нажатия этой кнопки: form1.Canvas.Pixels[1,1]:=clRed; Мы изменяем цвет точки с координатами 1 и 1 на красный. Для того чтобы при изменении размера формы и при других манипуляциях с формой цвет точки не восстанавливался напишем в обработчике события OnPaint формы вызов обработчика кнопки: Button1Click(nil); Если будут вопросы, то обращайтес в минифорум. Удачи!!! Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); procedure FormPaint(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin form1.Canvas.Pixels[1,1]:=clRed; end; procedure TForm1.FormPaint(Sender: TObject); begin Button1Click(nil); end; end.

Ответ отправил: Marked One (статус: 10-ый класс) Ответ отправлен: 27.03.2008, 21:48

Отвечает: Кудинов Антон Павлович Здравствуйте, Диана Мал! bitmap.canvas.pixels[x,y]:=color; // :tcolor function rgb(r,g,b):tcolor; свойство pixels подходит для любого вхождения canvas (есть у всех controls, forms, bitmaps, images, paintboxes);

Ответ отправил: Кудинов Антон Павлович (статус: 3-ий класс) Ответ отправлен: 27.03.2008, 23:12

Отвечает: Genia007 Здравствуйте, Диана Мал! Обычная точка рисуется очень просто: Form1.Canvas.Pixels[150,150]:= clRed; на форме рисуется один пиксел с координатами 150, 150 красным цветом, или так: Form1.Canvas.Pen.Color:= clRed; Form1.Canvas.Brush.Color:= clRed; Form1.Canvas.Ellipse(15,15,10,10); на форме рисуется красный кружок с координатами 10, 10 и размером 15 на 15.

Ответ отправил: Genia007 (статус: 9-ый класс) Ответ отправлен: 28.03.2008, 19:57

Вопрос № 129.366

Здравствуйте уважаемые программисты. Есть несколько вопросов: 1. У меня есть 2 проекта написаных на делфи, мне нужно в 1 проекте поместить кпопку, чтобы при нажитии запускался 2 проект,, но не как отдельная программа, я её нужно как бы вставить в 1 проект, и запуск происходил по типу form2.show(); 2. у меня в проекте есть видео файлы, и можно сделать так чтобы эти клипы были как бы сохранены в файле запуска программы exe, т.е чтобы я скидывал например эту программу (1 файл екзешны) а эти видео файлы уже были в нем,, ))) как смог так и обьяснил )) 3. При проигрывании видеофайлов, как мне програмно задать громкость чтобы при запуске, сразу была такая которую я пропишу...

Отправлен: 27.03.2008, 21:37 Вопрос задал: Makavely (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Makavely! 1. Используйте меню Project -> Add to Project. Через него можно выбрать нужную дополнительную форму. Но только все необходимые для нее модули также нужно будет подключить к проекту. 2. Вам нужно смотреть в сторону ресурсов. Пример привести не могу, но дам ссылки на статьи - в них все хорошо описано и проблем возникнуть не должно. Delphi: Работа с ресурсами (копия этой статьи находится в приложении) Ресурсы в delphi Работа с ресурсами в Delphi. Александр Василевский. Удачи! Приложение: Delphi: Работа с ресурсами Категория Работа с ресурсами, Delphi | Версия для печати Версия для печати Windows поддерживает такие виды ресурсов: * RT_ACCELERATOR Accelerator table * RT_ANICURSOR Animated cursor * RT_ANIICON Animated icon * RT_BITMAP Bitmap resource * RT_CURSOR Hardware-dependent cursor resource * RT_DIALOG Dialog box * RT_FONT Font resource * RT_FONTDIR Font directory resource * RT_GROUP_CURSOR Hardware-independent cursor resource * RT_GROUP_ICON Hardware-independent icon resource * RT_ICON Hardware-dependent icon resource * RT_MENU Menu resource * RT_MESSAGETABLE Message-table entry * RT_RCDATA Application-defined resource (raw data) * RT_STRING String-table entry * RT_VERSION Version resource Самый простой из них это RT_STRING - то есть строковый. Для работы с ним предусмотрено специальное зарезервированное слово - resourcestring. Пример использования строковых ресурсов смотрите ниже. unit StrConst; interface resourcestring SCreateError = 'Cannot create file'; SOpenError = 'Cannot open file'; SLineTooLong = 'Line too long'; implementation end. Объявленные строковые ресурсы можно использовать как стандартные константы. Например: unit Main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses StrConst; {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var S: array [0..255] of Char; begin LoadString(HInstance, SLineTooLong, S, SizeOf(S)); ShowMessage(S); end; Второй способ сделать то же самое немного сложнее, но он показывает принцип работы с ресурсами вообще. Для этого нам нужно создать включаемый файл myres.inc и в теле прописать константы, по которым мы будем обращаться к строковым ресурсам. const SCreateError = 1; SOpenError = 2; SLineTooLong = 3; Еще нам нужно создать ресурсный текстовый файл myres.rc. #include "myres.inc"; STRINGTABLE { SCreateError, "Cannot create file" SOpenError, "Cannot open file" SLineTooLong, "Line too long" } Обратите внимание, что теперь текст нужно брать в двойные кавычки. Теперь нам необходимо откомпилировать наш файл ресурсов. Создаем для удобства простой пакетный файл myres.bat, в который записываем такую строку brcc32.exe myres.rc Запускаем его на выполнение. Он должен создать скомпилированный файл ресурса myres.res. Если этого не произошло, то вам необходимо указать полный путь к файлу brcc32.exe. Это, как правило, C:Program FilesBorlandDelphiXBinrcc32.exe, где вместо X - номер вашей версии Delphi. Теперь подключаем myres.inc и myres.res в наш Main.pas. unit Main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} {$R MYRES.RES} {$I MYRES.INC} procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage(SLineTooLong); end; end. Теперь попробуем подключить к приложению свой курсор. Для этого необходимо: 1. Сначала в Image Editor'е или другом редакторе ресурсов создать свой курсор. Сохранить его под именем, например, Cursor.cur 2. Создаем файл MyCursor.rc, в теле которого записываем строку 3. MyCursor CURSOR "cursor.cur" 4. 3. Компилируем наш файл ресурса, набрав в командной строке 5. brcc32 MyCursor.rc и получаем на выходе скомпилированный файл ресурса MyCursor.res. 4. В *.pas-файле добавляем ссылку на наш файл ресурса. {$R MyCursor.res} 5. Объявляем константу, по которой будем обращаться к нашему курсору. const crMyCursor = 1; Замечание. Для своих курсоров можно использовать только положительные значения. 6. Добавляем в список курсоров новый... Screen.Cursors[crMyCursor] := LoadCursor(HInstance, 'MyCursor'); 7. Подключаем, вместо курсора по умолчанию, свой курсор. Cursor := crMyCursor; 8. Запускаем приложение. unit Main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; const crMyCursor = 1; implementation {$R MyCursor.res} {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin Screen.Cursors[crMyCursor] := LoadCursor(HInstance, 'MyCursor'); Cursor := crMyCursor; end; end. Подключение иконок и bitmap-ресурсов аналогично подключению курсоров. Мы попробуем подключить стандартные иконки и bitmap'ы. Это делается так. Image1.Picture.Icon.Handle := LoadIcon(0, PChar(IDI_APPLICATION)); Image2.Picture.Bitmap.Handle := LoadBitmap(0, PChar(OBM_ZOOM)); Для более подробной информации смотрите соответствующие функции WinApi. Теперь мы перешли к работе с определенными пользователем ресурсами. Мы попробуем подключить текстовый и *.avi-файл. 1. Берем из примеров Delphi файл cool.avi, который находится в каталоге C:Program FilesBorlandDelphiXDemosCoolstuf 2. Создаем любой текстовый файл с именем app.txt и помещаем эти файлы к каталог нашего проекта. 3. Создаем текстовый файл ресурса MyRes.rc с телом MyText Text APP.TXT CoolAvi AVI cool.avi 4. Компилируем его... brcc32 myres.rc 5. Делаем изменения в *.pas-файле. 6. Запускаем. unit Main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls; type TForm1 = class(TForm) Animate1: TAnimate; Memo1: TMemo; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } procedure TextResource; procedure AVIResource; end; var Form1: TForm1; implementation {$R *.DFM} {$R MyRes.res} procedure TForm1.AVIResource; begin Animate1.ResName := 'CoolAvi'; Animate1.Active := True; end; procedure TForm1.FormCreate(Sender: TObject); begin TextResource; AVIResource; end; procedure TForm1.TextResource; var Resource: THandle; begin Resource := LoadResource(hInstance, FindResource(hInstance, 'MyText', 'TEXT')); Memo1.Lines.Text := PChar(LockResource(Resource)); UnLockResource(Resource); FreeResource(Resource); end; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 27.03.2008, 21:57 Оценка за ответ: 5 Комментарий оценки: спасибо !!!

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 4.72.6 beta от 22.03.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru