Add to AutoRun

← →
Goorus © (2004-08-27 13:09) [0]

Необходимо добавить ярлык в атозагрзку. В самой программе это получилось, но по завершении выдавалась ошибка. Думал это связано с неосвобождением объектов, но у интерфейсов нет метода Free, а _Release не помогал.
Попробывал написать простую демку(форма с кнопкой), работать стало ещё хуже :) Демка даже не добавляет себя в автозагрузку, хотя код не изменялся. Причина: в переменную Folder передаётся неверный путь ("С:\Docum^ "). Вот код:
procedure TForm1.Button1Click(Sender: TObject); var List:PItemIdList; SLink:IShellLink; Folder:PChar; begin // создаём ярлык в автозагрузке // находим папку SHGetSpecialFolderLocation(0, CSIDL_STARTUP, List); New(Folder); SHGetPathFromIDList(List, Folder); ShowMessage(Folder); // <- неверный путь // прописываемся SLink:=IShellLink(CreateComObject(CLSID_ShellLink)); SLink.SetArguments("/a"); SLink.SetDescription("My Prog"); SLink.SetPath( PChar(ParamStr(0)) ); (SLink as IPersistFile).Save(PWChar(WideString(Folder+"\prog.lnk")), False); end;

← →
Skier © (2004-08-27 13:25) [1]

не поможет ?
http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=988622611&n=15

← →
DiamondShark © (2004-08-27 13:25) [2]

> New(Folder);

Вот мне интересно, от этой строчки что ожидалось?

procedure TForm1.Button1Click(Sender: TObject);
var
List:PItemIdList;
SLink:IShellLink;
Folder:array[0..MAX_PATH] of char;

← →
DiamondShark © (2004-08-27 13:29) [3]

Кстати, пидл не плохо было бы потом освобождать...

← →
WondeRu © (2004-08-27 13:40) [4]

в конце процедуры пиши!
SLink := nil

а нафига ярлык в автозагрузку? поверь мне, легче в реестре прописать!

← →
DiamondShark © (2004-08-27 13:45) [5]

> WondeRu © (27.08.04 13:40) [4]
> в конце процедуры пиши!
> SLink := nil

Думаешь, поможет?

← →
VMcL © (2004-08-27 13:46) [6]

>>Goorus © (27.08.04 13:09)

>SLink:=IShellLink(CreateComObject(CLSID_ShellLink));

По-хорошему нужно писать так:
SLink := CreateComObject(CLSID_ShellLink) as IShellLink;

>>WondeRu © (27.08.04 13:40) [4]

>в конце процедуры пиши! SLink := nil

Чушь.

← →
WondeRu © (2004-08-27 13:51) [7]

DiamondShark © (27.08.04 13:45) [5]
Думаешь, поможет?

поможет - не поможет - без понятия, но это обязательно! Освобождается интерфейс!

New(Folder); - объясните мне эту строчку!

← →
DiamondShark © (2004-08-27 13:57) [8]

> WondeRu © (27.08.04 13:51) [7]
> DiamondShark © (27.08.04 13:45) [5]
> Думаешь, поможет?
>
> поможет - не поможет - без понятия, но это обязательно!
> Освобождается интерфейс!

В хелп. Читать до просветления.

> New(Folder); - объясните мне эту строчку!

Это ко мне вопрос?

← →
WondeRu © (2004-08-27 14:13) [9]

VMcL © (27.08.04 13:46) [6]
Чушь.
DiamondShark © (27.08.04 13:57) [8]
В хелп. Читать до просветления.

пожалуйста, указывайте людям на ошибки в более мягкой форме (и желательно исправляйте)!

данный вариант работает нормально
procedure TForm1.Button1Click(Sender: TObject); var List:PItemIdList; SLink:IShellLink; Folder:array[0..1000] of Char; begin SHGetSpecialFolderLocation(0, CSIDL_STARTUP, List); SHGetPathFromIDList(List, Folder); ShowMessage(Folder); SLink:=IShellLink(CreateComObject(CLSID_ShellLink)); SLink.SetArguments("/a"); SLink.SetDescription("My Prog"); SLink.SetPath( PChar(ParamStr(0)) ); (SLink as IPersistFile).Save(PWChar(WideString(Folder+"\prog.lnk")), False); SLink := nil; end;

← →
DiamondShark © (2004-08-27 14:29) [10]

> WondeRu © (27.08.04 14:13) [9]

Если убрать в конце SLink := nil; работать будет точно так же.

Компилятор сам следит за освобождением интерфейсов, точно так же как он это делает для строк, динмассивов и вариантов.
При выходе за область видимости интерфейс всегда будет освобождён.

И не надо так возмущаться.
В вопросе проблема была из-за неправильного обращения с PChar-ом. Ты же влез с советом, который совершенно не в тему, при этом ещё и не понимая смысла своего же предложения.

← →
VMcL © (2004-08-27 14:34) [11]

>>WondeRu © (27.08.04 14:13) [9]

пожалуйста, указывайте людям на ошибки в более мягкой форме (и желательно исправляйте)!

