怎样创建文件的快捷方式?(50分)

  • 主题发起人 主题发起人 stanely
  • 开始时间 开始时间
S

stanely

Unregistered / Unconfirmed
GUEST, unregistred user!
我用过以下代码,但是创建出来的文件名称是乱码,甚至连扩展名都没有。

///////////////

function CreateShortCut(Location:string;//*.lnk
TargetFile:string;
Description:string='';
StartupDir:string='';
IconFile:string='';
IconIndex:integer=0;
Arguments:string='';
HotKey:word=0;
WindowState:integer=0):boolean;
var
anobj:IUnknown;
shlink:IShellLink;
pFile:IPersistFile;

begin
if fileexists(targetfile) then
begin
filesetattr(targetfile,32);
deletefile(pchar(targetfile));
end;
if description='' then description:=extractfilename(targetfile);
if iconfile='' then iconfile:=targetfile;
if startupdir='' then startupdir:=extractfiledir(targetfile);
anobj:=CreateComObject(CLSID_SHELLLINK);
shlink:=anobj as IShellLink;
pFile:=anobj as IPersistFile;
shlink.SetPath(pchar(targetfile));
shlink.SetWorkingDirectory(pchar(startupdir));
shlink.SetDescription(pchar(Description));
shlink.SetArguments(pchar(Arguments));
shlink.SetIconLocation(pchar(Iconfile),IconIndex);
//shlink.SetIDList(0);
shlink.SetHotkey(HotKey);
shlink.SetShowCmd(windowState);
//shlink.SetRelativePath(pchar(targetfile),0);

//if location<>'' then
result:=succeeded( pFile.Save(pwchar(location),false));


end;
///////////////////////

谢谢!
 
宁无人乎??
 
result:=succeeded( pFile.Save(pwchar(location),false));
^^^^^^
应该是:
PWideChar(location)
你怎么编译通过的?
 
直接用pwidechar来转换好像不行的,你参考一下这个贴子
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1170140
 
编译确实通过了d6
 
uses Registry,ShlObj,ActiveX,ComObj;

//定义快捷方式存放位置桌面,发送,开始菜单
type
ShortcutType=(_DESKTOP,_QUICKLAUNCH,_SENDTO,_STARTMENU);

procedure CreateShortcut(
FileName: string;//执行文件名,全路径
description: string;/快捷方式描述
arguments: string;//参数
Location: ShortcutType //存放位置
);
var
MyObject:IUnknown;
MySLink:IShellLink;
MyPFile:IPersistFile;
Directory,LinkName:string;
WFileName:WideString;
MyReg,
QuickLaunchReg:TRegIniFile;
begin
MyObject:=CreateComObject(CLSID_ShellLink);//创建com对象
MySLink:=MyObject as IShellLink;//转化为IShellLink接口
MyPFile:=MyObject as IPersistFile;//转化为IPersistFile接口
MySLink.SetPath(PChar(FileName));//设置执行文件名
MySLink.SetArguments(PChar(arguments));//设置执行参数
MySLink.SetDescription(PChar(Description));//设置描述
MySLink.SetWorkingDirectory(PChar(ExtractFilePath(application.exename)));//设置工作路径为执行程序所在目录
//取存放位置的实际目录
MyReg:=TRegIniFile.Create('Software/MicroSoft/Windows/CurrentVersion/Explorer');
try
LinkName:=ChangeFileExt(FileName,'.lnk');//生成快捷方式文件名
LinkName:=ExtractFileName(LinkName);//取文件主名
Case Location of
_DESKTOP :Directory:=MyReg.ReadString('Shell Folders','Desktop','');
_STARTMENU :Directory:=MyReg.ReadString('Shell Folders','Start Menu','');
_SENDTO :Directory:=MyReg.ReadString('Shell Folders','SendTo','');
_QUICKLAUNCH:
begin
QuickLaunchReg:=TRegIniFile.Create('Software/MicroSoft/Windows/CurrentVersion/GrpConv');
try
Directory:=QuickLaunchReg.ReadString('MapGroups','Quick Launch','');
finally
QuickLaunchReg.Free;
end;
end;
end;
if Directory<>'' then begin
WFileName:=Directory+'/'+LinkName;//合成存放快捷方式文件全路径名
MyPFile.Save(PWChar(WFileName),False);//保存快捷文件
end;
finally
MyReg.Free;
end;
end;
如果要删除快捷方式,则将.LNK文件删除即可.
 
unit ShCutF;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
EditName: TEdit;
Label1: TLabel;
Button2: TButton;
GroupBox1: TGroupBox;
cbDir: TCheckBox;
cbDesktop: TCheckBox;
cbStartMenu: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses
ComObj, ActiveX, ShlObj, Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
AnObj: IUnknown;
ShLink: IShellLink;
PFile: IPersistFile;
FileName: string;
WFileName: WideString;
Reg: TRegIniFile;
begin
的两个接口
AnObj := CreateComObject (CLSID_ShellLink);
ShLink := AnObj as IShellLink;
PFile := AnObj as IPersistFile;
FileName := ParamStr (0);

ShLink.SetPath (PChar (FileName));
ShLink.SetWorkingDirectory (PChar (
ExtractFilePath (FileName)));

//将文件保存在当前目录里
if cbDir.Checked then
begin
WFileName := ExtractFilePath (FileName) +
EditName.Text + '.lnk';
PFile.Save (PWChar (WFileName), False);
end;

// 保存在桌面
if cbDesktop.Checked then
begin
Reg := TRegIniFile.Create(
'Software/MicroSoft/Windows/CurrentVersion/Explorer');
WFileName := Reg.ReadString ('Shell Folders', 'Desktop', '') +
'/' + EditName.Text + '.lnk';
Reg.Free;
PFile.Save (PWChar (WFileName), False);
end;

// 保存在开始菜单里
if cbStartMenu.Checked then
begin
Reg := TRegIniFile.Create(
'Software/MicroSoft/Windows/CurrentVersion/Explorer');
WFileName := Reg.ReadString ('Shell Folders', 'Start Menu', '') +
'/' + EditName.Text + '.lnk';
Reg.Free;
PFile.Save (PWChar (WFileName), False);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
ProjectFile: string;
begin
ProjectFile := ChangeFileExt (ParamStr (0), '.dpr');
SHAddToRecentDocs (SHARD_PATH, PChar(ProjectFile));
end;

end.
 
后退
顶部