View Full Version : روش ساخت shortcut
good_boy
یک شنبه 27 فروردین 1391, 20:58 عصر
سلام دوستان
می خوام بدونم چطور میشه از یک فایل شورتکات ساخت لطفا اگه روشی رو بلدین در این باره توضیح بدین
بدون فایل DLL باشه بهتره
با تشکر
_______
محسن واژدی
یک شنبه 27 فروردین 1391, 21:29 عصر
سلام
کد زیر را بررسی کنید:
Private Sub Command1_Click()
Dim sTarApp$
sTarApp$ = "C:\Windows\Explorer.exe"
Set WshShell = CreateObject("wscript.shell")
Set oShellLink = WshShell.CreateShortcut(WshShell.SpecialFolders("Desktop") & "\MyExplorer.lnk")
With oShellLink
.TargetPath = sTarApp$ 'Shortcut target file path e.g C:\MyApp.exe
.WindowStyle = vbNormalFocus 'app window start status e.g VbAppWinStyle.vbNormalFocus
.Hotkey = "CTRL+SHIFT+F" 'Shortcut hot-key
.IconLocation = sTarApp$ 'Shortcut icon
.Description = "This is a shortcut file" 'Shortcut description
.WorkingDirectory = "C:\" 'Working dir
.Save
Set WshShell = Nothing
Set oShellLink = Nothing
End With
End Sub
TargetPath : مکان فایل اصلی
WindowStyle : سبک باز شدن فرم برنامه پس از شروع
Hotkey : کلید میانبری که به shortcut ایجاد شده اختصاص میدهیم
IconLocation : مکان آیکون میانبر
Description : توضیحات میانبر هنگام قرار گیری موس بر روی آن
WorkingDirectory : آدرس فولدری که فایل اصلی ما در آن قرار دارد
موفق باشید
بهروز عباسی
دوشنبه 28 فروردین 1391, 11:51 صبح
اینم دم دست من بود همون روشه اما این کارو در یک تایع پیاده سازی کرده
Private Sub Command1_Click()
Create_ShortCut "C:\WINDOWS\NOTEPAD.EXE", "Desktop", "Notepad", "test arg", , WshNormalFocus
End Sub
Private Sub Create_ShortCut(ByVal sTargetPath As String, ByVal sShortCutPath As String, ByVal sShortCutName As String, _
Optional ByVal sArguments As String, Optional ByVal sWorkPath As String, _
Optional ByVal eWinStyle As WshWindowStyle = vbNormalFocus, Optional ByVal iIconNum As Integer)
' Requires reference to Windows Script Host Object Model
Dim oShell As IWshRuntimeLibrary.WshShell
Dim oShortCut As IWshRuntimeLibrary.WshShortcut
Set oShell = New IWshRuntimeLibrary.WshShell
Set oShortCut = oShell.CreateShortcut(oShell.SpecialFolders(sShort CutPath) & _
"\" & sShortCutName & ".lnk")
With oShortCut
.TargetPath = sTargetPath
.Arguments = sArguments
.WorkingDirectory = sWorkPath
.WindowStyle = eWinStyle
.IconLocation = sTargetPath & "," & iIconNum
.Save
End With
Set oShortCut = Nothing: Set oShell = Nothing
End Sub
good_boy
دوشنبه 28 فروردین 1391, 21:22 عصر
سلام
بسیار ممنون به خاطر کمکتون
تنها یه سوال می مونه در روشی که آقای واژدی گفتن وقتی به جای
c:\
این آدرس رو می دم نمی دونم چرا عمل نمی کنه
"c:\Documents and Settings\All Users"
M.T.P
دوشنبه 28 فروردین 1391, 22:07 عصر
البته کد آقای واژدی درسته اما در نمایش کد سایت مشکل داره و Desktop رو توش فاصله انداخته و و با کپی و پیست کد نتیجه نمی گیرید.
این کد همون کد آقای واژدی بصورت تابع است:
Function CreateShortcut(ByVal sExePath As String, _
ByVal sHotKey As String, _
ByVal sComment As String, _
ByVal sWorkingDir As String, _
ByVal nWinStyle As VbAppWinStyle) As Boolean
On Error GoTo errline
Dim blnReturn As Boolean
Dim obWshShell As Object
Dim obShellLink As Object
Dim strExeName As String
strExeName = StrReverse(Mid(StrReverse(sExePath), 1, InStr(1, StrReverse(sExePath), "\") - 1))
strExeName = Mid$(strExeName, 1, InStr(1, strExeName, ".") - 1)
Set obWshShell = CreateObject("wscript.shell")
Set obShellLink = obWshShell.CreateShortcut(obWshShell.SpecialFolder s("Desktop") & "\" & strExeName & ".lnk")
With obShellLink
.TargetPath = sExePath
.WindowStyle = nWinStyle
.Hotkey = sHotKey
.IconLocation = sExePath
.Description = sComment
.WorkingDirectory = sWorkingDir
.Save
End With
blnReturn = True
errline:
CreateShortcut = blnReturn
Set obWshShell = Nothing
Set obShellLink = Nothing
End Function
که طبق گفته خودتون می تونید اینطوری استفاده کنید:
Private Sub Command1_Click()
CreateShortcut "C:\Windows\Explorer.exe", _
"CTRL+SHIFT+F", _
"This is a shortcut file", _
"c:\Documents and Settings\All Users", _
vbNormalFocus
End Sub
good_boy
سه شنبه 29 فروردین 1391, 19:46 عصر
سلام
نمی دونم چرا عمل نکرد
شما یه کپی پست کنید ببینید در ویندوز xp اجرا میشه
good_boy
جمعه 01 اردیبهشت 1391, 18:59 عصر
سلام
لطفا یه امتحان کنید ممنون میشم
شاید هم من بلد نیستم خوب از این کد استفاده کنم
هدف اصلی من قرار دادن shortcut در استارت آپ هستش
good_boy
جمعه 01 اردیبهشت 1391, 19:36 عصر
سلام
تونستم با گشتن در سایت های خارجی یه کد خوب پیدا کنم که مشکلم حل شد
فقط یه خط توش برام عجیبه که ظاهرا نبودشم کارم رو انجام میده
گه کسی میدونه توضیح بده بد نیست
1. 'Create a WshShell Object
2. Set wshshell = CreateObject("Wscript.Shell")
3.
4. ' select shortcut name and folder
5. Set oshelllink = wshshell.CreateShortcut(wshshell.specialfolders("allusersstartup") & "\aaa.lnk")
6.
7. 'Set the Target Path for the shortcut
8. oshelllink.TargetPath = "notepad.exe"
9.
10. 'Set the additional parameters for the shortcut
11. oshelllink.Arguments = "c:\windows\desktop\aaa.txt"
12.
13. 'Save the shortcut
14. oshelllink.Save
15.
16. 'Clean up the WshShortcut Object
17. Set oshelllink = Nothing
18. Set wshshell = Nothing
منظورم این هست:
oshelllink.Arguments = "c:\windows\desktop\aaa.txt"
M.T.P
جمعه 01 اردیبهشت 1391, 19:51 عصر
دوست عزیز کدهای بالا برای ایجاد Shortcut برنامه بر روی Desktop بود.
برای گذاشتن برنامه در Startup این تابع رو صدا بزن برنامه میره تو Startup.
Function AutorunMe() As Boolean
On Error GoTo ErrLine
Dim blnReturn As Boolean
Dim obReg As Object
blnReturn = False
Set obReg = CreateObject("wscript.shell")
obReg.RegWrite "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\WINDOWS\CURRE NTVERSION\RUN\" & App.EXEName, _
Chr$(34) & IIf(Right(App.Path, 1&) = "\", App.Path, App.Path & "\") & App.EXEName & ".exe" & Chr$(34)
blnReturn = True
ErrLine:
Set obReg = Nothing
AutorunMe = blnReturn
End Function
محسن واژدی
جمعه 01 اردیبهشت 1391, 20:53 عصر
سلام
تونستم با گشتن در سایت های خارجی یه کد خوب پیدا کنم که مشکلم حل شد
فقط یه خط توش برام عجیبه که ظاهرا نبودشم کارم رو انجام میده
گه کسی میدونه توضیح بده بد نیست
1. 'Create a WshShell Object
2. Set wshshell = CreateObject("Wscript.Shell")
3.
4. ' select shortcut name and folder
5. Set oshelllink = wshshell.CreateShortcut(wshshell.specialfolders("allusersstartup") & "\aaa.lnk")
6.
7. 'Set the Target Path for the shortcut
8. oshelllink.TargetPath = "notepad.exe"
9.
10. 'Set the additional parameters for the shortcut
11. oshelllink.Arguments = "c:\windows\desktop\aaa.txt"
12.
13. 'Save the shortcut
14. oshelllink.Save
15.
16. 'Clean up the WshShortcut Object
17. Set oshelllink = Nothing
18. Set wshshell = Nothing
منظورم این هست:
oshelllink.Arguments = "c:\windows\desktop\aaa.txt"
این کد پارامتری را به برنامه اجرا شده ارسال میکند، کاری که روزانه هنگام کلیک بر روی یک سند انجام میدهیم، برای مثال بهنگام کلید بر روی یک فایل متنی که در مسیر "c:\windows\desktop\aaa.txt" قرار دارد، پارامتری مشابه زیر به برنامه notepad ارسال میشود:
C:\Windows\System32\Notepad.exe c:\windows\desktop\aaa.txt
که برنامه پس از پردازش سند متنی را نمایش میدهد
در کدهای بالا پارامتر را در oshelllink.Arguments جایگزین میکنیم
موفق باشید
good_boy
جمعه 01 اردیبهشت 1391, 21:45 عصر
سلام
سپاس بسیار
پس نیازی نیست که در برنامه ازش استفاده بشه چون برنامه shortcut رو میسازه و مشکلی هم پیش نمیاد
درسته؟
با تشکر
محسن واژدی
جمعه 01 اردیبهشت 1391, 21:54 عصر
سلام
سپاس بسیار
پس نیازی نیست که در برنامه ازش استفاده بشه چون برنامه shortcut رو میسازه و مشکلی هم پیش نمیاد
درسته؟
با تشکر
سلام
بله همینطور هست مگر زمانی که نیازمند ساختن یک میانبر+یک پارامتر همراه باشیم در غیراینصورت برای ساختن میانبرهای عادی میتوانیم از بکاربردنش صرفنظر کنیم
موفق باشید
بهروز عباسی
یک شنبه 03 اردیبهشت 1391, 01:43 صبح
هر چند مشکل دوستمون حل شده اما این تابع هم بد نیست(API)
Rem programmer : Behrooz Abbasi
Rem www.programming-co.com
Private Declare Function fCreateShellLink Lib "vb6stkit.dll" (ByVal lpstrFolderName As String, _
ByVal lpstrLinkName As String, _
ByVal lpstrLinkPath As String, _
ByVal lpstrLinkArguments As String, _
ByVal fPrivate As Long, _
ByVal sParent As String) As Long
Public Sub CreateShortCut(ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String)
Call fCreateShellLink(lpstrFolderName, lpstrLinkName, lpstrLinkPath, vbNullChar, fPrivate, sParent)
End Sub
Private Sub Form_Load()
Call CreateShortCut("D:\", "API-Guide.lnk", "C:\Program Files\API-Guide\API-Guide.exe")
End Sub
vBulletin® v4.2.5, Copyright ©2000-1404, Jelsoft Enterprises Ltd.