Как скопировать участок памяти в переменную типа Variant? - VB
Формулировка задачи:
Стоит ли игра свеч?
Так естественно не получается, ибо особая структура контейнера.
Для чего это? Вообще, делаю некий аналог VB-шной функции Get и иже с ними на WinAPI.
Т.е. вне зависимости от типа данных переменной, переданной функции Get, ей присваивается значение из файла.
Выглядит это так (но хочется упростить, если это возможно):
Листинг программы
- 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
Листинг программы
- 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
Решение задачи: «Как скопировать участок памяти в переменную типа Variant?»
textual
Листинг программы
- 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д