苗启源的部落格

  Const BASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Private sBASE_64_CHARACTERS

  Function Base64encode(ByVal asContents)
    asContents = strUnicode2Ansi(asContents)
    Dim lnPosition,lsResult,Char1,Char2,Char3,Char4,Byte1,Byte2,Byte3,SaveBits1,SaveBits2,lsGroupBinary,lsGroup64,M4, len1, len2
    len1 = LenB(asContents)
    If len1 < 1 Then
      Base64encode = ""
      Exit Function
    End If
    M4 = len1 Mod 3
    If M4 > 0 Then asContents = asContents & String(3 - M4, Chr(0))
    '补足位数是为了便于计算
    If M4 > 0 Then
      len1 = len1 + (3 - M4)
      len2 = len1 - 3
    Else
      len2 = len1
    End If
    lsResult = ""
    sBASE_64_CHARACTERS = strUnicode2Ansi(BASE_64_CHARACTERS)
    For lnPosition = 1 To len2 Step 3
      lsGroup64 = ""
      lsGroupBinary = MidB(asContents, lnPosition, 3)
      Byte1 = AscB(MidB(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
      Byte2 = AscB(MidB(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
      Byte3 = AscB(MidB(lsGroupBinary, 3, 1))
      Char1 = MidB(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
      Char2 = MidB(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
      Char3 = MidB(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
      Char4 = MidB(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)
      lsGroup64 = Char1 & Char2 & Char3 & Char4
      lsResult = lsResult & lsGroup64
    Next
    '处理最后剩余的几个字符
    If M4 > 0 Then
      lsGroup64 = ""
      lsGroupBinary = MidB(asContents, len2 + 1, 3)
      Byte1 = AscB(MidB(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
      Byte2 = AscB(MidB(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
      Byte3 = AscB(MidB(lsGroupBinary, 3, 1))
      Char1 = MidB(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
      Char2 = MidB(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
      Char3 = MidB(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
      If M4 = 1 Then
        lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61) '用=号补足位数
      Else
        lsGroup64 = Char1 & Char2 & Char3 & ChrB(61) '用=号补足位数
      End If
      lsResult = lsResult & lsGroup64
    End If
    Base64encode = strAnsi2Unicode(lsResult)
  End Function

  Function Base64decode(ByVal asContents)
    asContents = strUnicode2Ansi(asContents)
    Dim lsResult,lnPosition,lsGroup64, lsGroupBinary,Char1, Char2, Char3, Char4,Byte1, Byte2, Byte3,M4, len1, len2
    len1 = LenB(asContents)
    M4 = len1 Mod 4

    If len1 < 1 Or M4 > 0 Then
      '字符串长度应当是4的倍数
      Base64decode = ""
      Exit Function
    End If
    '判断最后一位是不是 = 号
    '判断倒数第二位是不是 = 号
    '这里m4表示最后剩余的需要单独处理的字符个数
    If MidB(asContents, len1, 1) = ChrB(61) Then M4 = 3
    If MidB(asContents, len1 - 1, 1) = ChrB(61) Then M4 = 2
    If M4 = 0 Then
      len2 = len1
    Else
      len2 = len1 - 4
    End If
    sBASE_64_CHARACTERS = strUnicode2Ansi(BASE_64_CHARACTERS)
    For lnPosition = 1 To len2 Step 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 And 48) \ 16) Or (Char1 * 4) And &HFF)
      Byte2 = lsGroupBinary & ChrB(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
      Byte3 = ChrB((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
      lsGroupBinary = Byte1 & Byte2 & Byte3
      lsResult = lsResult & lsGroupBinary
    Next
    '处理最后剩余的几个字符
    If M4 > 0 Then
      lsGroupBinary = ""
      lsGroup64 = MidB(asContents, len2 + 1, M4) & ChrB(65) 'chr(65)=A，转换成值为0
      If M4 = 2 Then '补足4位，是为了便于计算
        lsGroup64 = lsGroup64 & ChrB(65)
      End If
      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 And 48) \ 16) Or (Char1 * 4) And &HFF)
      Byte2 = lsGroupBinary & ChrB(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
      Byte3 = ChrB((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
      If M4 = 2 Then
        lsGroupBinary = Byte1
      ElseIf M4 = 3 Then
        lsGroupBinary = Byte1 & Byte2
      End If
      lsResult = lsResult & lsGroupBinary
    End If
    Base64decode = strAnsi2Unicode(lsResult)
  End Function

  Function strUnicodeLen(ByVal asContents)
    '计算unicode字符串的Ansi编码的长度
    Dim asContents1
    Dim len1,k,i,asc1
    asContents1 = "a" & asContents
    len1 = Len(asContents1)
    k = 0
    For i = 1 To len1
      asc1 = Asc(Mid(asContents1, i, 1))
      If asc1 < 0 Then asc1 = 65536 + asc1
      If asc1 > 255 Then
        k = k + 2
      Else
        k = k + 1
      End If
    Next
    strUnicodeLen = k - 1
  End Function

  Function strUnicode2Ansi(ByVal asContents)
    '将Unicode编码的字符串，转换成Ansi编码的字符串
    Dim len1,i,VarChar,varAsc,varHex, varlow, varhigh
    strUnicode2Ansi = ""
    len1 = Len(asContents)
    For i = 1 To len1
      VarChar = Mid(asContents, i, 1)
      varAsc = Asc(VarChar)
      If varAsc < 0 Then varAsc = varAsc + 65536
      If varAsc > 255 Then
        varHex = Hex(varAsc)
        varlow = Left(varHex, 2)
        varhigh = Right(varHex, 2)
        strUnicode2Ansi = strUnicode2Ansi & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
      Else
        strUnicode2Ansi = strUnicode2Ansi & ChrB(varAsc)
      End If
    Next
  End Function

  Function strAnsi2Unicode(asContents)
    '将Ansi编码的字符串，转换成Unicode编码的字符串
    Dim len1,i,VarChar,varAsc
    strAnsi2Unicode = ""
    len1 = LenB(asContents)
    If len1 = 0 Then Exit Function
    For i = 1 To len1
      VarChar = MidB(asContents, i, 1)
      varAsc = AscB(VarChar)
      If varAsc > 127 Then
        strAnsi2Unicode = strAnsi2Unicode & Chr(AscW(MidB(asContents, i + 1, 1) & VarChar))
        i = i + 1
      Else
        strAnsi2Unicode = strAnsi2Unicode & Chr(varAsc)
      End If
    Next
  End Function

在很多场合，特别重要的要加密传输。使用成熟的加密算法是一个不错的选择，但是~ 有些算法这个语言支持而另一种语言不支持。或者直接要安装某某组件，实在是太烦琐了，为了方便以后使用，自己抽空写了一个。 阅读全文…

最近经常需要开发API，Microsoft.XMLHttp、MSXML2.XMLHTTP 等组件不能满足我的要求(主要是不能自定义header等信息)，通过查资料发现了WinHttp.WinHttpRequest.5.1，但是关于winhttprequest的资料太少了。通过这几天摸索，勉强了解了WinHttpRequest使用方法。 阅读全文…

自己写的ASP汉字转拼音的程序，支持部分不常见汉字的拼音。更多不常见汉字的拼音正在整理中，更新地址：http://www.miaoqiyuan.cn/product/update/pinyin.db.rar

  '=====================================================================
  '  意见反馈地址：http://www.miaoqiyuan.cn/p/asp-pinyin
  '  最新数据库：http://www.miaoqiyuan.cn/Products/update/pinyin.db.zip
  '=====================================================================
  '函数名：GET_PINYIN
  '  功能：返回拼音
  '  参数：word  - 要转换的汉字，只支持一个汉字
  Function GET_PINYIN(word)
    if asc(word) > 0 and asc(word) < 128 then
      GET_PINYIN = word
      exit function
    end if
    if word = "，" or word = "。" or word = "、" or word = "’" or word = "‘"  or word = "“"  or word = "”" or word = "：" then
      GET_PINYIN = word
      exit function
    end if
    set pydb = server.createobject("ADODB.Connection")
    pydb.open "provider=microsoft.jet.oledb.4.0;data source=" & Server.Mappath("py.db")
    set pyrs = pydb.execute("select pinyin from PinYin where content like '%" & word & "%'")
    if pyrs.eof then
      GET_PINYIN = "__"
    else
      GET_PINYIN = pyrs(0)
    end if
    pyrs.close
    set pyrs = nothing
    pydb.close
    set pydb = nothing
  End Function

  dim str,tmp
  str = "猫七，一个不知名程序员，博客地址是：http://www.miaoqiyuan.cn/"
  tmp = ""
  for i = 1 to len(str)
    tmp = tmp & mid(str,i,1)
  next
  response.write tmp

从2007-03-09开始，我的博客已经运行了1720天了。曾经更换过多次程序，最终运到Wordpress才稳定下来。结婚前坚持每月写几篇文章，Wordpress一直都是更新到最新版。

09年结婚后，事情太多，基本不写博客了。Wordpress之后基本没升级过，如今官方竟然升级到了3.2，我的博客却永远的定格了2.6。

最近决定升级，好好整理整理，重新开始博客生活。

谷歌的Chrome系统终于出现了，它的最大的优点是开机速度超快、入手超简单。进入ChromeOS，唯一的程序就是一个浏览器。所以可以说对所有木马和病毒免疫。所有文档均云存储在互联网上，不用担心丢失，也令其成为最安全的操作系统，另外几秒钟便可启动并接入互联网，也让同类上网本黯然失色。目前Win8是唯一能与之抗衡的系统。

可能用过Win8的用户，会感觉Win8是个怪胎。如果同时用ChromeOS和Win8的用户，会无奈的发现。这是一场革命。就像Win取代Dos，一部留神。我们都Out了。要知道当初Dos用户也说自己用的最优秀的系统，Win98/Win2000到05年的时候，仍占半壁江山。

阅读全文…