|
VFP 愛用者社區 本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
|
上一篇主題 :: 下一篇主題 |
發表人 |
內容 |
朱育興
註冊時間: 2003-08-25 文章: 661 來自: 台中市大里區
第 1 樓
|
發表於: 星期一 八月 26, 2019 1:41 pm 文章主題: 建立桌面捷徑及其 Windows 所有程式區、Windows 工作列 |
|
|
代碼: | FUNCTION CreateShortcut
* ------------------------------------------------------------------------------------------------- *
* 說明:建立桌面捷徑
* 作者:朱育興 ysc5096@gmail.com
* 建立日期:2019/08/15
* 更新日期:2019/08/15
* ------------------------------------------------------------------------------------------------- *
* 參數 型態 說明
* ------------------------ ---- -------------------------------------------------------------------
* Input:
* LP_cShortcutName C 桌面捷徑名稱。例:Test(測試)
* LP_cTargetFile C 1.捷徑目標。就是要執行的檔案(需�]含完整路徑)
* 2.例:C:\WINDOWS\system32\notepad.exe
* (LP_cArguments) C 1.(可選參數)捷徑目標的參數
* 2.例:如果要在桌面上建立一個名為 [檢驗資料自動上傳] 的捷徑:
* 在其 [內容] 顯示方塊中,於 [捷徑] 頁標籤中的 [目標] 要填入
* C:\WINDOWS\system32\notepad.exe D:\Test.txt
* 此時,LP_cTargetFile = 'C:\WINDOWS\system32\notepad.exe'、
* LP_cArguments = 'D:\Test.txt'
* (LP_cWorkingDir) C 1.(可選參數)�}始位置
* 2.預�]值=LP_cTargetFile 所在的目錄 ADDBS(JUSTPATH(LP_cTargetFile))
* (LP_cIconFile) C 1.(可選參數)捷徑圖示檔(需�]含完整路徑)
* 2.預�]值=LP_cTargetFile 本身的圖示(如果有的話)
* (LP_cShortcutDesc) C (可選參數)捷徑註解
* (LP_nRunAsMode) N 1.(可選參數)[以系統管理員身分執行此�{式] 勾選模式:
* 0:(預�]值) WinXP 以下(含)版本不勾選、以上(不含)要勾選
* 1:不勾選
* 2:勾選
* 2.WinXP 以下(含)版本:
* 若勾選,有時會出�{狀況(曾遇過,但無法舉出案例了)
* 3.WinXP 以上(不含)版本:
* 尤其到了 Windows 10,若不勾選,常常會遇到�]為不是系統管理員身分
* 的原�]而發生問題;但偶爾 (極少發生) 會�]以系統管理員身分執行而發
* 生問題 (請參酌)
* (LP_nAppendFunc) N 1.(可選參數)其他附�[功能:
* 1:本捷徑�[入到 Windows 所有�{式區 (所有使用者)、
* 2:本捷徑�[入到 Windows 所有�{式區 (本機使用者)、
* 4:本捷徑�[入到 Windows 工作列 (本機使用者)
* 可以是上述3個值的任意總和
* 2.上述的 1 與 2 的功能碼是互斥的。若兩者都有,則以 1 優先
* 3.有些 Windows 10 電腦執行本�{式還是無法�[入 Windows 工作列
* 4.例:1+4,代表本捷徑同時�[入到:
* Windows 所有�{式區 (所有使用者)、
* Windows 工作列 (本機使用者)
* (LP_cAllProgSubDirName) C 1.(可選參數)Windows 所有�{式區下的子目錄名稱
* 2.當 BITAND(LP_nAppendFunc, 1) = 1 OR BITAND(LP_nAppendFunc, 2) = 2
* 時,本參數才會使用
* ------------------------------------------------------------------------------------------------- *
LPARAMETERS LP_cShortcutName, LP_cTargetFile, LP_cArguments, LP_cWorkingDir, LP_cIconFile, LP_cShortcutDesc, LP_nRunAsMode, LP_nAppendFunc, LP_cAllProgSubDirName
LOCAL Wi_cShortcutName,; && C Windows 桌面捷徑名稱
Wi_cTargetFile,; && C 捷徑目標
Wi_cArguments,; && C 捷徑目標的參數
Wi_cWorkingDir,; && C �}始位置
Wi_cIconFile,; && C 捷徑圖示
Wi_cShortcutDesc,; && C 捷徑註解
Wi_lRunAsAdmin,; && L 捷徑是否勾選 [以系統管理員身分執行此�{式]
Wi_lAppendStartMeau_1,; && L 本捷徑是否�[入到 Windows 所有�{式區 (所有使用者)
Wi_lAppendStartMeau_2,; && L " (本機使用者)
Wi_cAllProgSubDirName,; && C Windows 所有�{式區下的子目錄名稱
Wi_lAppendTaskbar && L 本捷徑是否�[入到 Windows 工作列 (本機使用者)
LOCAL W1_cWindowsVresion && C Windows 版本主要編號 (�]為本�{式只要判斷是否是 6 以下的版本就可以了)
* ------------ *
* 參數傳入檢查 *
* ------------ *
* > 1.Windows 桌面捷徑名稱
Wi_cShortcutName = ALLTRIM(LP_cShortcutName)
* > 2.捷徑目標
Wi_cTargetFile = ALLTRIM(LP_cTargetFile)
* > 3.捷徑目標的參數
IF TYPE("LP_cArguments") = "C"
Wi_cArguments = ALLTRIM(LP_cArguments)
ELSE
Wi_cArguments = ""
ENDIF
* > 4.�}始位置
IF TYPE("LP_cWorkingDir") = "C"
Wi_cWorkingDir = ALLTRIM(LP_cWorkingDir)
ELSE
Wi_cWorkingDir = ALLTRIM(JUSTPATH(Wi_cTargetFile))
ENDIF
IF !EMPTY(Wi_cWorkingDir) AND !DIRECTORY(Wi_cWorkingDir)
Wi_cWorkingDir = ""
ENDIF
IF !EMPTY(Wi_cWorkingDir)
Wi_cWorkingDir = ADDBS(Wi_cWorkingDir)
ENDIF
* > 5.捷徑圖示
IF TYPE("LP_cIconFile") = "C"
Wi_cIconFile = ALLTRIM(LP_cIconFile)
DO CASE
CASE EMPTY(Wi_cIconFile)
* Do Nothing ...
CASE !(ALLTRIM(UPPER(JUSTEXT(Wi_cIconFile))) == UPPER("ICO"))
Wi_cIconFile = ""
CASE !FILE(Wi_cIconFile)
Wi_cIconFile = ""
ENDCASE
ELSE
Wi_cIconFile = ""
ENDIF
* > 6.捷徑註解
IF TYPE("LP_cShortcutDesc") = "C"
Wi_cShortcutDesc = ALLTRIM(LP_cShortcutDesc)
ELSE
Wi_cShortcutDesc = ""
ENDIF
* > 7.捷徑是否勾選 [以系統管理員身分執行此�{式]
IF TYPE("LP_nRunAsMode") <> "N"
LP_nRunAsMode = 0
ENDIF
IF !BETWEEN(LP_nRunAsMode, 0, 2)
LP_nRunAsMode = 0
ENDIF
DO CASE
CASE LP_nRunAsMode = 1
Wi_lRunAsAdmin = .F.
CASE LP_nRunAsMode = 2
Wi_lRunAsAdmin = .T.
OTHERWISE
W1_cWindowsVresion = "." + ALLTRIM(OS()) + "."
W1_cWindowsVresion = SUBSTR(W1_cWindowsVresion, 2, AT(".", W1_cWindowsVresion, 2)-1-1)
W1_cWindowsVresion = CHRTRAN(W1_cWindowsVresion, CHRTRAN(W1_cWindowsVresion, "1234567890", ""), "")
IF VAL(W1_cWindowsVresion) < 6
Wi_lRunAsAdmin = .F.
ELSE
Wi_lRunAsAdmin = .T.
ENDIF
ENDCASE
* > 8.其他附�[功能
Wi_lAppendStartMeau_1 = .F. && 本捷徑是否�[入到 Windows 所有�{式區 (所有使用者)
Wi_lAppendStartMeau_2 = .F. && 本捷徑是否�[入到 Windows 所有�{式區 (本機使用者)
Wi_lAppendTaskbar = .F. && 本捷徑是否�[入到 Windows 工作列
IF TYPE("LP_nAppendFunc") = "N"
Wi_lAppendStartMeau_1 = BITAND(LP_nAppendFunc, 1) = 1
IF Wi_lAppendStartMeau_1 = .F.
Wi_lAppendStartMeau_2 = BITAND(LP_nAppendFunc, 2) = 2
ENDIF
Wi_lAppendTaskbar = BITAND(LP_nAppendFunc, 4) = 4
ENDIF
* > 9.其他附�[功能-延伸參數:Windows 所有�{式區下的子目錄名稱
Wi_cAllProgSubDirName = ""
IF TYPE("LP_cAllProgSubDirName") = "C"
Wi_cAllProgSubDirName = ALLTRIM(LP_cAllProgSubDirName)
ENDIF
* ------------ *
* 區域變數宣告 *
* ------------ *
LOCAL W1_oShell,; && O CREATEOBJECT("WSCRIPT.SHELL") 物件參考
W1_oShell2,; && O CREATEOBJECT("Shell.Application") 物件參考
W1_cDesktopDir,; && C Windows 桌面資料夾
W1_cDesktopShortcutFile,; && C 桌面捷徑檔(含完整路徑)
W1_cShortcutFile4Tmp,; && C �{時捷徑檔(含完整路徑) (供 Wi_lRunAsAdmin = .T. 狀況下專用)
W1_cCMD_EXE && C Windows cmd.exe 檔案(含完整路徑)
LOCAL ARRAY W1_aDIR[1] && A ADIR 函數專用�}列
W1_oShell = CREATEOBJECT("WSCRIPT.SHELL")
W1_oShell2 = CREATEOBJECT("Shell.Application")
W1_cDesktopDir = ADDBS(ALLTRIM(W1_oShell.SpecialFolders("Desktop")))
W1_cDesktopShortcutFile = FORCEPATH(FORCEEXT(Wi_cShortcutName, "lnk"), W1_cDesktopDir)
W1_cShortcutFile4Tmp = FORCEPATH(FORCEEXT(SYS(2015), "lnk"), ADDBS(GETENV("TEMP")))
W1_cCMD_EXE = GETENV("COMSPEC")
* --------------------- *
* 建立 Windows 桌面捷徑 *
* --------------------- *
LOCAL W1_oShortCut && O Windows 桌面捷徑檔物件參考
IF Wi_lRunAsAdmin = .T.
W1_oShortCut = W1_oShell.CreateShortcut(W1_cShortcutFile4Tmp)
ELSE
W1_oShortCut = W1_oShell.CreateShortcut(W1_cDesktopShortcutFile)
ENDIF
WITH W1_oShortCut
.TargetPath = Wi_cTargetFile && 捷徑目標
IF !EMPTY(Wi_cArguments) && 捷徑目標的參數
.Arguments = Wi_cArguments
ENDIF
IF !EMPTY(Wi_cWorkingDir) && �}始位置
.WorkingDirectory = Wi_cWorkingDir
ENDIF
IF !EMPTY(Wi_cIconFile) && 捷徑圖示
.IconLocation = Wi_cIconFile
ENDIF
IF Wi_lRunAsAdmin = .T. && 捷徑註解
IF !EMPTY(Wi_cShortcutDesc)
.Description = Wi_cShortcutDesc + "(以系統管理員身分執行)"
ELSE
.Description = "以系統管理員身分執行"
ENDIF
ELSE
IF !EMPTY(Wi_cShortcutDesc)
.Description = Wi_cShortcutDesc
ENDIF
ENDIF
.Save()
ENDWITH
* ------------------------------------- *
* 捷徑勾選 [以系統管理員身分執行此�{式] *
* ------------------------------------- *
IF Wi_lRunAsAdmin = .T.
LOCAL W2_nHandle4Tmp,; && N W1_cShortcutFile4Tmp 低階檔案控制碼
W2_nFError4Tmp,; && N FERROR 函數傳回的錯誤碼編號 by W2_nHandle4Tmp
W2_cFErrorMess,; && M 要顯示的錯誤訊息
W2_nRemainSize4Tmp,; && N 傳回讀取 W2_nHandle4Tmp 後之剩餘的位元組數
W2_nReadOneByteCNT,; && N 讀取到 W2_nHandle4Tmp 的第幾個位元組
W2_nHandle,; && N W1_cDesktopShortcutFile 低階檔案控制碼
W2_cOneByte4Tmp && C 讀取 W2_nHandle4Tmp 的一個位元組
W2_nHandle4Tmp = FOPEN(W1_cShortcutFile4Tmp, 12)
W2_nFError4Tmp = FERROR()
IF W2_nFError4Tmp > 0
=FCLOSE(W2_nHandle4Tmp)
W2_cFErrorMess = W1_cShortcutFile4Tmp + " 檔案狀況:"
DO CASE
CASE W2_nFError4Tmp = 2
W2_cFErrorMess = W2_cFErrorMess + "檔案找不到"
CASE W2_nFError4Tmp = 4
W2_cFErrorMess = W2_cFErrorMess + "有太多已�}啟的檔案 (檔案控制碼不夠)"
CASE W2_nFError4Tmp = 5
W2_cFErrorMess = W2_cFErrorMess + "無法存取"
CASE W2_nFError4Tmp = 6
W2_cFErrorMess = W2_cFErrorMess + "給定的檔案控制碼不正確"
CASE W2_nFError4Tmp = 8
W2_cFErrorMess = W2_cFErrorMess + "記憶體不足"
CASE W2_nFError4Tmp = 25
W2_cFErrorMess = W2_cFErrorMess + "搜尋錯誤 (無法從檔案的�}頭處之前�}始搜尋)"
CASE W2_nFError4Tmp = 29
W2_cFErrorMess = W2_cFErrorMess + "磁碟已滿"
CASE W2_nFError4Tmp = 31
W2_cFErrorMess = W2_cFErrorMess + "錯誤地�}啟檔案"
ENDCASE
WAIT WINDOW W2_cFErrorMess
RELEASE W1_oShell2
RELEASE W1_oShell
RETURN
ENDIF
W2_nRemainSize4Tmp = FSEEK(W2_nHandle4Tmp, 0, 2)
W2_nReadOneByteCNT = 0
W2_nHandle = FCREATE(W1_cDesktopShortcutFile)
=FSEEK(W2_nHandle4Tmp, 0, 0)
DO WHILE !FEOF(W2_nHandle4Tmp)
W2_cOneByte4Tmp = FREAD(W2_nHandle4Tmp, 1)
* 此位元是決定 [以系統管理員身分執行此�{式]。CHR(0):不勾選、CHR(32):勾選
W2_nReadOneByteCNT = W2_nReadOneByteCNT + 1
IF W2_nReadOneByteCNT = 22
W2_cOneByte4Tmp = CHR(32)
ENDIF
=FWRITE(W2_nHandle, W2_cOneByte4Tmp, 1)
W2_nRemainSize4Tmp = W2_nRemainSize4Tmp - 1
IF W2_nRemainSize4Tmp = 0
EXIT
ENDIF
ENDDO
=FCLOSE(W2_nHandle)
=FCLOSE(W2_nHandle4Tmp)
DELETE FILE (W1_cShortcutFile4Tmp)
ENDIF
* ----------------------------- *
* 捷徑�[入到 Windows 所有�{式區 *
* ----------------------------- *
IF Wi_lAppendStartMeau_1 = .T. OR Wi_lAppendStartMeau_2 = .T.
LOCAL W2_cAllProgDir,; && C Windows 所有�{式區資料夾
W2_cNotLegalityStr,; && C 要被去除的特殊符號之字串
W2_cCheckChar,; && C 要檢查的字元
W2_cAllProgSubDir && C Windows 所有�{式區下的子目錄
IF Wi_lAppendStartMeau_2 = .T.
W2_cAllProgDir = ADDBS(W1_oShell.SpecialFolders("Programs"))
ELSE
W2_cAllProgDir = ADDBS(W1_oShell.SpecialFolders("AllUsersPrograms"))
ENDIF
IF !EMPTY(Wi_cAllProgSubDirName)
W2_cNotLegalityStr = '\/:*?"<>|'
DO WHILE !EMPTY(W2_cNotLegalityStr)
W2_cCheckChar = LEFT(W2_cNotLegalityStr, 1)
IF AT(W2_cCheckChar, Wi_cAllProgSubDirName) # 0
Wi_cAllProgSubDirName = STRTRAN(Wi_cAllProgSubDirName, W2_cCheckChar, "")
ENDIF
W2_cNotLegalityStr = SUBSTR(W2_cNotLegalityStr, 2)
ENDDO
ENDIF
W2_cAllProgSubDir = W2_cAllProgDir
IF !EMPTY(Wi_cAllProgSubDirName)
W2_cAllProgSubDir = W2_cAllProgSubDir + Wi_cAllProgSubDirName
ENDIF
W2_cAllProgSubDir = ADDBS(W2_cAllProgSubDir)
IF !DIRECTORY(W2_cAllProgSubDir)
W1_oShell2.ShellExecute(W1_cCMD_EXE, '/c md "'+W2_cAllProgSubDir+'"', , , 0)
=INKEY(1) && 等候目錄的建立
* 無法建立目錄時,改用 Runas 執行
IF !DIRECTORY(W2_cAllProgSubDir)
W1_oShell2.ShellExecute(W1_cCMD_EXE, '/c md "'+W2_cAllProgSubDir+'"', , "runas", 0)
=INKEY(1) && 等候目錄的建立
ENDIF
ENDIF
IF DIRECTORY(W2_cAllProgSubDir)
W1_oShell2.ShellExecute(W1_cCMD_EXE, '/c copy "'+W1_cDesktopShortcutFile+'" "'+FORCEPATH(JUSTFNAME(W1_cDesktopShortcutFile), W2_cAllProgSubDir)+'" /Y', , , 0)
=INKEY(1) && 等候複製檔案
* 無法複製檔案時,改用 Runas 執行
IF ADIR(W1_aDIR, FORCEPATH(JUSTFNAME(W1_cDesktopShortcutFile), W2_cAllProgSubDir)) <= 0
W1_oShell2.ShellExecute(W1_cCMD_EXE, '/c copy "'+W1_cDesktopShortcutFile+'" "'+FORCEPATH(JUSTFNAME(W1_cDesktopShortcutFile), W2_cAllProgSubDir)+'" /Y', , "runas", 0)
ENDIF
ENDIF
ENDIF
* ------------------------- *
* 捷徑�[入到 Windows 工作列 *
* ------------------------- *
IF Wi_lAppendTaskbar = .T.
IF VAL(W1_cWindowsVresion) < 6
LOCAL W2_cPrintHoodDir,; && C Windows 列印共用目錄
W2_cTaskBarDir && C Windows 工作列資料夾
W2_cPrintHoodDir = ADDBS(W1_oShell.SpecialFolders("PrintHood"))
W2_cTaskBarDir = ADDBS(JUSTPATH(JUSTPATH(W2_cPrintHoodDir))) + "Application Data\Microsoft\Internet Explorer\Quick Launch"
W2_cTaskBarDir = ADDBS(W2_cTaskBarDir)
IF DIRECTORY(W2_cTaskBarDir)
W1_oShell2.ShellExecute(W1_cCMD_EXE, '/c copy "'+W1_cDesktopShortcutFile+'" "'+FORCEPATH(JUSTFNAME(W1_cDesktopShortcutFile), W2_cTaskBarDir)+'" /Y', , , 0)
=INKEY(1) && 等候複製檔案
* 無法複製檔案時,改用 Runas 執行
IF ADIR(W1_aDIR, FORCEPATH(JUSTFNAME(W1_cDesktopShortcutFile), W2_cTaskBarDir)) <= 0
W1_oShell2.ShellExecute(W1_cCMD_EXE, '/c copy "'+W1_cDesktopShortcutFile+'" "'+FORCEPATH(JUSTFNAME(W1_cDesktopShortcutFile), W2_cTaskBarDir)+'" /Y', , "runas", 0)
ENDIF
EXIT
ENDIF
ELSE
LOCAL W1_oFSO,; && O CREATEOBJECT("Scripting.FileSystemObject") 物件參考
W1_cKeyCode,; && C 機碼
W1_cKeyValue && C 機碼的值
W1_oFSO = CREATEOBJECT("Scripting.FileSystemObject")
W1_cKeyCode = "HKCU\Software\Classes\*\shell\{:}"
WITH W1_oShell
W1_cKeyValue = .RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\CommandStore\shell\Windows.taskbarpin\ExplorerCommandHandler")
.RegWrite(W1_cKeyCode+"\ExplorerCommandHandler", W1_cKeyValue, "REG_SZ")
WITH W1_oShell2
WITH .Namespace(W1_oFSO.GetParentFolderName(W1_cDesktopShortcutFile))
WITH .ParseName(W1_oFSO.GetFileName(W1_cDesktopShortcutFile))
.InvokeVerb("{:}")
*!* 這是另一種方式:
*!* FOR EACH objVerb IN .Verbs
*!* IF ALLTRIM(STRTRAN(objVerb.Name, "&", "")) == "{:}"
*!* objVerb.DoIt
*!* EXIT
*!* ENDIF
*!* ENDFOR
ENDWITH
ENDWITH
ENDWITH
.Run('Reg.exe delete '+W1_cKeyCode+' /f', 0, .T.)
ENDWITH
RELEASE W1_oFSO
ENDIF
ENDIF
RELEASE W1_oShell2
RELEASE W1_oShell
ENDFUNC
|
範例:
代碼: | M_cShortcutName = "Test(測試)"
M_cTargetFile = "C:\WINDOWS\system32\notepad.exe"
M_cArguments = "D:\Test.txt"
* M_cWorkingDir = ""
* M_cIconFile = ""
M_cShortcutDesc = "測試"
* M_nRunAsMode = 0
M_nAppendFunc = 2 + 4
M_cAllProgSubDirName = "Test"
=CreateShortcut(M_cShortcutName, M_cTargetFile, M_cArguments, , , M_cShortcutDesc, , M_nAppendFunc, M_cAllProgSubDirName)
|
_________________ 希望有更多人來參與
VFP wiki - 需要大家一起完成的VFP電子書與FAQ |
|
回頂端 |
|
|
goodnight
註冊時間: 2008-10-13 文章: 472 來自: 台南市
第 2 樓
|
|
回頂端 |
|
|
|
|
您 無法 在這個版面發表文章 您 無法 在這個版面回覆文章 您 無法 在這個版面編輯文章 您 無法 在這個版面刪除文章 您 無法 在這個版面進行投票 您 無法 在這個版面附加檔案 您 無法 在這個版面下載檔案
|
|