Add the code to Get the path of the given filename

[veroca]

unit Unit1;

interface

uses
ShellApi,
clipbrd,
shlobj,
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
CommCtrl,
Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FHookStarted : Boolean;

public
end;
var
Form1: TForm1;
JHook: THandle;

implementation
{$R *.dfm}

function SelectedFilename(LvHandle : Thandle) : String;
var Index : Integer;
Written : Cardinal;
cItemInfo : TLVITEM;
pItemInfo : PLVITEM;
pString : PChar;
Buffer : array[0..1023] of Char;
hProcess : THandle;
FPid : Cardinal;

begin
Result := '';
GetWindowThreadProcessID(LvHandle, FPid);
if FPid = 0 then Exit;
Index := SendMessage(LvHandle, LVM_GETITEMCOUNT, 0, 0);
ZeroMemory(@cItemInfo, SizeOf(cItemInfo));
hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, FPid);
pItemInfo := VirtualAllocEx(hProcess, nil, SizeOf(cItemInfo), MEM_COMMIT, PAGE_EXECUTE_READWRITE);
pString := VirtualAllocEx(hProcess, nil, 1024, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
try
while Index > 0 do
begin
Dec(Index);
if SendMessage(LvHandle, LVM_GETITEMSTATE, Index, LVIS_SELECTED) and LVIS_SELECTED <> 0 then
begin
if Assigned(pItemInfo) then
begin
cItemInfo.cchTextMax := 1024;
cItemInfo.pszText := pString;
cItemInfo.iSubItem := 0;
if WriteProcessMemory(hProcess, pItemInfo, @cItemInfo, SizeOf(cItemInfo), Written) then
begin
SendMessage(LvHandle, LVM_GETITEMTEXT, Index, Integer(pItemInfo));
ReadProcessMemory(hProcess, pString, @Buffer, 1024, Written);
Result := Buffer;
end;
end;
end;
end;
finally
if Assigned(pItemInfo) then
VirtualFreeEx(hProcess, pItemInfo, 0, MEM_RELEASE);
if Assigned(pString) then
VirtualFreeEx(hProcess, pString, 0, MEM_RELEASE);
end;
end;

function SameNames(Hwnd : THandle; ClassName, WindowName : string) : Boolean;
var Str: array[0..255] of char;
begin
Result := False;
GetClassName(Hwnd, Str, 255);
if AnsiSameText(ClassName, Str) then
begin
GetWindowText(Hwnd, Str, 255);
Result := AnsiSameText(WindowName, Str);
end;
end;

function ActiveCaption: string;
var
Handle: THandle;
Len: LongInt;
Title: string;
begin
Result := '';
Handle := GetForegroundWindow;
if Handle <> 0 then
begin
Len := GetWindowTextLength(Handle) + 1;
SetLength(Title, Len);
GetWindowText(Handle, PChar(Title), Len);
ActiveCaption := TrimRight(Title);
end;
end;

function FindCWindow(ParentHwnd : THandle; ClassName, WindowName : String) : THandle;
var Child : THandle;

begin
Result := 0;
Child := FindWindowEx(ParentHwnd, 0, nil, nil);
while (Child <> 0) and (Result = 0) do
begin
if SameNames(Child, ClassName, WindowName) then
begin
Result := Child;
Break;
end
else
Result := FindCWindow(Child, ClassName, WindowName);
if Result = 0 then
Child := FindWindowEx(ParentHwnd, Child, nil, nil);
end;
end;

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
var
P: TPoint;
Hwnd : THandle;
selectF: string;
begin
Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
if Code < 0 then Exit;
if Code = HC_SYSMODALON then Exit;
if Code = HC_ACTION then
begin
if EventStrut.message = WM_LBUTTONDOWN then
begin
///////////////////begin test line here


Hwnd := FindWindow(nil, pchar(activecaption));
Hwnd := FindCWindow(hwnd, 'SysListView32', 'FolderView');
selectF:=Format('%s', [SelectedFilename(Hwnd)]);
Form1.Caption := selectF;



/////////////////////////end test line here
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
if JHook > 0 then
begin
FHookStarted := True;
end
else
ShowMessage('No Journal Hook availible');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FHookStarted := False;
UnhookWindowsHookEx(JHook);
JHook := 0;
end;

end.

 

[TonHu]

What's the issue?

 

[veroca]

I'm making a file viewer by clicking the file anywhere in windows explorer (not mouse over by others), and I need that code to work, the code was originaly written by someone's name (whosrdaddy's)? I'm not sure of it, but I know that one of the member of tek-tips contributed that code.

 

[whosrdaddy]

can you tell us what problem you have?
Error, AV, .... ?

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[sggaunt]

I hope he indented it better than it is there, you should use [[]code] [[]/code]

Steve: N.M.N.F.
If something is popular, it must be wrong: Mark Twain

 

[veroca]

Hello

There is no problem with the code, the code gets the filename of the selected file anywhere in windows, but it would be better to get the path also with the filename

eq:
image1.jpg = (present code only shows)
c:\windows\images\image1.jpg = has the path and filename (which is better)

Thank you

 

[veroca]

//I don't know if this is easier or not, but the code is not complete also. (getting the path and filename with dropacceptfiles then automate a dragdrop in listbox.

unit Unit1;

interface

uses
ShellApi,
clipbrd,
shlobj,
psapi,
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
CommCtrl,
Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
FHookStarted : Boolean;

procedure WMDROPFILES(var Msg: TMessage);
message WM_DROPFILES;

procedure AUTODRAG(var Msg: TMessage);
message CM_DRAG;

procedure AddFile(sFileName: string);
public
end;
var
Form1: TForm1;
JHook: THandle;

implementation
{$R *.dfm}

procedure TForm1.AddFile(sFileName: string);
begin
ListBox1.Items.Add(sFilename);
end;

procedure TForm1.WMDROPFILES(var Msg: TMessage);
var
pcFileName: PChar;
i, iSize, iFileCount: integer;
begin
pcFileName := '';
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
for i := 0 to iFileCount - 1 do
begin
iSize := DragQueryFile(Msg.wParam, iFileCount - 1, nil, 0) + 1;
pcFileName := StrAlloc(iSize);
DragQueryFile(Msg.wParam, i, pcFileName, iSize);
AddFile(pcFileName);
StrDispose(pcFileName);
end;
DragFinish(Msg.wParam);
end;

procedure TForm1.AUTODRAG(var Msg: TMessage);
begin
//not sure of this
end;

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
var
P: TPoint;
Hwnd : THandle;
begin
Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
if Code < 0 then Exit;
if Code = HC_SYSMODALON then Exit;
if Code = HC_ACTION then
begin
if EventStrut.message = WM_LBUTTONDOWN then
begin
///////////////////begin test line here

p.X:=EventStrut.paramL;
p.Y:=EventStrut.paramH;
GetCursorPos(p);
hwnd := WindowFromPoint(p);
Windows.ScreenToClient(hwnd, p);


DragAcceptFiles(form1.Listbox1.Handle, True);
//SendMessage(hwnd, CM_DRAG, 0, 0);
PostMessage(form1.Listbox1.Handle, WM_DROPFILES, 0, 0);


/////////////////////////end test line here
end;
end;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
Handled := False;
if (Msg.message = WM_CANCELJOURNAL) then
begin
JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
if JHook > 0 then
begin
FHookStarted := True;
end
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FHookStarted := False;
UnhookWindowsHookEx(JHook);
JHook := 0;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
if JHook > 0 then
begin
FHookStarted := True;
end
else
ShowMessage('No Journal Hook availible');
end;

end.

 

[roo0047]

I compiled both of your code posts in D7 to help me understand what these do. Yes, the second code adds the full path names and puts them in a list box. Well done!
I do agree with Steve's suggestion to indent and to use TGML tag "CODE" to make your code more readable.
See:

http://www.tipmaster.com/includes/tgmlinfo.cfm?w=450&h=450

and scroll about half way dowm for instruction, like this:

unit Unit1;

interface

uses
  ShellApi, clipbrd,  shlobj,  psapi,  Windows,  Messages,  SysUtils, Variants,
  Classes,  Graphics, Controls, Forms, CommCtrl, Dialogs, StdCtrls, AppEvnts;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ApplicationEvents1: TApplicationEvents;
    Button1: TButton;
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FHookStarted : Boolean;
    procedure WMDROPFILES(var Msg: TMessage); message WM_DROPFILES;
    procedure AUTODRAG(var Msg: TMessage);    message CM_DRAG;
    procedure AddFile(sFileName: string);
  public
  end;

var
  Form1: TForm1;
  JHook: THandle;

implementation

{$R *.dfm}

procedure TForm1.AddFile(sFileName: string);
begin
  ListBox1.Items.Add(sFilename);
end;

procedure TForm1.WMDROPFILES(var Msg: TMessage);
var
  pcFileName: PChar;
  i, iSize, iFileCount: integer;
begin
  pcFileName:= '';
  iFileCount:= DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
  for i:= 0 to iFileCount - 1 do begin
    iSize:= DragQueryFile(Msg.wParam, iFileCount - 1, nil, 0) + 1;
    pcFileName:= StrAlloc(iSize);
    DragQueryFile(Msg.wParam, i, pcFileName, iSize);
    AddFile(pcFileName);
    StrDispose(pcFileName);
  end;
  DragFinish(Msg.wParam);
end;

procedure TForm1.AUTODRAG(var Msg: TMessage);
begin
  //not sure of this
end;

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
var
  P: TPoint;
  Hwnd : THandle;
begin
  Result:= CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
  if Code < 0 then Exit;
  if Code = HC_SYSMODALON then Exit;
  if Code = HC_ACTION then begin
    if EventStrut.message = WM_LBUTTONDOWN then begin
      ///////////////////begin test line here
      p.X:=EventStrut.paramL;
      p.Y:=EventStrut.paramH;
      GetCursorPos(p);
      hwnd:= WindowFromPoint(p);
      Windows.ScreenToClient(hwnd, p);
      DragAcceptFiles(form1.Listbox1.Handle, True);
      //SendMessage(hwnd, CM_DRAG, 0, 0);
      PostMessage(form1.Listbox1.Handle, WM_DROPFILES, 0, 0);
      /////////////////////////end test line here
    end;
  end;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
  Handled:= False;
  if (Msg.message = WM_CANCELJOURNAL) then begin
    JHook:= SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
    if JHook > 0 then
      FHookStarted:= True;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FHookStarted:= False;
  UnhookWindowsHookEx(JHook);
  JHook:= 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  JHook:= SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
  if JHook > 0 then
    FHookStarted:= True
  else
    ShowMessage('No Journal Hook availible');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close
end;

end.

Roo
Delphi Rules!

 

[veroca]

Thank you, but, I don't understand, that you repost the code again with the same code originally posted that never work to get the path and file name with just a click, what do you mean that your showing another link about TGML, I think this has nothing to do with the codes I post. Please let me understand.

 

[roo0047]

Ok...
Your first code post just got the file-name (without path).
Your second code post gets the file-name with full path, or at least it worked for me. (D7 with XP)

As I understood your post, that was what you were demonstrating. However, it was suggested by Steve (sggaunt) that your post would be better understood if you indent and use code formatting function.

My post was to show you how to do that. Otherwise, yes, it is identical to your second post.

Now, where you say:

to get the path and file name with just a click,

I don't know what you meant by "just a click". To make your code work, I opened "My Documents" folder, selected a file, then used Drag-and-Drop to drop it on the list-box window of running Program1.EXE

Each file I did this to was added to the list, like this:

"C:\Documents and Settings\User\My Documents\Test1.txt"
"C:\Documents and Settings\User\My Documents\Test2.txt"

So, Like I said, it worked for me...

If you still have a problem to resolve, please explain.

Sorry to have confused you in any way.

Roo
Delphi Rules!

 

[veroca]

Ok,

The first code was from whosrdaddy?
But,it's not complete, it only gets the filename during a click. I need the path and filename. So I explored the second code to do so if possible.

The second code was from other delphi masters/geeks.

I just got an idea to mix up the [dragacceptfiles] to the second code to get the path and filename by NOT dragging the file in the listbox, BUT to automate the dragging by just clicking the file [theres no need to drag the file to the delphi form.listbox because by just clicking the file, the file will automate(a drag) in the listbox itself]

So, by just clicking the file in windows, the path and file name will automate to the form.listbox. That's why I used the sendmessage or postmessage and I can't work it out.

Thank you

 

[veroca]

Hello, did you get the point? Sorry for my bad English.

 

[roo0047]

Yes I did. Due to my weekday work-load, I have not had a chance to look at it further. It looks do-able, if someone else has time to play with it. I did notice that setting break-point at certain places within the code had a tendency to freeze my laptop, so just be aware.

Roo
Delphi Rules!