Recent

Author Topic: Windows Startup  (Read 6129 times)

Newmann

  • Jr. Member
  • **
  • Posts: 62
Windows Startup
« on: July 15, 2011, 08:52:02 pm »
Hi Guys,
Does anybody know how to write out a windows LNK file via code in Lazarus?
I've done this before through Delphi, but the same source is not working. :o

What I need is to write out a link/shortcut to my program's exe in the user startup folder (tried the registry route, but security policies is proving to be problematic). >:(

I know how to get to the UserFolder just fine, just to write out the lnk file is a bit tricky. Any help will be greatly appreciated.
Thanks. :)
Lazarus 1.0.14
FPC 2.6.0
Win7 Pro 64bit/Win XP Pro 32bit

lainz

  • Guest
Re: Windows Startup
« Reply #1 on: July 15, 2011, 09:00:27 pm »
Hi Guys,
Does anybody know how to write out a windows LNK file via code in Lazarus?
I've done this before through Delphi, but the same source is not working. :o

What I need is to write out a link/shortcut to my program's exe in the user startup folder (tried the registry route, but security policies is proving to be problematic). >:(

I know how to get to the UserFolder just fine, just to write out the lnk file is a bit tricky. Any help will be greatly appreciated.
Thanks. :)

Use an installer. you can do one with inno setup.

