急求:如何用PB代码创建快捷方式?

[lxh111222]

就是想用代码创建快捷方式,不想借助其他工具,能实现吗?
可以的话请给出代码~谢谢

[青锋-SS]

可以.

[青锋-SS]

$PBExportHeader$w_createshortcut.srw
forward
global type w_createshortcut from window
end type
type cb_select from commandbutton within w_createshortcut
end type
type st_2 from statictext within w_createshortcut
end type
type sle_destname from singlelineedit within w_createshortcut
end type
type sle_shortcutname from singlelineedit within w_createshortcut
end type
type st_1 from statictext within w_createshortcut
end type
type cb_create from commandbutton within w_createshortcut
end type
end forward

global type w_createshortcut from window
integer width = 1577
integer height = 704
boolean titlebar = true
boolean controlmenu = true
windowtype windowtype = response!
long backcolor = 67108864
string icon = "AppIcon!"
boolean clientedge = true
boolean center = true
cb_select cb_select
st_2 st_2
sle_destname sle_destname
sle_shortcutname sle_shortcutname
st_1 st_1
cb_create cb_create
end type
global w_createshortcut w_createshortcut

type variables
string is_filename

end variables

forward prototypes
public function integer f_center ()
end prototypes

public function integer f_center ();//*-----------------------------------------------------------------*/
//* f_Center: Center the window
//*-----------------------------------------------------------------*/
int li_screenheight, li_screenwidth, li_rc, li_x=1, li_y=1
environment lenv_obj

/* Check for a window association with this object */
If IsNull ( this ) Or Not IsValid ( this ) Then Return -1

/* Get environment */
If GetEnvironment ( lenv_obj ) = -1 Then Return -1

/* Determine current screen resolution and validate */
li_screenheight = PixelsToUnits ( lenv_obj.ScreenHeight, YPixelsToUnits! )
li_screenwidth = PixelsToUnits ( lenv_obj.ScreenWidth, XPixelsToUnits! )
If Not ( li_screenheight > 0 ) Or Not ( li_screenwidth > 0 ) Then Return -1

/* Get center points */
If li_screenwidth > this.Width Then
li_x = ( li_screenwidth / 2 ) - ( this.Width / 2 )
End If
If li_screenheight > this.Height Then
li_y = ( li_screenheight / 2 ) - ( this.Height / 2 )
End If

/* Center window */
li_rc = this.Move ( li_x, li_y )
If li_rc <> 1 Then Return -1

Return 1
end function

on w_createshortcut.create
this.cb_select=create cb_select
this.st_2=create st_2
this.sle_destname=create sle_destname
this.sle_shortcutname=create sle_shortcutname
this.st_1=create st_1
this.cb_create=create cb_create
this.Control[]={this.cb_select,&
this.st_2,&
this.sle_destname,&
this.sle_shortcutname,&
this.st_1,&
this.cb_create}
end on

on w_createshortcut.destroy
destroy(this.cb_select)
destroy(this.st_2)
destroy(this.sle_destname)
destroy(this.sle_shortcutname)
destroy(this.st_1)
destroy(this.cb_create)
end on

type cb_select from commandbutton within w_createshortcut
integer x = 1248
integer y = 228
integer width = 128
integer height = 104
integer taborder = 20
integer textsize = -12
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "..."
end type

event clicked;string ls_title="选择配置文件",ls_pathname="C:\",ls_filename,ls_extension="exe",ls_filter="可执行程序(*.exe),*.exe,可执行程序(*.com),*.com,批处理程序(*.bat),*.bat,所有文件(*.*),*.*",ls_curdir
long ll_rtn

is_filename = ""
ls_curdir = GetCurrentDirectory()
ll_rtn = GetFileOpenName(ls_title,ls_pathname,ls_filename,ls_extension,ls_filter)
Choose Case ll_rtn
Case 1 //执行成功
sle_destname.text = ls_pathname
is_filename = ls_pathname
Case 0 //用户取消
sle_destname.text = ""
MessageBox("提示信息","您取消了操作!",Exclamation!)
return
Case - 1 //执行出错
sle_destname.text = "执行时出错!"
MessageBox("提示信息","获取文件信息时出错!",StopSign!)
return
End Choose
ChangeDirectory(ls_curdir)

end event

type st_2 from statictext within w_createshortcut
integer x = 87
integer y = 240
integer width = 494
integer height = 72
integer textsize = -12
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = variable!
string facename = "宋体"
long textcolor = 33554432
long backcolor = 67108864
string text = "目标文件名称:"
boolean focusrectangle = false
end type

type sle_destname from singlelineedit within w_createshortcut
integer x = 581
integer y = 228
integer width = 649
integer height = 104
integer taborder = 20
integer textsize = -12
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = variable!
string facename = "宋体"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
end type

type sle_shortcutname from singlelineedit within w_createshortcut
integer x = 581
integer y = 108
integer width = 795
integer height = 104
integer taborder = 10
integer textsize = -12
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = variable!
string facename = "宋体"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
end type

type st_1 from statictext within w_createshortcut
integer x = 87
integer y = 124
integer width = 494
integer height = 72
integer textsize = -12
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = variable!
string facename = "宋体"
long textcolor = 33554432
long backcolor = 67108864
string text = "快捷方式名称:"
boolean focusrectangle = false
end type

type cb_create from commandbutton within w_createshortcut
integer x = 864
integer y = 400
integer width = 366
integer height = 128
integer taborder = 10
integer textsize = -12
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = variable!
string facename = "宋体"
string text = "创建(&C)"
end type

event clicked;oleobject ws, loo_shortcut
string ls_desktop,ls_shortcutname,ls_destname

ws = CREATE oleobject
ws.ConnectToNewObject("WScript.Shell")

ls_desktop = ws.SpecialFolders("Desktop") //取得桌面所在的路径
ls_shortcutname = Trim(sle_shortcutname.text)
if ls_shortcutname = "" or IsNull(ls_shortcutname) then
MessageBox("Caption","请输入快捷方式名称!",Exclamation!)
return
end if
ls_destname = Trim(sle_destname.text)
if ls_destname = "" or IsNull(ls_destname) then
MessageBox("Caption","请输入/选择目标文件名称!",Exclamation!)
return
end if
loo_shortcut = ws.CreateShortcut(ls_desktop +"\" + ls_shortcutname + ".lnk")
loo_shortcut.TargetPath = ls_destname;
loo_shortcut.WorkingDirectory = ls_desktop
loo_shortcut.WindowStyle = 1 //窗口打开时的默认大小 1->normal 3->max, 7->min
//loo_shortcut.IconLocation = ws.ExpandEnvironmentStrings("%WINDIR%\SYSTEM\url.dll , 0")
//loo_shortcut.IconLocation = ws.ExpandEnvironmentStrings("C:\WINNT\system32\SHELL32.DLL,12")
loo_shortcut.IconLocation = ws.ExpandEnvironmentStrings("%WINDIR%\system32\SHELL32.DLL,12")
loo_shortcut.Save
ws.DisconnectObject()
destroy ws

end event

[青锋-SS]

导入应该就可以了.

[lxh111222]

好长哦,谢谢,我试试先