作者FiraxisAngle (所指千歌音之處)
看板Visual_Basic
標題Re: [VB6] 專案群組中的專案 b 如何取得專案 a 的눠…
時間Sat Jan 31 01:08:18 2009
※ 引述《mron (樹林七閒)》之銘言：
: 我有一專案群組，其中包含：
: 專案ａ,專案 ｂ, ...
: 專案ａ：啟動專案，標準執行檔
: 專案ｂ：ActiveX DLL
: 專案ａ包含：表單ａ, ...
: 專案ｂ包含：表單ｂ, ...
: 請問表單ｂ如何取得專案ａ的產品名稱(即 App.ProductName)？
: －－
: 以下離題：
: 請問ＶＢ中有辦法取得啟動專案的名稱嗎？
這方法是建立在你專案a已經編譯成執行檔，表單b利用副程式 GetProductName
傳入執行檔所在路徑如
"C:\Program Files\Microsoft Visual Studio\MyProjects\sdfgh\Project1.exe"
可回傳 ProductName，程式碼如下
Option Explicit
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)
Private Type VS_NEWINFO
astr As String * 1024
End Type
Private Function GetProductName(cFileName As String) As String
' Declare
Dim iBufferLen As Long
Dim byteBuffer() As Byte
Dim sVS As VS_NEWINFO
Dim iVerPointer As Long
Dim iState As Long
Dim cTemp As String
Dim iTranslation As Long
' iBufferLen
iBufferLen = GetFileVersionInfoSize(cFileName, 0)
If iBufferLen < 1 Then
Exit Function
End If
ReDim byteBuffer(iBufferLen)
' cTemp
iVerPointer = 0
iState = GetFileVersionInfo(cFileName, 0&, iBufferLen, byteBuffer(0))
iState = VerQueryValue(byteBuffer(0), "\VarFileInfo\Translation", iVerPointer, 0)
MoveMemory iTranslation, iVerPointer, 4&
cTemp = "0" + Hex$(iTranslation)
cTemp = Right$(cTemp, 4) + Left$(cTemp, 4)
' GetProductName
iState = VerQueryValue(byteBuffer(0), "\StringFileInfo\" + cTemp + "\ProductName", iVerPointer, 0)
If iState <> 0 Then
MoveMemory sVS, iVerPointer, Len(sVS)
GetProductName = Left$(sVS.astr, (InStr(sVS.astr, Chr$(0)) - 1))
End If
End Function
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 220.137.59.222
※ 編輯: FiraxisAngle 來自: 220.137.59.222 (01/31 01:08)
1F：→ FiraxisAngle:要小心被截斷的程式碼 01/31 01:10