Форум программистов, компьютерный форум, киберфорум
Наши страницы
Visual Basic
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
1

Как скопировать участок памяти в переменную типа Variant?

09.06.2015, 10:50. Просмотров 961. Ответов 20
Метки нет (Все метки)

Стоит ли игра свеч?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Private Declare Sub memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
 
sub form_load()
    Dim vVar        As Variant
    Dim lVar        As Long
    
    lVar = 5
    
    memcpy vVar, lVar, LenB(lVar)
    
    Debug.Print vVar
    Stop
end sub
Так естественно не получается, ибо особая структура контейнера.

Для чего это? Вообще, делаю некий аналог VB-шной функции Get и иже с ними на WinAPI.
Т.е. вне зависимости от типа данных переменной, переданной функции Get, ей присваивается значение из файла.

Выглядит это так (но хочется упростить, если это возможно):

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit
 
Private Declare Function SetFilePointer Lib "kernel32.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfByConstesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
 
Const NO_ERROR                  As Long = 0&
Const INVALID_SET_FILE_POINTER  As Long = &HFFFFFFFF
Const FILE_BEGIN                As Long = 0&
Const FILE_CURRENT              As Long = 1&
Const FILE_END                  As Long = 2&
Const GENERIC_READ              As Long = &H80000000
Const GENERIC_WRITE             As Long = &H40000000
Const FILE_SHARE_READ           As Long = 1&
Const FILE_SHARE_WRITE          As Long = 2&
Const OPEN_EXISTING             As Long = 3&
Const INVALID_HANDLE_VALUE      As Long = -1&
 
 
sub form_load()
 
    Dim hFile       As Long
    Dim FileName    As String
    Dim PE_offset   As Long
 
    FileName = "d:\Наши проекты\Check Browsers LNK\Check Browsers LNK.exe"
 
    hFile = CreateFile(StrPtr(FileName), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
    
    If hFile = INVALID_HANDLE_VALUE Then Err.Raise 52
 
    GetW hFile, &H3C, PE_offset
 
    stop
end sub
 
Function GetW(hFile As Long, Pos As Long, vOut As Variant) As Long
    On Error GoTo ErrorHandler
    Dim lBytesRead  As Long
    Dim lVar_       As Long
    Dim iVar_       As Integer
    Dim sVar_       As String
    Dim cVar_       As Currency
    
    If INVALID_SET_FILE_POINTER <> SetFilePointer(hFile, Pos, ByVal 0&, FILE_BEGIN) Then
        If NO_ERROR = Err.LastDllError Then
            Select Case VarType(vOut)
            Case vbString
                If 0 = ReadFile(hFile, StrPtr(sVar_), Len(sVar_), lBytesRead, 0&) Then WriteC "Cannot read file!", cErr: Err.Raise 52
                vOut = sVar_
            Case vbLong
                If 0 = ReadFile(hFile, VarPtr(lVar_), LenB(lVar_), lBytesRead, 0&) Then WriteC "Cannot read file!", cErr: Err.Raise 52
                vOut = lVar_
            Case vbInteger
                If 0 = ReadFile(hFile, VarPtr(iVar_), LenB(iVar_), lBytesRead, 0&) Then WriteC "Cannot read file!", cErr: Err.Raise 52
                vOut = iVar_
            Case vbCurrency
                If 0 = ReadFile(hFile, VarPtr(cVar_), LenB(cVar_), lBytesRead, 0&) Then WriteC "Cannot read file!", cErr: Err.Raise 52
                vOut = cVar_
            Case Else
                WriteC "Error! GetW for type #" & VarType(vOut) & " of buffer is not supported.", cErr
            End Select
        Else
            WriteC "Cannot set file pointer!", cErr: Err.Raise 52
        End If
    Else
        WriteC "Cannot set file pointer!", cErr: Err.Raise 52
    End If
    
    Exit Function
ErrorHandler:
    WriteC "Error #" & Err.Number & ". LastDll=" & Err.LastDllError & ". " & Err.Description, cErr
    'ExitProcess 1
End Function
 
Private Sub WriteC(ByVal txt As String, cHandle As Long)
    'txt = txt & vbNewLine
    'WriteConsole cHandle, ByVal txt, Len(txt), 0&, ByVal 0&
End Sub
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
09.06.2015, 10:50
Ответы с готовыми решениями:

Как скопировать содержимое листа Excel в переменную типа Variant
Доброго времени суток! Передо мной встал следующий вопрос: есть книга Excel с листом данных, c...

Как записать в массив типа variant значение типа double?
Есть массив массивов типа variant. В первой ячейке (элементе) текст, в остальных 4 нули. Текст-1...

Как конвертировать переменную типа Double в переменную типа String?
Как конвертировать переменную типа Double в переменную типа String. И наоборот.

Как вывести переменную Variant(Excel) в компонент OleContainer ?
Всем привет! У меня получается работать с Excel документом через переменную Variant, и у меня...

Сохранить и прочитать из памяти переменную типа word
имеется программа которая читает показания с датчиков и сохраняет их в память а при получении...

20
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
09.06.2015, 13:47 2
Ну вообще данные у Variant'а храняться по смещению + 8, от начала структуры.
В первом word'е (Integer) хранится тип вместе с флагами.
Учти что при передачи по ссылке взводится флаг VT_BYREF (насколько я помню).
1
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
09.06.2015, 17:36  [ТС] 3
Спасибо, разобрался как работает. Наверное, получится наоборот только усложнить.
Цитата Сообщение от The trick Посмотреть сообщение
Учти что при передачи по ссылке взводится флаг VT_BYREF (насколько я помню).
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Declare Sub memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
 
Dim ret As Long
 
Private Sub Form_Load()
    Dim vVar_       As Variant
    vVar_ = 1&
    foo vVar_
End Sub
    
Function foo(vVar_)
    memcpy ret, ByVal VarPtr(vVar_), 4&
    Debug.Print "BYREF=" & ret
    Debug.Print "TYPE=" & VarType(vVar_)
End Function
Ответ 3 (VT_I4). Или куда передачу ты имел в виду?
0
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
09.06.2015, 19:32 4
Ты передаешь Variant. Если ты передашь туда переменную другого типа, то Variant будет ссылаться на эту переменную с флагом VT_BYREF:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Declare Sub memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
 
Dim ret As Long
 
Private Sub Form_Load()
    Dim vVar_       As Long
    vVar_ = 1&
    foo vVar_
End Sub
    
Function foo(vVar_)
    memcpy ret, ByVal VarPtr(vVar_), 4&
    Debug.Print "BYREF=" & ret
    Debug.Print "TYPE=" & VarType(vVar_)
End Function
1
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
17.06.2015, 11:50  [ТС] 5
А можно еще немного нубских вопросов?

1. Можно ли и как передать в функцию переменную по значению, а не по указателю,
если функция объявлена через byref, при условии, что нельзя менять ее прототип.

foo ByVal n - выдает ошибку типа.

2. Если решаемо, то исходя из этого потом вопрос: как внутри функции узнать, переменная была
передана по указателю или по значению?

Даже если так (см. п.1.) нельзя, и мы просто передадим константу, например:

foo 1&

то вопрос № 2 здесь тоже актуален: как узнать была передана константа или переменная по указателю...


Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
 
Private Sub Form_Load()
    Dim n&
    
    n = 1
    
    foo ByVal n
    Debug.Print n
    foo n
    Debug.Print n
End Sub
 
Function foo(arg As Long)
    arg = arg + 1
End Function
Добавлено через 4 минуты
P.S. Вопрос № 1 решил примерно так:
Visual Basic
1
foo CLng(n)
хотя оно выглядит не очень корректно.
0
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
17.06.2015, 12:03 6
Цитата Сообщение от Dragokas Посмотреть сообщение
1. Можно ли и как передать в функцию переменную по значению, а не по указателю,
если функция объявлена через byref, при условии, что нельзя менять ее прототип.
Нет, только в API.
Цитата Сообщение от Dragokas Посмотреть сообщение
то вопрос № 2 здесь тоже актуален: как узнать была передана константа или переменная по указателю...
Никак. Передается не константа а параеменная содержащая значение константы, можешь проверить это вызвав внутри foo другую функцию передав аргумент по ссылке.
Цитата Сообщение от Dragokas Посмотреть сообщение
Вопрос № 1 решил примерно так:
Можешь просто заключить в скобки.
0
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
17.06.2015, 12:10  [ТС] 7
PPS. Ошибся. Все сказанное "по указателю" понимать как "по ссылке". (указатель предполагает возможность задавать адрес, а в функции VB такого не поддерживают).

Добавлено через 6 минут
Жаль. Хотел написать для удобного использования wrapper для DispCallFunc, да вот только
мне не хватает такого объекта как byRef ParamArray.

И даже если сделать прототип со скажем, 6 опциональными отдельными аргументами вместо ParamArray,
то нельзя определить как дальше конструировать новый массив, т.к. не ясно какому из эл-тов присваивать адрес переданной переменной, а какому просто значение.
0
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
17.06.2015, 12:20 8
Почему бы не использовать ParamArray?

Добавлено через 1 минуту
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Public Function ApiStdCall(LibName As String, FuncName As String, ByVal retType As VbVarType, ParamArray params()) As Variant
    Dim types()     As Integer
    Dim list()      As Long
    Dim param()     As Variant
    Dim pIndex      As Long
    Dim ptrList     As Long
    Dim ptrTypes    As Long
    Dim resultCall  As Long
    Dim hLib        As Long
    Dim funcAddress As Long
 
    Const CC_STDCALL    As Long = 4
 
    hLib = LoadLibrary(LibName)
    If hLib = 0 Then Err.Raise 5: Exit Function
    
    funcAddress = GetProcAddress(hLib, FuncName)
    If funcAddress = 0 Then Err.Raise 5: Exit Function
 
    If LBound(params) <= UBound(params) Then
        
        ReDim list(LBound(params) To UBound(params))
        ReDim types(LBound(params) To UBound(params))
        ReDim param(LBound(params) To UBound(params))
        
        For pIndex = LBound(params) To UBound(params)
            param(pIndex) = params(pIndex)
            list(pIndex) = VarPtr(param(pIndex))
            types(pIndex) = VarType(param(pIndex))
        Next
        
        ptrList = VarPtr(list(LBound(list)))
        ptrTypes = VarPtr(types(LBound(types)))
        
    End If
 
    resultCall = DispCallFunc(ByVal 0, _
                              funcAddress, _
                              CC_STDCALL, _
                              retType, _
                              UBound(params) - LBound(params) + 1, _
                              ptrTypes, _
                              ptrList, _
                              ApiCall)
             
    FreeLibrary hLib
    
    If resultCall Then Err.Raise 5: Exit Function
    
End Function
Добавлено через 6 минут
Используя DispCallFunc можно также вызывать методы интерфейса, вот к примеру работы с ITypeLib, ITypeInfo без tlb.
0
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
17.06.2015, 12:33  [ТС] 9
Цитата Сообщение от The trick Посмотреть сообщение
Никак. Передается не константа а параеменная содержащая значение константы, можешь проверить это вызвав внутри foo другую функцию передав аргумент по ссылке.
Ну почему же нельзя.

Переменные попадают в стек последовательно в обратном порядке.
Это означает, что если тип аргументов прототипа заранее известен и
если обусловится, что 1-й аргумент функции всегда будет передаваться по значению,
то адреса остальных переменных можно заранее вычислить.
И если этот адрес будет не совпадать с расчетным, то такая переменная была передана по ссылке.
Вот смотри:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
 
Private Sub Form_Load()
    Dim n&
    
    n = 1
    
    foo 1, 2, 3, 4
    
    Debug.Print "----------"
    
    foo 1, 2, n, 4
End Sub
 
Function foo(v1&, v2&, v3&, v4&)
    Debug.Print VarPtr(v1)
    Debug.Print VarPtr(v2)
    Debug.Print VarPtr(v3)
    Debug.Print VarPtr(v4)
End Function
1243232
1243228
1243224
1243220
----------
1243232
1243228
1243236
1243224
В 1-м случае прослеживается последовательность (-4)
Во 2-м случае последовательность "ламается" на 3-м аргументе.

Добавлено через 12 минут
Хм... The trick, видимо я что-то упустил. ParamArray действительно воспринимает по ссылке.
0
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
17.06.2015, 12:35 10
Как ты определишь что это константы или переменные если передать переменные которые расположены на таком же расстоянии как и псевдопеременные в которые копируется значение константы?
К тому же последовательность ломается и без этого. (см скрин)
0
Миниатюры
Как скопировать участок памяти в переменную типа Variant?  
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
17.06.2015, 16:35  [ТС] 11
У меня не работало, потому что я передавал массив ParamArray params напрямую, не делая так как ты в строке № 27 через промежуточный.
Visual Basic
1
param(pIndex) = params(pIndex)
Кстати, почему напрямую нельзя?

Добавлено через 3 минуты
Цитата Сообщение от The trick Посмотреть сообщение
Как ты определишь что это константы или переменные если передать переменные которые расположены на таком же расстоянии как и псевдопеременные в которые копируется значение константы?
К тому же последовательность ломается и без этого. (см скрин)
Идея была, чтобы 1-й эл-т всегда передавался по значению. От него и плясать.
Но судя по твоим тестам - Убедил

Добавлено через 3 часа 7 минут
Анатолий, а можешь пожалуйста, подсказать, как задать для DispCallFunc тип данных произвольного размера?

Ниже - полностью рабочая демка (чисто для теста), использующая UDT.
Мне нужно увеличить размер UDT, соответственно я поменяю в строке № 65
rtnType на vbvartype.vbUserDefinedType. Но похоже функция не узнает эту константу и выдает ошибку:
80070057
E_INVALIDARG
One or more arguments are invalid
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
 
Private Type UDT
    Data(3) As Byte
End Type
 
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal loLibfileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function DispCallFunc Lib "oleaut32.dll" _
    (ByVal pvInstance As Long, _
    ByVal FuncAddr As Long, _
    ByVal CallConvention As Integer, _
    ByVal rtnType As VbVarType, _
    ByVal FuncArgsCnt As Long, _
    FuncArgTypes As Any, _
    FuncArgVarAddresses As Any, _
    FuncResult As Any) As Long
 
Const CC_CDECL As Long = 1&
 
Public Sub form_load()
    Dim ret             As Variant
    Dim sOut            As String
    Dim sFormat         As String
    Dim lParam1         As Long
    Dim sParam2         As String
    Dim hLib            As Long
    sOut = String(100, vbNullChar)
    sFormat = "Param1 = %d , Param2 = %s"
    lParam1 = 123456
    sParam2 = "abc"
    hLib = LoadLibrary("user32.dll")
    ret = Exec_Func(hLib, "wsprintfW", vbLong, sOut, sFormat, lParam1, sParam2)
    FreeLibrary hLib
    Debug.Print sOut
End Sub
 
Function Exec_Func(hLib As Long, FunctionName As String, rtnType As VbVarType, ParamArray Args()) As Variant
    Dim i           As Long
    Dim hProc       As Long
    Dim ret         As UDT
    Dim iVarTypes() As Integer
    Dim lVarPtrs()  As Long
    Dim vParams()   As Variant
    Dim ErrRtn      As Long
    
    hProc = GetProcAddress(hLib, FunctionName)
    If hProc = 0 Then MsgBox "Error: cannot get " & FunctionName & " function address!": Exit Function
    
    'ret = Empty
    
    If UBound(Args) > -1 Then
        ReDim vParams(UBound(Args))
        ReDim iVarTypes(UBound(Args))
        ReDim lVarPtrs(UBound(Args))
        
        For i = 0 To UBound(vParams)
            vParams(i) = Args(i)
            iVarTypes(i) = VarType(vParams(i))
            lVarPtrs(i) = VarPtr(vParams(i))
        Next
                
        'VbVarType.vbUserDefinedType
        ErrRtn = DispCallFunc(0&, hProc, CC_CDECL, rtnType, UBound(vParams) + 1, iVarTypes(0), lVarPtrs(0), ret)
        
        If ErrRtn <> 0 Then Debug.Print Hex(ErrRtn): Exit Function
    Else
        If 0 <> DispCallFunc(0&, hProc, CC_CDECL, rtnType, 0&, ByVal 0&, ByVal 0&, ret) Then Exit Function
    End If
    
    'Exec_Func = ret
    For i = 0 To UBound(Args): Args(i) = vParams(i): Next
End Function
0
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
17.06.2015, 17:40 12
Цитата Сообщение от Dragokas Посмотреть сообщение
Кстати, почему напрямую нельзя?
Возможно (не знаю точно), что некоторые параметры могут передаться с флагом VT_BYREF и это возможно вызовет ошибку.
Цитата Сообщение от Dragokas Посмотреть сообщение
rtnType на vbvartype.vbUserDefinedType. Но похоже функция не узнает эту константу и выдает ошибку:
Так нельзя. Передавай vbLong - это возвратит указатель, из него копируй.
0
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
16.07.2015, 14:07  [ТС] 13
А есть ли какой аналог LenB(), так чтобы в скобках указать не переменную, а ее адрес? (переменная - целочисленного типа)
0
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
16.07.2015, 15:51  [ТС] 14
Анатолий, а сможешь еще подсказать как получить указатель на массив, переданный функции?

У меня вот что получается:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
 
Private Declare Function memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long) As Long
 
