VBA पर XXEncode प्रारूप, या किसी दस्तावेज़ में एक बाइनरी लोड करने का तरीका

एक्सेल + वीबीए के एक समूह में काम करते समय, आपको कभी-कभी एक कंटेनर में द्विआधारी डेटा को संग्रहीत करने की आवश्यकता होती है जो सामग्री पर प्रतिबंध लगाता है। इन कार्यों के लिए, XXEncode प्रारूप विकसित किया गया था। और अब, मान लें कि आप अपने VBA प्रोजेक्ट से संबंधित आवश्यक पुस्तकालयों और उपयोगिताओं को हमेशा .xx वर्कबुक के अंदर रखना चाहते हैं। नीचे मैं दिखाऊंगा कि मैंने वीबीए परियोजनाओं के मानक मॉड्यूल की टिप्पणियों में बाइनरी फाइलों के भंडारण को कैसे लागू किया।

XXE में द्विआधारी डेटा की एन्कोडिंग और व्युत्क्रम परिवर्तन - डीकोडिंग - मैंने क्रमशः दो कार्यों, बिन 2 एक्सएक्सएक्स और एक्सएक्स 2 एनबी के साथ कार्यान्वित किया। विभिन्न कार्यों के बीच कोड को अधिक या कम पोर्टेबल बनाने के लिए, बाइनरी डेटा को बाइट्स की एक सरणी द्वारा दर्शाया जाता है, और XXE में एन्कोडेड डेटा को स्ट्रिंग्स में संग्रहीत किया जाता है।

''      xxe Function bin2xxe(src() As Byte, fname As String) As String Dim i As Long, n As Long, t As Byte, xxe() As String, s As String, sz As Long, pt As Long xxe = Split("+ - 0 1 2 3 4 5 6 7 8 9 ABCDEFGHIJKLMNOPQRSTU VWXYZ abcdefghijklmnopqrstu vwxyz") i = 0 n = UBound(src) s = Space(((n + 1) \ 45) * 63 + ((n + 1) Mod 45) * 4 \ 3 + 280) pt = 1 sz = 12 + Len(fname) Mid$(s, 1, sz) = "begin 644 " & fname & vbCrLf pt = pt + sz + 1 sz = pt - 1 Do While i <= n If i Mod 3 = 0 Then Mid$(s, pt, 1) = xxe(src(i) \ 4): pt = pt + 1 t = (src(i) And 3) * 16 ElseIf i Mod 3 = 1 Then Mid$(s, pt, 1) = xxe(t + (src(i) \ 16)): pt = pt + 1 t = (src(i) And 15) * 4 ElseIf i Mod 3 = 2 Then Mid$(s, pt, 2) = xxe(t + src(i) \ 64) & xxe(src(i) And 63): pt = pt + 2 t = 0 End If If i Mod 45 = 44 Then Mid$(s, sz, 1) = "h" Mid$(s, pt, 2) = vbCrLf: pt = pt + 3: sz = pt - 1 End If i = i + 1 Loop If (n + 1) Mod 3 <> 0 Then Mid$(s, pt, 1) = xxe(t): pt = pt + 1 End If t = (n Mod 45) + 1 If t <> 45 Then Mid$(s, sz, 1) = xxe(t) Mid$(s, pt, 3) = "+" & vbCrLf: pt = pt + 3 End If Mid$(s, pt, 3) = "end": sz = pt + 2 bin2xxe = Left(s, sz) End Function '   xxe    Function xxe2bin(src As String, fname As String) As Byte() Dim t() As String, t0() As String, i As Long, j As Long, k As Long Dim xxe As String, bStrLen As Byte, lStart As Long, h As Byte, x As Byte Dim dst() As Byte, xxeIdx(43 To 122) As Byte xxeIdx(43) = 0: xxeIdx(45) = 1 For i = 48 To 57: xxeIdx(i) = i - 46: Next For i = 65 To 90: xxeIdx(i) = i - 53: Next For i = 97 To 122: xxeIdx(i) = i - 59: Next t = Split(src, vbCrLf) t0 = Split(t(0)) If t0(0) <> "begin" Then Exit Function If UBound(t0) = 2 Then fname = t0(2) Else Exit Function j = 1 Do While t(j) <> "end" And j <= UBound(t) lStart = lStart + xxeIdx(Asc(t(j))) j = j + 1 Loop ReDim dst(0 To lStart - 1) j = 1: lStart = 0: x = 0 Do While t(j) <> "end" And j <= UBound(t) bStrLen = xxeIdx(Asc(t(j))) i = 2 k = 0 Do While i <= Len(t(j)) And k <= bStrLen - 1 h = xxeIdx(Asc(Mid$(t(j), i, 1))) Select Case i And 3 Case 0: dst(lStart + k) = x + h \ 4 x = (h And 3) * 64 k = k + 1 Case 1: dst(lStart + k) = x + h x = 0 k = k + 1 Case 2: x = h * 4 Case 3: dst(lStart + k) = x + h \ 16 x = (h And 15) * 16 k = k + 1 End Select i = i + 1 Loop lStart = lStart + bStrLen j = j + 1 Loop xxe2bin = dst End Function 

