| |
Как известно, Windows использует в своей работе две
кодовые таблицы, которые мы обычно называем DOS и
Windows, но формально они именуются OEM и ANSI. Довольно
многие функции обработки строковых переменных
зависят от значения кодовых таблиц,
установленных при инсталляции системы, которые
можно определить с помощью функций API:
Private Declare Function GetACP Lib "kernel32" () As
Long
Private Declare Function GetOEMCP Lib "kernel32" () As Long
Private Sub Form_Load()
MsgBox "ACP = " & GetACP & vbCrLf & "OEMCP = " &
GetOEMCP
End Sub
В принципе значения кодовых таблиц можно
менять уже после инсталляции Windows. Мы не советуем
злоупотреблять этим, но такая коррекция может
быть полезной при тестировании и анализе работы
программ. Параметры ACP и OEMCP хранятся в разделе
HKEY_Local_Machine/System/CurrentControlSet/Control/Nls/Codepage файла Реестра
и редактируются с помощью утилиты REGEDIT.EXE. Для их
активизации нужно перезагрузить Windows.
Номера таблиц, которые могут понадобиться:
OEMCP = 866 (Russian), 437 (US — default), 850 (International), 855 (Cyrilic)
ACP = 1250 (Eastern European), 1251 (Cyrilic & Russian), 1252 (US & Western
European), 1200 (Unicode)
© 1999, Андрей Колесов, Ольга Павлова
'КОД ФОРМЫ
Private Sub Command1_Click()
MsgBox GetFileDescription("c:\win\system\shell32.dll")
'MsgBox GetFileDescription(Text1.Text)
End Sub
'КОД МОДУЛЯ
Option Explicit
Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As Long,
ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long
Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, ByVal
strSrc As Any, ByVal lBytes As Long)
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias
"GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias
"GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal
lpSize As Long, ByVal lpBuf As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias
"VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As
Long, lLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias
"RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long
Public Function StringFromBuffer(buffer As String) As String
Dim nPos As Long
nPos = InStr(buffer, vbNullChar)
If nPos > 0 Then
StringFromBuffer = Left$(buffer, nPos - 1)
Else
StringFromBuffer = buffer
End If
End Function
Public Function GetFileDescription(ByVal sFile As String) As String
Dim lVerSize As Long
Dim lTemp As Long
Dim lRet As Long
Dim bInfo() As Byte
Dim lpBuffer As Long
Dim sDesc As String
Dim sKEY As String
lVerSize = GetFileVersionInfoSize(sFile, lTemp)
ReDim bInfo(lVerSize)
If lVerSize > 0 Then
lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))
If lRet <> 0 Then
sKEY = GetNLSKey(bInfo)
lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & "\FileDescription", lpBuffer,
lVerSize)
If lRet <> 0 Then
sDesc = Space$(lVerSize)
lstrcpyn sDesc, lpBuffer, lVerSize
GetFileDescription = StringFromBuffer(sDesc)
End If
End If
End If
End Function
Public Function GetNLSKey(byteVerData() As Byte) As String
Static strLANGCP As String
Dim lpBufPtr As Long
Dim strNLSKey As String
Dim fGotNLSKey As Integer
Dim intOffset As Integer
Dim lVerSize As Long
Dim lTmp As Long
Dim lBufLen As Long
Dim lLCID As Long
Dim strTmp As String
On Error GoTo GNLSKCleanup
If VerQueryValue(VarPtr(byteVerData(0)), "\VarFileInfo\Translation", lpBufPtr,
lVerSize) <> 0 Then
If Len(strLANGCP) = 0 Then
lLCID = GetUserDefaultLCID()
If lLCID > 0 Then
strTmp = Space$(8)
GetLocaleInfoA lLCID, 11, strTmp, 8
strLANGCP = StringFromBuffer(strTmp)
Do While Len(strLANGCP) < 4
strLANGCP = "0" & strLANGCP
Loop
GetLocaleInfoA lLCID, 9, strTmp, 8
strLANGCP = StringFromBuffer(strTmp) & strLANGCP
Do While Len(strLANGCP) < 8
strLANGCP = "0" & strLANGCP
Loop
End If
End If
If VerQueryValue(VarPtr(byteVerData(0)), strLANGCP, lTmp, lBufLen) <> 0 Then
strNLSKey = strLANGCP
Else
For intOffset = 0 To lVerSize - 1 Step 4
CopyMemory lTmp, ByVal lpBufPtr + intOffset, 4
strTmp = Hex$(lTmp)
Do While Len(strTmp) < 8
strTmp = "0" & strTmp
Loop
strNLSKey = "\StringFileInfo\" & Right$(strTmp, 4) & Left$(strTmp, 4)
If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
fGotNLSKey = True
Exit For
End If
Next
If Not fGotNLSKey Then
strNLSKey = "\StringFileInfo\040904E4"
If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
fGotNLSKey = True
End If
End If
End If
End If
GNLSKCleanup:
If fGotNLSKey Then
GetNLSKey = strNLSKey
End If
End Function
|
|