Private Sub Form_Load()
    Dim b(1) As Byte
    
    b(0) = 3
    b(1) = 4
 
    Debug.Print "Addr b(0)=" & Hex(VarPtr(b(0)))
    foo b
End Sub
 
Function foo(v As Variant)
    Dim ptr As Long
    
    Debug.Print "Addr v: " & Hex(VarPtr(v))
    
    memcpy ptr, ByVal VarPtr(v) + 8, 4&
    Debug.Print "Addr ptr: " & Hex(ptr)
    Debug.Print "Type: " & Hex(VarType(v))
    
End Function
Как скопировать участок памяти в переменную типа Variant?


Addr b(0)=C508720
Addr v: 18FB4C
Addr ptr: 18FAC0
Type: 2011
Т.е. даже если по картинке рассматривать будто 0x920001 - это какое-то смещение, то C508720 все равно на много дальше.
Перевернутое значение C508720 в памяти искал. Глухо.

А на счет типа - это он неверно определяет. В памяти видно, что оно = 6011 как и должно быть (VT_BYREF + VT_ARRAY + VT_BOOL (byte)).
1
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
15.08.2015, 00:02 15
Цитата Сообщение от Dragokas Посмотреть сообщение
А на счет типа - это он неверно определяет. В памяти видно, что оно = 6011 как и должно быть (VT_BYREF + VT_ARRAY + VT_BOOL (byte)).
Там шестнадцатеричное значение 1116 = 1710 = VT_UI1 = Byte - все правильно.
Смотри:
По смещению 8 относительно варианта содержится указатель (т.к. VT_BYREF) на указатель на SafeArray (т.е. VB-шный массив). Соответственно 18FAC8 - это указатель на структуру SafeArray:
  • 0x0001h - cDims - (количество размерностей);
  • 0x0092h - fFeatures - (флаги FADF_HAVEVARTYPE|FADF_FIXEDSIZE|FADF_STATIC);
  • 0x00000001 - cbElements (размер одного элемента);
  • 0x00000000 - cLocks (количество блокировок);
  • 0x0C508720 - pvData (указатель на первый элемент массива (соответствует действительностти));
  • 0x00000002 - cElements (количество элементов массива UBound - LBound + 1);
  • 0x00000000 - lLbound (нижняя граница - LBound(arr)).
