Чтение дополнительных сведений, о программе

[Lunatic]

Как получить эти данные, из чужой проги. Подходящих API не нашёл.
Ткните носом) Особенно интересует пункт Original Filename

[arvitaly]

API функция VerQueryValue, единственно для названия компании нужно в lPSubBlock передать "\StringFileInfo\" & cp & "\CompanyName", где cp-
кодовая страница, вот тут описано как ее получить на VB6
http://msdn.microsoft.com/en-us/library ... 85%29.aspx

[Lunatic]

C чтением разобрался, а с записью. Помогите. Только не ссылкой на MSDN, я там уже был.

Код: Выделить всё

Private Declare Function BeginUpdateResource Lib "kernel32.dll" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Private Declare Function UpdateResource Lib "kernel32.dll" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As String, ByVal lpName As String, ByVal wLanguage As Long, ByRef lpData As Any, ByVal cbData As Long) As Long
Private Declare Function EndUpdateResource Lib "kernel32.dll" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long

Private Const RT_VERSION As Long = 16

Private Const LANG_ENGLISH As Long = &H9
Private Const LANG_RUSSIAN As Long = &H19
Private Const LANG_UKRAINIAN As Long = &H22
Private Const LANG_SPANISH As Long = &HA

Public Sub UPDRES(FName As String)
Dim Ret As Long
Dim IPData() As Byte
Dim Hndl As Long


Hndl = BeginUpdateResource(FName, True)
Ret = UpdateResource(Hndl, RT_VERSION, **Имя Ресурса** , LANG_ENGLISH, 0, 0) 'IPData(), Len(IPData))   '...0,0) удалить
EndUpdateResource Hndl, False
End Sub

Что должно быть в IPData? Если правильно понял MSDN то выровненая Unicode инфа, неразбирусь как её выравнивать, и вообще какого она должна быть вида
А имя ресурса? = "1033"

[arvitaly]

Чье творение решил присвоить

[Lunatic]

Cвоё! Хочу сделать полиморфным

Найдутся же сволочи которые отслеживают моё детище не только по HInstance но и по ProductName. Тут уже дело принципов.

[Lunatic]

Сразу чтоб не подумали на вирусы там какие-то. Это простая конкуренция. Жизни не дают и пытаются монополизировать всё и вся

[Денис]

Лунтик, не пыли, если продукт действительно стоящий, никто у тебя его не присвоит.

[Lunatic]

Ден! Ты неправильно понял суть проблемы.

Есть одна глобальная прога, под неё написали плагин(без которого работа проги просто теряет смысл. Поэтому он необходим). Но так сложилось, что авторы этого плагина не в ладах со мной, темболее у них есть аналог моего. Ну и ясен перец, что они его толкают. Я же немогу втиснутся, потому что первый плагин как только находит меня, сразу убивает. Вот и хочу сделать чтобы не находили меня. Можно было б раз сделать и забыть, если б эта зараза не обновлялась. Я замучался постоянно обновлятся вместе с ними.

Вообщем запутанная очень история, и поверьте. Если б был какой-то депломатический или иной способ её решить, я б уже это сделал.

[Lunatic]

Это всё можно сделать и ручками в ResHacker. Мне же нужно автоматизировать. Да и разобратся с функцией не мешало бы. Вдруг пригодится еще когда-то

[Lunatic]

Код: Выделить всё

Option Explicit

Private Const RT_VERSION As Long = 16
Private Const SUBLANG_DEFAULT As Long = &H1
Private Const LANG_NEUTRAL As Integer = &H0
Private Const LANG_ENGLISH As Long = &H9
Private Const LANG_RUSSIAN As Long = &H19
Private Const LANG_UKRAINIAN As Long = &H22
Private Const LANG_SPANISH As Long = &HA

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 BeginUpdateResource Lib "KERNEL32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingReources As Boolean) As Long
Private Declare Function UpdateResource Lib "KERNEL32" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function EndUpdateResource Lib "KERNEL32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Boolean) As Long

Public Sub UpdateFileVersion(ByVal vstrFilePath As String)

    Dim llngHandle As Long
    Dim llngVersionInfoLength As Long
    Dim llngResult As Long
    Dim lbytBuffer() As Byte
    Dim llngResourceHandle As Long
    Dim llngReturnValue As Long

    llngVersionInfoLength = GetFileVersionInfoSize(vstrFilePath, llngHandle)