इसके अलावा, कार्य के लिए एन्कोडिंग / डिकोडिंग के लिए शेल प्रक्रियाओं के एक जोड़े को भी लिखा गया था: फ़ाइल 2stdm एक द्विआधारी फ़ाइल को VBA प्रोजेक्ट के मानक मॉड्यूल में लोड कर रहा है (xxe कोड को टिप्पणियों में एक अलग मॉड्यूल में रखा गया है) और इनवॉइस रूपांतरण - मानक मॉड्यूल में एन्कोडेड है जो से फ़ाइल को अनपैक करना stdm2file । यहां यह ध्यान दिया जाना चाहिए कि VBProject में मुफ्त हेरफेर के लिए, VBA परियोजनाओं तक पहुंच को लक्ष्य मशीन पर अनुमति दी जानी चाहिए। निम्नलिखित रैपर प्रक्रियाओं के एक जोड़े हैं:

 '      VBA Sub file2stdm(fpath As String, fname As String, wbk As Workbook) Dim src() As Byte, s As String, i As Long, t() As String Dim stdm As VBComponent, f As Long f = FreeFile Open fpath & "\" & fname For Binary Access Read As #f ReDim src(0 To LOF(f) - 1) As Byte Get #f, 1, src Close #f s = bin2xxe(src, fname) t = Split(s, vbCrLf) For i = 0 To UBound(t) t(i) = "'" & t(i) Next s = Join(t, vbCrLf) Set stdm = wbk.VBProject.VBComponents.Add(vbext_ct_StdModule) stdm.Name = "m" & Replace(fname, ".", "") stdm.CodeModule.AddFromString s Set stdm = Nothing End Sub '      VBA Sub stdm2file(fpath As String, fname As String, wbk As Workbook) Dim stdm As VBComponent, i As Long, m As Long, n As Long Dim s As String, t() As String, dst() As Byte, f As Long Set stdm = wbk.VBProject.VBComponents("m" & Replace(fname, ".", "")) For i = 1 To stdm.CodeModule.CountOfLines If stdm.CodeModule.Lines(i, 1) Like "'begin *" Then m = i If stdm.CodeModule.Lines(i, 1) Like "'end*" Then n = i - m + 1 Next s = stdm.CodeModule.Lines(m, n) Set stdm = Nothing t = Split(s, vbCrLf) For i = 0 To UBound(t) t(i) = Mid(t(i), 2) Next s = Join(t, vbCrLf) dst = xxe2bin(s, fname) f = FreeFile Open ThisWorkbook.Path & "\" & fname For Binary Access Write As #f Put #f, 1, dst Close #f End Sub 

बेशक, अब हमें बस इतना करना है कि काम में जुट जाना है। दो परीक्षण प्रक्रियाएं, एक फाइल को मॉड्यूल में लोड करती है, दूसरी फाइल को मॉड्यूल से डिस्क पर अनपैक करती है।

 Sub test1() '     (  xxe) stdm2file ThisWorkbook.Path, "dzp.exe", ThisWorkbook '  ,    'Shell ThisWorkbook.Path & "\" & "dzp.exe", vbNormalNoFocus End Sub Sub test2() '   mdzpexe   On Error Resume Next With ThisWorkbook.VBProject.VBComponents .Remove .Item("mdzpexe") End With '     (  xxe) file2stdm ThisWorkbook.Path, "dzp.exe", ThisWorkbook End Sub 

इसके अलावा, XXE प्रारूप में एन्कोडिंग का उपयोग ई-मेल (बेस 64 के साथ) में संलग्नक को संग्रहीत करने के लिए किया जा सकता है, और एन्कोडिंग वर्ण सेट (+ -ए-ज़ा-ज़) आपको बाइनरी को लगभग किसी भी इंटरैक्टिव साइट पर पोस्ट करने की अनुमति देता है, टिप्पणियों में कहें। यह संसाधन के नियमों के खिलाफ नहीं है।

सूत्रों का कहना है:
विकिपीडिया पर Xencoding लेख