Results 1 to 1 of 1

Thread: How to convert String Picture back to Object, Decoding again
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Mar 2009
    Post Thanks / Like
    2 Post(s)
    0 Thread(s)

    Default How to convert String Picture back to Object, Decoding again

    Here Encoder how to convert to Decoder

    Sub EncdPic()
    Call EncodeFilebase64("C:\Users\User\Desktop\Untitled.png") '"FullPath with Pic Extention"
    End Sub
    Public Function EncodeFilebase64(strPicPath As String) As String
        Dim PicExtn As String, FLPath As String
        Dim StrPath As Variant
        Dim BSC As Long
        Dim fso As Object
        PicExtn = Split(strPicPath, ".")(1)
       ' StrPath = Split(strPicPath, "\")
        'BSC = UBound(StrPath)
        'FLPath = Left(strPicPath, Len(strPicPath) - Len(StrPath(BSC)))
         FLPath = Replace(strPicPath, PicExtn, ".txt")
       'or remove ' apostrophe from below
       'FLPath = Replace(strPicPath, PicExtn, ".htm") ' swich to show it in HTML PIC
        'Please Remove Space after < in "< img
        ' EncodeFilebase64 = "< img src='data:image/" & PicExtn & ";base64," & EncodeFile(strPicPath) & "'/>" ' to be used for HTML
        'or use below
        EncodeFilebase64 = EncodeFile(strPicPath)
        'Close notepad File if it open
         Close_Notepad_ByName FLPath
         ' Kill File
         If Len(Dir(FLPath)) <> 0 Then Kill FLPath
        Set fso = CreateObject("Scripting.FileSystemObject")
        Dim Fileout As Object
        Set Fileout = fso.CreateTextFile(FLPath, True, True)
        Fileout.Write EncodeFilebase64
        'Open File
        If InStr(1, FLPath, "txt", vbTextCompare) <> 0 Then
        Call Shell("Notepad" & " " & FLPath, vbNormalFocus)
        ElseIf InStr(1, FLPath, "htm", vbTextCompare) <> 0 Then
        Call Shell("explorer.exe" & " " & FLPath, vbNormalFocus)
        End If
    Set Fileout = Nothing
    Set fso = Nothing
    End Function
    Public Function EncodeFile(strPicPath As String) As String
        Const adTypeBinary = 1          ' Binary file is encoded
        ' Variables for encoding
        Dim objXML
        Dim objDocElem
        ' Variable for reading binary picture
        Dim objStream
        ' Open data stream from picture
        Set objStream = CreateObject("ADODB.Stream")
        objStream.Type = adTypeBinary
        objStream.LoadFromFile (strPicPath) ' if error check Path is correct or Exist
        ' Create XML Document object and root node
        ' that will contain the data
        Set objXML = CreateObject("MSXml2.DOMDocument")
        Set objDocElem = objXML.createElement("Base64Data")
        objDocElem.DataType = "bin.base64"
        ' Set binary value
        objDocElem.NodeTypedValue = objStream.Read()
        ' Get base64 value
        EncodeFile = objDocElem.Text
        ' Clean all
        Set objXML = Nothing
        Set objDocElem = Nothing
        Set objStream = Nothing
    End Function
    Public Sub Close_Notepad_ByName(NtpPath As String)
    Dim oServ As Object
    Dim cProc As Object
    Dim oProc As Object
    StrProcessName = "Notepad.exe"
    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("select * from win32_process")
    For Each oProc In cProc
        If InStr(1, oProc.Name, StrProcessName, vbTextCompare) <> 0 Then ' check if Notepad
            If InStr(1, oProc.CommandLine, NtpPath, vbTextCompare) <> 0 Then ' check Path
            End If
        End If
    Set oServ = Nothing
    Set cProc = Nothing
    End Sub
    Last edited by Dossfm0q; Jun 13th, 2018 at 11:08 AM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts