บางครั้งทุกคนก็สนุกกับการเข้ารหัสและถอดรหัส base64 ต่อไปนี้คือโค้ดการใช้งานเฉพาะที่เพื่อนๆ ต้องการสามารถอ้างอิงได้ คัดลอกรหัสรหัสดังต่อไปนี้:
-
sBASE_64_CHARACTERS = ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/
sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
ฟังก์ชัน strUnicodeLen(asContents)
'คำนวณความยาวของการเข้ารหัส Ansi ของสตริง Unicode
asContents1=a&asContents
len1=เลน (asContents1)
เค=0
สำหรับ i=1 ถึง len1
asc1=asc(กลาง(asContents1,i,1))
ถ้า asc1<0 ดังนั้น asc1=65536+asc1
ถ้า asc1>255 แล้ว
เค=เค+2
อื่น
เค=เค+1
สิ้นสุดถ้า
ต่อไป
strUnicodeLen=k-1
ฟังก์ชันสิ้นสุด
ฟังก์ชัน strUnicode2Ansi(asContents)
'แปลงสตริงที่เข้ารหัส Unicode เป็นสตริงที่เข้ารหัส Ansi
strUnicode2Ansi=
len1=len (ตามเนื้อหา)
สำหรับ i=1 ถึง len1
varchar=mid(asContents,i,1)
varasc=asc(วาร์ชาร์)
ถ้า varasc<0 ดังนั้น varasc=varasc+65536
ถ้า varasc>255 แล้ว
varHex=Hex(วาราสค์)
varlow=ซ้าย(varHex,2)
varhigh=ขวา(varHex,2)
strUnicode2Ansi=strUnicode2Ansi & chrb(&H & varlow ) & chrb(&H & varhigh )
อื่น
strUnicode2Ansi=strUnicode2Ansi & chrb(varasc)
สิ้นสุดถ้า
ต่อไป
สิ้นสุดฟังก์ชัน
ฟังก์ชัน strAnsi2Unicode (asContents)
'แปลงสตริงที่เข้ารหัส Ansi เป็นสตริงที่เข้ารหัส Unicode
strAnsi2Unicode =
len1 = lenb (ตามเนื้อหา)
ถ้า len1=0 ให้ออกจากฟังก์ชัน
สำหรับ i=1 ถึง len1
varchar=midb(asContents,i,1)
varasc=ascb(วาร์ชาร์)
ถ้า varasc > 127 แล้ว
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
ฉัน=ฉัน+1
อื่น
strAnsi2Unicode = strAnsi2Unicode & chr(วาราสค์)
สิ้นสุดถ้า
ต่อไป
สิ้นสุดฟังก์ชัน
ฟังก์ชั่น Base64encode (asContents)
'Base64 เข้ารหัสสตริงที่เข้ารหัส Ansi
'asContents ควรเป็นสตริงที่เข้ารหัส ANSI (สามารถใช้สตริงไบนารี่ได้เช่นกัน)
Dim lnตำแหน่ง
ล่ม lsResult
ดิมชาร์1
ดิมชาร์2
ดิมชาร์3
ดิมชาร์4
ดิมไบต์1
ดิมไบต์2
ดิมไบต์3
Dim SaveBits1
ติ่ม SaveBits2
ติ่ม lsGroupBinary
ดิม lsGroup64
หรี่ m4,len1,len2
len1=Lenb(asContents)
ถ้า len1<1 แล้ว
รหัส Base64=
ออกจากฟังก์ชัน
สิ้นสุดถ้า
m3=Len1 รุ่น 3
ถ้า M3 > 0 ดังนั้น asContents = asContents & String(3-M3, chrb(0))
'ตัวเลขเสริมใช้เพื่ออำนวยความสะดวกในการคำนวณ
ถ้า m3 > 0 แล้ว
len1=len1+(3-m3)
len2=len1-3
อื่น
len2=len1
สิ้นสุดถ้า
lsResult=
สำหรับ lnPosition = 1 ถึง len2 ขั้นตอนที่ 3
lsGroup64 =
lsGroupBinary = Midb(asContents, lnPosition, 3)
Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 และ 3
Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 และ 15
Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
Char1 = Midb(sBASE_64_CHARACTERS, ((ไบต์1 และ 252) / 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 และ 240) / 16) หรือ (SaveBits1 * 16) และ &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 และ 192) / 64) หรือ (SaveBits2 * 4) และ &HFF) + 1, 1)
Char4 = Midb(sBASE_64_CHARACTERS, (ไบต์3 และ 63) + 1, 1)
lsGroup64 = Char1 & Char2 & Char3 & Char4
lsResult = lsResult & lsGroup64
ต่อไป
'ประมวลผลอักขระสุดท้ายที่เหลืออยู่
ถ้า M3 > 0 แล้ว
lsGroup64 =
lsGroupBinary = Midb(asContents, len2+1, 3)
Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 และ 3
Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 และ 15
Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
Char1 = Midb(sBASE_64_CHARACTERS, ((ไบต์1 และ 252) / 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 และ 240) / 16) หรือ (SaveBits1 * 16) และ &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 และ 192) / 64) หรือ (SaveBits2 * 4) และ &HFF) + 1, 1)
ถ้า M3=1 แล้ว
lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61) 'ใช้ = เครื่องหมายเพื่อกรอกตัวเลข
อื่น
lsGroup64 = Char1 & Char2 & Char3 & ChrB(61) 'ใช้ = เครื่องหมายเพื่อสร้างตัวเลข
สิ้นสุดถ้า
lsResult = lsResult & lsGroup64
สิ้นสุดถ้า
Base64encode = lsResult
ฟังก์ชันสิ้นสุด
ฟังก์ชั่น Base64decode (asContents)
'แปลงสตริงที่เข้ารหัส Base64 เป็นสตริงที่เข้ารหัส Ansi
'asContents ควรเป็นสตริงที่เข้ารหัส ANSI ด้วย (ยอมรับสตริงไบนารี่ได้เช่นกัน)
ล่ม lsResult
Dim lnตำแหน่ง
หรี่ lsGroup64, lsGroupBinary
หรี่ Char1, Char2, Char3, Char4
หรี่ Byte1, Byte2, Byte3
หรี่ M4,len1,len2
len1= Lenb (ตามเนื้อหา)
M4 = len1 มด 4
ถ้า len1 < 1 หรือ M4 > 0 แล้ว
'ความยาวของสตริงควรเป็นผลคูณของ 4'
Base64decode=
ออกจากฟังก์ชัน
สิ้นสุดถ้า
'จงพิจารณาว่าหลักสุดท้ายคือ = เครื่องหมายหรือไม่'
'จงพิจารณาว่าหลักสุดท้ายคือ = เครื่องหมายหรือไม่'
'ในที่นี้ m4 แสดงถึงจำนวนอักขระสุดท้ายที่เหลืออยู่ซึ่งจำเป็นต้องประมวลผลแยกกัน
ถ้า midb(asContents, len1, 1) = chrb(61) แล้ว m4=3
ถ้า midb(asContents, len1-1, 1) = chrb(61) แล้ว m4=2
ถ้า m4 = 0 แล้ว
len2=len1
อื่น
len2=เลน1-4
สิ้นสุดถ้า
สำหรับ lnPosition = 1 ถึง Len2 ขั้นตอนที่ 4
lsGroupBinary =
lsGroup64 = Midb(asContents, lnPosition, 4)
Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
Byte1 = Chrb(((Char2 และ 48) / 16) หรือ (Char1 * 4) และ &HFF)
Byte2 = lsGroupBinary & Chrb(((Char3 และ 60) / 4) หรือ (Char2 * 16) และ &HFF)
Byte3 = Chrb((((Char3 และ 3) * 64) และ &HFF) หรือ (Char4 และ 63))
lsGroupBinary = ไบต์1 & ไบต์2 & ไบต์3
lsResult = lsResult & lsGroupBinary
ต่อไป
'ประมวลผลอักขระสุดท้ายที่เหลืออยู่
ถ้า M4 > 0 แล้ว
lsGroupBinary =
lsGroup64 = Midb(asContents, len2+1, m4) & chrB(65) 'chr(65)=A, แปลงเป็นค่า 0
ถ้า M4=2 ให้เพิ่มตัวเลข 4 หลักเพื่อช่วยในการคำนวณ
lsGroup64 = lsGroup64 & chrB(65)
สิ้นสุดถ้า
Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
Byte1 = Chrb(((Char2 และ 48) / 16) หรือ (Char1 * 4) และ &HFF)
Byte2 = lsGroupBinary & Chrb(((Char3 และ 60) / 4) หรือ (Char2 * 16) และ &HFF)
Byte3 = Chrb((((Char3 และ 3) * 64) และ &HFF) หรือ (Char4 และ 63))
ถ้า M4=2 แล้ว
lsGroupBinary = ไบต์ 1
มิฉะนั้นถ้า M4=3 แล้ว
lsGroupBinary = ไบต์ 1 และ ไบต์ 2
สิ้นสุดถ้า
lsResult = lsResult & lsGroupBinary
สิ้นสุดถ้า
Base64decode = lsResult
ฟังก์ชันสิ้นสุด
-