Нет проблем. Только для этого нужно советы (а особенно неправильные) тоже давать в более мягкой форме.

← →
WondeRu © (2004-08-27 14:46) [12]

DiamondShark © (27.08.04 14:29) [10]
Компилятор сам следит за освобождением интерфейсов
и чего люди мучаются?
из модуля DSUtil.pas (входит в DSPack): ...................... function AddGraphToRot(Graph: IFilterGraph; out ID: integer): HRESULT; var Moniker: IMoniker; ROT : IRunningObjectTable; wsz : WideString; begin result := GetRunningObjectTable(0, ROT); if (result <> S_OK) then exit; wsz := format("FilterGraph %p pid %x",[pointer(graph),GetCurrentProcessId()]); result := CreateItemMoniker("!", PWideChar(wsz), Moniker); if (result <> S_OK) then exit; result := ROT.Register(0, Graph, Moniker, ID); Moniker := nil; end; ......... procedure TSysDevEnum.GetCat(catlist: TList; CatGUID: TGUID); var SysDevEnum : ICreateDevEnum; EnumCat : IEnumMoniker; Moniker : IMoniker; Fetched : ULONG; PropBag : IPropertyBag; Name : olevariant; hr : HRESULT; i : integer; begin if catList.Count > 0 then for i := 0 to (catList.Count - 1) do if assigned(catList.Items[i]) then Dispose(catList.Items[i]); catList.Clear; CocreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum); hr := SysDevEnum.CreateClassEnumerator(CatGUID, EnumCat, 0); if (hr = S_OK) then begin while(EnumCat.Next(1, Moniker, @Fetched) = S_OK) do begin Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag); new(ACategory); PropBag.Read("FriendlyName", Name, nil); ACategory^.FriendlyName := Name; if (PropBag.Read("CLSID",Name,nil) = S_OK) then ACategory^.CLSID := StringToGUID(Name) else ACategory^.CLSID := GUID_NULL; catlist.Add(ACategory); PropBag := nil; Moniker := nil; end; end; EnumCat :=nil; SysDevEnum :=nil; end; .............

← →
WondeRu © (2004-08-27 15:03) [13]

еще пример из VCLCom.pas - borland"овская библтотека:

procedure TApartmentThread.Execute; var msg: TMsg; Unk: IUnknown; begin try CoInitialize(nil); try FCreateResult := FFactory.CreateInstanceLic(FUnkOuter, nil, FIID, "", Unk); FUnkOuter := nil; FFactory := nil; if FCreateResult = S_OK then CoMarshalInterThreadInterfaceInStream(FIID, Unk, IStream(FStream)); ReleaseSemaphore(FSemaphore, 1, nil); if FCreateResult = S_OK then while GetMessage(msg, 0, 0, 0) do begin DispatchMessage(msg); Unk._AddRef; if Unk._Release = 1 then break; end; finally Unk := nil; CoUninitialize; end; except { No exceptions should go unhandled } end; end;

2DiamondShark
Так что почему Вы не присваиваете nil? Счетчик ссылок на объект данного интерфейса не обнулится (пока прога не завершится), соотвествсвенно объект останется в памяти, только указатель на него потеряется! (как смог так и сформулировал, а терминологией у меня проблемы:)

← →
jack128 © (2004-08-27 15:17) [14]

WondeRu © (27.08.04 15:03) [13]
finally
Unk := nil;
CoUninitialize; // Здесь мы Завершаем работу с СOM - значит к этому моменту все интерфейсы должны быть освобождены
end;

← →
DiamondShark © (2004-08-27 15:22) [15]

Удалено модератором

← →
WondeRu © (2004-08-27 15:23) [16]

jack128 © (27.08.04 15:17) [14]
это и ежу понятно! но "Компилятор сам следит" ;-)
а чего скажешь насчет 12-го поста?

----
понимаю что выхожу в оффтоп, но охота разобраться че к чему

← →
DiamondShark © (2004-08-27 15:27) [17]

Удалено модератором

← →
Goorus © (2004-08-27 15:30) [18]

> Skier
Этот пример я взял за основу

New(Folder) - это тоже я взял из примера в ФАКе, и что самое удивительно к определённых случаях это работает :)

SLink:=nil;
Не помогало, уже пробывал. А реестр штука ненадёжная, а меню автозагрузки для того и существует, оттуда пользователю легче программы выкидывать :)

Всем спасибо!

Folder:array[0..1000] of Char; // гениально !!! ;)

← →
WondeRu © (2004-08-27 15:31) [19]

[15]
как лягушку припарировал )

DiamondShark © (27.08.04 15:22) [15]
Так что удавись, ламерок.

эээхх! вроде взрослый человек, а ведет себя как ребенок!(
"Вам бы лечиться" © ;-)

← →
VMcL © (2004-08-27 15:33) [20]

>DiamondShark

Эта... полегче с выражениями.

← →
WondeRu © (2004-08-27 15:35) [21]

Удалено модератором

← →
jack128 © (2004-08-27 15:36) [22]

