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

Узнай цену своей работы

Формулировка задачи:

Стоит ли игра свеч?
Листинг программы
  1. Private Declare Sub memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
  2. sub form_load()
  3. Dim vVar As Variant
  4. Dim lVar As Long
  5. lVar = 5
  6. memcpy vVar, lVar, LenB(lVar)
  7. Debug.Print vVar
  8. Stop
  9. end sub
Так естественно не получается, ибо особая структура контейнера. Для чего это? Вообще, делаю некий аналог VB-шной функции Get и иже с ними на WinAPI. Т.е. вне зависимости от типа данных переменной, переданной функции Get, ей присваивается значение из файла. Выглядит это так (но хочется упростить, если это возможно):
Листинг программы
  1. Option Explicit
  2. Private Declare Function SetFilePointer Lib "kernel32.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
  3. 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
  4. 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
  5. Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
  6. Const NO_ERROR As Long = 0&
  7. Const INVALID_SET_FILE_POINTER As Long = &HFFFFFFFF
  8. Const FILE_BEGIN As Long = 0&
  9. Const FILE_CURRENT As Long = 1&
  10. Const FILE_END As Long = 2&
  11. Const GENERIC_READ As Long = &H80000000
  12. Const GENERIC_WRITE As Long = &H40000000
  13. Const FILE_SHARE_READ As Long = 1&
  14. Const FILE_SHARE_WRITE As Long = 2&
  15. Const OPEN_EXISTING As Long = 3&
  16. Const INVALID_HANDLE_VALUE As Long = -1&
  17.  
  18. sub form_load()
  19. Dim hFile As Long
  20. Dim FileName As String
  21. Dim PE_offset As Long
  22. FileName = "d:\Наши проекты\Check Browsers LNK\Check Browsers LNK.exe"
  23. hFile = CreateFile(StrPtr(FileName), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
  24. If hFile = INVALID_HANDLE_VALUE Then Err.Raise 52
  25. GetW hFile, &H3C, PE_offset
  26. stop
  27. end sub
  28. Function GetW(hFile As Long, Pos As Long, vOut As Variant) As Long
  29. On Error GoTo ErrorHandler
  30. Dim lBytesRead As Long
  31. Dim lVar_ As Long
  32. Dim iVar_ As Integer
  33. Dim sVar_ As String
  34. Dim cVar_ As Currency
  35. If INVALID_SET_FILE_POINTER <> SetFilePointer(hFile, Pos, ByVal 0&, FILE_BEGIN) Then
  36. If NO_ERROR = Err.LastDllError Then
  37. Select Case VarType(vOut)
  38. Case vbString
  39. If 0 = ReadFile(hFile, StrPtr(sVar_), Len(sVar_), lBytesRead, 0&) Then WriteC "Cannot read file!", cErr: Err.Raise 52
  40. vOut = sVar_
  41. Case vbLong
  42. If 0 = ReadFile(hFile, VarPtr(lVar_), LenB(lVar_), lBytesRead, 0&) Then WriteC "Cannot read file!", cErr: Err.Raise 52
  43. vOut = lVar_
  44. Case vbInteger
  45. If 0 = ReadFile(hFile, VarPtr(iVar_), LenB(iVar_), lBytesRead, 0&) Then WriteC "Cannot read file!", cErr: Err.Raise 52
  46. vOut = iVar_
  47. Case vbCurrency
  48. If 0 = ReadFile(hFile, VarPtr(cVar_), LenB(cVar_), lBytesRead, 0&) Then WriteC "Cannot read file!", cErr: Err.Raise 52
  49. vOut = cVar_
  50. Case Else
  51. WriteC "Error! GetW for type #" & VarType(vOut) & " of buffer is not supported.", cErr
  52. End Select
  53. Else
  54. WriteC "Cannot set file pointer!", cErr: Err.Raise 52
  55. End If
  56. Else
  57. WriteC "Cannot set file pointer!", cErr: Err.Raise 52
  58. End If
  59. Exit Function
  60. ErrorHandler:
  61. WriteC "Error #" & Err.Number & ". LastDll=" & Err.LastDllError & ". " & Err.Description, cErr
  62. 'ExitProcess 1
  63. End Function
  64. Private Sub WriteC(ByVal txt As String, cHandle As Long)
  65. 'txt = txt & vbNewLine
  66. 'WriteConsole cHandle, ByVal txt, Len(txt), 0&, ByVal 0&
  67. End Sub

Решение задачи: «Как скопировать участок памяти в переменную типа Variant?»

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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

7   голосов , оценка 3.857 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы