作者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