给一个例子研究（完整源码）：
unit CSystemSpy
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,shlobj,Activex
const
SHCNE_RENAMEITEM = $1
SHCNE_CREATE = $2
SHCNE_DELETE = $4
SHCNE_MKDIR = $8
SHCNE_RMDIR = $10
SHCNE_MEDIAINSERTED = $20
SHCNE_MEDIAREMOVED = $40
SHCNE_DRIVEREMOVED = $80
SHCNE_DRIVEADD = $100
SHCNE_NETSHARE = $200
SHCNE_NETUNSHARE = $400
SHCNE_ATTRIBUTES = $800
SHCNE_UPDATEDIR = $1000
SHCNE_UPDATEITEM = $2000
SHCNE_SERVERDISCONNECT = $4000
SHCNE_UPDATEIMAGE = $8000
SHCNE_DRIVEADDGUI = $10000
SHCNE_RENAMEFOLDER = $20000
SHCNE_FREESPACE = $40000
SHCNE_ASSOCCHANGED = $8000000
SHCNE_DISKEVENTS = $2381F
SHCNE_GLOBALEVENTS = $C0581E0
SHCNE_ALLEVENTS = $7FFFFFFF
SHCNE_INTERRUPT = $80000000
SHCNF_IDLIST = 0
// LPITEMIDLIST
SHCNF_PATHA = $1
// path name
SHCNF_PRINTERA = $2
// printer friendly name
SHCNF_DWORD = $3
// DWORD
SHCNF_PATHW = $5
// path name
SHCNF_PRINTERW = $6
// printer friendly name
SHCNF_TYPE = $FF
SHCNF_FLUSH = $1000
SHCNF_FLUSHNOWAIT = $2000
SHCNF_PATH = SHCNF_PATHW
SHCNF_PRINTER = SHCNF_PRINTERW
WM_SHNOTIFY = $401
NOERROR = 0
type
TForm1 = class(TForm)
Button1: TButton
Memo1: TMemo
procedure FormClose(Sender: TObject var Action: TCloseAction)
procedure Button1Click(Sender: TObject)
procedure FormCreate(Sender: TObject)
private
{ Private declarations }
procedure WMShellReg(var Message:TMessage)message WM_SHNOTIFY
public
{ Public declarations }
end
type PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT
SHNOTIFYSTRUCT = record
dwItem1 : PItemIDList
dwItem2 : PItemIDList
end
Type PSHFileInfoByte=^SHFileInfoByte
_SHFileInfoByte = record
hIcon :Integer
iIcon :Integer
dwAttributes : Integer
szDisplayName : array [0..259] of char
szTypeName : array [0..79] of char
end
SHFileInfoByte=_SHFileInfoByte
Type PIDLSTRUCT = ^IDLSTRUCT
_IDLSTRUCT = record
pidl : PItemIDList
bWatchSubFolders : Integer
end
IDLSTRUCT =_IDLSTRUCT
function SHNotify_Register(hWnd : Integer) : Bool
function SHNotify_UnRegister:Bool
function SHEventName(strPath1,strPath2:stringlParam:Integer):string
function SHChangeNotifyDeregister(hNotify:integer):integerstdcall
external 'Shell32.dll' index 4
function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord
lpps :PIDLSTRUCT)
:integer
stdcallexternal 'Shell32.dll' index 2
function SHGetFileInfoPidl(pidl : PItemIDList
dwFileAttributes : Integer
psfib : PSHFILEINFOBYTE
cbFileInfo : Integer
uFlags : Integer
) : Integer
stdcallexternal 'Shell32.dll' name 'SHGetFileInfoA'
var
Form1: TForm1
m_hSHNotify:Integer
m_pidlDesktop : PItemIDList
implementation
{$R *.DFM}
function SHEventName(strPath1,strPath2:stringlParam:Integer):string
var
sEvent:String
begin
case lParam of //根据参数设置提示消息
SHCNE_RENAMEITEM: sEvent := '重命名文件'+strPath1+'为'+strpath2
SHCNE_CREATE: sEvent := '建立文件 文件名：'+strPath1
SHCNE_DELETE: sEvent := '删除文件 文件名：'+strPath1
SHCNE_MKDIR: sEvent := '新建目录 目录名：'+strPath1
SHCNE_RMDIR: sEvent := '删除目录 目录名：'+strPath1
SHCNE_MEDIAINSERTED: sEvent := strPath1+'中插入可移动存储介质'
SHCNE_MEDIAREMOVED: sEvent := strPath1+'中移去可移动存储介质'+strPath1+' '+strpath2
SHCNE_DRIVEREMOVED: sEvent := '移去驱动器'+strPath1
SHCNE_DRIVEADD: sEvent := '添加驱动器'+strPath1
SHCNE_NETSHARE: sEvent := '改变目录'+strPath1+'的共享属性'
SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性 文件名'+strPath1
SHCNE_UPDATEDIR: sEvent := '更新目录'+strPath1
SHCNE_UPDATEITEM: sEvent := '更新文件 文件名：'+strPath1
SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接'+strPath1+' '+strpath2
SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE'
SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI'
SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹'+strPath1+'为'+strpath2
SHCNE_FREESPACE: sEvent := '磁盘空间大小改变'
SHCNE_ASSOCCHANGED: sEvent := '改变文件关联'
else
sEvent:='未知 *** 作'+IntToStr(lParam)
end
Result:=sEvent
end
function SHNotify_Register(hWnd : Integer) : Bool
var
ps:PIDLSTRUCT
begin
{$R-}
Result:=False
GetMem(ps,SizeOf(ps))
If m_hSHNotify = 0 then begin
//获取桌面文件夹的Pidl
if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,
m_pidlDesktop)<> NOERROR then Form1.close
if Boolean(m_pidlDesktop) then begin
ps.bWatchSubFolders:=1
ps.pidl := m_pidlDesktop
// 利用SHChangeNotifyRegister函数注册系统消息处理
m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE Or SHCNF_IDLIST),
(SHCNE_ALLEVENTS Or SHCNE_INTERRUPT),WM_SHNOTIFY, 1, ps)
Result := Boolean(m_hSHNotify)
end
Else
// 如果出现错误就使用 CoTaskMemFree函数来释放句柄
CoTaskMemFree(m_pidlDesktop)
FreeMem(ps)
End
{$R+}
end
function SHNotify_UnRegister:Bool
begin
Result:=False
If Boolean(m_hSHNotify) Then
//取消系统消息监视，同时释放桌面的Pidl
If Boolean(SHChangeNotifyDeregister(m_hSHNotify)) Then begin
{$R-}
m_hSHNotify := 0
CoTaskMemFree(m_pidlDesktop)
Result := True
{$R-}
End
end
procedure TForm1.WMShellReg(var Message:TMessage) //系统消息处理函数
Var
strPath1,strPath2:String
charPath:array[0..259]of char
pidlItem:PSHNOTIFYSTRUCT
begin
pidlItem:=PSHNOTIFYSTRUCT(Message.wParam)
//获得系统消息相关得路径
SHGetPathFromIDList(pidlItem.dwItem1,charPath)
strPath1:=charPath
SHGetPathFromIDList(pidlItem.dwItem2,charPath)
strPath2:=charPath
if StrPath1<>'' then
Memo1.Lines.Add(SHEvEntName(strPath1,strPath2,Message.lParam))
end
procedure TForm1.FormClose(Sender: TObject var Action: TCloseAction)
begin
//在程序退出的同时删除监视
if Boolean(m_pidlDesktop) then SHNotify_Unregister
end
procedure TForm1.Button1Click(Sender: TObject) //Button1的Click消息
begin
m_hSHNotify:=0
if SHNotify_Register(Form1.Handle) then begin //注册Shell监视
ShowMessage('Shell监视程序成功注册')
Button1.Enabled := False
end else ShowMessage('Shell监视程序注册失败')
end
procedure TForm1.FormCreate(Sender: TObject)
begin
Button1.Caption := '打开监视'
end
end.
效果图：
方法有很多种，这里做个小结吧。一、 简洁的方法
先通过Windows为相应的程序创建一个快捷方式，再将系统自动生成的快捷方式名修改一下，也就是把快捷方式名中的空格删除。然后可以建立一个批处理文件，使用move命令或copy命令即可完成。比如需要为C盘tv目录下的vnc.exe在桌面是创建快捷方式，可先通过Windows系统为该程序创建一个快捷方式vnc.lnk，然后建立个bat文件，在文件中编写如下命令：
cd %userprofile%\桌面
copy c:\tv\vnc.lnk
或者输入以下命令：
cd %userprofile%\桌面
move c:\tv\vnc.lnk
二、稍微复杂点的办法
直接建立一个批处理文件，在其中输入以下命令(依然以“为C盘tv目录下的vnc.exe在桌面是创建快捷方式”为例)：
set path=c:\tv\vnc.exe
set topath="%USERPROFILE%\桌面\VNC.url"
echo [InternetShortcut] >>%topath%
echo URL="%path%" >>%topath%
echo IconIndex=0 >>%topath%
echo IconFile=%path% >>%topath%
三、编写一个程序，通过API函数为相应的程序创建快捷方式
通过Shell编程达到目的，但是这种方法在XP中不太实用，因为不容易得到不同用户的桌面目录。下面是MFC代码：
HRESULT CttDlg::CreateShortcut(LPCSTR pszPathObj, LPSTR pszParam, LPSTR pszPath, LPSTR pszPathLink,LPSTR pszDesc)
{
HRESULT hres
IShellLink * psl
IPersistFile* ppf
WORD wsz[ 100]
CoInitialize(NULL)
hres = (HRESULT)CoCreateInstance( CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, IID_IShellLink,(void **) &psl)
if( FAILED( res))
{
CoUninitialize()
return FALSE
}
// set the path to the shortcut target, and add the description
psl->SetPath(pszPathObj)
psl->SetArguments(pszParam)
psl->SetDescription(pszDesc)
psl->SetWorkingDirectory(pszPath)
// query IShellLink for the IPersistFile interface for saving the shortcut in persistent storage
hres = (HRESULT)(psl ->QueryInterface( IID_IPersistFile, (void **)&ppf))
if( FAILED( hres))
{
CoUninitialize()
return FALSE
}
// ensure that that string is ANSI
MultiByteToWideChar( CP_ACP, 0, pszPathLink, -1, (LPWSTR)wsz, 100)
// save the link by calling IPersistFile::Save
hres = ppf->Save((LPCOLESTR)wsz, STGM_READWRITE)
// release the IPersistFile interface
ppf ->Release()
// release the IShellLink interface
psl ->Release()
CoUninitialize()
return hres
}
为了通知系统桌面发生变化，需要再定义如下函数：
void CttDlg::NotifyShell(LONG wEventId, LPSTR szPath)
{
SHChangeNotify(wEventId,SHCNF_FLUSH | SHCNF_PATH,szPath,0)
SHChangeNotify(SHCNE_UPDATEDIR | SHCNE_INTERRUPT,SHCNF_FLUSH | SHCNF_PATH,szPath,0)
}
然后就可以通过如下代码进行调用了：
CreateShortcut("c:\\windows\\notepad.exe","c:\\config.sys","c:\\windows","C:\\Documents and Settings\\Xu YingMing\\桌面记事本.lnk","记事本")
NotifyShell(SHCNE_MKDIR | SHCNE_INTERRUPT,"c:\\windows\\notepad.exe")
以上三种方法皆可实现目的，但是前两种相对简单，而第三种方法就要复杂的多
（转自别人的）分为两步，第一步让explorer从注册表重新读取信息，第二步刷新桌面，代码如下
void CRefreshExplorerDlg::OnRefreshExplorer()
{
::SHChangeNotify( SHCNE_ASSOCCHANGED , SHCNF_IDLIST ¦ SHCNF_FLUSH, 0, 0)
HWND hWndProgram = ::FindWindow( _T("Progman"), NULL)
HWND hWndDefView = ::FindWindowEx( hWndProgram, NULL, _T("SHELLDLL_DefView"), NULL)
HWND hWndListView= ::FindWindowEx( hWndDefView, NULL, _T("SysListView32"),NULL)
::PostMessage( hWndListView, WM_KEYDOWN, VK_F5, 0)
::PostMessage( hWndListView, WM_KEYUP,VK_F5, 0)
}
需要shlobj.h头文件
在project menu > options > directories/conditionals里的conditionals中加入NO_WIN32_LEAN_AND_MEAN 即可。
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）