If llngVersionInfoLength <> 0 Then
        ReDim lbytBuffer(llngVersionInfoLength)
        llngResult = GetFileVersionInfo(vstrFilePath, 0, llngVersionInfoLength, lbytBuffer(0))
       
        If llngResult <> 0 Then
            'lbytBuffer(505) = 56


            llngResourceHandle = BeginUpdateResource(vstrFilePath, False)
            If llngResourceHandle <> 0 Then
            'Тут где-то ошибка!
                llngReturnValue = UpdateResource(llngResourceHandle, RT_VERSION, 1, 1033, lbytBuffer, UBound(lbytBuffer))
'llngReturnValue = UpdateResource(llngResourceHandle, "Version Info", "1", 1033, VarPtr(lbytBuffer(0)), UBound(lbytBuffer))
            'Хотя функция возвращает единицу
                If llngReturnValue = 0 Then
                    MsgBox "Unable to update resource (" & Err.LastDllError & ")", vbExclamation, Me.Caption
                End If
                llngReturnValue = EndUpdateResource(llngResourceHandle, False)
               
                If llngReturnValue <> 0 Then
                    MsgBox "Version number updated", vbInformation, Me.Caption
                Else
                    MsgBox "Unable to write updated resource (" & Err.LastDllError & ")", vbExclamation, Me.Caption
                End If
            Else
                MsgBox "Unable to retrieve resource update handle", vbExclamation, Me.Caption
            End If
        Else
            MsgBox "Unable to get file version info (" & Err.LastDllError & ")", vbExclamation, Me.Caption
        End If
    Else
        MsgBox "Unable to get file version info size (" & Err.LastDllError & ")", vbExclamation, Me.Caption
    End If

End Sub

Private Function MAKELANGID(ByVal vintPrimaryLanguage As Integer, ByVal _
vintSubLanguage As Integer) As Long

    MAKELANGID = (vintSubLanguage * 1024) Or vintPrimaryLanguage

End Function

Declare Function UpdateResource Lib "kernel32.dll" Alias "UpdateResourceA" ( _
ByVal hUpdate As Long, _
ByVal lpType As String, _
ByVal lpName As String, _
ByVal wLanguage As Long, _
ByRef lpData As Any, _
ByVal cbData As Long) As Long

Declare Function UpdateResource Lib "kernel32.dll" Alias "UpdateResourceA" ( _
ByVal hUpdate As Long, _
ByVal lpType As Long, _
ByVal lpName As Long, _
ByVal wLanguage As Long, _
ByRef lpData() As Byte, _
ByVal cbData As Long) As Long

Тоже интересно получается если меняем параметр записи (добавить/обновить)
BeginUpdateResource(vstrFilePath, False)

Помогите! У кого есть рабочий пример

[Хакер]

Lunatic, ну и что, что типы аргументов в объявлениях различаются?

[Lunatic]

А вы попробуйте и поймёте.

Если указывать через стринг, то секция видать не может корректно найтись и не обновляется, а создаётся ее дубликат c таким же именем.

[Хакер]

Нет. Дело в том, что если бы я был на месте kernel32 и мне бы предложили миллиард долларов за то, что я скажу, как была определена функция в программе, которая сейчас её вызывает, то я бы при всём желании получить миллиард не смог бы это сделать.

А у настоящей kernel32 нет ни возможности, ни желания. Так что нет никакой разницы, как объявлен аргумент, As String или As Long. Есть разница в том, как будет вызвана функция и что при этом фактически передастся.

[Lunatic]

Вот я и спрашиваю. Как вызвать эту функцию, и что ей фактически передать?

[Хакер]

На этот вопрос ответит документация по функции.

[Lunatic]

Спасибо...!! Как я сам, сразу не догадался, посмотреть в первую очередь документацию.

[alibek]

Видишь, как все просто.

[Lunatic]

Невижу! Проблема ведь осталась.

[Lunatic]

Вот файлы ДО и ПОСЛЕ UpdateResource

Что скажете?

[Хакер]

Тебе уже сказали. О том, как пользоваться вещами, написано в инструкции к вещам. Windows API функции --- не исключение. Если читать инструкции, вникать в них, следовать им --- не будет никаких проблем.

[Lunatic]

http://support.microsoft.com/kb/833659/en-us

[Хакер]

Вот видишь, документация всегда содержит ответ.

[Lunatic]

У меня более поздняя зборка Kernel32, и всё равно не работает.
Фикс для SP2, у меня SP3 стоит.

Косяк винды? Попробуйте кто нибудь код что я выложил. Если хоть у одного он заработает, я успокоюсь, и буду вспоминать добрым словом Microsoft, если же у меня руки растут не с того места, то покажите где делаю ошибку.