2
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
16.08.2015, 18:37  [ТС] 16
Цитата Сообщение от The trick Посмотреть сообщение
Там шестнадцатеричное значение 1116 = 1710 = VT_UI1 = Byte - все правильно.
Никто не споит. Но VarType внутри функции возвращает 201116, в то время как в памяти - 601116. Разница в VT_BYREF (400016).

Спасибо за описание структуры SafeArray. Разобрался.

Кстати, нашел пример от Comintern,
где подменой указателя на SafeArray пользуются, чтобы "преобразовать" в массив участок памяти, на который спроэцирован файл, для удобства операций, подобно сишному:

C++
1
2
3
PBYTE pbFile = (PBYTE) MapViewOfFile(hFileMapping, FILE_MAP_WRITE, 0, 0, 0);
BYTE bSomeByte = pbFile[0]; // чтение
pbFile[0] = 0; // запись
Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Option Explicit
 
' File Mapping example by Comintern (vbforums.com)
'
' Fork by Dragokas
' Added missed CloseHandle & recover of array pointer & some code protections
 
'API DECs
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, _
                                                                     ByVal ByteLen As Long)
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" (ByVal lpFileName As Long, _
                                         ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
                                         ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, _
                                         ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
'MEMORY MAPPING APIs
Private Declare Function MapViewOfFile Lib "kernel32.dll" (ByVal hFile As Long, ByVal dwDesiredAccess As Long, _
                                         ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, _
                                         ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function CreateFileMapping Lib "kernel32.dll" Alias "CreateFileMappingA" (ByVal hFile As Long, _
                                         ByVal lpAttributes As Long, ByVal flProtect As Long, _
                                         ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, _
                                         ByVal lpName As String) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32.dll" (ByVal lpBaseAddress As Long) As Boolean
 
'STRUCTS FOR THE SAFEARRAY:
Private Type SafeBound
    cElements As Long
    lLbound As Long
End Type
 
Private Type SafeArray
    cDim As Integer
    fFeature As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    rgsabound As SafeBound
End Type
 
'MISC CONSTs
Private Const VT_BY_REF = &H4000&
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const MOVEFILE_REPLACE_EXISTING = &H1
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_BEGIN = 0
Private Const CREATE_NEW = 1
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const PAGE_READWRITE = 4
Private Const FILE_MAP_WRITE = &H2
Private Const FILE_MAP_READ = &H4
Private Const FADF_FIXEDSIZE = &H10
Private Const INVALID_HANDLE_VALUE As Long = -1&
 
Public Sub MapFileMemory()
    Dim hFile As Long, sFile As String, lPointer As Long, hFileMap As Long, lFileLen As Long, uTemp As SafeArray, oldTemp As SafeArray
    Dim bBytes() As Byte
 
    sFile = "c:\temp\Test2.txt"                         'Set the filename.
    
    lFileLen = FileLen(sFile)                           'Find the length of the target file.
    
    If lFileLen = 0 Then Exit Sub                       'dwMaximumSizeLow of CreateFileMapping cannot be 0, if file size is 0.
    
                                                        'Map it.
    hFile = CreateFile(StrPtr(sFile), GENERIC_READ Or GENERIC_WRITE, 0&, 0&, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0&)
    If hFile = INVALID_HANDLE_VALUE Then Exit Sub
    
    hFileMap = CreateFileMapping(hFile, 0&, PAGE_READWRITE, 0&, 0&, "MySharedMapping")
    If hFileMap = 0 Then Exit Sub
    
    lPointer = MapViewOfFile(hFileMap, FILE_MAP_WRITE, 0&, 0&, 0&)
    If lPointer = 0 Then Exit Sub
 
    bBytes = StrConv("TestTestTest", vbFromUnicode)     'Create an array.
    
    If GetArrayInfo(bBytes, uTemp) Then                 'Load the UDT with the array info.
        oldTemp = uTemp                                 'Backup old array struct
        uTemp.cbElements = 1                            'Set element size to a byte.
        uTemp.rgsabound.cElements = lFileLen            'Set the UBound of the array.
        uTemp.fFeature = uTemp.fFeature And FADF_FIXEDSIZE  'Set the "Fixed size" flag, SHOULD MAKE REDIM FAIL!
        uTemp.pvData = lPointer                         'Point it to the memory mapped file as it's data.
        Call AlterArray(bBytes, uTemp)                  'Write the UDT over the old array.
    End If
 
    For lFileLen = LBound(bBytes) To UBound(bBytes)     'This should be reading from the file.
        Debug.Print bBytes(lFileLen)
    Next lFileLen
 
    bBytes(0) = 61                                      'Change the first char to a "=" to see if it worked.
    
    Call AlterArray(bBytes, oldTemp)                    'Recover array struct
    UnmapViewOfFile lPointer                            'Release the memory map.
    CloseHandle hFileMap                                'Close File Mapping
    CloseHandle hFile                                   'Close the opened file.
 
End Sub
 
Private Function GetArrayInfo(vArray As Variant, uInfo As SafeArray) As Boolean
    
    'NOTE, the array is passed as a variant so we can get it's absolute memory address.  This function
    'loads a copy of the SafeArray structure into the UDT.
    
    Dim lPointer As Long, iVType As Integer
    
    If Not IsArray(vArray) Then Exit Function               'Need to work with a safearray here.
 
    With uInfo
        CopyMemory iVType, vArray, 2                        'First 2 bytes are the subtype.
        CopyMemory lPointer, ByVal VarPtr(vArray) + 8, 4    'Get the pointer.
 
        If (iVType And VT_BY_REF) <> 0 Then                 'Test for subtype "pointer"
            CopyMemory lPointer, ByVal lPointer, 4          'Get the real address.
        End If
        
        CopyMemory uInfo.cDim, ByVal lPointer, 16           'Write the safearray to the passed UDT.
        
        If uInfo.cDim = 1 Then                              'Can't do multi-dimensional
            CopyMemory .rgsabound, ByVal lPointer + 16, LenB(.rgsabound)
            GetArrayInfo = True
        End If
    End With
 
End Function
 
Private Function AlterArray(vArray As Variant, uInfo As SafeArray) As Boolean
    
    'NOTE, the array is passed as a variant so we can get it's absolute memory address.  This function
    'writes the SafeArray UDT information into the actual memory address of the passed array.
    
    Dim lPointer As Long, iVType As Integer
 
    If Not IsArray(vArray) Or uInfo.cDim <> 1 Then Exit Function
 
    With uInfo
        CopyMemory iVType, vArray, 2                        'Get the variant subtype
        CopyMemory lPointer, ByVal VarPtr(vArray) + 8, 4    'Get the pointer.
 
        If (iVType And VT_BY_REF) <> 0 Then                 'Test for subtype "pointer"
            CopyMemory lPointer, ByVal lPointer, 4          'Get the real address.
        End If
 
        CopyMemory ByVal lPointer, uInfo.cDim, 16           'Overwrite the array with the UDT.
 
        If uInfo.cDim = 1 Then                              'Multi-dimensions might wipe out other memory.
            CopyMemory ByVal lPointer + 16, .rgsabound, LenB(.rgsabound)
            AlterArray = True
        End If
 
    End With
 
End Function
0
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
16.08.2015, 19:16 17
Цитата Сообщение от Dragokas Посмотреть сообщение
Никто не споит.
Просто ты написал VT_BOOL. VT_BOOL - это WORD.
Цитата Сообщение от Dragokas Посмотреть сообщение
где подменой указателя на SafeArray пользуются, чтобы "преобразовать" в массив участок памяти, на который спроэцирован файл, для удобства операций, подобно сишному:
Я тоже делал такое, даже подробно описывал тут. Имея 2 функции PtGet и PtRelease можно работать с указателями через массив.
1
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
16.08.2015, 20:28  [ТС] 18
Цитата Сообщение от The trick Посмотреть сообщение
Просто ты написал VT_BOOL. VT_BOOL - это WORD.
Ага. Вижу. Систему счисления спутал.
0
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
06.08.2016, 11:15  [ТС] 19
А адрес указателя на структуру как вычислить?
Хочу подменить указатель.

Можно конечно завести массив структур, и получить указатель по методу из поста №14-15.
Но хочется знать как без массива.
0
The trick
Модератор
7728 / 2746 / 769
Регистрация: 22.02.2013
Сообщений: 3,887
Записей в блоге: 77
06.08.2016, 12:59 20
Цитата Сообщение от Dragokas Посмотреть сообщение
А адрес указателя на структуру как вычислить?
В стеке?
0
06.08.2016, 12:59
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
06.08.2016, 12:59

Размер памяти, выделяемый под переменную комбинированного типа
1)type Complex=record Re, Im:real end; M=array of Complex; var a:M; ...

Как строковую переменную(String) сканвертировать в переменную типа(Real)
У меня есть Edit1.Text (строковая) а var x: Real каким образом мне сконвертировать Edit1.Text в...

Как передать из ACCESS переменную STRING в переменную окружения (типа CMD команды SET=)
Добрый день! Подскажите как установить переменную окружения из ACCESS. Допустим у меня есть...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru