 |
VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
|
| 上一篇主題 :: 下一篇主題 |
| 發表人 |
內容 |
garfield
Site Admin
註冊時間: 2003-01-30
文章: 2157
第 1 樓
|
 發表於: 星期三 七月 08, 2009 6:11 pm 文章主題: vfp6 可用的 Base64 編碼/解碼程式 |
 |
|
本來想用在elleryq 寫的程式, 但發現vfp6並不支援資料型態是Q的二進位資料,
http://blog.roodo.com/thinkingmore/archives/553966.html
所以另外找到
http://fox.wikis.com/wc.dll?Wiki~Base64~SoftwareEng
但是發現這個程式有點小瑕疵,
在編碼時不足3byte時, 須用=填滿它, 而不是用A
所以改寫它給有須要的人用.並增強它的功能, 讓它除了傳檔名之外也可以傳字串.
| 代碼: |
*!* *************************************************
*!* * Sample code, including timing test
*!* *************************************************
*!* LOCAL loBase64
*!* loBase64 = CREATEobject("Base64")
*!* strtofile('資料來源http://fox.wikis.com/wc.dll?Wiki~Base64~SoftwareEng,�{式修改: garfield','c:\a.txt')
*!* ?"----------------"
*!* WITH loBase64
*!* lnSeconds = SECONDS()
*!* .Encode("c:\a.txt", "c:\base64.txt")
*!* ?SECONDS() - lnSeconds
*!* .Encode("c:\a.txt")
*!* ? .Encodestr
*!* .Encode(filetostr("c:\a.txt"), .t.) &&--傳來欲編碼的字串時, 第2個參數要傳來 .t.
*!* ? .Encodestr
*!* ?SECONDS() - lnSeconds
*!* lnSeconds = SECONDS()
*!* IF .not. .Decode("c:\___base64.txt", "c:\b.txt")
*!* ? .errorcode
*!* ENDIF
*!* IF .not. .Decode("c:\base64.txt", "czxc:\b.txt")
*!* ? .errorcode
*!* ENDIF
*!* .Decode("c:\base64.txt", "c:\b.txt")
*!* .Decode("c:\base64.txt")
*!* *? .Decodestr
*!* ?SECONDS() - lnSeconds
*!* ENDWITH
*!* *************************************************
DEFINE Class Base64 As Custom
DIMENSION aBase64[64]
Encodestr=''
Decodestr=''
errorcode=''
*********************************************************************************
PROCEDURE Encode(tcInFile, tcOutFile)
*********************************************************************************
*
* Method: Encode()
*
* Purpose: Converts the specified file to Base64 encoding
*
* Remarks:
*
*******************************************************************************
* Character variables
LOCAL ;
lcBase64, ;
lcLine, ;
lcStr, ;
lcBin
* Integer variables
LOCAL ;
liDecimal, ;
liHandle, ;
i, ;
j
this.errorcode='' &&--如果有問題會有錯誤字串
IF vartype(tcOutFile)='L' .and. tcOutFile &&--指定 tcInFile 為一個字串而非檔名
this.Decodestr = tcInFile
ELSE
* Only proceed if the specified file exists
IF !FILE(tcInFile)
this.errorcode= '找不到檔案:'+tcInFile
ELSE
* Set some starting values
this.Decodestr = FILETOSTR(tcInFile)
ENDIF
ENDIF
IF empty(this.errorcode)
lcBase64 = ""
this.Encodestr = ""
* Get the characters from the input
* file, in groups of three each
FOR i = 1 TO LEN(this.Decodestr) STEP 3
lcStr = SUBSTR(this.Decodestr, i, 3)
* Encode the binary code to Base64 and
* add it to the existing output string
lcBase64 = lcBase64 + This.Split4(lcStr)
ENDFOR
* Build the encoded output string,
* in lines of 76 characters each
FOR i = 1 TO LEN(lcBase64) STEP 76
this.Encodestr = this.Encodestr + SUBSTR(lcBase64, i, 76) + chr(13)+chr(10)
ENDFOR
if !empty(this.Encodestr)
this.Encodestr = left(this.Encodestr,len(this.Encodestr)-2)
endif
IF vartype(tcOutFile)='C' &&--有傳檔名來, 表示要建立檔案
* Create the output file, overwriting it if it exists
liHandle = FCREATE(tcOutFile)
* Only proceed if we could create the output file
IF liHandle > 0
* Write & close the output file
FWRITE(liHandle, this.Encodestr)
FCLOSE(liHandle)
ELSE
this.errorcode= '無法建立檔案:'+tcOutFile
ENDIF
ENDIF
ENDIF
mret = empty( this.errorcode)
RETURN mret
ENDPROC
*********************************************************************************
PROCEDURE Decode(tcInFile, tcOutFile)
*********************************************************************************
*
* Method: Decode()
*
* Purpose: Converts the specified file from Base64 encoding
*
* Remarks: Input file must contain no extra characters
* other than Base64 encoded characters, and each
* line must be exactly 76 characters long
*
*******************************************************************************
* Character variables
LOCAL ;
lcString, ;
lcBinary, ;
lcChr, ;
lcBin
* Integer variables
LOCAL ;
liHandle, ;
liDec, ;
i, ;
j
this.errorcode= ''
IF vartype(tcOutFile)='L' .and. tcOutFile &&--指定 tcInFile 為一個字串而非檔名
this.Encodestr = tcInFile
ELSE
* Only proceed if the specified file exists
IF !FILE(tcInFile)
this.errorcode= '找不到檔案:'+tcInFile
ELSE
* Set some starting values
this.Encodestr = FILETOSTR(tcInFile)
ENDIF
ENDIF
IF empty(this.errorcode)
this.Decodestr = ""
* Strip out linefeeds, so we have
* one continous string to process
this.Encodestr = CHRTRAN(this.Encodestr, chr(13)+chr(10), "")
* Get the characters from the input
* file, in groups of four each
FOR i = 1 TO LEN(this.Encodestr) STEP 4
lcString =strt( SUBSTR(this.Encodestr, i, 4),'=','') &&--去掉填滿4個byte的碼數=
WITH This
for j=1 to len(lcString)
lcString = stuff( lcString , j,1,CHR(ASCAN(.aBase64, SUBSTR(lcString, j, 1)) - 1))
*!* lcString = ;
*!* CHR(ASCAN(.aBase64, SUBSTR(lcString, 1, 1)) - 1) + ;
*!* CHR(ASCAN(.aBase64, SUBSTR(lcString, 2, 1)) - 1) + ;
*!* CHR(ASCAN(.aBase64, SUBSTR(lcString, 3, 1)) - 1) + ;
*!* CHR(ASCAN(.aBase64, SUBSTR(lcString, 4, 1)) - 1)
next
* Decode the binary code from Base64
* and build the existing output string
this.Decodestr = this.Decodestr + .Split3(lcString)
ENDWITH
ENDFOR
IF vartype(tcOutFile)='C' &&--有傳檔名來, 表示要建立檔案
* Create the output file, overwriting it if it exists
liHandle = FCREATE(tcOutFile)
* Only proceed if we could create the output file
IF liHandle > 0
* Write & close the output file
FWRITE(liHandle, this.Decodestr)
FCLOSE(liHandle)
ELSE
this.errorcode= '無法建立檔案:'+tcOutFile
ENDIF
ENDIF
ELSE
this.errorcode= '找不到檔案:'+tcInFile
ENDIF
mret = empty( this.errorcode)
RETURN mret
ENDPROC
*********************************************************************************
Hidden PROCEDURE Split3(tcBinary)
*********************************************************************************
*
* Method: Split3()
*
* Purpose: Splits a 24-bit binary string into 3 8-bit
* strings, converts them into decimal values and
* returns them as concatenated ASCII characters
*
* Remarks:
*
*******************************************************************************
WITH This
LOCAL ;
liOutByte1, ;
liOutByte2, ;
liOutByte3, ;
liInByte1, ;
liInByte2, ;
liInByte3, ;
liInByte4
liInByte1 = ASC(SUBSTR(tcBinary, 1, 1))
liInByte2 = ASC(SUBSTR(tcBinary, 2, 1))
liInByte3 = ASC(SUBSTR(tcBinary, 3, 1))
liInByte4 = ASC(SUBSTR(tcBinary, 4, 1))
liOutByte1 = BITLSHIFT(BITAND(liInByte1, 0x3f), 2) + BITRSHIFT(liInByte2, 4)
liOutByte2 = BITLSHIFT(BITAND(liInByte2, 0x0f), 4) + BITRSHIFT(liInByte3, 2)
liOutByte3 = BITLSHIFT(BITAND(liInByte3, 0x03), 6) + BITAND(liInByte4, 0x3f)
RETURN ;
CHR(liOutByte1) + ;
CHR(liOutByte2) + ;
CHR(liOutByte3)
ENDWITH
ENDPROC
*********************************************************************************
Hidden PROCEDURE Split4(tcBinary)
*********************************************************************************
*
* Method: Split4()
*
* Purpose: Splits a 24-bit binary string into 4 6-bit
* strings, converts them into decimal values and
* returns them as concatenated Base64 characters
*
* Remarks:
*
*******************************************************************************
LOCAL ;
liOutByte1, ;
liOutByte2, ;
liOutByte3, ;
liOutByte4, ;
liInByte1, ;
liInByte2, ;
liInByte3,;
mret
*mret = '====' &&--長度不足3個字的皆用= 來取代, 不可以用0 ==>A
liInByte1 = ASC(SUBSTR(tcBinary, 1, 1))
liInByte2 = ASC(SUBSTR(tcBinary, 2, 1))
liInByte3 = ASC(SUBSTR(tcBinary, 3, 1))
liOutByte1 = BITRSHIFT(liInByte1, 2)
liOutByte2 = BITLSHIFT(BITAND(liInByte1, 0x03), 4) + BITRSHIFT(BITAND(liInByte2, 0xf0), 4)
liOutByte3 = BITLSHIFT(BITAND(liInByte2, 0x0f), 2) + BITRSHIFT(BITAND(liInByte3, 0xc0), 6)
liOutByte4 = BITAND(liInByte3, 0x3f)
WITH This
mret = ;
.aBase64[liOutByte1 + 1] + ;
.aBase64[liOutByte2 + 1] + ;
.aBase64[liOutByte3 + 1] + ;
.aBase64[liOutByte4 + 1]
ENDWITH
return left(mret, len(tcBinary)+1)+repl('=',3-len(tcBinary))
ENDPROC
*********************************************************************************
Hidden PROCEDURE Init()
*********************************************************************************
*
* Method: Init()
*
* Purpose:
*
* Remarks: Build the encode/decode array, based
* on the following Base64 lookup table
*
* -------------------------------------------
* | 0 = A | 16 = Q | 32 = g | 48 = w |
* | 1 = B | 17 = R | 33 = h | 49 = x |
* | 2 = C | 18 = S | 34 = i | 50 = y |
* | 3 = D | 19 = T | 35 = j | 51 = z |
* | 4 = E | 20 = U | 36 = k | 52 = 0 |
* | 5 = F | 21 = V | 37 = l | 53 = 1 |
* | 6 = G | 22 = W | 38 = m | 54 = 2 |
* | 7 = H | 23 = X | 39 = n | 55 = 3 |
* | 8 = I | 24 = Y | 40 = o | 56 = 4 |
* | 9 = J | 25 = Z | 41 = p | 57 = 5 |
* | 10 = K | 26 = a | 42 = q | 58 = 6 |
* | 11 = L | 27 = b | 43 = r | 59 = 7 |
* | 12 = M | 28 = c | 44 = s | 60 = 8 |
* | 13 = N | 29 = d | 45 = t | 61 = 9 |
* | 14 = O | 30 = e | 46 = u | 62 = + |
* | 15 = P | 31 = f | 47 = v | 63 = / |
* -------------------------------------------
*
*******************************************************************************
LOCAL i
FOR i = 0 TO 25
this.aBase64[i + 1] = CHR(i + 65)
ENDFOR
FOR i = 26 TO 51
this.aBase64[i + 1] = CHR(i + 71)
ENDFOR
FOR i = 52 TO 61
this.aBase64[i + 1] = CHR(i - 4)
ENDFOR
this.aBase64[63] = "+"
this.aBase64[64] = "/"
ENDPROC
ENDDEFINE
|
_________________
利用>>搜尋<<的功能會比問的還要快得到答案. |
|
| 回頂端 |
|
 |
goto-dream
註冊時間: 2004-05-11
文章: 909
第 2 樓
|
| 發表於: 星期二 十一月 10, 2009 11:24 am 文章主題: |
|
|
這個跟下面函數有差別嗎??
STRCONV( ) Function
STRCONV(cExpression, nConversionSetting [, nRegionalIdentifier [, nRegionalIDType]])
nConversionSetting :
13
Converts single-byte characters in cExpression to encoded base64 binary.
14
Converts base64 encoded data in cExpression to original unencoded data.
_________________
福隆昌淨水有限公司--淨水器的專家,淨水器,飲水機,濾心!!
想了解更多，您可上幸福雞湯組.找尋!!丁澐瑄.老師.
愛作夢 |
|
| 回頂端 |
|
|
garfield
Site Admin
註冊時間: 2003-01-30
文章: 2157
第 3 樓
|
| 發表於: 星期三 十一月 11, 2009 1:53 pm 文章主題: |
|
|
vfp6 無法用13的參數.
_________________
利用>>搜尋<<的功能會比問的還要快得到答案. |
|
| 回頂端 |
|
|
goto-dream
註冊時間: 2004-05-11
文章: 909
第 4 樓
|
|
| 回頂端 |
|
|
ssyun
註冊時間: 2024-03-27
文章: 3
第 5 樓
|
| 發表於: 星期二 四月 09, 2024 12:27 pm 文章主題: |
|
|
各位先進請問一下,上面base64編碼程式,也可以直接對政府發的憑證檔直接編碼嗎?
因為我編完也不知道如何驗證對不對? |
|
| 回頂端 |
|
|
|
|
您 無法 在這個版面發表文章
您 無法 在這個版面回覆文章
您 無法 在這個版面編輯文章
您 無法 在這個版面刪除文章
您 無法 在這個版面進行投票
您 無法 在這個版面附加檔案
您 無法 在這個版面下載檔案
|
|
常見問題
搜尋
會員列表
會員群組
會員註冊
個人資料
登入檢查您的私人訊息
登入
