Nostalgia: Mouse chased by cat

Code: (Select All)
DefInt A-Z

'Print image2data("E:\TEMP\Cats.png"): End



ReDim Shared icon(1 To 1) As Long

init

main

System



Sub init

  Declare CustomType Library

    Function FindWindow%& (ByVal ClassName As _Offset, WindowName$)

    Function ShowWindow& (ByVal hwnd As _Offset, Byval nCmdShow As Long) 'maximize process

    Function GetForegroundWindow%& 'find currently focused process handle

    Function SetForegroundWindow& (ByVal hwnd As _Offset) 'set foreground window process(focus)

    Sub SENDKEYS Alias keybd_event (ByVal bVk As Long, Byval bScan As Long, Byval dwFlags As Long, Byval dwExtraInfo As Long)

  End Declare

  title$ = "mdChaseMouse"

  hwnd%& = FindWindow(0, title$ + Chr$(0))

  If hwnd%& > 0 Then

    FGwin%& = GetForegroundWindow%& 'get current process in focus

    y& = ShowWindow&(hwnd&, 1) 'maximize minimized program

    If FGwin%& <> hwnd%& Then z& = SetForegroundWindow&(hwnd%&) 'set focus when necessary

    SENDKEYS &H1B, 0, 0, 0: SENDKEYS &H1B, 0, &H2, 0 'Esc

    System

  End If



  n% = getIcons(icon())

  Screen _NewImage(_DesktopWidth, _DesktopHeight, 32): Do: _Delay .1: Loop Until _ScreenExists: _Delay .1: _FullScreen

  'Screen _NewImage(_DesktopWidth - 6, _DesktopHeight - 69, 32): Do: _Delay .1: Loop Until _ScreenExists: _Delay .1: _ScreenMove 0, 0

  '         alphaLevel 0=Transparent; initial focus once, >0=Less transparent; has focus

  '            zorder  1=bottom, -1=always on top 0=normal

  '                titlebar 0=no

  _Title title$

  setWindow 0, -1, 0

End Sub



Sub main ()

  Type mpType

    x As Long

    y As Long

  End Type

  Dim mp As mpType

  Declare Dynamic Library "user32"

    Function getMouse%% Alias GetCursorPos (lpPoint As mpType)

  End Declare

  x = _Width / 2

  y = _Height / 2

  s = 10

  Do

    _Limit 10

    r = getMouse(mp): xd = (mp.x - x): yd = (mp.y - y)

    If Abs(xd) > 0 Or Abs(yd) > 0 Or i < 13 Or i > 15 Then

      If Abs(xd) > s Then xd = Sgn(xd) * s

      If Abs(yd) > s Then yd = Sgn(yd) * s

      i = ((Sgn(yd) + 1) * 3 + (Sgn(xd) + 1)) * 3 + 1

      If i <> 13 Then

        it = (it + 1) Mod 3: i = i + it

        t! = Timer

      End If

      x = x + xd

      y = y + yd

      Cls

      _PutImage (x - 32, y + 1)-Step(64, 64), icon(i)

      _Display

    ElseIf (Timer - t!) > 5 Then

      Cls

      _PutImage (x - 32, y + 1)-Step(64, 64), icon(14)

      _Display

      t! = 86400

    End If

  Loop Until InKey$ <> ""

End Sub



