如何双击文件获得文件名和路径？
例如C盘下有个文件“try.txt”，如何用delphi编程，进行监控：当打开该文件时，在memo1中显示文件名和路径？只有34分了。
[解决办法]
uses
TlHelp32,psapi;
function GetPathFileofModule(ModuleName:String):String; //枚举进程文件所在路径
var
hProcSnap: THandle;
pProcess: THandle;
pe32: TProcessEntry32;
buf:array[0..MAX_PATH] of char;
hMod:HMODULE;
cbNeeded:DWORD;
begin
hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
if hProcSnap = INVALID_HANDLE_VALUE then Exit;
pe32.dwSize := SizeOf(ProcessEntry32);
if Process32First(hProcSnap, pe32) = True then
while Process32Next(hProcSnap, pe32) = True do
begin
if uppercase(pe32.szExeFile)=uppercase(ModuleName) then
begin
pProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
FALSE,
pe32.th32ProcessID);
if pProcess<>0 then
begin
if EnumProcessModules( pProcess,@hMod,sizeof(hMod),cbNeeded) then
begin
ZeroMemory(@buf,MAX_PATH+1);
GetModuleFileNameEx(pProcess, hMod,buf,MAX_PATH+1);
Result:=strpas(buf);
end;
end;
end;
end;
CloseHandle(hProcSnap);
end;
调用方法:
ShowMessage(GetPathFileofModule('explorer.exe'));
delphi 通过进程名获得文件全路径的函数
网上发现的，有不少帖子，我没有自己看，不过，证明了通过进程获得文件路径是可行的
[解决办法]
function ChangeRecord2String(ChangeRecord : TDirectoryChangeRecord) : String; var s : String;begin Result := '无变化'; if ChangeRecord.FileFlag then s := '文件 ' else s := '目录 '; s := s + '"' + ChangeRecord.Name + '"'; case ChangeRecord.ChangeType of // ctAttributes : Result := s + ' 属性改变. 旧: ' + IntToHex(ChangeRecord.OldAttributes,8) + ', 新: ' + IntToHex(ChangeRecord.NewAttributes,8); // ctSize : Result := s + ' 大小改变. 旧: ' + IntToStr(ChangeRecord.OldSize) + ', 新: ' + IntToStr(ChangeRecord.NewSize); // ctCreationTime : Result := s + ' 创建时间改变. 旧: ' + DateTimeToStr(ChangeRecord.OldTime) + ', 新: ' + DateTimeToStr(ChangeRecord.NewTime); ctLastModificationTime : Result := s + ' 最后修改时间改变. 旧: ' + DateTimeToStr(ChangeRecord.OldTime) + ', 新: ' + DateTimeToStr(ChangeRecord.NewTime); // ctLastAccessTime : Result := s + ' 最后访问时间改变. 旧: ' + DateTimeToStr(ChangeRecord.OldTime) + ', 新: ' + DateTimeToStr(ChangeRecord.NewTime); // ctLastTime : Result := s + ' 时间改变. 旧: ' + DateTimeToStr(ChangeRecord.OldTime) + ', 新: ' + DateTimeToStr(ChangeRecord.NewTime); ctCreate : Result := s + ' 创建'; ctRemove : Result := s + ' 删除'; end;end;
[解决办法]
DWORD GetModuleFileName( HMODULE hModule, // handle to module to find filename for LPTSTR lpFilename, // pointer to buffer for module path DWORD nSize // size of buffer, in characters );
[解决办法]
创建COM工程：
首先创建ActiveX Library
New-ActiveX页-选择ActiveX Library
再创建一个COMObject：同样
New-ActiveX页-选择COM Object
命名为TCTestSHExecHook,不需要勾选Include TypeLibrary，确定，保存为TestSHExecHookIntf.pas
New-Uint-保存为TestSHExecHookClass.pas
TestSHExecHookClass.pas代码如下：
unit TestSHExecHookClass;interfaceuses Windows,Messages,Classes,Forms,ShellAPI, SysUtils;type TSHExecHookOpraClass = Class Of TTestSHExecHookOpra; TTestSHExecHookOpra = Class(TObject) private protected public constructor Create; destructor Destroy; override; function DllOpenFile(sFileName:string):boolean; published end;implementation{ TTestSHMenuOpra }constructor TTestSHExecHookOpra.Create;beginend;destructor TTestSHExecHookOpra.Destroy;begin inherited;end;function TTestSHExecHookOpra.DllOpenFile( sFileName: string): boolean;begin //这里的sFileName就是打开的文件名; Result := Messagebox(0, PChar('是否允许打开：'+sFileName), '',MB_YESNO)=idYes;end;end.
[解决办法]
这是通过api hook来监视进程创建的代码，我钩的是CreateProcessInternalW,钩ShellExecuteExW不行
Detour.pas:
[code=Delphi(Pascal]
unit Detour;
interface
uses Windows,ShellApi,SysUtils;
type PtrArray=array[0..255]of Pointer;
PDETOUR_RECORD=^DETOUR_RECORD;
DETOUR_RECORD=record
CallbackFunction:Pointer;
ProcessHandle:THANDLE;
CodeBase:Pointer;
TargetFunction:Pointer;
ParameterCount:Cardinal;
LocalPipeHandle:THANDLE;
RemotePipeHandle:THANDLE;
LocalEventHandle:THANDLE;
RemoteEventHandle:THANDLE;
OriginalData:array[0..7]of Byte;
end;
MONTORCALLBACK=procedure(var DetourRec:DETOUR_RECORD;Parameters:PPointer);
function GetShellWindow:HWND;stdcall;external'user32.dll';
procedure PatchProcedure(ProcessHandle:THANDLE;TargetFunction:Pointer;ParameterCount:Cardinal;var DetourRec:DETOUR_RECORD);
procedure StartCallWatch(var DetourRec:DETOUR_RECORD;CallbackFunction:Pointer);
procedure StopCallWatch(var DetourRec:DETOUR_RECORD);
procedure RemovePatch(var DetourRec:DETOUR_RECORD);
implementation
procedure msgbox(a:LongBool);overload;
begin
MessageBox(0,PWideCHar(IntToStr(Cardinal(a))),nil,0);
end;
procedure msgbox(a:Cardinal);overload;
begin
MessageBox(0,PWideCHar(IntToStr(Cardinal(a))),nil,0);
end;
procedure msgbox(a:pointer);overload;
begin
MessageBox(0,PWideCHar(IntToHex(Cardinal(a),8)),nil,0);
end;
procedure PatchProcedure(ProcessHandle:THANDLE;TargetFunction:Pointer;ParameterCount:Cardinal;var DetourRec:DETOUR_RECORD);
label CallbackStart,Original,Goback,Length,PipeHandle,EventHandle,CallWriteOffset,CallWaitOffset;
var Callback:Pointer;ToOriginal,ToGoback,ToLength,ToPipeHandle,ToEventHandle,ToCallWriteOffset,ToCallWaitOffset,CodeLength,ParameterSize,ReturnLength,kernel32:Cardinal;CodeBase,pWriteFile,pWaitForSingleObject:Pointer;
PatchData:packed record Opcode:Byte;Offset:Cardinal;end;//r:LongBool;
begin
asm
mov ecx,offset CallbackStart
mov Callback,ecx
mov eax,offset Original
sub eax,ecx
mov ToOriginal,eax
mov eax,offset Goback
sub eax,ecx
mov ToGoback,eax
add eax,5
mov CodeLength,eax
mov eax,offset Length
sub eax,ecx
mov ToLength,eax
mov eax,offset PipeHandle
sub eax,ecx
mov ToPipeHandle,eax
mov eax,offset EventHandle
sub eax,ecx
mov ToEventHandle,eax
mov eax,offset CallWriteOffset
sub eax,ecx
mov ToCallWriteOffset,eax
mov eax,offset CallWaitOffset
sub eax,ecx
mov ToCallWaitOffset,eax
end;
ParameterSize:=ParameterCount*SizeOf(Pointer);
DetourRec.LocalEventHandle:=CreateEvent(nil,False,False,nil);
DuplicateHandle(Cardinal(-1),DetourRec.LocalEventHandle,ProcessHandle,@DetourRec.RemoteEventHandle,0,False,2);
CreatePipe(DetourRec.LocalPipeHandle,DetourRec.RemotePipeHandle,nil,ParameterSize);
DuplicateHandle(Cardinal(-1),DetourRec.RemotePipeHandle,ProcessHandle,@DetourRec.RemotePipeHandle,0,False,3);
kernel32:=GetModuleHandleW('kernel32.dll');
pWriteFile:=GetProcAddress(kernel32,PAnsiChar('WriteFile'));
pWaitForSingleObject:=GetProcAddress(kernel32,PAnsiChar('WaitForSingleObject'));
CodeBase:=VirtualAllocEx(ProcessHandle,nil,CodeLength,MEM_RESERVE or MEM_COMMIT,PAGE_EXECUTE_READWRITE);
DetourRec.ProcessHandle:=ProcessHandle;
DetourRec.CodeBase:=CodeBase;
DetourRec.TargetFunction:=TargetFunction;
DetourRec.ParameterCount:=ParameterCount;
ReadProcessMemory(ProcessHandle,TargetFunction,@DetourRec.OriginalData,8,ReturnLength);
WriteProcessMemory(ProcessHandle,CodeBase,Callback,CodeLength,ReturnLength);
WriteProcessMemory(ProcessHandle,Pointer(Cardinal(CodeBase)+ToLength),@ParameterSize,4,ReturnLength);
WriteProcessMemory(ProcessHandle,Pointer(Cardinal(CodeBase)+ToPipeHandle),@DetourRec.RemotePipeHandle,4,ReturnLength);
PatchData.Offset:=Cardinal(pWriteFile)-Cardinal(CodeBase)-ToCallWriteOffset-4;
WriteProcessMemory(ProcessHandle,Pointer(Cardinal(CodeBase)+ToCallWriteOffset),@PatchData.Offset,4,ReturnLength);
WriteProcessMemory(ProcessHandle,Pointer(Cardinal(CodeBase)+ToEventHandle),@DetourRec.RemoteEventHandle,4,ReturnLength);
PatchData.Offset:=Cardinal(pWaitForSingleObject)-Cardinal(CodeBase)-ToCallWaitOffset-4;
WriteProcessMemory(ProcessHandle,Pointer(Cardinal(CodeBase)+ToCallWaitOffset),@PatchData.Offset,4,ReturnLength);
WriteProcessMemory(ProcessHandle,Pointer(Cardinal(CodeBase)+ToOriginal),@DetourRec.OriginalData,5,ReturnLength);
PatchData.Offset:=Cardinal(TargetFunction)-Cardinal(CodeBase)-ToGoback;
WriteProcessMemory(ProcessHandle,Pointer(Cardinal(CodeBase)+ToGoback+1),@PatchData.Offset,4,ReturnLength);
PatchData.Opcode:=$e9;
PatchData.Offset:=Cardinal(CodeBase)-Cardinal(TargetFunction)-5;
WriteProcessMemory(ProcessHandle,TargetFunction,@PatchData,5,ReturnLength);
exit;
asm
CallbackStart:
push eax
mov eax,esp
push 0
push eax
db $68
Length:
dd 0
add eax,8
push eax
db $68
PipeHandle:
dd 0
db $e8
CallWriteOffset:
dd 0
pop eax
push $FFFFFFFF
db $68
EventHandle:
dd 0
db $e8
CallWaitOffset:
dd 0
Original:
mov edi,edi
push ebp
mov ebp,esp
Goback:
db $e9,0
end;
end;
function MonitorThreadProc(DetourRec:PDETOUR_RECORD):Cardinal;stdcall;
var Paramaters:PPointer;n:Cardinal;
begin
Paramaters:=PPointer(Cardinal(DetourRec)+SizeOf(DETOUR_RECORD));
while ReadFile(DetourRec.LocalPipeHandle,Paramaters^,SizeOf(Pointer)*DetourRec.ParameterCount,n,nil) do
begin
if n=1 then break;
MONTORCALLBACK(DetourRec.CallbackFunction)(DetourRec^,Paramaters);
SetEvent(DetourRec.LocalEventHandle);
end;
HeapFree(GetProcessHeap,0,DetourRec);
Result:=0;
end;
procedure StartCallWatch(var DetourRec:DETOUR_RECORD;CallbackFunction:Pointer);
var Tid:Cardinal;NewDetourRec:PDETOUR_RECORD;
begin
NewDetourRec:=HeapAlloc(GetProcessHeap,0,SizeOf(DETOUR_RECORD)+SizeOf(Pointer)*DetourRec.ParameterCount);
DetourRec.CallbackFunction:=CallbackFunction;
NewDetourRec^:=DetourRec;
CloseHandle(CreateRemoteThread(Cardinal(-1),nil,0,@MonitorThreadProc,NewDetourRec,0,Tid));
end;
procedure StopCallWatch(var DetourRec:DETOUR_RECORD);
var PipeHandle,ReturnLength:Cardinal;
begin
DuplicateHandle(DetourRec.ProcessHandle,DetourRec.RemotePipeHandle,Cardinal(-1),@PipeHandle,0,False,2);
WriteFile(PipeHandle,PipeHandle,1,ReturnLength,nil);
CloseHandle(PipeHandle);
end;
procedure RemovePatch(var DetourRec:DETOUR_RECORD);
var ReturnLength:Cardinal;
begin
StopCallWatch(DetourRec);
DuplicateHandle(DetourRec.ProcessHandle,DetourRec.RemotePipeHandle,0,nil,0,False,1);
DuplicateHandle(DetourRec.ProcessHandle,DetourRec.RemoteEventHandle,0,nil,0,False,1);
WriteProcessMemory(DetourRec.ProcessHandle,DetourRec.TargetFunction,@DetourRec.OriginalData,5,ReturnLength);
VirtualFreeEx(DetourRec.ProcessHandle,DetourRec.CodeBase,0,MEM_RELEASE);
CloseHandle(DetourRec.LocalPipeHandle);
CloseHandle(DetourRec.LocalEventHandle);
end;
end.
[/code]
Unit1.pas:
[code=Delphi(Pascal]
unit Unit1;
interface
uses
Windows, shellapi,Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
PProcessWindow = ^TProcessWindow;
TProcessWindow = record
TargetProcessID: Cardinal;
FoundWindow: hWnd;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses KeySec, Detour;
{$R *.dfm}
var rec:DETOUR_RECORD;
procedure sss(var DetourRec:DETOUR_RECORD;Paramaters:PtrArray);
var CmdLine:array[0..255]of WideChar;n:Cardinal;
begin
ReadProcessMemory(DetourRec.ProcessHandle,Paramaters[2],@CmdLine,512,n);
Form1.Memo1.Lines.Add(CmdLine);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
StartCallWatch(rec,@sss);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StopCallWatch(rec);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
RemovePatch(rec);
end;
procedure TForm1.FormCreate(Sender: TObject);
var hp,pid:Cardinal;
begin
GetWindowThreadProcessId(GetShellWindow,pid);
hp:=OpenProcess(PROCESS_ALL_ACCESS,False,pid);
PatchProcedure(hp,GetProcAddress(GetModuleHandleW('kernel32.dll'),PAnsiChar('CreateProcessInternalW')),3,rec);
end;
end.
[/code]
构建环境是delphi xe
你可以从获得的命令行中得到文件名
[解决办法]
写好了，你参考一下。
unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DDEMan;type TForm1 = class(TForm) Memo1: TMemo; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FWindowHandle: HWND; Procedure WndProc2(Var Msg: TMessage); public Procedure GetWordFileName(Var Msg: TMessage); end;Function RegisterShellHookWindow(HWND: LongWord): Integer; stdcall; external 'User32.dll';Function StrCmpIW(w1,w2:LPWSTR): Integer; stdcall; external 'Shlwapi.dll';var Form1: TForm1; Msg_ID: Cardinal; cDDE: TDDEClientConv;implementation{$R *.dfm}Procedure TForm1.WndProc2(Var Msg: TMessage);var wcName: string; buf: array [0..MAX_PATH] Of WideChar;Begin If Msg.Msg = Msg_ID then begin GetClassNameW(Msg.LParam,@buf,MAX_PATH); if StrCmpIW('OpusApp',@buf) = 0 then GetWordFileName(Msg); end else Msg.result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.WParam, Msg.lParam);End;procedure TForm1.FormCreate(Sender: TObject);begin FWindowHandle := AllocateHWnd(WndProc2); Msg_ID := RegisterWindowMessage('SHELLHOOK'); RegisterShellHookWindow(FWindowHandle); cDDE := TDDEClientConv.Create(nil);end;procedure TForm1.FormDestroy(Sender: TObject);begin DeallocateHWnd(FWindowHandle); cDDE.Free;end;Procedure TForm1.GetWordFileName(Var Msg: TMessage);var fList: TStringList;begin case Msg.WParam of HSHELL_WINDOWCREATED: if cDDE.SetLink('WinWord','System') then begin fList := TStringList.Create; fList.StrictDelimiter := True; fList.Delimiter := #9; while fList.Count < 3 do fList.DelimitedText := cDDE.RequestData('Topics'); Memo1.Lines.Add(fList[1]); cDDE.CloseLink; fList.Free; end; end;end;end.