20/11/2018, 15:02
Resimleri base64'e çevirmek için kod gerekli. Ayrıca bu işlem için resimlerin dizine aktarılması da gerekli. Tabloya gömülü resmi kodlayamazsınız. Anlamadığınız kodlamayı kullanmadığınız için örnek hazırlamaya gerek yok.
Sayfalar: 1 2
20/11/2018, 15:02
20/11/2018, 15:11
Kod:
Sub TestBase64()
Dim bytes, b64
With CreateObject("ADODB.Stream")
.Open
.Type = ADODB.adTypeBinary
.LoadFromFile "c:\temp\TestPic.jpg"
bytes = .Read
.Close
End With
Debug.Print bytes
b64 = Base64Encode(bytes)
Debug.Print vbCrLf + vbCrLf
Debug.Print b64
Debug.Print vbCrLf + vbCrLf
Debug.Print Base64Decode(CStr(b64))
End Sub
' Decodes a base-64 encoded string (BSTR type).
' 1999 - 2004 Antonin Foller, http://www.motobit.com
' 1.01 - solves problem with Access And 'Compare Database' (InStr)
Function Base64Decode(ByVal base64String)
'rfc1521
'1999 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
'remove white spaces, If any
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
'The source must consists from groups with Len of 4 chars
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
Err.Raise 1, "Base64Decode", "Bad Base64 string."
Exit Function
End If
' Now decode each group:
For groupBegin = 1 To dataLength Step 4
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
' Each data group encodes up To 3 actual bytes.
numDataBytes = 3
nGroup = 0
For CharCounter = 0 To 3
' Convert each character into 6 bits of data, And add it To
' an integer For temporary storage. If a character is a '=', there
' is one fewer data byte. (There can only be a maximum of 2 '=' In
' the whole string.)
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
End If
If thisData = -1 Then
Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
Exit Function
End If
nGroup = 64 * nGroup + thisData
Next
'Hex splits the long To 6 groups with 4 bits
nGroup = Hex(nGroup)
'Add leading zeros
nGroup = String(6 - Len(nGroup), "0") & nGroup
'Convert the 3 byte hex integer (6 chars) To 3 characters
pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 5, 2)))
'add numDataBytes characters To out string
sOut = sOut & Left(pOut, numDataBytes)
Next
Base64Decode = sOut
End Function
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, i
'For each group of 3 bytes
For i = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, i, 1)) + _
&H100 * MyASC(Mid(inData, i + 1, 1)) + MyASC(Mid(inData, i + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Functiongibi bir kodlamanın bu iş için kullanılacağının farkındayım. Evet bu kod beni haydi haydi aşar. Aradığım, bu iş için tabloya gömülü bir OLE nin ya da EK'in bir sorgu vasıtası ile convert edilip edilemeyeceği idi. Teşekkürler.
20/11/2018, 15:38
Ekli metin belgesindeki kod, örnek uygulamanızdaki resmin base kodlarıdır. Bu kodları kopyalayıp aşağıdaki siteden dönüştürerek test edebilirsiniz. Bu resim kodunu, Vba kodu kullanmadan sadece sorgu ile dönüştüremezsiniz. Resim farkını bulmak için, iki resme ait kodların ilk 1000 karakterini karşılaştırarak test edilebilir. Benim bahsettiğim mevzu bu idi.
https://codebeautify.org/base64-to-image-converter
https://codebeautify.org/base64-to-image-converter
20/11/2018, 16:48
Ekli örnek, tablodaki Bit İşlem Resmini istenilen dizine aktarılması için örnektir. Resim farkını bulmak için resmin base64 kodlamasını yapar ve karşılaştırır. Resim farkından ziyade resmi dizine aktarmak için kullanılabilir. Kodlamaya göre resim temp içerisine aktarılıyor.
20/11/2018, 18:49
(20/11/2018, 16:48)ozanakkaya yazdı: [ -> ]Ekli örnek, tablodaki Bit İşlem Resmini istenilen dizine aktarılması için örnektir. Resim farkını bulmak için resmin base64 kodlamasını yapar ve karşılaştırır. Resim farkından ziyade resmi dizine aktarmak için kullanılabilir. Kodlamaya göre resim temp içerisine aktarılıyor.
Tşk.
Sayfalar: 1 2