Function getIcons% (icon() As Long)

  iw% = 32: ih% = 32

  Cats: 'E:\TEMP\Cats.png' (288x96)

  Data 288,96

  Data "eJzlncuOHEkVhkt09dV9dfs+ttse8QAzjIVA4hFmgcQrIPEIgDS7kZBgyyPMAiQk2PIeLIc1G94B42j6b3/99Ym8VJU9HuNWqSojzy3O+eNEZOTJ9NH24nTxevH6s1efvd5bvP39DX4/w++X+H13UfPex+9//+vby++dou1+h/+4o492fIHfX3/91eX3J0XbRdF2OtG+e2j721++ufw0Oh6bbkje4UT7qn78SLaYLm0XRdvpCv348sufX+pudO18+93a5vjlcKJ9VT+eX7VtXcnd1vG+/Nts2x/h2S1icmcFPacr+Km1x09NTmjn+D3+bMexf6zPd4o+707s8xw9B+JJHJuu2L9X+NK6Kr5qLN1ZUd/pCjFpbe08aZZXPD36ntwqhrST9je+2F3FcWcCXxXLKfoYzy30o33acXAZ3l3Qx1/WP0XOTmHvnQ3Z4tiPxfQc9IxraCLXckJ/Ln2UHznUZ2ykX8xb6Wf6TT/0sNLadmbKMG5WteUA9Owz6ew3xi88zsVTZQ3haRM2nWwII4vFzdxB3vg1fI12CJuVbus1Rtp5x5dy6Rf2pZJlvE2V47l2HZsOhFPm4vjCcxntn8O/HMHYKvrPNoiL8PQwMQWPlW7qPSp84DUCZcUfydkVhpYz+L3+mKuf/I1uu5hnPFd43lxHTnzr+W4dW047WGj/5mKhl1toyxD+ejnROg8Xt3NAxlj8YR+0T3yUecp4sq+nyDjYkC378kmjORJP8kQvH/b4PB8drKjrTLHOv94cVsXbcz/HMXUZV0PzFrF1JF0cv5FzJF32CeeVIZ5qrTFFF9dNrX0p3+/r2Gu2KXzxy1w+6jtD/4Lj/BuK3d2ReFdjouLjWnhojeR5pdcv2mm/UO5cvqn6qrHKPh4U8euN1yG+6JvLF31nRfwY86nxMw4ZtyqOPdx4XWG9HPOUe4C+GqOeh+m7qXzr6KMPov9Q8+ThO6Z3nKvxPTVevragT3vjdoifx9W8wrhnjmD/yJM59vAd0x/J/6E7vuLzGngdmrHcPNX3TVbl+6Gc23jGYlf5qcrZTVb6xWsG+nNdmhPQxN4KZ+17Dz4+fs98Z0VMuMaqYpJ2xoT8nhMYk5zv8dvu6K7yAXHbfu8tbs9JlpfrwuP3zGc/h8Z+21W+PNkAH+0b46OdXIu2f714BvOOZ9Zp5ttCW8XjPEx+Yij8zsnsE7HCuFQ+2jSf/X5exDLnMh/ymjr96+Eg6xXG1Ou/8B8P6E77FDnGRxXf+IC48J5zfNX4vZfja7FggvNSvpfCErFADNOvGZOJT+J12uGlLxptfG7+k4n8Oe/x2ZvnbsTqKkZcUy+v7Dnp8C2Bka2Cj/e1jdn8bXVkxKZefDlXMI65Zr0nXJKv0TAf0H/VvUnijXghrtJX+mRZ9Icx4Z7VmC97fIwd+eLX6z/lDY4F5tzIY8ySLyMzOCc2KGMJOsugfGLENmwt3u5lDsm6PxBnrlkq+iq+vfaKL32o9B4rPo02ffE6kv7k/OQ9cdpnfuOk0Xj+M0/s2QId+b3XRVzRR5e2AWc539pPChnbPRni9f4X/bsUPiyrfRwzYydjvP1+WKwXPX7Y/lCyY3+lh3mQOMsf9405zoIr72N4HJF3u+Bl3u/pWnbGka+vrJ9rOWMp56vrlsjYkh8ji3H1tRH59zr87fcD4ZpzT3zhWHIdzNiz/aFsuca/9DA30mceb14LEU9nksE1Avnsx/DfBb957LvwnCuGnsPjh6XoznS8BO7I63VF6Hv3u9u5B7L12l/gfzQQ76r9UdFPy/c8uyywcp3DQRcfpq9lvi7oK9p90T6U7Ocjx+5nk/m0aGM+SvtTxMR+jvwnI8d/33sr41PIo+xf4PcftOZr3y+KtidFG+sGnxfnfy+MWXbanhRtnxfynhV0rOH8FX63mFpf2p4UbZ8Xsp+NyPOeVNpSn5DzPx45f7Ihu9PGOdD2Dcl3TWXm1SXs5Vh5NZP+WDozL16ovbW5r6F9OaFvvE/msZbx7v72fFfV85Jv8cM/3tjjYt6/vh55Q2N/zeHbhN+eruGT"

  Data "PeE3MhL3Zmfi39qqesKpMfF1bMYI7frJz/5x7b8b131v2to5+3oKfTUG59a/tr5NrX+do2d3A/53DJvsy3n3ygftew7/mA3VuDxSTLh/xL23xOTxFT3rSM9nyqiuiexTY3AL+nj96dq+G9cBM2V5/bWOXcbHOrH1fld8XNnN6545+PI8U82jrZ1788zFVW1c/FXtN3Hfjtf6PT3eg+N1bupzYsP1PsoV/tP35PIKO2lbVZZjsAn7XHu7LgZaG/fUm8yDxdtauciag70D6a3mjNxL99zNnMVxxPEVu51PLGtIh3HHnJR+XF5nYVx4n554qbC8qkz7b1Nyd9eIezuf+hfa47pE8jp3DumrxnSj/c2Xry4/6U+Oh7CTcRO5nvPab9Z+eu04V2flh+hp8diFLmNmLq+xMZd/d4147snuLfmHmGOtlPEwRXeeJzAmEqNv//TLWzFqbcwR5HPOquY7YtT5alW9rQ/EffzANT/xMEbr+I/R76wQs6kxb/0mP+ujNoGXU/Ez93EeYLvHM32aeaqK9cmKurhGcX6jjvQ5sg7eM9/2jDhWsfCaIfjLmM16jjjwmJ+jt7pXwnG8U9A6js2+fdg3Nr7HZJ92fG9sxPfuK8d62wNcV8Y6duzMiOe+dPh5Lj/jSAxUe9g9XQfSw33mxDO0rEXgOd9bik5fO1RzJzExV6efr2aeCMa51vc8wjxzABs2JWsTdhkzVdzpzyUw4GehqlzqNfRWIetyPfdG3hgGh+YTX0Nkv8n6q5wSGo+7YMF2595ohck5unOc6ymu0VwvTX+l77GPNa/ryrqzYdv2V8CIn6eNvibD9UmRGxl8vr6a8+fidtnBK69pGU/eVzZ+Y2+FG/aZ19fGYXJW/GwcTtFPe/mML3NofELcVj6Nba6P8/XaHFmH78C+wxHc7HVww7Vn7j+7f7zfTXuq2pipOZHjiDHjvfNghbmG8xfnMO43GdfEWPrMazXnu7k2uC6ENMHs9b3ZN9/bV37k848nRQzGeA43oLeKPecfy/HeTvxA+yObOLjG0evbvq1s8diIDNpFW9JOHLhWhfmXx+mja1d74436eZ+f6272ea4dFRbiD9ZBcH3knM24V/tNtpUyXB949I7t4R7YNd4KLHFcVHgjHmJrNaa8RifGmf+MU/bD6zOuTZgz3XZXY7Z9M7fEBvbZc1z1rMCQTttIf9tPXA85dh6nxlPFnzo2z5/r2uD9Ks9V1/n56o/+db4knjyP5PxycTs39LB4Q7fyZi8Hsp04SX4Jpnl91X6zPpr5muOQ9nOODq1rlnq6/Kw1aXc68WNMqvhFFv0Q2R5zPd517AguQ3vd99c341EeF/q9jqENxlGPt6r5Th6wbs4bD6TbNuf8zpX85yP057Jnr2N7chhzDecQX5/wvOmn6DgWzx0d39Xxjo4fdPwc+V8VNgQ/9LGx9WKA75/S+UjHn+r4pzs3r6H+s7h5zPoxzk9/Rjvr8liv52cxwkt6+v1Cun8n/vZd1fC9KNrudnT0dLv2L+2nnb5RjmvIbGfaXhRtc+10PJi/PFf1fFP58AvpM13aXhRt6/Sh2tMc81nl23dtP3Pg0yIG7ffZRH2VXalDzVxt2lxTcpyYtnoHwdR+sP1D7Qffg+mc4vND/cma8ELtra1XexjMvouaOPpk7vs27a/KL48XN/GavfrQPB7hdw3AOv6L/KyLhupYXBOWeLp2Z4os3uOjLNc0rWOX30tgPz/U+ewr9s6bv6rj/VDqO6uYDNWasP6NewTE3iZkRlYV53Xt8/Wp48n3N0du9p1Dx/nm/oi8/4c60Oo+x1BdSmLn/TPv4/l9hevK9T2eTdpa3S8dwg2fQZ5Tk+/3VOd89IQneo6FT84RH2tNqfHYq5dpH97f7eFuKn+Fr7m6TzeAiynPHayKv6pGeWh8JG4fU93pvmzNvfnEdndxcw7we7R69MTPVNmna8R9ynMMc3FV7b1+X2pJWRPWPqk3GqpLs973wXe2Rgxbu2uH5mLiQ6oH5VhMrY/rMjnWPY64R/hdynBcx+LEmsSx+Pbq"

  Data "/Iyt77qm02tPYpB1yVznRzZ92+Ix9C7J70qWY9yLIX3Tq9nvYYH3877vNZ2eN5MTXL/RvnkvlPKzx+53TX4IsoKnuc9r+H3UrX1KHf/5TD3EkrH8sdSAGmOWxzjlnK89govjDcjivkX1Xs0p8nguGKz2I1bBTnK481oVi0a7KlZ77y5M/z6WGlE+e5rr3dRi5R5p7vEGZycTeVhD4HvaY7y8hrWMVZ8tMRbC33s+YVXMuQZmnXrMo8LmD62+0+9vjez0v5KXOo/gkTUltCt8rL+i7bxP7/qZHn/+LGfu8yvER3yRPbfQ8txc/FX1jxwjVc3kUL3nGO9ozSZ83JPhZwTt8+QFr2mG8MA9X/PdkF/ULfn9dkMytqSTclyD5Vhzb7r6v/yyPvP+kukjp4chv18z54fmdY5L4py4og8spxojt3gR30rGDRwtFreeKUz7Uv3jdRD30FhLQ4yQp6pVok3GB+dS+m5KXRRzZBXrRlu9R7J6TuC+9FEefd7DgvuSNvqBfu/VP3JcJT6WGznGhuVwbA3JYkzi/23xJgacZ5yLTec6K+cFx3VvgJ7rqYzj9PNB4YPUUjOf+F1z1bVaaP1/u1BO7E6fl+pX/Or3TLOv+UtfLbOKr2Us5S+Ppdb2eFGPNfujOv+k4I3uZ0Usk1sjL78faczwGobHjwq85nfsSvs99T00tGFbNK4T9P/HyTVZ87/rL4dqEenr0Pv4qY4vCv9yXnD84uOc4/FjxZJ5OVigf42Ti4Fz7fNJ0fec/7V445NPCpmRx2PXAxl/8ddLHT/X8W/lg2c6Zi6uzv/1B/87/i+VKk6+"

  Data "*"

  Restore Cats

  hImg& = data2image ' Screen hImg&: Sleep: End '@@

  _ClearColor &HFF00FF00, hImg&

  i% = 0

  If hImg& < -1 Then

    iws% = _Width(hImg&) \ iw%

    ihs% = _Height(hImg&) \ ih%

    ReDim icon(1 To iws% * ihs%) As Long

    For y% = 1 To ihs%

      For x% = 1 To iws%

        i% = i% + 1

        icon(i%) = _NewImage(iw%, ih%, 32)

        _PutImage (0, 0), hImg&, icon(i%), ((x% - 1) * iw%, (y% - 1) * ih%)-Step(iw% - 1, ih% - 1)

      Next x%

    Next y%

  End If

  getIcons = i%

