Форум: "Основная";
Текущий архив: 2004.09.12;
Скачать: [xml.tar.bz2];
Вниз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-й пункт правил поведения на форуме.
← →
DiamondShark © (2004-08-27 15:54) [25]
> конечно с утечкой памяти возможны варианты (если CatList
> - реально не TList, а его наследник),
Не... Там итемы удаляются Dispose (самый первый for).
Конечно, саму запись Dispose удалит корректно, менеджер памяти с размерами разберётся. Но запись не будет финализирована. И если в ней есть управляемые поля (длинные строки, в частности), то они повиснут.
← →
DiamondShark © (2004-08-27 16:03) [26]
> DiamondShark © (27.08.04 15:54) [25]
Впрочем, если это таки наследник, и свойство переопределено как типизированное (а не Pointer):
property Items[Index: integer]: PТрамПамПам;
то всё, конечно же, будет финализировано.
← →
jack128 © (2004-08-27 16:04) [27]DiamondShark © (27.08.04 15:54) [25]
> Но запись не будет финализирована
наследник может Notify перекрыть и там файнализировать. очень маловероятно и идеологически не верно, но возможно..
← →
VMcL © (2004-08-27 16:11) [28]>>DiamondShark © (27.08.04 15:54) [25]
Насчет Dispose ты неправ. Если правильно типизировать параметр Dispose, то всё прекрасно финализируется. Можешь проверить по хелпу о Finalize.
← →
jack128 © (2004-08-27 16:21) [29]VMcL © (27.08.04 16:11) [28]
Если правильно типизировать параметр Dispose
в коде правильной типизации нет.
← →
VMcL © (2004-08-27 16:28) [30]>>jack128 © (27.08.04 16:21) [29]
И верно нет. Тады ой, судя поACategory^.FriendlyName := Name;
← →
DiamondShark © (2004-08-27 16:31) [31]
> VMcL © (27.08.04 16:11) [28]
А я написал в [26].
Конечно, не видя описания catList -- это гадание на кофейной гуще. Но всё же, что-то мне подсказывает, что это просто TList, иначе, от чего же управление итемами не вынесено в него, а стоит сторонний цикл?
Да не в том дело, типизирован там Items или нет. Этот фрагмент был приведён в качестве образца как надо обращаться с интерфейсами. И не в кассу -- что закономерно, ибо как раз с интерфейсами там ситуация шибко нестандартная.
← →
GrayFace © (2004-08-27 19:48) [32]Удалено модератором
← →
Sanek_metaller © (2004-08-27 21:22) [33]А через реестр не легче?
← →
Экспериментатор (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;
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.09.12;
Скачать: [xml.tar.bz2];
Память: 0.56 MB
Время: 0.034 c