Форум: "WinAPI";
Текущий архив: 2003.03.17;
Скачать: [xml.tar.bz2];

Вниз

Shell II   Найти похожие ветки 

← →
msts   (2003-01-21 09:57) [0]

Вот налобал дему под NT4 и выше
Попробуйте после запуска чего нибудь сломать
(с учетом что есть сервис контролирующий запуск прог со списком запрещенных)


program Project1;

uses
Windows,
Messages,
Classes,
SysUtils,
ShellAPI,
StdCtrls,
Dialogs,
Forms;

{$R *.res}

const
C_ClubDesktop = "ClubDesktop!";

type
TTest = class(TComponent)
procedure Close(Sender: TObject);
procedure Open(Sender: TObject);
end;

TSwitchDesktopThread = class(TThread)
private
FDesk : HDESK;
protected
procedure Execute; override;
public
constructor Create(ADesk : HDESK);
end;

var
Form : TForm;
Test : TTest;

function GetDesktopName(ADesk : HDESK) : string;
var
lpnLengthNeeded : Cardinal;
pvInfo : PChar;
begin
result := "";
pvInfo := nil;
GetUserObjectInformation(ADesk,UOI_NAME,pvInfo,0,lpnLengthNeeded); // здесь возвращается 2xN а ниже N (lpnLengthNeeded)
pvInfo := StrAlloc(lpnLengthNeeded); // почему? хз
try // наверное сначала думает вернуть для Unicode
if GetUserObjectInformation(ADesk,UOI_NAME,pvInfo,lpnLengthNeeded,lpnLengthNeeded) then begin
SetString(result,pvInfo,lpnLengthNeeded-1);
end;
finally
StrDispose(pvInfo);
end;
end;

function IsClubDesktop : boolean;
var
hObj : HDESK;
begin
hObj := GetThreadDesktop(GetCurrentThreadId);
result := GetDesktopName(hObj)=C_ClubDesktop;
end;

procedure CreateClubDesktop;
var
hObj : HDESK;
begin
hObj := CreateDesktop(C_ClubDesktop,nil,nil,DF_ALLOWOTHERACCOUNTHOOK,
DESKTOP_CREATEMENU or
DESKTOP_CREATEWINDOW or
DESKTOP_ENUMERATE or
DESKTOP_JOURNALPLAYBACK or
DESKTOP_JOURNALRECORD or
DESKTOP_HOOKCONTROL or
DESKTOP_READOBJECTS or
DESKTOP_SWITCHDESKTOP or
DESKTOP_WRITEOBJECTS,
nil);
if hObj=0 then raise Exception.Create(SysErrorMessage(GetLastError));
end;

