刀锋铁骑手机:桌面右键菜单

你要的是桌面右键菜单的吧？那得用到shell编程，找本相关的资料看看，我这儿有一个实现文件管理器上的右键菜单代码，贴给你：
第一个：conextmenu_TLB.pas
unit   contextmenu_TLB;

//   ************************************************************************   //
//   WARNING                                                                                                                                        
//   -------                                                                                                                                        
//   The   types   declared   in   this   file   were   generated   from   data   read   from   a              
//   Type   Library.   If   this   type   library   is   explicitly   or   indirectly   (via                
//   another   type   library   referring   to   this   type   library)   re-imported,   or   the      
//   'Refresh '   command   of   the   Type   Library   Editor   activated   while   editing   the      
//   Type   Library,   the   contents   of   this   file   will   be   regenerated   and   all                
//   manual   modifications   will   be   lost.                                                                                  
//   ************************************************************************   //

//   PASTLWTR   :   $Revision:       1.130     $
//   File   generated   on   2003-5-10   0:29:30   from   Type   Library   described   below.

//   ************************************************************************     //
//   Type   Lib:   F:\TELECOM\ContextMenu\contextmenu.tlb   (1)
//   LIBID:   {5F6B1CC4-1752-491B-A689-5C19331A3364}
//   LCID:   0
//   Helpfile:  
//   DepndLst:  
//       (1)   v2.0   stdole,   (C:\WINDOWS\System32\stdole2.tlb)
//   ************************************************************************   //
{$TYPEDADDRESS   OFF}   //   Unit   must   be   compiled   without   type-checked   pointers.  
{$WARN   SYMBOL_PLATFORM   OFF}
{$WRITEABLECONST   ON}

interface

uses   ActiveX,   Classes,   Graphics,   StdVCL,   Variants,   Windows;
   

//   *********************************************************************//
//   GUIDS   declared   in   the   TypeLibrary.   Following   prefixes   are   used:                
//       Type   Libraries           :   LIBID_xxxx                                                                            
//       CoClasses                     :   CLASS_xxxx                                                                            
//       DISPInterfaces           :   DIID_xxxx                                                                              
//       Non-DISP   interfaces:   IID_xxxx                                                                                
//   *********************************************************************//
const
    //   TypeLibrary   Major   and   minor   versions
    contextmenuMajorVersion   =   1;
    contextmenuMinorVersion   =   0;

    LIBID_contextmenu:   TGUID   =   '{5F6B1CC4-1752-491B-A689-5C19331A3364} ';

implementation
uses   ComObj;
end. 第二个：contextmenuhandle.pas
unit   contextmenuhandle;

interface

uses   Windows,ActiveX,ComObj,ShlObj,Classes;

type
    TContextMenu   =   class(TComObject,IShellExtInit,IContextMenu)
private
    FFileName:   array[0..MAX_PATH]   of   Char;
protected
    function   IShellExtInit.Initialize   =   SEIInitialize;   //   Avoid   compiler   warning
    function   SEIInitialize(pidlFolder:   PItemIDList;   lpdobj:   IDataObject;
                                                    hKeyProgID:   HKEY):   HResult;   stdcall;
    function   QueryContextMenu(Menu:   HMENU;   indexMenu,   idCmdFirst,   idCmdLast,
                                                    uFlags:   UINT):   HResult;   stdcall;
    function   InvokeCommand(var   lpici:   TCMInvokeCommandInfo):   HResult;   stdcall;
    function   GetCommandString(idCmd,   uType:   UINT;   pwReserved:   PUINT;
                                                    pszName:   LPSTR;   cchMax:   UINT):   HResult;   stdcall;
    function   IsValidFileType(FileName:   String):Boolean;
end;

const
    Class_ContextMenu:   TGUID   =   '{19770906-C300-11D1-8233-0020AF3E97A0} ';
    {全局唯一标识符(GUID)是一个16字节（128为）的值，它唯一地标识一个接口(interface)}

var
    FileName:   String;
    FileNumber:   Integer;

implementation

uses   ComServ,   SysUtils,   ShellApi,   Registry,   opwindow;

function   TContextMenu.SEIInitialize(pidlFolder:   PItemIDList;   lpdobj:   IDataObject;
                                                                        hKeyProgID:   HKEY):   HResult;
var
    StgMedium:   TStgMedium;
    FormatEtc:   TFormatEtc;
begin
    //如果lpdobj等于Nil，则本调用失败
    if   (lpdobj   =   nil)   then   begin
        Result   :=   E_INVALIDARG;
        Exit;
    end;
    //首先初始化并清空FileList以添加文件   (duduwolf修改，取消FileList)
    //FileList:=TStringList.Create;
    //FileList.Clear;
    FileName:=   ' ';
    //初始化剪贴版格式文件
    with   FormatEtc   do   begin
        cfFormat   :=   CF_HDROP;
        ptd   :=   nil;
        dwAspect   :=   DVASPECT_CONTENT;
        lindex   :=   -1;
        tymed   :=   TYMED_HGLOBAL;
    end;
    Result   :=   lpdobj.GetData(FormatEtc,   StgMedium);
    if   Failed(Result)   then   Exit;
    //首先查询用户选中的文件的个数
    FileNumber   :=   DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
    //循环读取，将所有用户选中的文件保存到FileList中     (duduwolf修改)
    //如果文件个数大于1就返回
    {for   i:=0   to   FileNumber-1   do   begin
        DragQueryFile(StgMedium.hGlobal,   i,   FFileName,   SizeOf(FFileName));
        FileList.Add(FFileName);
        Result   :=   NOERROR;
    end;}
    if   FileNumber   =   1   then
    begin
        DragQueryFile(StgMedium.hGlobal,   0,   FFileName,   SizeOf(FFileName));
        FileName:=   FFileName;
        Result:=   NOERROR;
    end;
    ReleaseStgMedium(StgMedium);
end;

function   TContextMenu.QueryContextMenu(Menu:   HMENU;   indexMenu,   idCmdFirst,
                                        idCmdLast,   uFlags:   UINT):   HResult;
var
    bmp1:   HBITMAP;
begin
    Result   :=   0;
    if   ((uFlags   and   $0000000F)   =   CMF_NORMAL)   or
    ((uFlags   and   CMF_EXPLORE)   <>   0)   then   begin
        if   (FileNumber   =   1)   and   (IsValidFileType(FileName)   =   true)   then   begin
            InsertMenu(Menu,indexMenu+1,   MF_SEPARATOR   or   MF_BYPOSITION,idCmdLast,nil);
            InsertMenu(Menu,   indexMenu+2,   MF_STRING   or   MF_BYPOSITION,
                            idCmdFirst,PChar( 'Telecom   -   发送报表 '));
            InsertMenu(Menu,indexMenu+3,   MF_SEPARATOR   or   MF_BYPOSITION,idCmdLast,nil);
            //   往Context   Menu中加入一个菜单项   ,菜单项的标题为察看位图文件
            bmp1:=   LoadBitmap(hInstance, 'B1 ');
            SetMenuItemBitmaps(Menu,indexMenu+2,MF_BYPOSITION,bmp1,0);
            //   返回增加菜单项的个数
            Result   :=   3;
        end;
    end;
end;

function   TContextMenu.InvokeCommand(var   lpici:   TCMInvokeCommandInfo):   HResult;
var
    frmOP:TFrmContextMenu;
begin
//   首先确定该过程是被系统而不是被一个程序所调用
    if   (HiWord(Integer(lpici.lpVerb))   <>   0)   then
    begin
        Result   :=   E_FAIL;
        Exit;
    end;
    //   确定传递的参数的有效性
    if   (LoWord(lpici.lpVerb)   <>   0)   then   begin
        Result   :=   E_INVALIDARG;
        Exit;
    end;
    //建立文件操作窗口
    frmOP:=TFrmContextMenu.Create(nil);
    //将所有的文件列表添加到文件操作窗口的列表中
    frmOP.Edit1.Text   :=   FileName;
    frmOP.Show;
    Result   :=   NOERROR;
end;

function   TContextMenu.GetCommandString(idCmd,   uType:   UINT;   pwReserved:   PUINT;
                            pszName:   LPSTR;   cchMax:   UINT):   HRESULT;
begin
    if   (idCmd   =   0)   then   begin
        if   (uType   =   GCS_HELPTEXT)   then
    {返回该菜单项的帮助信息，此帮助信息将在用户把鼠标
    移动到该菜单项时出现在状态条上。}
    StrCopy(pszName,   PChar( 'Telecom商品管理软件报表发送 '));
    Result   :=   NOERROR;
    end
    else
        Result   :=   E_INVALIDARG;
    end;


type
    TContextMenuFactory   =class(TComObjectFactory)

public

procedure   UpdateRegistry(Register:   Boolean);   override;

end;

procedure   TContextMenuFactory.UpdateRegistry(Register:   Boolean);
var
    ClassID:   string;
begin
    if   Register   then   begin
        inherited   UpdateRegistry(Register);
        ClassID   :=   GUIDToString(Class_ContextMenu);
        //当注册扩展库文件时，添加库到注册表中
        CreateRegKey( '*\shellex ',   ' ',   ' ');
        CreateRegKey( '*\shellex\ContextMenuHandlers ',   ' ',   ' ');
        CreateRegKey( '*\shellex\ContextMenuHandlers\FileOpreation ',   ' ',   ClassID);
        //如果操作系统为Windows   NT的话
        if   (Win32Platform   =   VER_PLATFORM_WIN32_NT)   then
            with   TRegistry.Create   do
                try
                    RootKey   :=   HKEY_LOCAL_MACHINE;
                    OpenKey( 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell   Extensions ',   True);
                    OpenKey( 'Approved ',   True);
                    WriteString(ClassID,   'Telecom   Send   Reports   ContextMenu ');
                finally
                    Free;
                end;
            end
        else   begin
            DeleteRegKey( '*\shellex\ContextMenuHandlers\FileOpreation ');
            inherited   UpdateRegistry(Register);
        end;
end;

function   TContextMenu.IsValidFileType(FileName:   String):   Boolean;
begin

    Result:=   false;
    if   FileExists(FileName)   then
    begin
        if   UpperCase(ExtractFileExt(FileName))   =   '.XLS '   then   Result:=   true
        else   if   UpperCase(ExtractFileExt(Filename))   =   '.DOC '   then   Result:=   true
        else   Result:=   false;
    end;
end;

initialization
    TContextMenuFactory.Create(ComServer,   TContextMenu,   Class_ContextMenu, ' ',   'Telecom   Send   Reports   ContextMenu ',   ciMultiInstance,tmApartment);
end.第三个：点击右键显示的窗体部分opwindow.pas
unit   opwindow;

interface  
uses  
    Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,
    ExtCtrls,   StdCtrls,ActiveX,   ComCtrls,   IniFiles,   Registry,   DB,   ADODB,   StrUtils;
type
    TFrmContextMenu   =   class(TForm)
    Button1:   TButton;
    Button2:   TButton;
        PageControl1:   TPageControl;
        TabSheet1:   TTabSheet;
        Label5:   TLabel;
        RichEdit1:   TRichEdit;
        Aqy:   TADOQuery;
        Label3:   TLabel;
        Edit1:   TEdit;
        Label6:   TLabel;
        Label7:   TLabel;
        Edit3:   TEdit;
        Edit4:   TEdit;
        Label4:   TLabel;
        Edit2:   TEdit;
        CheckBox1:   TCheckBox;
        Label1:   TLabel;
        Image1:   TImage;
        procedure   FormCreate(Sender:   TObject);
        procedure   Button1Click(Sender:   TObject);
        procedure   Button2Click(Sender:   TObject);

private
    {   Private   declarations   }
    function   GetListUser(SourceStr:   String):String;
    function   GetFileType(FileName:   String):Integer;
public
    FileList:TStringList;
    {   Public   declarations   }
end;

var
    FrmContextMenu:   TFrmContextMenu;
    sUserName,   sConnectString:   String;

implementation
{$R   *.DFM}

procedure   TFrmContextMenu.FormCreate(Sender:   TObject);
var
    Reg:   TRegistry;
    IpAddress,   sLastUser:   String;
begin
    //从注册表中取出数据库的计算机局域网IP地址

    Reg:=   TRegistry.Create(HKEY_LOCAL_MACHINE);
    Reg.RootKey:=   HKEY_LOCAL_MACHINE;
    if   (Reg.OpenKey( 'SOFTWARE\Telecom ',   False))   then   begin
        sLastUser:=   Reg.ReadString( 'LastUser ');
        IpAddress:=   Reg.ReadString( 'ServerIpAddress ');
        Edit3.Text:=   sLastUser;
    end
    else   begin
        MessageBox(Self.Handle, 'Telecom没有安装或者软件安装有错误，请联系系统管理员！ ', '错误 ',MB_ICONERROR);
        Reg.Free;
        Exit;
    end;
    Reg.Free;
    //初始化数据库连接字符串
    if   Trim(IpAddress)   <>   ' '   then
    begin
        sConnectString:=   'Provider=SQLOLEDB.1;Password=I   am   DuDuWolf@I   Love   JYX   Forever;Persist   Security   Info=True;User   ID=sa;Initial   Catalog=TELECOM; ';
        sConnectString:=   sConnectString   +   'Data   Source= '+Trim(IpAddress);
        Aqy.ConnectionString:=   sConnectString;
    end   else   begin
        MessageBox(Self.Handle, 'Telecom软件安装有错误，请联系系统管理员！ ', '错误 ',MB_ICONERROR);
        Exit;
    end;
    Self.Show;
end;

procedure   TFrmContextMenu.Button1Click(Sender:   TObject);
var
    FileNo,   i:   Integer;
    tb:   TADOTable;
    pField:   TBlobField;
    UserList:   TStringList;
    SendMan:   String;
begin
    //发送报表
    if   Trim(Edit3.Text)   =   ' '   then   begin
        MessageBox(Self.Handle, '用户名不能为空！ ', '错误 ',MB_ICONERROR);
        ExIT;
    end;
    Aqy.Close;
    Aqy.SQL.Clear;
    Aqy.SQL.Add( 'select   *   from   oper   where   操作员工号= ' ' '+Edit3.Text+ ' ' ' ');
    Aqy.SQL.Add( '   and   密码= ' ' '+Edit4.Text+ ' ' ' ');
    Aqy.Open;
    if   Aqy.Eof   then   begin
        MessageBox(Self.Handle, '用户名或者密码输入错误！ ', '错误 ',MB_ICONERROR);
        Exit;
    end   else   begin
        sUserName:=   Edit3.Text;
    end;
    if   Trim(Edit2.Text)   =   ' '   then
    begin
        MessageBox(Self.Handle, '没有输入发送标题，无法发送！ ', '错误 ',MB_ICONERROR);
        Exit;
    end;
    if   not   FileExists(Edit1.Text)   then
    begin
        MessageBox(Self.Handle,PChar( '选择的文件名 ' ' '+Edit2.Text+ ' ' '不存在，请重新选择！ '), '错误 ',MB_ICONERROR);
        Exit;
    end;
    //得到发送人的报表发送权限和接受人列表
    Aqy.Close;
    Aqy.SQL.Clear;
    Aqy.SQL.Add( 'select   SendMan   from   oa_power   where   oper= ' ' '+sUserName+ ' ' '   ');
    Aqy.Open;
    if(Aqy.Eof)   then   begin
        MessageBox(Self.Handle,PChar( '操作员 ' ' '+sUserName+ ' ' '没有发送报表的权限 '), '错误 ',MB_ICONERROR);
        Exit;
    end   else   begin
        UserList:=   TStringList.Create;
        SendMan:=   Aqy.Fields.Fields[0].AsString;
        while   Length(SendMan)> 0   do
        begin
            UserList.Add(Copy(SendMan,2,3));
            Delete(SendMan,1,5);
        end;
    end;

    //得到全文列表中的新的ID标示号
    FileNo:=   0;
    Aqy.Close;
    Aqy.SQL.Clear;
    Aqy.SQL.Add( 'SELECT   MAX(FileID)   FROM   oa_file ');
    Aqy.Open;
    if   not   Aqy.Eof   then
        FileNo:=   Aqy.Fields.Fields[0].AsInteger   +   1;

    //首先插入OA_FILE表
    tb:=   TADOTable.Create(nil);
    tb.ConnectionString   :=   sConnectString;
    tb.TableName   :=   'OA_FILE ';
    tb.Open;
    tb.Insert;
    tb.FieldByName( 'FileID ').AsInteger   :=   FileNo;
    tb.FieldByName( 'FileType ').AsInteger   :=   GetFileType(Edit1.Text);
    tb.FieldByName( 'FileName ').AsString   :=   ExtractFileName(Edit1.Text);
    pField:=   tb.FieldByName( 'FileBuffer ')   as   TBlobField;
    //((TBlobField   )tb.FieldByName( 'FileBuffer ')).LoadFromFile(Edit1.Text);
    pField.LoadFromFile(Edit1.Text);
    tb.Post;
    tb.Free;
    //插入OA_MAIN表
    Aqy.Close;
    Aqy.SQL.Clear;
    for   i:=0   to   UserList.Count   -   1   do
    if   Edit3.Text   <>   GetListUser(UserList.Strings[i])   then
    begin
        Aqy.SQL.Add( 'INSERT   INTO   OA_MAIN(SendMan,RecvMan,FileID,Title, ');
        Aqy.SQL.Add( 'Message,ReadWriteTag,SendTime,Comment)   ');
        Aqy.SQL.Add( 'VALUES( ' ' '+sUserName+ ' ' ', ');
        Aqy.SQL.Add( ' ' ' '+GetListUser(UserList.Strings[i])+ ' ' ', '+IntToStr(FileNo)+ ', ');
        Aqy.SQL.Add( ' ' ' '+Edit2.Text+ ' ' ', ');
        Aqy.SQL.Add( ' ' ' '+AnsiReplaceStr(RichEdit1.Text, ' ' ' ', ' ' ' ')+ ' ' ', ');
        if   CheckBox1.Checked   then
            Aqy.SQL.Add( '0, ')
        else   Aqy.SQL.Add( '1, ');
        Aqy.SQL.Add( ' ' ' '+FormatDateTime( 'yyyy-MM-dd   hh:mm:ss ',Now())+ ' ' ', ' ' ' ')   ');
    end;
    if   Trim(Aqy.SQL.Text)   <>   ' '   then
        Aqy.ExecSQL;
    MessageBox(Self.Handle, '发送成功！ ', '成功 ',MB_ICONINFORMATION);
    Self.Close;
end;

procedure   TFrmContextMenu.Button2Click(Sender:   TObject);
begin
    Self.Close;
end;

function   TFrmContextMenu.GetListUser(SourceStr:   String):   String;
begin
    Result:=   Copy(SourceStr,   Length(SourceStr)-3,   3);
end;

function   TFrmContextMenu.GetFileType(FileName:   String):   Integer;
var
    FileType:   Integer;
begin
    FileType:=   0;
    if   FileExists(FileName)   then
    begin
        if   UpperCase(ExtractFileExt(FileName))   =   '.XLS '   then   FileType   :=   1
        else   if   UpperCase(ExtractFileExt(Filename))   =   '.DOC '   then   FileType   :=   2
        else   if   UpperCase(ExtractFileExt(Filename))   =   '.TXT '   then   FileType   :=   3
        else   FileType   :=   4;
    end;
    Result:=   FileType
end;

end.