Пример контроля версий DLL Clarion (и не только).
1. Добавляем где-нибудь в Global Map и линкуем к проекту Version.lib (прикреплён, см. ниже):
Код: Выделить всё
Module('Windows')
Glo:memcpy(Long lpDest,Long lpSource,Long nCount),Long,Proc,Name('_memcpy')
end
Module('Version.dll')
WinGetFileVersionInfoSizeA(*CSTRING lptstrFilename, *ULong lpdwHandle),ULONG,PASCAL,RAW,Name('GetFileVersionInfoSizeA')
WinGetFileVersionInfoA( *CSTRING lptstrFilename, Long dwHandle, Long dwLen, *String lpData),BOOL,PASCAL,RAW,Name('GetFileVersionInfoA')
WinVerQueryValueA(*String pBlock, *CSTRING lpSubBlock, *ULong lplpBuffer, *ULong puLen),BOOL,PASCAL,RAW,Name('VerQueryValueA')
end
2. Пример проверки версии DLL используемой в Вашем проекте (где-нибудь при запуске EXE):
Код: Выделить всё
ExeVersion# = System{Prop:ExeVersion,3} ! Версия сборки EXE модуля
If CheckVerDll(ExeVersion#, 'CLAASC.DLL') Or |
CheckVerDll(ExeVersion#, 'CLATPS.DLL') Or |
CheckVerDll(ExeVersion#, 'CLADOS.DLL') then Return.
3. И собственно сама процедура проверки (кто найдёт ошибку - тому спасибо !):
Код: Выделить всё
CheckVerDll PROCEDURE (Long xVersion_, String xDllName_, Byte xMess_ = 0)
Loc:RetValue BYTE(False)
Loc:SubBlock CSTRING('\')
Loc:puLen ULONG(0)
Loc:Buffer ULONG
Loc:verHandle ULONG(0)
Loc:verSize ULONG
Loc:verData &STRING
Loc:verFile CSTRING(256)
Loc:verInfo Group
dwSignature Long
dwStrucVersion Long
dwFileVersionMS Long
dwFileVersionLS Long
dwProductVersionMS Long
dwProductVersionLS Long
dwFileFlagsMask Long
dwFileFlags Long
dwFileOS Long
dwFileType Long
dwFileSubtype Long
dwFileDateMS Long
dwFileDateLS Long
end
Code
Loc:verFile = Command('0') ! Получить папку EXE модуля (может отличаться от текущей папки работы)
Loc:verFile = LongPath(xExtractFileName(Loc:verFile,1) & xExtractFileName(Loc:verFile,2) & xDllName_)
Loc:verSize = WinGetFileVersionInfoSizeA(Loc:verFile, Loc:verHandle)
If Loc:verSize > 0
Loc:verData &= New(String(Loc:verSize)) ! Создаем буфер для загрузки
If ~(Loc:verData &= NULL) ! Если буфер удачно создан
If WinGetFileVersionInfoA(Loc:verFile,0,Loc:verSize,Loc:verData) <> 0 ! Получить данные о версии
If WinVerQueryValueA(Loc:verData,Loc:SubBlock,Loc:Buffer,Loc:puLen) <> 0 ! Получить адрес структуры версии
If Loc:puLen = 52
Glo:memcpy(address(Loc:verInfo), Loc:Buffer, Loc:puLen) ! Копируем кусок памяти в Loc:verInfo
If (Loc:verInfo.dwSignature = 0FEEF04BDh) and | ! Проверка сигнатуры структуры версии
(Sub(LongToHex(Loc:verInfo.dwFileVersionLS,False),5,4) <> Sub(LongToHex(xVersion_,False),5,4))
Message('Нарушена целостность библиотек программы !|' & |
'Различные версии сборки EXE и DLL файлов программы.||' & |
LongPath(Command('0')) & '|Версия: 0x' & Sub(LongToHex(xVersion_,False),5,4) & ' ( ' & |
Clip(Left(xVersion_)) & ' )||' & |
Loc:verFile & '|Версия: 0x' & Sub(LongToHex(Loc:verInfo.dwFileVersionLS,False),5,4) & ' ( ' & |
Evaluate('0' & Sub(LongToHex(Loc:verInfo.dwFileVersionLS,False),5,4) & 'h') & ' )||' & |
'Выполните пожалуйста переустановку программы.', 'У нас проблема',Icon:Exclamation,'&1. Закрыть')
Loc:RetValue = True ! Не совпадение версий DLL и EXE
end
! Просмотр содержимого Loc:verInfo при отладке
!Message(Loc:verFile & '||' & |
! 'Signature = ' & LongToHex(Loc:verInfo.dwSignature , False) & '|' & |
! 'StrucVersion = ' & LongToHex(Loc:verInfo.dwStrucVersion , False) & '|' & |
! 'FileVersionMS = ' & LongToHex(Loc:verInfo.dwFileVersionMS , False) & '|' & |
! 'FileVersionLS = ' & LongToHex(Loc:verInfo.dwFileVersionLS , False) & '|' & |
! 'ProductVersionMS = ' & LongToHex(Loc:verInfo.dwProductVersionMS, False) & '|' & |
! 'ProductVersionLS = ' & LongToHex(Loc:verInfo.dwProductVersionLS, False) & '|' & |
! 'FileFlagsMask = ' & LongToHex(Loc:verInfo.dwFileFlagsMask , False) & '|' & |
! 'FileFlags = ' & LongToHex(Loc:verInfo.dwFileFlags , False) & '|' & |
! 'FileOS = ' & LongToHex(Loc:verInfo.dwFileOS , False) & '|' & |
! 'FileType = ' & LongToHex(Loc:verInfo.dwFileType , False) & '|' & |
! 'FileSubtype = ' & LongToHex(Loc:verInfo.dwFileSubtype , False) & '|' & |
! 'FileDateMS = ' & LongToHex(Loc:verInfo.dwFileDateMS , False) & '|' & |
! 'FileDateLS = ' & LongToHex(Loc:verInfo.dwFileDateLS , False))
end ! If Loc:puLen = 52
end ! If WinVerQueryValueA(
elsIf xMess_ then Message('Ошибка WinGetFileVersionInfo !','У нас проблема',Icon:Exclamation,'&1. Закрыть')
end ! If WinGetFileVersionInfoA(
Dispose(Loc:verData)
end ! If ~(Loc:verData &= NULL)
elsIf xMess_ then Message('Ошибка GetFileVersionInfoSize !','У нас проблема',Icon:Exclamation,'&1. Закрыть')
end ! If Loc:verSize > 0
Return Loc:RetValue