Solved

File links in Delphi

Posted on 2000-03-28
10
218 Views
Last Modified: 2010-04-04
I am opening a file using assignfile as a text file. I need to have multiple copies of the file available in different locations. Rather than copy the file several times, I would rather uses NT links to point to the original file. I guess that when I open the link in Delphi as a text file, I'll just get the link contents, and not the file. How do I extract the file location information from the link as a Delphi text file ?
0
Comment
Question by:sparkido
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
  • 2
10 Comments
 
LVL 13

Accepted Solution

by:
Epsylon earned 100 total points
ID: 2663817
You can use this to find the path to the file:


procedure TForm1.Button1Click(Sender: TObject);
var
  s1,s2,s3:String;
begin
  GetLinkInfo('c:\windows\start menu\programs\windows explorer.lnk',
              s1,s2,s3);
  ShowMessage('File: '+s1+#13+'Target: '+s2+#13+'Working: '+s3);
end;

procedure TForm1.GetLinkInfo(ALnk: String;
                             var AFile, APath, AWork: String);
const
  // took this TGUID from OLE2.pas
  IID_IPersistFile: TGUID = (D1:$0000010B;
                             D2:$0000;
                             D3:$0000;
                             D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  // Missing from Windows.pas
  MB_ERR_INVALID_CHARS = $00000008;
var
  fShellLink   : IShellLink;
  fPersistFile : IPersistFile;
  fFindData    : TWin32FindData;
  fWideBuf     : array[0..MAX_PATH] of WideChar;
  fBuf         : array[0..MAX_PATH] of Char;
  hResx        : hResult;
  WideLen      : Integer;
begin
  // get an interface pointer to the IShellLink interface
  hResx := CoCreateInstance(CLSID_ShellLink,
                            nil,
                            CLSCTX_INPROC_SERVER,
                            IID_IShellLinkA,
                            fShellLink);
  if SUCCEEDED(hResx) then
  begin
    // get an interface pointer to the IPersistFile interface
    // of IShellLink
    hResx := fShellLink.QueryInterface(IID_IPersistFile,
                                       fPersistFile);
    if SUCCEEDED(hResx) then
    begin
      // convert the link file pathname to a PWideChar
      WideLen := MultiByteToWideChar(CP_ACP,
                                     MB_ERR_INVALID_CHARS,
                                     pChar(ALnk),
                                     Length(ALnk),
                                     @fWideBuf,
                                     MAX_PATH);
      if WideLen = 0 then
      begin
        ShowMessage('MultiByteToWideChar FAILED');
        Exit;
      end;
      // terminate our widechar at the length returned
      fWideBuf[WideLen] := #0;
      // initialize the IShellLink object from its disk image
      hResx := fPersistFile.Load(@fWideBuf,
                                 STGM_READ or
                                 STGM_SHARE_DENY_NONE);
      if SUCCEEDED(hResx) then
      begin
        // get target file & path
        fShellLink.GetPath(@fBuf,
                           MAX_PATH,
                           fFindData,
                           0);
        AFile := fFindData.cFileName;
        APath := StrPas(fBuf);
        // get target directory
        fShellLink.GetWorkingDirectory(@fBuf,
                                       Max_Path);
        AWork := StrPas(fBuf);
      end;
    end;
  end;
end;
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2664419
Hi Epsylon, do you mind if I shorten your source a bit? I'm always a bit sad, if I see code that doesn't use all the Delphi goodies...

procedure TForm1.GetLinkInfo(ALnk: String;
                             var AFile, APath, AWork: String);
var fShellLink : IShellLink;
    fFindData  : TWin32FindData;
    fBuf       : array [0..MAX_PATH] of Char;
begin
  fShellLink := CreateComObject(CLSID_ShellLink) as IShellLink;
  if (fShellLink as IPersistFile).Load(PWideChar(wideString(ALnk)), 0) = 0 then begin
    fShellLink.GetPath(fBuf, MAX_PATH, fFindData, 0);
    AFile := fFindData.cFileName;
    APath := fBuf;
    fShellLink.GetWorkingDirectory(fBuf, MAX_PATH);
    AWork := fBuf;
  end;
end;

Okay, that were just some little changes, but together they make a difference, don't you think so?   :-)

Regards, Madshi.
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2664560
Hi Madshi, I copy-pasted that code from a PAQ    :o)
Looks a lot better this way!
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:sparkido
ID: 2664733
I get an exception when I run the code on

if (fShellLink as IPersistFile).Load(PWideChar(wideString(ALnk)), 0) = 0 then begin ...

What format should ALnk take, full path and filename ???


0
 
LVL 20

Expert Comment

by:Madshi
ID: 2664826
ALnk should be the exact file name, e.g. 'c:\windows\startmenu\programs\winword.lnk'.

Which exception do you get? It works fine for me.

Perhaps you need to add CoInitialize(nil) in your project's initialization.
0
 

Author Comment

by:sparkido
ID: 2669586
I actual get an access violation.
I can't find any docs on FShellLink, so I'm struggling to work out why.
0
 

Author Comment

by:sparkido
ID: 2669805
Ignore the last comment, I got it working. Thanks very much.

Submit an answer.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2669846
You can accept Eps comment as the answer. There's a link in the top right of each comment with which you can convert a comment into an answer.
0
 

Author Comment

by:sparkido
ID: 2669870
Ignore the last comment, I got it working. Thanks very much.

Submit an answer.
0
 

Author Comment

by:sparkido
ID: 2669877
Spotted that after I had posted !! (twice!!)
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
NetCrunch network monitor is a highly extensive platform for network monitoring and alert generation. In this video you'll see a live demo of NetCrunch with most notable features explained in a walk-through manner. You'll also get to know the philos…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
Suggested Courses
Course of the Month5 days, 11 hours left to enroll

626 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question