Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0693: Verschlüsselung mit dem Advanced Vigenère-Algorithmus

VB 5/6-Tipp 0693: Verschlüsselung mit dem Advanced Vigenère-Algorithmus

 von Udo Schmidt

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (API_CopyByRef), CallWindowProcA (ASM_Hash), CallWindowProcA (ASM_cdRF3)

Download: Download des Beispielprojektes [26,74 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'---- Anfang Klasse "asmCryption" alias asmCryption.cls  ----


'---------------------------------------------------------------------------------------
' Module    : asmCryption
' Author    : (softKUS) - I/2004
'---------------------------------------------------------------------------------------
Option Base 0
Option Explicit
Option Compare Text

' s. also: http://www.itl.nist.gov/fipspubs/fip180-1.htm
'
Const def_flg = 72
Const def_len = 73

Dim asm()   As Long
Dim def()   As Long

Private Declare Sub API_CopyByRef _
    Lib "kernel32" Alias "RtlMoveMemory" _
   (ByRef hpvDest As Any, _
    ByRef hpvSource As Any, _
    ByVal cbCopy As Long)

Private Declare Function ASM_Hash _
    Lib "user32" Alias "CallWindowProcA" _
   (ByRef asm As Long, _
    ByVal src As Long, _
    ByVal ref As Long, _
    ByRef tgt As Long, _
    ByRef def As Long) As Long

Private Sub Class_Initialize()
    ReDim asm(124)
    ReDim def(73)

    ' program code
    asm(0) = &HEC8B5590:  asm(1) = &H8B575653:  asm(2) = &H968B1475
    asm(3) = &H120:       asm(4) = &H124868B:   asm(5) = &H50520000
    asm(6) = &H1A8EC81:   asm(7) = &HC2F60000:  asm(8) = &HA81D7401
    asm(9) = &HBC850F3F:  asm(10) = &HC1000001: asm(11) = &H840F06E8
    asm(12) = &H1B3:      asm(13) = &HC7E84589: asm(14) = &HFFFFE445
    asm(15) = &H52EBFFFF: asm(16) = &H8A09C083: asm(17) = &H6E8C1C8
    asm(18) = &H743FC1F6: asm(19) = &H45894001: asm(20) = &H24BC8DE8
    asm(21) = &H120:      asm(22) = &HB9EC758B: asm(23) = &H3F
    asm(24) = &HF133CE23: asm(25) = &H3E47589:  asm(26) = &H37BB0875
    asm(27) = &H2B000000: asm(28) = &H830373D9: asm(29) = &HA4F340C3
    asm(30) = &H478007C6: asm(31) = &HCB8AC18A: asm(32) = &H458BAAF3
    asm(33) = &HF708B1EC: asm(34) = &HFCA0FE1:  asm(35) = &H891789C8
    asm(36) = &H7D8B0447: asm(37) = &H14758B10: asm(38) = &H100C681
    asm(39) = &H8B90000:  asm(40) = &HF3000000: asm(41) = &H8558BA5
    asm(42) = &H40E46D83: asm(43) = &H948D0773: asm(44) = &H12024
    asm(45) = &H8BFC8B00: asm(46) = &H8B11075:  asm(47) = &HDF8BA5F3
    asm(48) = &HFB1F28B:  asm(49) = &H1F045F7:  asm(50) = &H75000000
    asm(51) = &H8E048B0B: asm(52) = &H489C80F:  asm(53) = &HF579498F
    asm(54) = &H8BA5F341: asm(55) = &HD23352F4: asm(56) = &H7240FA83
    asm(57) = &HF8438B32: asm(58) = &HF88BC88B: asm(59) = &HC111C8C1
    asm(60) = &HEFC113C9: asm(61) = &H33C1330A: asm(62) = &H8B0389C7
    asm(63) = &HC88BC443: asm(64) = &HC8C1F88B: asm(65) = &H12C9C107
    asm(66) = &H3303EFC1: asm(67) = &H3C733C1:  asm(68) = &H4303E443
    asm(69) = &H8B0301C0: asm(70) = &HF88B1046: asm(71) = &HF7144623
    asm(72) = &H187E23D7: asm(73) = &H468BF833: asm(74) = &HC1C88B10
    asm(75) = &HC9C106C8: asm(76) = &HC1C1330B: asm(77) = &HC1330EC9
    asm(78) = &H7D8BC703: asm(79) = &H3A040314: asm(80) = &H31C4603
    asm(81) = &H68B5003:  asm(82) = &H4623F88B: asm(83) = &H87E2304
    asm(84) = &H7E8BC733: asm(85) = &H87E2304:  asm(86) = &H68BF833
    asm(87) = &HC8C1C88B: asm(88) = &HDC9C102:  asm(89) = &HC9C1C133
    asm(90) = &H3C13309:  asm(91) = &H7E8D50C7: asm(92) = &H18C6831C
    asm(93) = &H7B9:      asm(94) = &HA5F3FD00: asm(95) = &H8FF78BFC
    asm(96) = &H6015806:  asm(97) = &H83104601: asm(98) = &HC28004C3
    asm(99) = &H4D830F04: asm(100) = &H8BFFFFFF: asm(101) = &H7B1107D
    asm(102) = &H18E048B: asm(103) = &H79498F04: asm(104) = &H8B5A41F7
    asm(105) = &HEB830C7D: asm(106) = &HF70FB140: asm(107) = &H1F045
    asm(108) = &H1C740000: asm(109) = &H318B048B: asm(110) = &H4318F04
    asm(111) = &HF479498A: asm(112) = &HC458341: asm(113) = &HE84DFF40
    asm(114) = &HFEE7850F: asm(115) = &H16EBFFFF: asm(116) = &H318B048B
    asm(117) = &H79498F04: asm(118) = &HC28341F7: asm(119) = &HE84DFF40
    asm(120) = &HFEC2850F: asm(121) = &H8DF9FFFF: asm(122) = &HC01BF465
    asm(123) = &H5D5B5E5F: asm(124) = &H10C2
    
    ' dwords for manipulation loop (K)
    def(0) = &H428A2F98:  def(1) = &H71374491:  def(2) = &HB5C0FBCF
    def(3) = &HE9B5DBA5:  def(4) = &H3956C25B:  def(5) = &H59F111F1
    def(6) = &H923F82A4:  def(7) = &HAB1C5ED5:  def(8) = &HD807AA98
    def(9) = &H12835B01:  def(10) = &H243185BE: def(11) = &H550C7DC3
    def(12) = &H72BE5D74: def(13) = &H80DEB1FE: def(14) = &H9BDC06A7
    def(15) = &HC19BF174: def(16) = &HE49B69C1: def(17) = &HEFBE4786
    def(18) = &HFC19DC6:  def(19) = &H240CA1CC: def(20) = &H2DE92C6F
    def(21) = &H4A7484AA: def(22) = &H5CB0A9DC: def(23) = &H76F988DA
    def(24) = &H983E5152: def(25) = &HA831C66D: def(26) = &HB00327C8
    def(27) = &HBF597FC7: def(28) = &HC6E00BF3: def(29) = &HD5A79147
    def(30) = &H6CA6351:  def(31) = &H14292967: def(32) = &H27B70A85
    def(33) = &H2E1B2138: def(34) = &H4D2C6DFC: def(35) = &H53380D13
    def(36) = &H650A7354: def(37) = &H766A0ABB: def(38) = &H81C2C92E
    def(39) = &H92722C85: def(40) = &HA2BFE8A1: def(41) = &HA81A664B
    def(42) = &HC24B8B70: def(43) = &HC76C51A3: def(44) = &HD192E819
    def(45) = &HD6990624: def(46) = &HF40E3585: def(47) = &H106AA070
    def(48) = &H19A4C116: def(49) = &H1E376C08: def(50) = &H2748774C
    def(51) = &H34B0BCB5: def(52) = &H391C0CB3: def(53) = &H4ED8AA4A
    def(54) = &H5B9CCA4F: def(55) = &H682E6FF3: def(56) = &H748F82EE
    def(57) = &H78A5636F: def(58) = &H84C87814: def(59) = &H8CC70208
    def(60) = &H90BEFFFA: def(61) = &HA4506CEB: def(62) = &HBEF9A3F7
    def(63) = &HC67178F2

    ' Initial hash values
    def(64) = &H6A09E667: def(65) = &HBB67AE85: def(66) = &H3C6EF372
    def(67) = &HA54FF53A: def(68) = &H510E527F: def(69) = &H9B05688C
    def(70) = &H1F83D9AB: def(71) = &H5BE0CD19

    ' Parameters
    def(72) = 0     ' flags
    def(73) = 0     ' message length
End Sub

' Crypt     Encryption/Decryption
'
' CALL:     Crypt(src, @tgt, pwd, cmd, [F1:AddSHA], [F2:AddTime], [F3:AddText])
'
' IN:       bar:src Sourcedata
'           bar:tgt Targetdata
'           chr:pwd Password
'           bol:cmd .F.: Encrypt
'                   .T.: Decrypt
'           lng:F1  SHA-DWords to be appended (0 to 8)
'           bol:F2  Timestamp to be used?
'           chr:F3  Identifier-string to be appended
'
' OUT:      bol     success
'
Public Function Crypt( _
    src() As Byte, _
    tgt() As Byte, _
    pwd As String, _
    cmd As Boolean, _
    Optional AddSHA As Long = 8, _
    Optional AddTime As Boolean = True, _
    Optional AddText As String = "") As Boolean
    
    Static svd  As Long         ' stored timestamp
    
    Dim txt     As String       ' temp
    Dim bar()   As Byte         ' temp
    Dim msg()   As Long         ' standardized message
    Dim sha(8)  As Long         ' hash (+Timestamp)
    Dim tmp(8)  As Long         ' password validation
    Dim ref(63) As Byte         ' xor message...
    Dim flg     As Boolean      ' password okay?
    Dim UBsrc   As Long         ' UBound(src)+1
    Dim UBtgt   As Long         ' UBound(tgt)+1
    Dim TxLen   As Long         ' Len(AddText)
    Dim ToAdd   As Long         ' onDecrypt: decrease,
                                ' onEncrypt: increase msglen
    
    If x_arrDIM(src) <> 1 Then
        ' invalid no of dimensions
        
    Else
        ' initialize values, create hash(pwd)
        UBsrc = UBound(src) + 1
        x_Hash StrConv(pwd, vbFromUnicode), ref, sha, False
        
        ' calculate number of additional bytes
        ' (info to be appended/deleted on encryption/decryption)
        If AddSHA Then AddSHA = ((AddSHA - 1) And 7) + 1
        TxLen = Len(AddText)
        ToAdd = AddSHA * 4 _
              + (AddTime And 4) _
              + TxLen
        UBtgt = UBsrc + IIf(cmd, -ToAdd, ToAdd)
        
           ' on encrypt: get timestamp, if required
        If cmd = False Then
            If AddTime Then
                ' ensure to get an unique value
                sha(AddSHA) = DateDiff("s", DateSerial(1970, 1, 1), Now)
                If sha(AddSHA) <= svd Then sha(AddSHA) = svd + 1
                svd = sha(AddSHA)
            End If
            
           ' on decrypt: get info from file, check password
        ElseIf UBsrc > ToAdd Then
            flg = True  ' assume no password-check required
            
               ' if available, copy sha and timestamp from src
            If ToAdd > TxLen Then
                API_CopyByRef tmp(0), src(UBsrc - ToAdd), ToAdd - TxLen
                If AddTime Then sha(AddSHA) = tmp(AddSHA)
                
                ' check password, if sha was added
                If AddSHA Then flg = lngCMP(sha(0), tmp(0), AddSHA - 1)
            End If
        End If
        
        If cmd Imp flg Then
            ' create hash(hash+timestamp+pwd)
            txt = LNG2CHR(sha(0), 8)
            x_Hash StrConv(txt & pwd, vbFromUnicode), ref, tmp, False
        
            ' En/Decrypt message
            ReDim tgt(((UBtgt + 63) And -64&) - 1)
            API_CopyByRef tgt(0), src(0), UBsrc - IIf(cmd, ToAdd, 0)
            x_Hash ref, tgt, tmp, True
        
            ' onEncode: append admin info
            If cmd = False And ToAdd > 0 Then
                txt = Left$(txt, AddSHA * 4 + (AddTime And 4)) & AddText
                bar = StrConv(txt, vbFromUnicode)
                API_CopyByRef ByVal VarPtr(tgt(0)) + UBsrc, bar(0), ToAdd
            End If
            
            ' adjust length
            ReDim Preserve tgt(UBtgt - 1)
            Crypt = True
        End If
    End If
End Function

Public Function Hash(src() As Byte) As Long()
    Dim tgt(7)  As Long
    Dim ref(63) As Byte
    
    If x_Hash(src, ref, tgt, False) Then
        Hash = tgt
    End If
End Function

Private Function x_arrDIM(arr) As Long
    Dim N1 As Long
    Dim N2 As Long
    
    If IsArray(arr) Then
        API_CopyByRef N1, ByVal VarPtr(arr), 2
        API_CopyByRef N2, ByVal VarPtr(arr) + 8, 4
        If N1 And &H4000 Then API_CopyByRef N2, ByVal N2, 4
        If N2 Then API_CopyByRef N1, ByVal N2, 2
        
        If N2 Then x_arrDIM = N1
    End If
End Function

Private Function x_Hash( _
    src() As Byte, _
    ref() As Byte, _
    sha() As Long, _
    flg As Boolean) As Boolean
    
    def(def_flg) = (flg And 1)
    def(def_len) = IIf(flg, UBound(ref), UBound(src)) + 1
    
    x_Hash = ASM_Hash(asm(0), _
                      VarPtr(src(0)), _
                      VarPtr(ref(0)), _
                      sha(0), _
                      def(0))
End Function

'----- Ende Klasse "asmCryption" alias asmCryption.cls  -----
'--------- Anfang Modul "asmLong" alias asmLong.bas ---------

Option Explicit

Private Declare Sub API_CopyByRef _
    Lib "kernel32" Alias "RtlMoveMemory" _
   (ByRef hpvDest As Any, _
    ByRef hpvSource As Any, _
    ByVal cbCopy As Long)

Private Declare Function ASM_cdRF3 _
    Lib "user32" Alias "CallWindowProcA" _
   (ByRef asm As Long, _
    ByRef PA1 As Long, _
    ByRef PA2 As Long, _
    ByVal PA3 As Long, _
    ByVal PA4 As Long) As Long

' LNG2CHR   Convert longs to string (*)
'
' CALL:     LNG2CHR(src, [bnd], [flg:Cnv2Unicode])
'
' IN:       ptr:src Long v longarray
'           lng:bnd Bound - zerobased loopcount (dflt=0)
'           bol:flg .T.: Convert to unicode (dflt)
'                   .F.: Do not convert to unicode
'
' OUT:      chr     chr converted array
'
' Hints:    - Since VB always passes pointers, you may use simple
'             longs as well as arrays and immediates for src:
'             I1, J1 ... I1(0), J1(x) ... &H80000000, 4711 ...
'
' Caution:  The unicode conversion does not only include a zero
'           after each character (i.E. &H91 becomes 12 20). This
'           may cause differences between the strings and the
'           longs. Hence, you must re-convert the string returned
'           to ansi before using it.
'
Function LNG2CHR( _
    src As Long, _
    Optional bnd As Long = 0, _
    Optional Cnv2Unicode As Boolean = True) As String
    
    Dim bar() As Byte
    
    ReDim bar(bnd * 4 + 3)
    API_CopyByRef ByVal VarPtr(bar(0)), src, UBound(bar) + 1
    
    If Cnv2Unicode Then
        LNG2CHR = StrConv(bar, vbUnicode)
    Else
        LNG2CHR = bar
    End If
End Function

' lngCMP    Compare longs
'
' CALL:     lngCMP(pa1, pa2, [bnd], [@pos])
'
' IN:       ptr:pa1 Long v longarray
'           ptr:pa2 Long v longarray
'           lng:bnd Bound - zerobased loopcount (dflt=0)
'           lng:pos Placeholder for position of first difference
'
' OUT:      bol     .T.: pa1=pa2  (pos = unchanged)
'                   .F.: pa1<>pa2 (pos = first difference)
'
' Hints:    - Since VB always passes pointers, you may use simple
'             longs as well as arrays and immediates for pa1/pa2:
'             I1, J1 ... I1(0), J1(x) ... &H80000000, 4711 ...
'           - A simple compare command was lngCMP(V1, V2), but
'             this could be fullfilled much faster via If V1=V2, so
'             this function is really made for to compare arrays
'
Function lngCMP( _
    PA1 As Long, _
    PA2 As Long, _
    Optional bnd As Long = 0, _
    Optional pos As Long) As Boolean
    
    Static asm(10) As Long

    If asm(0) = 0 Then
        asm(0) = &H748B5756:  asm(1) = &H7C8B0C24:  asm(2) = &H4C8B1024
        asm(3) = &HF3411424:  asm(4) = &HFF418DA7:  asm(5) = &H442B0E74
        asm(6) = &HD0F71424:  asm(7) = &H18247C8B:  asm(8) = &HC0330789
        asm(9) = &H10C25E5F:  asm(10) = &H0
    End If
    
    ' *******************************************************************

    lngCMP = ASM_cdRF3(asm(0), PA1, PA2, bnd, VarPtr(pos))
End Function

' lngRND    Create random figure(s)
'           acc. to the formula of Park & Miller in:
'           actvieVB, "Advanced Vigenère"
'
' CALL:     lngRND(@sat, [bnd], [min], [max], [def])
'
' IN:       ptr:sat Long v longarray
'           lng:bnd Bound - zerobased loopcount     (dflt=0)
'           lng:min Minimum value [with bnd=0 only] (dflt=0)
'           lng:max Maximum value [with bnd=0 only] (dflt=&H7FFFFFFD)
'           lng:def Initialization value (in case of [sat]=zero)
'
' OUT:      lng     Last processed value -1
'
' Hints:    - Since VB always passes pointers, you may use simple
'             longs as well as arrays and immediates for sat/pa2:
'             I1, J1 ... I1(0), J1(x) ... &H80000000, 4711 ...
'           - A simple random command is done via lngRND()
'             Initiating an array of values was:
'             Dim sat(10): lngRND sat(0), 10
'           - If using lngRND with arrays, all target values
'             are 1-based! (use: sat(x)-1 in calculations)
'
' Caution:  - If (sat[x] Or def) equals to zero the CPU-ticker
'             is taken for initialization. This command requires
'             a pentium processor!
'
Function lngRND( _
    Optional sat As Long, _
    Optional bnd As Long, _
    Optional min As Long, _
    Optional max As Long, _
    Optional def As Long) As Long
    
    Static asm(33) As Long

    If asm(0) = 0 Then
        asm(0) = &HC8685790:  asm(1) = &H680000AD:  asm(2) = &HD47
        asm(3) = &HBC8F68:    asm(4) = &H247C8B00:  asm(5) = &H244C8B14
        asm(6) = &H8F048B1C:  asm(7) = &H2A7FC00B:  asm(8) = &H474D8F7
        asm(9) = &HC0332479:  asm(10) = &H2024440B: asm(11) = &H1A790674
        asm(12) = &H16EBE8D1: asm(13) = &HB151310F: asm(14) = &HD3C82207
        asm(15) = &H33C533C0: asm(16) = &H3CAD3D7:  asm(17) = &HD87859C2
        asm(18) = &HF799EA74: asm(19) = &H52082474: asm(20) = &H543BE2D1
        asm(21) = &HA720C24:  asm(22) = &H1A90775:  asm(23) = &H74000000
        asm(24) = &H64F74001: asm(25) = &H4870824:  asm(26) = &H2464F724
        asm(27) = &HC22B5A04: asm(28) = &HFF050579: asm(29) = &H897FFFFF
        asm(30) = &H79498F04: asm(31) = &HC483489C: asm(32) = &H10C25F0C
        asm(33) = &H0
    End If
    
    ' *******************************************************************

    Dim ret As Long
    Dim tmp As Long
    
    ret = ASM_cdRF3(asm(0), sat, 0, bnd, def)
    
    If bnd = 0 And (min Or max) Then
        If min > max Then tmp = min: min = max: max = tmp
        If min >= 0 And max <= &H7FFFFFFD Then
            ret = min + (ret Mod (max - min + 1))
        Else
            ret = 0
        End If
    End If
    
    lngRND = ret
End Function

' lngROL    Left-rotate longs
'
' CALL:     lngROL(sat/@sat, [cnt], [bnd], [cmd])
'
' IN:       ptr:sat Long v longarray
'                   This value wont be changed, with
'                   cnt=0 and cmd=1
'           lng:cnt Number of bits to rotate (dflt=1)
'           lng:bnd Bound - zerobased loopcount (dflt=0)
'           lng:cmd 0: result = rol(sat) (dflt)
'                   1: sat[0] = rol(sat[0]) ... sat[bnd] = rol(sat[bnd])
'                   3: sat[0...bnd] = rol(sat[0...bnd])
'
' OUT:      cmd=0   sat Lrotate cnt
'           cmd=1/3 undefined
'
' Hints:    - Since VB always passes pointers, you may use simple
'             longs as well as arrays and immediates for sat:
'             I1, J1 ... I1(0), J1(x) ... &H80000000, 4711 ...
'           - A simple rotate command was lngROL(V1, x)
'           - If using bnd>0, be aware that the most significant
'             dWord is expected at the array's highest position,
'             hence, the memory is physically rotated to the right!
'
Function lngROL( _
    sat As Long, _
    Optional cnt As Long = 1, _
    Optional bnd As Long = 0, _
    Optional cmd As Long = 0) As Long
    
    Static asm(35) As Long

    If asm(0) = 0 Then
        asm(0) = &H247C8B57:  asm(1) = &H244C8B08:  asm(2) = &H2464C010
        asm(3) = &H14740614:  asm(4) = &HC24548B:   asm(5) = &H107B0679
        asm(6) = &H1075D20B:  asm(7) = &H4A9704D3:  asm(8) = &H4EBFA79
        asm(9) = &HC0D3078B:  asm(10) = &H10C25F:   asm(11) = &H40C28B52
        asm(12) = &H5E8C191:  asm(13) = &HC1F1F799: asm(14) = &H2E7402E2
        asm(15) = &H8B535655: asm(16) = &H8D348DEF: asm(17) = &H0
        asm(18) = &H573E1C8D: asm(19) = &H78BFD8B:  asm(20) = &HFB3BFA03
        asm(21) = &HFE2B0272: asm(22) = &H74490787: asm(23) = &H75FD3B09
        asm(24) = &H4C583EF:  asm(25) = &H5B5FE6EB: asm(26) = &HB95A5D5E
        asm(27) = &H1F:       asm(28) = &H10244C23: asm(29) = &H3C8DB274
        asm(30) = &H8B37FF97: asm(31) = &HA50FFC47: asm(32) = &H4EF8307
        asm(33) = &H58F4754A: asm(34) = &HEB07A50F: asm(35) = &H9B
    End If

    ' *******************************************************************

    lngROL = ASM_cdRF3(asm(0), sat, ByVal bnd, cnt, cmd)
End Function

' lngROR    Right-rotate longs
'
' CALL:     lngROR(@sat, [cnt], [bnd], [cmd])
'
' IN:       ptr:sat Long v longarray
'                   This value wont be changed, with
'                   cnt=0 and cmd=1
'           lng:cnt Number of bits to rotate (dflt=1)
'           lng:bnd Bound - zerobased loopcount (dflt=0)
'           lng:cmd 0: result = ror(sat) (dflt)
'                   1: sat[0] = ror(sat[0]) ... sat[bndÌ = ror(sat[bnd])
'                   3: sat[0...bnd] = ror(sat[0...bnd])
'
' OUT:      cmd=0   sat Rrotate cnt
'           cmd=1/3 undefined
'
' Hints:    - Since VB always passes pointers, you may use simple
'             longs as well as arrays and immediates for sat:
'             I1, J1 ... I1(0), J1(x) ... &H80000000, 4711 ...
'           - A simple rotate command was lngROR(V1, x)
'           - If using bnd>0, be aware that the most significant
'             dWord is expected at the array's highest position,
'             hence, the memory is physically rotated to the left!
'
Function lngROR( _
    sat As Long, _
    Optional cnt As Long = 1, _
    Optional bnd As Long = 0, _
    Optional cmd As Long = 0) As Long
    
    Static asm(35) As Long

    If asm(0) = 0 Then
        asm(0) = &H247C8B57:  asm(1) = &H244C8B08:  asm(2) = &H2464C010
        asm(3) = &H14740614:  asm(4) = &HC24548B:   asm(5) = &H107B0679
        asm(6) = &H1075D20B:  asm(7) = &H4A970CD3:  asm(8) = &H4EBFA79
        asm(9) = &HC8D3078B:  asm(10) = &H10C25F:   asm(11) = &H40C28B52
        asm(12) = &H5E8C191:  asm(13) = &HC1F1F799: asm(14) = &H317402E2
        asm(15) = &H8D535655: asm(16) = &H8D34&:    asm(17) = &HDF8B0000
        asm(18) = &HFC3E7C8D: asm(19) = &H8B57EF8B: asm(20) = &H2B078BFD
        asm(21) = &H73FB3BFA: asm(22) = &H87FE0302: asm(23) = &H9744907
        asm(24) = &HEF75FD3B: asm(25) = &HEB04ED83: asm(26) = &H5E5B5FE6
        asm(27) = &H1FB95A5D: asm(28) = &H23000000: asm(29) = &H7410244C
        asm(30) = &H8B37FFAF: asm(31) = &HAD0F0447: asm(32) = &H4C78307
        asm(33) = &H58F4754A: asm(34) = &HEB07AD0F: asm(35) = &H9B
    End If

    ' *******************************************************************

    lngROR = ASM_cdRF3(asm(0), sat, ByVal bnd, cnt, cmd)
End Function

' lngSWP    Swap longs
'           little endian to big endian (and vice versa)
'
' CALL:     lngSWP(src, [@tgt], [bnd])
'
' IN:       ptr:src Long v longarray to get values from
'           ptr:tgt Long v longarray to put results in
'           lng:bnd Bound - zerobased loopcount (dflt=0)
'
' OUT:      lng     last processed value
'
' Hints:    - Since VB always passes pointers, you may use simple
'             longs as well as arrays and immediates for src:
'             I1, J1 ... I1(0), J1(x) ... &H80000000, 4711 ...
'           - A simple swap command was lngSWP(V1)
'           - In order to put the converted value in the source
'             array call: lngSWP src(0), src(0), UBound(src)
'
Function lngSWP( _
    src As Long, _
    Optional tgt As Long, _
    Optional bnd As Long = 0) As Long
    
    Static asm(7) As Long

    If asm(0) = 0 Then
        asm(0) = &H748B5756:  asm(1) = &H7C8B0C24:  asm(2) = &H4C8B1024
        asm(3) = &H48B1424:   asm(4) = &H89C80F8E:  asm(5) = &HE9838F04
        asm(6) = &H5FF37301:  asm(7) = &H10C25E
    End If

    ' *******************************************************************

    lngSWP = ASM_cdRF3(asm(0), src, tgt, bnd, 0)
End Function

'---------- Ende Modul "asmLong" alias asmLong.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.