ftp递归上传多个文件:桌面右键菜单
来源:百度文库 编辑:中财网 时间:2024/09/21 09:23:11
你要的是桌面右键菜单的吧?那得用到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.
第一个: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.
关于桌面右键菜单
清理桌面右键菜单
修改桌面右键菜单
桌面右键菜单设置?
桌面右键菜单问题
桌面右键菜单怎么设置??
注册表自定义桌面右键菜单
win98桌面右击弹不出右键菜单
桌面右键菜单--新建弹出菜单 丢失
请问如何修改桌面右键菜单?
桌面右键菜单弹出速度太慢
桌面右键菜单弹出很慢为什么
桌面点击右键出来的菜单太长
在桌面右键弹出菜单慢
鼠标右键菜单在桌面无法弹出!
如何除去桌面右键菜单中的JUJUMAO?
桌面鼠标右键菜单消失了,怎么办?
如何在桌面右键菜单添加选项?
如何添加桌面鼠标右键菜单
如何添加桌面鼠标右键菜单
如何清除桌面右键多余菜单??
如何屏蔽桌面右键的显卡菜单
没法子在桌面打开右键菜单怎么办
在桌面右键属性不弹出菜单