Add(MainForm,2953706,84,84)
{
Width=638
Height=504
Position=1
}
Add(InlineCode,16564328,511,287)
{
@Hint=#52:Некоторая работа с открытыми окнами Windows Explorer|37:Автор: 3042. Версия 1.0 от 2.10.2020.|
WorkPoints=#84:doEnum=Перечисляет открытые папки Windows Explorer, выдавая сведения на нижние точки|99:doGetDataByHandle=Получает сведения об открытой папке по идентификатору, выдавая их на нижние точки|89:doNavigate=Открывает в папке с идентификатором dtHandle адрес dtAddress (типа C:\Windows)|
EventPoints=#106:onEnum=Происходит всякий раз при нахождении очередного открытого окна Windows Explorer, выдавая его handle|
VarPoints=#36:varLocationURL=Путь к открытой папке|38:varHandle=Идентификатор открытой папки|
DataPoints=#22:dtHandle=Идентификатор|15:dtAddress=Адрес|
Code=#54://Некоторая работа с открытыми окнами Windows Explorer|39://Автор: 3042. Версия 1.0 от 2.10.2020.|15:unit HiAsmUnit;|0:|9:interface|0:|48:uses kol,Share,Debug,KOLSHDocVw,ActiveX,windows;|0:|74:const CLASS_ShellWindows:TGUID = '{9BA05972-F6A8-11CF-A442-00A0C90A8F39}';|73: IID_IShellWindows:TGUID = '{85CB6900-4D95-11CF-960C-0080C7F4EE85}';|0:|4:type|37: IShellWindows = interface(IDispatch)|46: ['{85CB6900-4D95-11CF-960C-0080C7F4EE85}']|43: function Get_Count: Integer; safecall;|60: function Item(index: OleVariant ): IDispatch; safecall;|43: function _NewEnum: IUnknown; safecall;|110: procedure Register(const pid: IDispatch; HWND: Integer; swClass: SYSINT; out plCookie: Integer); safecall;|74: procedure RegisterPending(lThreadId: Integer; var pvarloc: OleVariant;|109: var pvarlocRoot: OleVariant; swClass: SYSINT; out plCookie: Integer); safecall;|49: procedure Revoke(lCookie: Integer); safecall;|78: procedure OnNavigate(lCookie: Integer; var pvarloc: OleVariant); safecall;|73: procedure OnActivated(lCookie: Integer; fActive: WordBool); safecall;|95: function FindWindow(var pvarloc: OleVariant; var pvarlocRoot: OleVariant; swClass: SYSINT;|87: out pHWND: Integer; swfwOptions: SYSINT): IDispatch; safecall;|74: procedure OnCreated(lCookie: Integer; const punk: IUnknown); safecall;|63: procedure ProcessAttachDetach(fAttach: WordBool); safecall;|43: property Count: Integer read Get_Count;|6: end;|28: THiAsmClass = class(TDebug)|10: private|27: FStrLocationURL:string;|21: FIntHWND:integer;|31: ShellWindows:IShellWindows;|25: CurrWin:IWebBrowser2;|26: EmptyParam:OleVariant;|9: public|23: dtHandle:THI_Event;|24: dtAddress:THI_Event;|21: onEnum:THI_Event;|0:|23: constructor Create;|47: procedure doEnum(var dt:TData; index:word);|58: procedure doGetDataByHandle(var dt:TData; index:word);|51: procedure doNavigate(var dt:TData; index:word);|55: procedure varLocationURL(var dt:TData; index:word);|50: procedure varHandle(var dt:TData; index:word);|5: end;|0:|14:implementation|0:|31:constructor THiAsmClass.Create;|5:begin|18: inherited Create;|34: FStrLocationURL:=''; FIntHWND:=0;|4:end;|0:|71://----------------------------Внешние точки----------------------------|29:procedure THiAsmClass.doEnum;|14:var i:integer;|5:begin|35: FStrLocationURL:=''; FIntHWND:=0;|97: CoCreateInstance(CLASS_ShellWindows, nil, 1+2+4 {CLSCTX_ALL}, IID_IShellWindows, ShellWindows);|43: for i:=0 to ShellWindows.Count-1 do begin|51: CurrWin := ShellWindows.Item(i) as IWebBrowser2;|96: if LowerCase(Copy(CurrWin.FullName,Length(CurrWin.FullName)-11,12))='explorer.exe' then begin|43: FStrLocationURL := CurrWin.LocationURL;|29: FIntHWND := CurrWin.HWND;|37: _hi_OnEvent(onEnum,CurrWin.HWND);|7: end;|6: end;|32: //_debug(CurrWin.LocationURL);|19: //CurrWin.GoBack;|28: //CurrWin.Visible := true;|4:end;|0:|33:procedure THiAsmClass.doNavigate;|16:var i,h:integer;|13: s:string;|5:begin|35: FStrLocationURL:=''; FIntHWND:=0;|32: h := ReadInteger(dt,dtHandle);|32: s := ReadString(dt,dtAddress);|38: if not DirectoryExists(s) then exit;|97: CoCreateInstance(CLASS_ShellWindows, nil, 1+2+4 {CLSCTX_ALL}, IID_IShellWindows, ShellWindows);|43: for i:=0 to ShellWindows.Count-1 do begin|51: CurrWin := ShellWindows.Item(i) as IWebBrowser2;|121: if (LowerCase(Copy(CurrWin.FullName,Length(CurrWin.FullName)-11,12))='explorer.exe') and (CurrWin.HWND = h) then begin|68: CurrWin.Navigate(s,EmptyParam,EmptyParam,EmptyParam,EmptyParam);|10: break;|7: end;|6: end;|4:end;|0:|40:procedure THiAsmClass.doGetDataByHandle;|16:var i,h:integer;|5:begin|35: FStrLocationURL:=''; FIntHWND:=0;|32: h := ReadInteger(dt,dtHandle);|97: CoCreateInstance(CLASS_ShellWindows, nil, 1+2+4 {CLSCTX_ALL}, IID_IShellWindows, ShellWindows);|43: for i:=0 to ShellWindows.Count-1 do begin|51: CurrWin := ShellWindows.Item(i) as IWebBrowser2;|121: if (LowerCase(Copy(CurrWin.FullName,Length(CurrWin.FullName)-11,12))='explorer.exe') and (CurrWin.HWND = h) then begin|43: FStrLocationURL := CurrWin.LocationURL;|29: FIntHWND := CurrWin.HWND;|6: //|10: break;|7: end;|6: end;|4:end;|0:|0:|37:procedure THiAsmClass.varLocationURL;|5:begin|31: dtString(dt, FStrLocationURL);|4:end;|0:|32:procedure THiAsmClass.varHandle;|5:begin|25: dtInteger(dt, FIntHWND);|4:end;|0:|4:end.|
link(onEnum,15883568:doWork2,[])
link(dtAddress,9342762:Text,[])
}
Add(Button,15639755,392,280)
{
Left=10
Top=205
Width=175
Caption="Перечислить открытые папки"
link(onClick,3644856:doEvent1,[])
AddHint(-74,-29,167,13,Caption)
}
Add(FormatStr,9927412,581,287)
{
DataCount=4
Mask="%3 ‹%4›"
link(onFString,5931435:doAdd,[])
link(Str3,16564328:varLocationURL,[(601,275)(559,275)(559,331)(517,331)])
link(Str4,16564328:varHandle,[(608,275)(566,275)(566,331)(524,331)])
}
Add(ListBox,5931435,679,287)
{
Top=242
Width=630
Height=235
Align=4
Hint="Дважды щёлкните на папке для открытия в ней адреса"
DataType=1
Point(onDblClick)
Point(String)
link(onDblClick,16404937:doSearch,[])
}
Add(Hub,3644856,441,280)
{
link(onEvent1,7542783:In,[])
link(onEvent2,16564328:doEnum,[])
}
Add(LineBreak,15101070,630,294)
{
link(Out,6238006:doWork2,[])
Primary=[7542783,-161,-14]
}
Add(Edit,9342762,518,238)
{
Left=205
Top=205
Width=180
Text="C:\Windows\system32"
}
Add(BlockFind,16404937,735,301)
{
IncludeBlock=1
StartBlock="‹"
EndBlock="›"
link(onSearch,16564328:doNavigate,[(779,307)(779,348)(498,348)(498,307)])
link(Text,5931435:String,[(741,289)(723,289)(723,344)(706,344)])
}
Add(Edit,9628975,392,336)
{
Left=390
Top=205
Width=180
Text="Получить сведения по handle"
link(onEnter,15779796:doEvent1,[])
}
Add(Hub,15779796,441,343)
{
OutCount=3
link(onEvent1,16564328:doGetDataByHandle,[(483,349)(483,300)])
link(onEvent2,14665906:In,[])
link(onEvent3,15883568:doWork3,[(557,363)])
}
Add(HubEx,15883568,553,287)
{
link(onEvent,9927412:doString,[])
}
Add(LineBreak,13972734,630,301)
{
link(Out,6238006:doWork3,[(669,307)])
Primary=[14665906,-161,49]
}
Add(HubEx,6238006,665,294)
{
link(onEvent,5931435:doClear,[])
}
У меня вопрос к более опытным коллегам: можно ли каждый раз вызывать CoCreateInstance, надо ли уничтожать ShellWindows, не будет ли утечки?
И просьба: проверить на разных компьютерах.
У меня Win10 1909 - всё работает.
Редактировалось 2 раз(а), последний 2020-10-05 13:07:39
Поиск
Друзья
Администрация