重新整理问题:
本人今天写了一个东西(如果可以叫软件的话),其中有个功能是点击按钮察看指定路径(绝对路径)“资料”,因为本人利用SETUP FACTORY7.0做成了安装程序,所以考虑到不同的人会把它安装在不同的路径下,所以前面的“资料”的绝对路径可能造成错误,想把程序中的绝对路径改称能够获取安装路径的办法。特发此文以求正解,望指明,深表感谢。
答案:期待中……在线等。
[此贴子已经被作者于2007-9-1 8:35:05编辑过]
如果你说的“安装路径”指的就是程序本身路径
App.Path很有用
Public Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As String, ByVal Source As Long, ByVal Length As Long)
Function sGetCommandLine() As String
' 获取本程序启动完整命令行
' 拓扑关系: 被 FUNC sGetAppExePathName()和 FUNC bArgExists() 依赖
Dim lRet As Long, sCmd As String
lRet = GetCommandLine
If lRet > 0 Then
sCmd = String(256, 32)
CopyMemory sCmd, lRet, Len(sCmd)
sCmd = Mid(sCmd, 1, InStr(1, sCmd, Chr(0)) - 1)
End If
sGetCommandLine = sCmd
' 关于API GetCommandLine() 的使用说明
' MSDN:
' The return value is a pointer to the command-line string for the current process.
' 返回字符串指针(指向当前命令行缓冲区的一个指针),并非字符串,API Viewer的声明是错误的。
' References:
' http://topic.csdn.net/t/20020410/17/636954.html
End Function
Function sGetAppExePathName() As String
' 得到应用程序完整路径
' 拓扑关系:依赖于 sGetCommandLine()
Dim sBufCmd As String, sResponse As String
sBufCmd = sGetCommandLine()
' 若完整命令行以半角双引号开始
If """" = Left(sBufCmd, 1) Then
Dim iPosPairQuot As Integer
iPosPairQuot = InStr(2, sBufCmd, """")
sResponse = Mid(sBufCmd, 2, iPosPairQuot - 2)
Else
' 若不存在半角双引号则路径中不包含空格,无需考虑空格的情形
Dim iPosSpace As Integer
iPosSpace = InStr(2, sBufCmd, " ")
sResponse = Left(sBufCmd, iPosSpace - 1)
End If
sGetAppExePathName = sResponse
End Function