or try this (i don't know where i get it):


Code: [Select]
UNIT shortcut;

INTERFACE

  uses windows;

  FUNCTION createShortcut(lnkpos : widestring; dstfn,dstargs,dstwdir,descr,iconfn : AnsiString; iconnum : longint) : boolean;

  // create a windows shortcut file (*.lnk)@lnkpos.
  // example: createSohrtcut('c:\test.lnk','c:\pascal\myprog.exe','-L 1000','c:\pascal','A nice Program.','c:\pascal\myprog.exe',0);

IMPLEMENTATION

TYPE
REFCLSID = PGUID;
REFIID   = PGUID;

CONST
CLSID_ShellLink  : TGUID = '{00021401-0000-0000-C000-000000000046}';
IID_IShellLink   : TGUID = '{000214EE-0000-0000-C000-000000000046}';
IID_IPersistFile : TGUID = '{0000010b-0000-0000-C000-000000000046}';
CLSCTX_INPROC_SERVER = 1;

FUNCTION CoInitialize(p : pointer) : HRESULT; stdcall;  external 'ole32.dll';
FUNCTION CoUninitialize(p : pointer) : HRESULT; stdcall;  external 'ole32.dll';
FUNCTION CoCreateInstance(a:REFCLSID; b:pointer; c:DWORD; d:REFIID; e:pointer)  : HRESULT; stdcall;  external 'ole32.dll';

TYPE
PPISHellLink = ^PISHellLink;
PISHellLink = ^ISHellLink;
ISHellLink = packed record
  QueryInterface : FUNCTION(basis,id,p : pointer) : Hresult; stdcall;
  AddRef : FUNCTION(basis : pointer) : Hresult; stdcall;
  Release : FUNCTION(basis : pointer) : Hresult; stdcall;
  GetPath : pointer;
  GetIDList : pointer;
  SetIDList : pointer;
  GetDescription : pointer;
  SetDescription : FUNCTION(basis : pointer; descr : Pchar) : Hresult; stdcall;
  GetWorkingDirectory : pointer;
  SetWorkingDirectory : FUNCTION(basis : pointer; descr : Pchar) : Hresult; stdcall;
  GetArguments : pointer;
  SetArguments : FUNCTION(basis : pointer; args : Pchar) : Hresult; stdcall;
  GetHotkey : pointer;
  SetHotkey : pointer;
  GetShowCmd : pointer;
  SetShowCmd : pointer;
  GetIconLocation : pointer;
  SetIconLocation : FUNCTION(basis : pointer; iconfile : Pchar; icon : longint) : Hresult; stdcall;
  SetRelativePath : pointer;
  Resolve : pointer;
  SetPath : FUNCTION(basis : pointer; path : Pchar) : Hresult; stdcall;
end;

PPIPersistFile = ^PIPersistFile;
PIPersistFile  = ^IPersistFile;
IPersistFile   = packed record
  QueryInterface : FUNCTION(basis,id,p : pointer) : Hresult; stdcall;
  AddRef : FUNCTION(basis : pointer) : Hresult; stdcall;
  Release : FUNCTION(basis : pointer) : Hresult; stdcall;
  GetClassID : FUNCTION(basis,p : pointer) : Hresult; stdcall;
  IsDirty : FUNCTION(basis : pointer) : Hresult; stdcall;
  Load : FUNCTION(basis : pointer; fn : Pchar; dw : dword) : Hresult; stdcall;
  Save : FUNCTION(basis : pointer; fn : Pchar; dw : dword) : Hresult; stdcall;
  SaveCompleted : FUNCTION(basis : pointer; fn : Pchar) : Hresult; stdcall;
  GetCurFile : FUNCTION(basis : pointer; fn : PPchar) : Hresult; stdcall;
end;


FUNCTION createShortcut(lnkpos : widestring; dstfn,dstargs,dstwdir,descr,iconfn : AnsiString; iconnum : longint) : boolean;
VAR psl : PPISHellLink; psp : PPIPersistFile;
BEGIN
  createShortcut := FALSE;
  if CoCreateInstance(@CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER,@IID_IShellLink,@psl)=0 then begin
//    writeln('got IShellLink');
    if  (psl^^.setPath(psl,@dstfn[1])=0)
    and (psl^^.SetArguments(psl,@dstargs[1])=0)
    and (psl^^.SetWorkingDirectory(psl,@dstwdir[1])=0)
    and (psl^^.SetDescription(psl,@descr[1])=0)
    and (psl^^.SetIconLocation(psl,@iconfn[1],iconnum)=0)
    and (psl^^.queryInterface(psl,@IID_IPersistFile,@psp)=0) then begin
      if psp^^.save(psp,@lnkpos[1],0)=0 then createShortcut := true;   
      psp^^.release(psp);
    end;
    psl^^.Release(psl);
  end;
END;

BEGIN
  CoInitialize(nil);
END.

Newmann

  • Jr. Member
  • **
  • Posts: 62
Re: Windows Startup
« Reply #2 on: July 15, 2011, 09:09:08 pm »
I can't use the installer as it's an optional user setting.

It's a utility I wrote to help me round the office- some of the guys use it, others don't- and if I make it start up for everybody they nag at me like a bunch of old ladies...

I'll give the code a try- thanks a lot ;)
Lazarus 1.0.14
FPC 2.6.0
Win7 Pro 64bit/Win XP Pro 32bit

Newmann

  • Jr. Member
  • **
  • Posts: 62
Re: Windows Startup
« Reply #3 on: July 16, 2011, 03:50:35 am »
Lianz, that unit worked like a dream!!!

Thanks for the help ;)
Lazarus 1.0.14
FPC 2.6.0
Win7 Pro 64bit/Win XP Pro 32bit

CaptBill

  • Sr. Member
  • ****
  • Posts: 435
Re: Windows Startup
« Reply #4 on: July 16, 2011, 04:03:46 am »
Hi Newmann,

Good to see you found a good solution to the issue.

Do us a favor and append the thread title with [RESOLVED] or [SOLVED]. This is helpful when narrowing down a search of the subject for others in the future. For good resolutions like this one especially.

Thanks

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Windows Startup
« Reply #5 on: July 16, 2011, 10:46:28 am »
Apart from CaptBill's comments, if the code is useful and works, someone could always add it to the wiki to maximize people's chances of finding it :)

Added:
http://wiki.lazarus.freepascal.org/Windows_Programming_Tips
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

 

TinyPortal © 2005-2018