procedure StartClubShell;
var
SI : STARTUPINFO;
PI : TPROCESSINFORMATION;
begin
FillMemory(@SI, sizeof(SI), 0);
FillMemory(@PI, sizeof(PI), 0);
SI.cb := sizeof(SI);
SI.lpDesktop := PChar("WinSta0\"+C_ClubDesktop);
if not CreateProcess(pchar(Application.ExeName), nil, nil, nil, false, NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE,
nil, nil, SI, PI) then begin
raise Exception.Create(SysErrorMessage(GetLastError));
end;
end;

function SwitchDesktopExt(ADesk : HDESK) : boolean;
begin
with TSwitchDesktopThread.Create(ADesk) do try
WaitFor;
Result := Boolean(ReturnValue);
finally
Free;
end;
end;


---

← →
msts   (2003-01-21 10:10) [1]


procedure ShowClubDesktop;
var
hObj : HDESK;
begin
hObj := OpenDesktop(C_ClubDesktop,DF_ALLOWOTHERACCOUNTHOOK,true,
DESKTOP_CREATEMENU or
DESKTOP_CREATEWINDOW or
DESKTOP_ENUMERATE or
DESKTOP_HOOKCONTROL or
DESKTOP_READOBJECTS or
DESKTOP_SWITCHDESKTOP or
DESKTOP_WRITEOBJECTS);
SwitchDesktopExt(hObj);
CloseDesktop(hObj);
end;

procedure ShowDefaultDesktop;
var
hObj : HDESK;
begin
hObj := OpenDesktop("Default",DF_ALLOWOTHERACCOUNTHOOK,true,
DESKTOP_CREATEMENU or
DESKTOP_CREATEWINDOW or
DESKTOP_ENUMERATE or
DESKTOP_HOOKCONTROL or
DESKTOP_READOBJECTS or
DESKTOP_SWITCHDESKTOP or
DESKTOP_WRITEOBJECTS);
SwitchDesktopExt(hObj);
CloseDesktop(hObj);
end;

{ TTest }

procedure TTest.Close(Sender: TObject);
begin
Form.Close;
end;

procedure TTest.Open(Sender: TObject);
begin
with TOpenDialog.Create(nil) do try
if Execute then ShellExecute(Form.Handle,"open",PChar(FileName),nil,nil,SW_SHOW);
finally
Free;
end;
end;

{ TSwitchDesktopThread }

constructor TSwitchDesktopThread.Create(ADesk: HDESK);
begin
inherited Create(false);
FDesk := ADesk;
end;

procedure TSwitchDesktopThread.Execute;
begin
ReturnValue := Integer(false);
if SetThreadDesktop(FDesk) then
if SwitchDesktop(FDesk) then ReturnValue := Integer(false);
end;

begin
Application.Initialize;
if IsClubDesktop then begin
Application.CreateForm(TForm, Form);
Test := TTest.Create(Form);
with TButton.Create(Form) do begin
Parent:=Form;
Visible:=true;
Caption := "Close";
SetBounds(10,10,100,20);
OnClick := Test.Close;
end;
with TButton.Create(Form) do begin
Parent:=Form;
Visible:=true;
Caption := "Open";
SetBounds(10,40,100,20);
OnClick := Test.Open;
end;
Application.Run;
Test.Free;
ShowDefaultDesktop;
end else begin
CreateClubDesktop;
StartClubShell;
ShowClubDesktop;
end;
end.


---

← →
ers   (2003-01-21 11:47) [2]

Да, вот ещё проблема! Ведьтем же Explorer`om можно зайти спокойно и на диск Ц, Д, и т.д.
Нужно мне кажется ловить в броузере адрес, и проверять его на валидность!
Вопрос: Как это сделать?
Вопрос2: Как сделать список задачь в своей проге Button`нами желательно с картинками!
Вопрос3: Какое лучше сообщение посылать при выгрузке Explorer`a? WM_QUIT - Он спокойно выходит, но потом при запуске его он считает что комп только что включили (Тоесть грузит что в автозагрузке напиххано)..... А если WM_DESTROY то он пытается возрадится......................

---

← →
SeF   (2003-01-21 12:06) [3]

> ers (21.01.03 11:47)
> Да, вот ещё проблема! Ведьтем же Explorer`om можно зайти
> спокойно и на диск Ц, Д, и т.д.

против смотрения на C/D/etc. есть политика безопасности которая настраивается в домене. после этого при попытке набрать С: появляется сообщение о недостатке прав. вот.

---

← →
ers   (2003-01-21 12:34) [4]

Я имел ввиду Internet Explorer, Netscape, Opera и etc.

---

← →
DVM   (2003-01-23 21:21) [5]

Тут как то это в форуме пробегало - один чел процедуру написал

---

← →
SeF   (2003-01-23 21:27) [6]

> ers (21.01.03 12:34)
> Я имел ввиду Internet Explorer, Netscape, Opera и etc.

Имел ввиду или пробовал?

---

← →
DVM   (2003-01-24 17:04) [7]

>msts
Здорово. Даже три пальца не работают. Давай объединять усилия, если согласен пиши на мыло.

>ers Причем тут Опера, с ее помощью доступ на диск не получишь.

Я вот тут http://dm.rsl.ru/files/MyShell.rar
панель задач сбацал. Ну точнее её прообраз.
Задачи она правда не переключает (пока), но это и не сложно добавить.
Вот что она уже умеет делать.
1. Ловит момент запуска новой задачи и рисует кнопки.
2. Кнопки содержат иконку и текст заголовка окна задачи.
3. Если текст или иконка окна меняется со временем, то они меняются и на кнопках.
4. Ловит момент закрытия окна задачи и убирает кнопку.
5. Если задач станновится много кнопки уменьшаются в размерах.
6. Если задач очень много кнопки располагаются в 2 и более рядов, а справа появляется прокрутка.
7. Кнопки сами нажимаются - отжимаются если окно активируется - деактивируется.
8. Следит за изменением языка.
9. Окна разворачиваются только до нее, а не до того места, где была раньше виндовая панель задач.

Конечно это только набросок, сделанный немного кривовато. Но работает.

Правильнее было бы сделать так (над чем я сейчас и работаю):
1. Создать компонент TTaskButton (потомок от TSpeedButton), который будет иметь свойство Task:hWnd и руководствуясь этим свойством сам будет следить за задачей.
2. Создать компонент TTaskPanel (потомок от TPanel), который сам будет следить за задачами и создавать/удалять кнопки а также заниматься собственной прокруткой.
3. Создать окно класса TAppBar, перетаскиваемое по экрану и ведущее себя как настоящая панель задач.

P.S. Не забудьте explorer закрыть перед запуском.

---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2003.03.17;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.009 c