Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 587
  • Last Modified:

Need MIME or Base64 encoding VB implementation

I'm looking for a VB implementation of base64 encoding of a string. So no dll's or other modules and no delphi or c code.

Comments only please. I'll award the points when the correct answer has been given.
0
Mirkwood
Asked:
Mirkwood
1 Solution
 
peterwestCommented:
Hi there,

Try the following - i've used it in the past and it works fine for me.  I'll post a routine for decoding too if you need it.

THanks

Pete
--------------------


Private Declare Function CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ptrDest As Any, ptrSource As Any, ByVal lenCopy As Long) As Long

Private Sub USAsciiToBase64(bIN() As Byte, b64() As Byte)

   Const TriPadding As Byte = 61 ' =
   Const Base64Table = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
   Static Base64(0 To 63) As Byte, Initialized As Boolean
   Dim TriBuf(0 To 3) As Byte, b As Byte, TriBits&
   Dim Trips&, Xtras&, bInLen&, bInPtr&, b64Ptr&

   If Not Initialized Then
      Initialized = True
      For b = 0 To 25
         Base64(b) = b + 65
         Base64(b + 26) = b + 97
      Next
      For b = 52 To 61
         Base64(b) = b - 4
      Next
      Base64(62) = 43
      Base64(63) = 47
   End If
   bInLen = UBound(bIN) - LBound(bIN) + 1
   Trips = bInLen \ 3
   Xtras = bInLen Mod 3
   ReDim b64(0 To IIf(Xtras, Trips + 1, Trips) * 4 + 1) '+1 for vbCrLf
   For bInPtr = 0 To Trips * 3 - 1 Step 3
      TriBuf(2) = bIN(bInPtr)
      TriBuf(1) = bIN(bInPtr + 1)
      TriBuf(0) = bIN(bInPtr + 2)
      CopyMemory TriBits, TriBuf(0), 3
      b64(b64Ptr) = Base64(TriBits \ &H40000)
      b64(b64Ptr + 1) = Base64((TriBits \ &H1000&) And &H3F&)
      b64(b64Ptr + 2) = Base64((TriBits \ &H40&) And &H3F&)
      b64(b64Ptr + 3) = Base64(TriBits And &H3F&)
      b64Ptr = b64Ptr + 4
   Next
   If Xtras > 0 Then
      TriBuf(0) = 0 'TriPadding
      TriBuf(2) = bIN(bInPtr)
      If Xtras > 1 Then
         TriBuf(1) = bIN(bInPtr + 1)
      Else
         TriBuf(1) = 0 'TriPadding
      End If
      CopyMemory TriBits, TriBuf(0), 3
      b64(b64Ptr) = Base64(TriBits \ &H40000)
      b64(b64Ptr + 1) = Base64((TriBits \ &H1000&) And &H3F&)
      b64(b64Ptr + 2) = IIf(Xtras = 1, TriPadding, Base64((TriBits \ &H40&) And &H3F&))
      b64(b64Ptr + 3) = TriPadding 'IIf(Xtras > 1, TriPadding, Base64(TriBits And &H3F&))
      b64Ptr = b64Ptr + 4
   End If
   b64(b64Ptr) = 13 'vbCr
   b64(b64Ptr + 1) = 10 'vbLf

End Sub

0
 
MirkwoodAuthor Commented:
With some byte & string conversion everything seems to be working OK. Please answer the question PeterWest to receive your points.
0
 
peterwestCommented:
Thanks,

Pete
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
mark2150Commented:
Hey Mirkwood!

You can download an entire MIME decoder program from my website - all source included!

www.cyberchute.com/rvbus/madmark

M

0
 
jknickelbeinCommented:
PeterWest,
Could you please post that decoding code for me?  It would be really helpful.
0
 
peterwestCommented:
jknickelbein,

I'll happily post the code you request but not under this question - i'd rather have it in a seperate question so other people browsing the PAQ's can find it.  Point's aren't an issue for me - i'm certainly not point hungry - so if you post a question, just assign it 5 points or something, and i'll happily post the code.

Thanks

Pete

0
 
idcanadaCommented:
peterwest,
Could you please notify me when you do post this code.

Thanks.
0
 
peterwestCommented:
idcanada,

How do you want me to notify you???

Pete

0
 
idcanadaCommented:
I thought this was a good notification :)
0
 
drjoerossCommented:
I would be very interested in seeing the code for the Mime decoder. I could not currently locate it on this site.
Thanks,
Joe
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now