Побитовый сдвиг в лево\право VB6

[Res5]

Возможно ли это? В шарпе это делается легко >> или << . Можно попробовать закомпилить длл с функцией, но надеюсь есть другие варианты.

[alibek]

Нециклический — чистая арифметика.

[Res5]

Нециклический

[The trick]

Умножение на 2 - сдвиг влево, деление на 2 - сдвиг вправо (арифметический). Для логического сдвига вправо, обнулять после деления старший бит. Для циклического проверять бит до сдвига и устанавливать его с другой стороны. Все это относится к одиночному случаю (один сдвиг)

[ger_kar]

Есть готовые примеры реализации сдвига на VB. Можно или использовать как есть, либо просто посмотреть как реализовано.

[The trick]

Есть готовые примеры реализации сдвига на VB. Можно или использовать как есть, либо просто посмотреть как реализовано.

Глупо для элементарных команд использовать кучу лишнего, проверку ошибок, когда можно сделать проще. К тому же код не будет работать на новых ОС, где требуется разрешение на выполнение. Если и делать через вызов функций, то делать по-человечески, чтобы работало везде

Код: Выделить всё

Option Explicit

Private Declare Function HeapCreate Lib "kernel32" (ByVal flOptions As Long, ByVal dwInitialSize As Long, ByVal dwMaximumSize As Long) As Long
Private Declare Function HeapDestroy Lib "kernel32" (ByVal hHeap As Long) As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (pSrc As Any, pDst As Any) As Long
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal ptrFc As Long, ByVal P1 As Long, ByVal P2 As Long, ByVal P3 As Long, ByVal P4 As Long) As Long

Private Const HEAP_CREATE_ENABLE_EXECUTE = &H40000
Private Const HEAP_NO_SERIALIZE = &H1

Dim Code() As Long, hHeap As Long, lpFunc As Long, lpOldPt As Long, lpSA As Long

Public Function InitSh() As Boolean ' Инициализация процедур
    ReDim Code(4)
    hHeap = HeapCreate(HEAP_CREATE_ENABLE_EXECUTE Or HEAP_NO_SERIALIZE, (UBound(Code) + 1) * 4, (UBound(Code) + 1) * 4)
    If hHeap = 0 Then MsgBox "Error creating heap", vbCritical: Exit Function
    lpFunc = HeapAlloc(hHeap, HEAP_NO_SERIALIZE, (UBound(Code) + 1) * 4)
    If lpFunc = 0 Then MsgBox "HeapAlloc return NULL", vbCritical: Exit Function
    GetMem4 ByVal ArrPtr(Code()), lpSA
    GetMem4 ByVal lpSA + 12, lpOldPt
    GetMem4 lpFunc, ByVal lpSA + 12
    Code(0) = &H53E58955: Code(1) = &H8B08458B: Code(2) = &HD30C4D: Code(3) = &H5DEC895B: Code(4) = &HC3
End Function
Public Function DeinitSh() As Boolean   ' Деинициализация
    GetMem4 lpOldPt, ByVal lpSA + 12
    If lpFunc Then HeapFree hHeap, HEAP_NO_SERIALIZE, ByVal lpFunc
    If hHeap Then HeapDestroy hHeap
End Function
Public Function Shl(ByVal Operand As Long, ByVal Count As Long) As Long     ' Логический сдвиг влево
    Code(2) = &HE0D30C4D
    Shl = CallWindowProc(VarPtr(Code(0)), Operand, Count, 0, 0)
End Function
Public Function Sal(ByVal Operand As Long, ByVal Count As Long) As Long     ' Арифметический сдвиг влево
    Sal = Shl(Operand, Count)
End Function
Public Function Shr(ByVal Operand As Long, ByVal Count As Long) As Long     ' Логический сдвиг вправо
    Code(2) = &HE8D30C4D
    Shr = CallWindowProc(VarPtr(Code(0)), Operand, Count, 0, 0)
End Function
Public Function Sar(ByVal Operand As Long, ByVal Count As Long) As Long     ' Арифметический сдвиг вправо
    Code(2) = &HF8D30C4D
    Sar = CallWindowProc(VarPtr(Code(0)), Operand, Count, 0, 0)
End Function

Код: Выделить всё

Private Sub Form_Load()
    Dim i As Long
   
    InitSh
   
    For i = 0 To 32
        Debug.Print Hex(Shr(-1, i)); Tab(20); Hex(Sar(-1, i)); Tab(40); Hex(Shl(-1, i))
    Next
   
    DeinitSh
End Sub


[alibek]

Если и делать через вызов функций, то делать по-человечески, чтобы работало везде

Это как раз не по человечески, использовать машиннокодовые вставки в языке высокого уровня, когда в этом нет острой необходимости.

[Хакер]

Это как раз не по человечески, использовать машиннокодовые вставки в языке высокого уровня, когда в этом нет острой необходимости.

Код GSerg-а, на который ссылаются выше. тоже их использует. Так что в этом плане разницы нет. А под чёловечностью он имел в виду HEAP_CREATE_ENABLE_EXECUTE, ибо те, кто этим не пользуются — не человеки.