VBScript 字符编码转换

2014/11/17 52113

清华大佬耗费三个月吐血整理的几百G的资源，免费分享！....>>>

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
'UTF转GB---将UTF8编码文字转换为GB编码文字
function UTF2GB(UTFStr)
for Dig=1 to len(UTFStr)
  '如果UTF8编码文字以%开头则进行转换
  if mid(UTFStr,Dig,1)="%" then
     'UTF8编码文字大于8则转换为汉字
    if len(UTFStr) >= Dig+8 then
         GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9))
         Dig=Dig+8
    else
        GBStr=GBStr & mid(UTFStr,Dig,1)
    end if
  else
       GBStr=GBStr & mid(UTFStr,Dig,1)
  end if
next
UTF2GB=GBStr
end function
 
'UTF8编码文字将转换为汉字
function ConvChinese(x)
     A=split(mid(x,2),"%")
     i=0
     j=0
  for i=0 to ubound(A)
       A(i)=c16to2(A(i))
  next
  for i=0 to ubound(A)-1
      DigS=instr(A(i),"0")
      Unicode=""
    for j=1 to DigS-1
      if j=1 then
          A(i)=right(A(i),len(A(i))-DigS)
          Unicode=Unicode & A(i)
      else
           i=i+1
           A(i)=right(A(i),len(A(i))-2)
           Unicode=Unicode & A(i)
      end if
    next
 
    if len(c2to16(Unicode))=4 then
         ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode)))
    else
         ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode)))
    end if
  next
end function
 
'二进制代码转换为十六进制代码
function c2to16(x)
     i=1
   for i=1 to len(x) step 4
        c2to16=c2to16 & hex(c2to10(mid(x,i,4)))
   next
end function
'二进制代码转换为十进制代码
function c2to10(x)
     c2to10=0
   if x="0" then exit function
       i=0
   for i= 0 to len(x) -1
      if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i)
   next
end function
 
'十六进制代码转换为二进制代码
function c16to2(x)
      i=0
    for i=1 to len(trim(x))
        tempstr= c10to2(cint(int("&h" & mid(x,i,1))))
      do while len(tempstr)<4
           tempstr="0" & tempstr
      loop
        c16to2=c16to2 & tempstr
   next
end function
 
'十进制代码转换为二进制代码
function c10to2(x)
     mysign=sgn(x)
     x=abs(x)
     DigS=1
   do
      if x<2^DigS then
        exit do
      else
          DigS=DigS+1
      end if
   loop
     tempnum=x
 
     i=0
   for i=DigS to 1 step-1
      if tempnum>=2^(i-1) then
           tempnum=tempnum-2^(i-1)
           c10to2=c10to2 & "1"
      else
           c10to2=c10to2 & "0"
      end if
   next
   if mysign=-1 then c10to2="-" & c10to2
end function
 
'GB转unicode---将GB编码文字转换为unicode编码文字
function chinese2unicode(Str)
  dim i
  dim Str_one
  dim Str_unicode
  if(isnull(Str)) then
     exit function
  end if
  for i=1 to len(Str)
     Str_one=Mid(Str,i,1)
     Str_unicode=Str_unicode&chr(38)
     Str_unicode=Str_unicode&chr(35)
     Str_unicode=Str_unicode&chr(120)
     Str_unicode=Str_unicode& Hex(ascw(Str_one))
     Str_unicode=Str_unicode&chr(59)
  next
   chinese2unicode=Str_unicode
end function  
 
'URL解码
Function URLDecode(enStr)
dim deStr
dim c,i,v
deStr=""
for i=1 to len(enStr)
   c=Mid(enStr,i,1)
  if c="%" then
    v=eval("&h"+Mid(enStr,i+1,2))
   if v<128 then
     deStr=deStr&chr(v)
     i=i+2
   else
    if isvalidhex(mid(enstr,i,3)) then
     if isvalidhex(mid(enstr,i+3,3)) then
       v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
       deStr=deStr&chr(v)
       i=i+5
     else
       v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
       deStr=deStr&chr(v)
       i=i+3
     end if
    else
      destr=destr&c
    end if
   end if
  else
   if c="+" then
     deStr=deStr&" "
   else
     deStr=deStr&c
   end if
  end if
next
URLDecode=deStr
end function
 
'判断是否为有效的十六进制代码
function isvalidhex(str)
dim c
isvalidhex=true
str=ucase(str)
if len(str)<>3 then isvalidhex=false:exit function
if left(str,1)<>"%" then isvalidhex=false:exit function
   c=mid(str,2,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
   c=mid(str,3,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
end function