Re: [VB6] 專案群組中的專案 b 如何取得專案 a 的눠…

看板Visual_Basic作者 (所指千歌音之處)時間17年前 (2009/01/31 01:08), 編輯推噓0(001)
留言1則, 1人參與, 最新討論串1/1
※ 引述《mron (樹林七閒)》之銘言: : 我有一專案群組,其中包含: : 專案a,專案 b, ... : 專案a:啟動專案,標準執行檔 : 專案b:ActiveX DLL : 專案a包含:表單a, ... : 專案b包含:表單b, ... : 請問表單b如何取得專案a的產品名稱(即 App.ProductName)? : -- : 以下離題: : 請問VB中有辦法取得啟動專案的名稱嗎? 這方法是建立在你專案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)

01/31 01:10, , 1F
要小心被截斷的程式碼
01/31 01:10, 1F
文章代碼(AID): #19WpG6jj (Visual_Basic)