End Function



Sub setWindow (alphaLevel As _Unsigned _Byte, zorder As Integer, titlebar As Integer)

  'alphaLevel: 0=alphaColor, 1..255 whole window transparent..solid

  'zorder: 0=normal, 1=bottom, -1=topmost (alphaLevel 0=initial focus once)

  'titlebar: 0=none 1=titlebar

  Const GWL_STYLE = -16

  Const GWL_EXSTYLE = -20

  Const WS_BORDER = &H800000

  Const WS_POPUP = &H80000000

  Const WS_VISIBLE = &H10000000

  Const WS_EX_LAYERED = &H00080000

  Const WS_EX_NOACTIVATE = &H08000000 'background prc: no clickable & no icon

  Const HWND_TOP = 0 'Normal

  Const HWND_BOTTOM = 1 'Bottom

  Const HWND_TOPMOST = -1 'Always on top

  Const LWA_COLORKEY = &H1

  Const LWA_ALPHA = &H2

  Const SWP_SHOWWINDOW = &H0040

  Const SWP_HIDEWINDOW = &H0080

  Const SWP_NOSIZE = &H0001 'ignores cx and cy size parameters

  Const SWP_NOMOVE = &H0002 'ignores X and Y parameters

  Const SWP_NOACTIVATE = &H0010 'does not activate window

  Declare Dynamic Library "User32"

    Function getWinLong& Alias GetWindowLongA (ByVal hwnd As Long, Byval nIndex As Long)

    Function setWinLong& Alias SetWindowLongA (ByVal hwnd As Long, Byval nIndex As Long, Byval dwNewLong As Long)

    Function setLayWinAttr& Alias SetLayeredWindowAttributes (ByVal hwnd As Long, Byval crKey As Long, Byval bAlpha As _Unsigned _Byte, Byval dwFlags As Long)

    Function setWinPos& Alias SetWindowPos (ByVal hWnd%&, Byval hWndInsertAfter%&, Byval X&, Byval Y&, Byval cx&, Byval cy&, Byval uFlags~&)

  End Declare

  'alphaColor = transparent background used when  alphaLevel=0

  Dim As Long hWnd, alphaColor: hWnd = _WindowHandle: alphaColor = &HFF000000

  If titlebar = 0 Then

    a& = getWinLong&(hWnd, GWL_STYLE)

    a& = setWinLong&(hWnd, GWL_STYLE, WS_POPUP Or WS_VISIBLE)

  End If

  If alphaLevel <> 255 Then

    a& = getWinLong&(hWnd, GWL_EXSTYLE)

    a& = setWinLong&(hWnd, GWL_EXSTYLE, a& Or WS_EX_LAYERED Or WS_EX_NOACTIVATE)

    If alphaLevel > 0 Then

      a& = setLayWinAttr&(hWnd, alphaColor, alphaLevel, LWA_ALPHA)

    Else

      a& = setLayWinAttr&(hWnd, alphaColor, alphaLevel, LWA_COLORKEY)

    End If

  End If

  If zorder <> 0 Then

    a& = setWinPos(_WindowHandle, zorder, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)

  End If

