mencode.bas

来自「用vb写的一个小程序。希望喜欢。 ＬＨＢＳＥＡＭＡＮ·１６３。ＣＯＭ」· BAS 代码 · 共 44 行

Attribute VB_Name = "mEncode"
Option Compare Binary
Option Explicit

Function fcnGetCodeList(strType As String, arrChars As Variant) As Boolean
  Const lngMaxBuffer = 10&
  Static strLastType(lngMaxBuffer) As String
  Static arrLastOutput(lngMaxBuffer) As Variant
  Static lngMainPointer As Long

  Dim strOut           As String, lngNum As Long, strText As String, strChar As String * 1, strEncodeTest As String
  Dim rstConvert       As DAO.Recordset
  ReDim arrChars(255) As String
  Dim lngPointer       As Long

  Do While StrComp(strType, strLastType(lngPointer), vbTextCompare) <> 0 And lngPointer < lngMaxBuffer
    lngPointer = lngPointer + 1
  Loop

  If StrComp(strType, strLastType(lngPointer), vbTextCompare) = 0 Then
    fcnGetCodeList = True
    arrChars = arrLastOutput(lngPointer)
  Else

    Set rstConvert = ActiveDB.OpenRecordset("select * from " & TBL & "convert where " & FLD & "type=""" & strType & """ order by " & FLD & "key", dbOpenDynaset, dbDenyWrite)
    With rstConvert

      If .EOF Then
        fcnGetCodeList = False
      Else

        While Not .EOF
          strChar = Mid$(.Fields(FLD & "original"), 2, 1) & vbNullString
          strText = Mid$(.Fields(FLD & "changeto"), 2, Len(.Fields(FLD & "changeto")) - 2) & vbNullString

          '***  !TODO: insert error handling
          If Len(strChar) <> 1 Then Stop
          If Len(strText) < 1 Then Stop

          '***  IF the special character (strChar) is in the encoded text (strText)
          '***  like '&' in '&amp;' and '%' in '%25'
          '***  then it _MUST_ be the first character to process when encoding
          '***  (and the last one when decoding)
          '***  otherwise (html) encoding could encode "