برنامه تبدیل لینک به کد base64

[omid2018]

برنامه ای میخوام که ورودی اول که یک لینک هستش را بگیره
ورودی دوم هم که اونم یه لینک هستش را هم بگیره و اونو به base64 تبدیل کنه مشابه این لینک https://base64encode.com/
یعنی Encode to base64 انجام بده و بعد اونو به انتهای لینک ورودی اول اضافه بکنه
و خروجی به صورت لینک تحویل بده
این پلتفرم رو هر چی باشه فرقی فقط استفاده راحت و ساده باشه
این دقیقا کاریه که میخوام امید وارم ادمین به لینک ها گیر نده
a: : یه لینک هستش ورودی اول میشه
https://deemanetwork.com/click/d/6b848bcf_47a5_4680_8c8f_41abc2ca89b7/
b : اونم یه لینکه که میشه
https://www.khanoumi.com/prime-eye-firming-treatment-18516
الان میخوام این لینک b به کد base 64 تبدیل بشه که با سایت
https://base64encode.com/
این کارو به صورت دستی انجام میدم و خروجی کد زیر میشه که اسمشو میزارم c
aHR0cHM6Ly93d3cua2hhbm91bWkuY29tL3ByaW1lLWV5ZS1maX JtaW5nLXRyZWF0bWVudC0xODUxNg==
الان میخوام c به انتهای a بچسپه بدون فاصله، یعنی بین a و c فقط یک / باید باشه که به شکل زیر در میاد اسمشو میزاریم d
https://deemanetwork.com/click/d/6b848bcf_47a5_4680_8c8f_41abc2ca89b7/aHR0cHM6Ly93d3cua2hhbm91bWkuY29tL3ByaW1lLWV5ZS1maX JtaW5nLXRyZWF0bWVudC0xODUxNg==
a تقریبا ثابته حداکثر 10 تا لینک مثل a دارم
اما b متغییره و هر دفعه باید عوض بشه و خروجی d به من بده

[isaac23]

سلام این زیاد سخت نیست شما فقط سورس تبدیل به Base64 رو داشته باشید راحت میشه درستش کرد

[omid2018]

خب این سورس چجوری پیدا کنم؟ میشه زحمتشو برام بکشین؟

[isaac23]

Public Function ToBase64(sInput As String) As String

Dim sOutput As String, sLast As String


Dim B(2) As Byte


Dim j As Integer


Dim I As Long, nLen As Long, nQuants As Long


Dim iIndex As Long

nLen = Len(sInput)
nQuants = nLen \ 3
sOutput = String(nQuants * 4, " ")
iIndex = 0


' Now start reading in 3 bytes at a time
For I = 0 To nQuants - 1
For j = 0 To 2
B(j) = Asc(Mid(sInput, (I * 3) + j + 1, 1))
Next


Mid$(sOutput, iIndex + 1, 4) = EncodeQuantum(B)
iIndex = iIndex + 4
Next

' Cope with odd bytes
Select Case nLen Mod 3


Case 0
sLast = ""


Case 1
B(0) = Asc(Mid(sInput, nLen, 1))
B(1) = 0
B(2) = 0
sLast = EncodeQuantum(B)
' Replace last 2 with =
sLast = Left(sLast, 2) & "=="


Case 2
B(0) = Asc(Mid(sInput, nLen - 1, 1))
B(1) = Asc(Mid(sInput, nLen, 1))
B(2) = 0
sLast = EncodeQuantum(B)
' Replace last with =
sLast = Left(sLast, 3) & "="
End Select

ToBase64 = sOutput & sLast
End Function

این کد بالا برای تبدیل متن به بیس 64 هست و این کد پایینی هم برای خواندن از بیس 64 هست ، امید وارم متوجه شده باشید .


Public Function FromBase64(sEncoded As String) As String


Dim sDecoded As String


Dim d(3) As Byte


Dim c As Byte


Dim di As Integer


Dim I As Long


Dim nLen As Long


Dim iIndex As Long

nLen = Len(sEncoded)
sDecoded = String((nLen \ 4) * 3, " ")
iIndex = 0
di = 0
Call MakeDecTab


' Read in each char in trun
For I = 1 To Len(sEncoded)
c = CByte(Asc(Mid(sEncoded, I, 1)))
c = aDecTab(c)


If c >= 0 Then
d(di) = c
di = di + 1


If di = 4 Then
Mid$(sDecoded, iIndex + 1, 3) = DecodeQuantum(d)
iIndex = iIndex + 3


If d(3) = 64 Then
sDecoded = Left(sDecoded, Len(sDecoded) - 1)
iIndex = iIndex - 1
End If


If d(2) = 64 Then
sDecoded = Left(sDecoded, Len(sDecoded) - 1)
iIndex = iIndex - 1
End If


di = 0
End If
End If


Next I

FromBase64 = sDecoded
End Function


خدمت شما