End Sub



Function image2data (image$)

  Const I2DBLOCK = 2048

  hImg& = _LoadImage(image$, 32): If hImg& < -1 Then _Source hImg& Else Print "LOAD ERROR": Exit Function

  iWidth% = _Width(hImg&): iHeight% = _Height(hImg&)

  pathsep$ = Mid$("/\", 1 - (Left$(_OS$, 4) = "[WIN"), 1)

  in% = _InStrRev(image$, pathsep$): If in% > 0 Then datafile$ = Mid$(image$, in% + 1) Else datafile$ = image$

  in% = _InStrRev(datafile$, "."): If in% > 0 Then lbl$ = Left$(datafile$, in% - 1) Else lbl$ = datafile$

  datafile$ = lbl$ + ".img"

  Print "Generating "; datafile$; " ("; _Trim$(Str$(iWidth%)); "x"; _Trim$(Str$(iHeight%)); "x32) ... ";

  Dim alpha As _Byte, cval As Long, imgArray(iWidth% * iHeight%) As Long

  Get (0, 0)-(iWidth% - 1, iHeight% - 1), imgArray(): _Source 0: _FreeImage hImg&

  alpha = _Alpha32(imgArray(1)): If alpha = &H10 Then imgArray(1) = imgArray(1) + (2 ^ 24)

  cn& = 1: cval = imgArray(1): o$ = String$(4 * iWidth% * iHeight%, 0): opos~& = 1

  For n& = 2 To iWidth% * iHeight%

    alpha = _Alpha32(imgArray(n&)): If alpha = &H10 Then imgArray(n&) = imgArray(n&) + (2 ^ 24)

    it& = n& - cn&

    If cval <> imgArray(n&) Or it& = (2 ^ 24) - 1 Then

      If it& > 2 Then

        Mid$(o$, opos~&, 8) = MKL$(&H10000000 + it&) + MKL$(cval): opos~& = opos~& + 8

      ElseIf it& = 2 Then

        Mid$(o$, opos~&, 8) = MKL$(cval) + MKL$(cval): opos~& = opos~& + 8

      Else

        Mid$(o$, opos~&, 4) = MKL$(cval): opos~& = opos~& + 4

      End If

      cn& = n&: cval = imgArray(n&)

    End If

  Next n&

  it& = n& - cn&

  If it& > 2 Then

    Mid$(o$, opos~&, 8) = MKL$(&H10000000 + it&) + MKL$(cval): opos~& = opos~& + 8

  ElseIf it& = 2 Then

    Mid$(o$, opos~&, 8) = MKL$(cval) + MKL$(cval): opos~& = opos~& + 8

  Else

    Mid$(o$, opos~&, 4) = MKL$(cval): opos~& = opos~& + 4

  End If

  o64$ = base64encode$(_Deflate$(Left$(o$, opos~& - 1)))

  Print Using "##,###,### bytes"; Len(o64$)

  Open datafile$ For Output As #1

  Print #1, lbl$ + ": '"; image$; "' ("; _Trim$(Str$(iWidth%)); "x"; _Trim$(Str$(iHeight%)); ")"

  Print #1, "Data"; RTrim$(Str$(iWidth%)); ","; RTrim$(Str$(iHeight%))

  For n& = 1 To Len(o64$) Step I2DBLOCK

    Print #1, "Data " + Chr$(34) + Mid$(o64$, n&, I2DBLOCK) + Chr$(34)

  Next n&

  Print #1, "Data " + Chr$(34) + "*" + Chr$(34)

  Print #1, "Restore "; lbl$

  Close #1: image2data = -1

End Function



Function data2image&

  Read iWidth%, iHeight%

  Dim alpha As _Byte, cval As Long, imgArray(iWidth% * iHeight%) As Long: imgArray(0) = iHeight% * 2 ^ 16 + iWidth%

  Read lin$: i64$ = String$(6 * iWidth% * iHeight%, 0): i64pos~& = 1

  Do While lin$ <> "*"

    l& = Len(lin$): Mid$(i64$, i64pos~&, l&) = lin$: i64pos~& = i64pos~& + l&: Read lin$

  Loop

  i$ = _Inflate$(base64decode$(Left$(i64$, i64pos~& - 1))): cn& = -3

  Do While n& < iWidth% * iHeight%

    cn& = cn& + 4: cval = CVL(Mid$(i$, cn&, 4)): alpha = _Alpha32(cval)

    If alpha = &H10 Then

      it& = cval - &H10000000: cn& = cn& + 4: cval = CVL(Mid$(i$, cn&, 4))

      Do While it& > 0

        n& = n& + 1: imgArray(n&) = cval: it& = it& - 1

      Loop

    Else

      n& = n& + 1: imgArray(n&) = cval

    End If

  Loop

  hImg& = _NewImage(iWidth%, iHeight%, 32): _Dest hImg&: Put (0, 0), imgArray(): _Dest 0: data2image& = hImg&

End Function



Function base64encode$ (b$)

  ' elke 3 bytes > 4 bytes

  ' +1 + elke overige byte

  d$ = b$: dl~& = Len(d$): d$ = d$ + String$((3 - (Len(b$) Mod 3)) Mod 3, 0): e$ = Space$(_Ceil((dl~& * 4) / 3)): ep~& = 0

  For i3~& = 1 To dl~& Step 3

    v~& = 0

    For p = 0 To 2

      c = Asc(Mid$(d$, i3~& + p, 1)): x2~& = 2 ^ ((2 - p) * 8): v~& = v~& + c * x2~&

    Next p

    For p1 = 3 To 0 Step -1

      c1 = v~& \ 2 ^ (p1 * 6): v~& = v~& - c1 * 2 ^ (p1 * 6): ep~& = ep~& + 1

      Select Case c1

        Case 0 To 25

          Mid$(e$, ep~&, 1) = Chr$(c1 + Asc("A"))

        Case 26 To 51

          Mid$(e$, ep~&, 1) = Chr$(c1 - 26 + Asc("a"))

        Case 52 To 61

          Mid$(e$, ep~&, 1) = Chr$(c1 - 52 + Asc("0"))

        Case 62

          Mid$(e$, ep~&, 1) = "+"

        Case 63

          Mid$(e$, ep~&, 1) = "/"

        Case Else

      End Select

    Next p1

  Next i3~&

  e$ = Left$(e$, _Ceil((dl~& * 4) / 3)): base64encode$ = e$ + String$((4 - (Len(e$) Mod 4)) Mod 4, "=")

End Function



Function base64decode$ (b$)

  ' elke 4 bytes > 3 bytes

  ' + Int(overige bytes*3/4)

  e$ = b$ + String$((4 - (Len(b$) Mod 4)) Mod 4, "="): el~& = Len(e$): d$ = Space$(el~& / 4 * 3): dp~& = -2

  For i4~& = 1 To el~& Step 4

    v~& = 0

    For p = 0 To 3

      c = Asc(Mid$(e$, i4~& + p, 1)): x2~& = 2 ^ ((3 - p) * 6)

      Select Case c

        Case Asc("A") To Asc("Z")

          v~& = v~& + (c - Asc("A")) * x2~&

        Case Asc("a") To Asc("z")

          v~& = v~& + (c - Asc("a") + 26) * x2~&

        Case Asc("0") To Asc("9")

          v~& = v~& + (c - Asc("0") + 52) * x2~&

        Case Asc("+")

          v~& = v~& + (c - Asc("+") + 62) * x2~&

        Case Asc("/")

          v~& = v~& + (c - Asc("/") + 63) * x2~&

        Case Asc("=")

          el~& = el~& - 1

        Case Else

      End Select

    Next p

    c1 = v~& \ 2 ^ 16: v~& = v~& - c1 * 2 ^ 16: c2 = v~& \ 2 ^ 8: v~& = v~& - c2 * 2 ^ 8: c3 = v~&: dp~& = dp~& + 3

    Mid$(d$, dp~&, 3) = Chr$(c1) + Chr$(c2) + Chr$(c3)

  Next i4~&

  base64decode$ = Left$(d$, Int(el~& / 4 * 3))

End Function