WondeRu © (27.08.04 15:23) [16]
но "Компилятор сам следит" ;-)
Ну так он же компилятор , а не искуственный интеллект (с) почти ЮЗ

> а чего скажешь насчет 12-го поста?

DS все расписал. конечно с утечкой памяти возможны варианты (если CatList - реально не TList, а его наследник), но это маловероятно..

← →
DiamondShark © (2004-08-27 15:48) [23]

> WondeRu © (27.08.04 15:31) [19]

Ты взялся советовать. Причём, советовать а) не в кассу б) обладая представлениями, основанными не на понимании, а на обезьянском подражании тому, что тебе удалось где-то подсмотреть.
Первый намёк тебе на это был весьма сдержанный.

← →
Danilka © (2004-08-27 15:52) [24]

[23] DiamondShark © (27.08.04 15:48)
Тем не менее, это не повод переходить к оскорблениям. Ты и без них все объяснил, зачем заходить так далеко?
С.м. 8-й пункт правил поведения на форуме.

> конечно с утечкой памяти возможны варианты (если CatList
> - реально не TList, а его наследник),

Не... Там итемы удаляются Dispose (самый первый for).
Конечно, саму запись Dispose удалит корректно, менеджер памяти с размерами разберётся. Но запись не будет финализирована. И если в ней есть управляемые поля (длинные строки, в частности), то они повиснут.

> DiamondShark © (27.08.04 15:54) [25]

Впрочем, если это таки наследник, и свойство переопределено как типизированное (а не Pointer):

property Items[Index: integer]: PТрамПамПам;

то всё, конечно же, будет финализировано.

DiamondShark © (27.08.04 15:54) [25]

> Но запись не будет финализирована

наследник может Notify перекрыть и там файнализировать. очень маловероятно и идеологически не верно, но возможно..

>>DiamondShark © (27.08.04 15:54) [25]

Насчет Dispose ты неправ. Если правильно типизировать параметр Dispose, то всё прекрасно финализируется. Можешь проверить по хелпу о Finalize.

> VMcL © (27.08.04 16:11) [28]

А я написал в [26].

Конечно, не видя описания catList -- это гадание на кофейной гуще. Но всё же, что-то мне подсказывает, что это просто TList, иначе, от чего же управление итемами не вынесено в него, а стоит сторонний цикл?

Да не в том дело, типизирован там Items или нет. Этот фрагмент был приведён в качестве образца как надо обращаться с интерфейсами. И не в кассу -- что закономерно, ибо как раз с интерфейсами там ситуация шибко нестандартная.

Удалено модератором

А через реестр не легче?

← →
Экспериментатор (2004-08-28 14:58) [34]

Например, так
ну примерно так (Вызываешь в программе функцию SetAutoRun(True) и все дела)
var Ga_RegKey : string = "Имя программы"; function IsNT : boolean; begin case Win32Platform of VER_PLATFORM_WIN32_NT: Result:=True; else Result:=False; end; end; procedure SetAutoRun( isCreate : boolean); var Reg: TRegistry; begin Reg := TRegistry.Create; try if isNT then Reg.RootKey := HKEY_CURRENT_USER else Reg.RootKey := HKEY_LOCAL_MACHINE; if isCreate then begin if Reg.OpenKey("\Software\Microsoft\Windows\CurrentVersion\Run", False) then begin if Reg.ReadString(Ga_RegKey)<>ParamStr(0) then begin if(Application.MessageBox( "Добавить "+Ga_RegKey+" в автозагрузку?", "Добавление в автозагрузку",MB_ICONQUESTION + MB_YesNO + MB_DEFBUTTON2) = IDYES) then try Reg.WriteString(Ga_RegKey,ParamStr(0)); Application.MessageBox(Ga_RegKey+" успешно добавлена в автозагрузку!", "Автозагрузка",MB_ICONINFORMATION + MB_OK); except Application.MessageBox( "Ошибка изменения реестра. Нет доступа!", "Автозагрузка",MB_ICONERROR + MB_OK); end end else Application.MessageBox( Ga_RegKey+" уже добавлена в автозагрузку!", "Автозагрузка",MB_ICONWARNING + MB_OK); end; end else begin if (Application.MessageBox("Вы действительно хотите убрать "+Ga_RegKey+" из автозагрузки?", "Удаление из автозагрузки", MB_ICONQUESTION + MB_YesNO + MB_DEFBUTTON2) = IDYES) and Reg.OpenKey("\Software\Microsoft\Windows\CurrentVersion\Run", False) and Reg.ValueExists(Ga_RegKey) then if Reg.DeleteValue(Ga_RegKey) then Application.MessageBox( Ga_RegKey+" успешно удалена из автозагрузки!", "Автозагрузка",MB_ICONINFORMATION + MB_OK) else Application.MessageBox( Ga_RegKey+" не удалена из автозагрузки!"+ ^M+"Нет доступа!", "Автозагрузка",MB_ICONSTOP + MB_OK); end; finally Reg.CloseKey; Reg.Free; end; end;

Add to AutoRun Найти похожие ветки