Many cellular & mobile phones now support Internet access via WAP (wireless application protocol) or more advanced technologies such as iMode or cHTML.
Unfortunately there is a big gap between what is available on the web in HTML format, and what is available in WAP-readable WML (Wireless Markup Language format).
This article describes how to convert WML into HTML by stripping out any features of HTML that are not available in WML, and converting the HTML form format with that of WML. All this is done with some clever string parsing in VB.NET. You build this into an ASP.NET web application, or a custom server to dynamically convert website content into WAP format once the ACCEPT HTTP header of the client included text/vnd.wap.wml ? and thus could be reasonably assumed to be a WAP phone, not a browser. This article only deals with WML to HTML conversion, if you抮e looking to implement a dynamic website converter, you should find the section on WAP programming in Network Programming in .NET (Buy at Amazon UK) (Buy at Amazon US) an invaluable resource.
Before we get down and dirty into the code, let抯 look at the differences between WML and HTML.
- WAP phones do not support standard graphics such as Gifs or Jpegs, they do support a black-and-white image format called WBMP (Wireless Bitmap)
- WAP phones cannot show applets, Flash movies or any other embedded objects. Frames, DHTML, JavaScript etc. are out too.
- WAP phones are limited to 2000 characters of text.
- You cannot view WAP sites on your browser, for this, I recommend using the openwave UP SDK
In order for a Wap phone to ensure correct media, the MIME type for WML must be returned in the HTTP header as displayed below.
|
Status: 200 OK |
If your server does not know the MIME type for wml, you can change it by trying the following
- If your Server is an 'Apache' , create a file called .htaccess in the directory you wish to place your wml files, with the following content: addtype text/vnd.wap.wml wml If you have cgi access, you can make your WML file the default file in a directory by adding the following lines to your WML homepage. Then execute chmod 755 index.cgi
|
#!{location of perl executable} |
- For Windows Servers, you can add a MIME type directly into Windows registry by adding the following entries using REGEDIT :
HKEY_CLASSES_ROOT\MIME\Database\Content Type\text/vnd.wap.wml
HKEY_CLASSES_ROOT\MIME\Database\Content Type\text/vnd.wap.wml\Extention = ".wml"
The following is a list of Html tags that can be translated to WML. Items denoted by an asterix are handled by WAP phones but are not handled by the example WML to HTML converter. The reason for this omission is because many sites may contain malformed HTML, where tags are incorrectly nested. To give an example, the HTML: <b><I>Bold Italic</b></I> will render in Internet explorer, but because the bold tag is closed before the italic tag, then it will be seen as being malformed, and will not be rendered by WAP browsers.
|
<br> |
line break |
|
<p> |
Paragraph * |
|
<b> |
bold * |
|
<big> |
big text * |
|
<small> |
small text * |
|
<strong> |
strong text * |
|
<form> |
Forms (Get & Post versions) |
|
<input type="text"> |
textboxes |
|
<input type="submit"> |
submit buttons |
|
<a> |
hyperlinks (http & mailto ) |
|
<i> |
italic * |
|
<u> |
underline * |
|
META HTTP-EQUIV="refresh" |
Timed site redirection |
|
<table>,<td>,<tr> |
Tables * |
Below left is example HTML forms, directly opposite is the WML equivalent.
|
<form method="Get" action="A"> |
<input name="B"/> |
|
<form method="Post" action="A"> |
<input name="B"> |
|
<Meta HTTP-equiv="refresh" content="A ; URL=B"> |
<onevent type="ontimer"> |
|
<texarea name="A"> |
<input name="A"/> |
|
<select name='A'> |
<select name="A"> |
代碼如下：
Option Explicit On
Module Web2Wap
' Copyright 2000-2004
' http://network.programming-in.net
Public Function ConvertToWML(ByRef HTML As String, Optional ByRef ReRoute As String = Nothing, Optional ByRef MaxSize As Int32 = Nothing) As String
Dim firstchar As String
Dim NextScrap As Int32
Dim ParsedHTMl As String
Dim LastOpenTag As Int32
Dim LastCloseTag As Int32
Dim CutHTML As String
Dim NearSpace As Int32
Dim Neartag As Int32
Dim afterchar As String
Dim z As Int32
Dim OK As Boolean
Dim offset As Int32
Dim Entity As Int32
Dim i As Int32
Dim HTMlpart As String()
Dim rtags As String()
Dim recognized As String
Dim PossibleError As String
' Remove Scripting
'On Error GoTo ThrowException
HTML = Replace(HTML, ">>", ">")
PossibleError = "Failed to remove <script>"
HTML = RemoveEnclosure(HTML, "<script", "</script>")
PossibleError = "Failed to remove <!-- .. -->"
HTML = RemoveEnclosure(HTML, "<!--", "-->")
PossibleError = "Failed to remove <STYLE>"
HTML = RemoveEnclosure(HTML, "<STYLE", "</STYLE>")
' Remove Unrecognized tags
PossibleError = "Failed to seperate tags"
recognized = "br,form,input,a,meta http-equiv=""refresh"""
rtags = Split(recognized, ",")
HTMlpart = Split(HTML, "&")
For i = 1 To UBound(HTMlpart)
Entity = InStr(HTMlpart(i), ";")
If Entity > 0 And Entity < 8 Then HTMlpart(i) = Mid(HTMlpart(i), Entity + 1)
Next
HTML = Join(HTMlpart, "")
HTMlpart = Split(HTML, "<")
For i = 0 To UBound(HTMlpart)
If Left(HTMlpart(i), 1) = "/" Then
offset = 2
Else
offset = 1
End If
OK = False
For z = 0 To UBound(rtags)
afterchar = Mid(HTMlpart(i), offset + Len(rtags(z)), 1)
If LCase(Mid(HTMlpart(i), offset, Len(rtags(z)))) = rtags(z) And (afterchar = " " Or afterchar = ">" Or afterchar = Chr(13)) Then
OK = True : Exit For
End If
Next
If Not OK Then
Neartag = InStr(HTMlpart(i), ">")
NearSpace = InStr(HTMlpart(i), " ")
If NearSpace > Neartag Or NearSpace = 0 Then NearSpace = Neartag
If Neartag * NearSpace = 0 Then GoTo SkipTag
HTMlpart(i) = Mid(HTMlpart(i), Neartag + 1)
Else
HTMlpart(i) = "<" + HTMlpart(i)
End If
SkipTag:
Next
PossibleError = "Failed to convert to lowercase"
HTML = Join(HTMlpart, "")
HTML = LCaseTags(HTML)
HTML = Replace(HTML, "<br>", "<br/>")
HTML = Replace(HTML, "<br clear=""all"">", "<br/>")
HTML = Replace(HTML, " ", "")
HTML = LCaseTags(HTML)
If Not IsNothing(MaxSize) Then
CutHTML = Left(HTML, MaxSize)
LastCloseTag = InStr(StrReverse(CutHTML), ">")
LastOpenTag = InStr(StrReverse(CutHTML), "<")
If LastCloseTag = 0 Then LastCloseTag = MaxSize * 2
If LastOpenTag = 0 Then LastOpenTag = MaxSize * 2
If LastCloseTag > LastOpenTag Then CutHTML = Left(CutHTML, (MaxSize - LastOpenTag) - 1)
HTML = CutHTML
End If
HTML = MatchUP(HTML, "a", "href")
HTML = Replace(HTML, "$", "$$")
PossibleError = "Failed to Parse Form"
If IsNothing(ReRoute) Then
ParsedHTMl = WMLFORM(HTML)
Else
ParsedHTMl = WMLFORM(HTML, ReRoute)
End If
ParsedHTMl = Replace(ParsedHTMl, """""", """")
' clean up tag scraps
Do
NextScrap = InStr(NextScrap + 1, ParsedHTMl, "<")
If NextScrap = 0 Then Exit Do
firstchar = Mid(ParsedHTMl, NextScrap + 1, 1)
If (firstchar < "a" Or firstchar > "z") And firstchar <> "/" Then
ParsedHTMl = Replace(ParsedHTMl, "<" & firstchar, "")
End If
Loop
ConvertToWML = "<?xml version=""1.0"" encoding=""ISO-8859-1""?>" & vbCrLf & "<wml><card><p align=""left"">" & vbCrLf & ParsedHTMl & vbCrLf & "</p></card></wml>"
Exit Function
ThrowException:
ConvertToWML = "<?xml version=""1.0"" encoding=""ISO-8859-1""?>" & vbCrLf & "<wml><card><p align=""left"">" & vbCrLf & "ERR:" & PossibleError & vbCrLf & Err.Description & vbCrLf & "</p></card></wml>"
End Function
Public Function UrlEncode(ByRef PlainText As String) As String
Dim HexPart As String
Dim z As Int32
Dim OK As Boolean
Dim i As Int32
Dim rtags As String()
Dim recognised As String
recognised = "*,+,-,.,0,1,2,3,4,5,6,7,8,9,_," & "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z," & "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z"
' the symbol / was removed from the recognised list.
rtags = Split(recognised, ",")
Dim Ptags(Len(PlainText)) As String
For i = 1 To Len(PlainText)
Ptags(i) = Mid(PlainText, i, 1)
OK = False
For z = 0 To UBound(rtags)
If Ptags(i) = rtags(z) Then
OK = True : Exit For
End If
Next
If Not OK Then
HexPart = Hex(Asc(Ptags(i)))
If Len(HexPart) = 1 Then HexPart = "0" + HexPart
Ptags(i) = "%" + HexPart
End If
Next
UrlEncode = Join(Ptags, "")
End Function
Function GetParam(ByRef Rawtext As String, ByRef After As Int32) As String
Dim FirstEdge As Int32
Dim FirstSpace As Int32
Dim lastic As Int32
Dim firstic As Int32
Dim ic As String
Dim start As Int32
start = InStr(1, Rawtext, After, CompareMethod.Text)
If start = 0 Then Exit Function
If InStr(start, Rawtext, """") = 0 Then ic = "'"
If InStr(start, Rawtext, "'") = 0 Then ic = """"
If ic = "" And InStr(start, Rawtext, "'") < InStr(start, Rawtext, """") Then ic = "'"
' check for un-bracketed param
firstic = InStr(start, Rawtext, ic)
lastic = InStr(firstic + 1, Rawtext, ic)
FirstSpace = InStr(start, Rawtext, " ")
FirstEdge = InStr(start, Rawtext, ">")
If FirstSpace = 0 Then FirstSpace = Len(Rawtext) * 2
If FirstEdge = 0 Then FirstEdge = Len(Rawtext) * 2
If firstic = 0 Then firstic = Len(Rawtext) * 2
If lastic = 0 Then lastic = Len(Rawtext) * 2
If FirstEdge < FirstSpace Then FirstSpace = FirstEdge
If FirstSpace < firstic Or ic = "" Then
lastic = FirstSpace
firstic = InStr(start, Rawtext, "=")
End If
If firstic > lastic Then
GetParam = "" : Exit Function
End If
If Mid(Rawtext, firstic + 1, 1) = """" Then
firstic = firstic + 1
lastic = InStr(firstic + 1, Rawtext, """")
End If
GetParam = Mid(Rawtext, firstic + 1, lastic - firstic - 1)
End Function
Function WMLFORM(ByRef HTML As String, Optional ByRef ReRoute As String = Nothing) As String
Dim wml As String
Dim FormString As String
Dim Paramstring As String
Dim refid As Int32
Dim SubmitLine As String
Dim submitlabel As String
Dim corrected As String
Dim InputTag As String
Dim Nextinput As Int32
Dim cpos As Int32
Dim storedform As String
Dim cgi As String
Dim postform As String
Dim startformline As String
Dim endform As Int32
Dim startform As Int32
Dim killinputs As Boolean
Dim RedirectWML As String
Dim toURL As String
Dim TimeToLoad As Int32
Dim EndOfline As Int32
Dim content As String
Dim Redirectpos As Int32
Dim ic As String
Dim nl As String
Dim vbcrf As Int32
'On Error GoTo 0
nl = vbcrf
ic = """"
Redirectpos = InStr(1, HTML, "<meta http-equiv=""refresh""", CompareMethod.Text)
If Redirectpos Then
content = GetParam(Mid(HTML, Redirectpos), "content")
EndOfline = InStr(Redirectpos, HTML, ">")
HTML = Replace(HTML, Mid(HTML, Redirectpos, EndOfline - Redirectpos + 1), "")
TimeToLoad = Val(content)
toURL = Mid(content, InStr(1, content, "URL=", CompareMethod.Text) + 4)
If Not IsNothing(ReRoute) Then
' Reroute is in the format: http://server/Gateway?URL=docroot/
If InStr(toURL, "http://") Then
toURL = Left(ReRoute, InStr(ReRoute, "=") + 1) & UrlEncode(toURL)
Else
toURL = ReRoute & UrlEncode(toURL)
End If
End If
' How do I redirect to same page in WML?, i.e. if ToUrl=""
RedirectWML = "<onevent type=""ontimer"">" & vbCrLf & " <go href=""" + toURL + """/>" & vbCrLf & "</onevent>" & vbCrLf & "<timer value=""" & TimeToLoad & """/>" & vbCrLf
End If
killinputs = False
Do
startform = InStr(startform + 1, HTML, "<form", CompareMethod.Text)
endform = InStr(endform + 1, HTML, "</form>", CompareMethod.Text)
If endform = 0 Then
endform = Len(HTML)
killinputs = True
If startform <> 0 Then
startformline = Mid(HTML, startform, InStr(startform, HTML, ">") - startform + 1)
HTML = Replace(HTML, startformline, "")
End If
Exit Do
End If
If LCase(GetParam(Mid(HTML, startform), "method")) = "post" Then postform = True
startformline = Mid(HTML, startform, InStr(startform, HTML, ">") - startform + 1)
cgi = GetParam(startformline, "action")
If cgi <> "" Then Exit Do
HTML = Replace(HTML, startformline, "", , 1)
HTML = Replace(HTML, "</form>", "", , 1, CompareMethod.Text)
Loop
If Not killinputs Then
storedform = Mid(HTML, startform, endform - startform) & "</form>"
HTML = RemoveEnclosure(HTML, "<form", "</form>")
HTML = Left(HTML, startform) & storedform & Mid(HTML, startform)
If Not IsNothing(ReRoute) Then
If InStr(cgi, "http://") Then
cgi = Left(ReRoute, InStr(ReRoute, "=")) & UrlEncode(cgi)
Else
cgi = ReRoute & UrlEncode(cgi)
End If
End If
End If
cpos = startform
Do
Nextinput = InStr(cpos + 1, HTML, "<input", CompareMethod.Text)
If Nextinput = 0 Or Nextinput > endform Then Exit Do
InputTag = Mid(HTML, Nextinput)
InputTag = Left(InputTag, InStr(InputTag, ">"))
If killinputs Then
HTML = Replace(HTML, InputTag, "")
Else
If LCase(GetParam(InputTag, "type")) = "submit" Then
corrected = InputTag
submitlabel = GetParam(Mid(HTML, Nextinput), "value")
If submitlabel = "" Then submitlabel = "Submit"
EndOfline = InStr(Nextinput, HTML, ">")
SubmitLine = Mid(HTML, Nextinput, EndOfline - Nextinput + 1)
Else
refid = GetParam(Mid(HTML, Nextinput), "name")
If refid <> "" Then
corrected = "<input name=""" & refid & """/>"
Else
corrected = ""
End If
If refid <> "" Then
If postform Then
Paramstring = Paramstring + "<postfield name=""" + refid + """ value=""$(" + refid + ")""/>" + vbCrLf
Else
Paramstring = Paramstring + UrlEncode(refid) + "=$(" + refid + ")&"
End If
End If
End If
HTML = Replace(HTML, InputTag, corrected)
End If
cpos = Nextinput
Loop
If killinputs Then
WMLFORM = RedirectWML + HTML
Else
If Not postform Then Paramstring = Left(Paramstring, Len(Paramstring) - 1)
HTML = Replace(HTML, startformline, "")
HTML = Replace(HTML, SubmitLine, "")
wml = FormString + vbCrLf
If submitlabel = "" Then submitlabel = "submit"
wml = wml + "<do type=" + ic + "accept" + ic + " label=" + ic + submitlabel + ic + ">" + vbCrLf
If postform Then
wml = wml + "<go href=""" + cgi + """ method=""Post"">" + vbCrLf
wml = wml + Paramstring
wml = wml + "</go>"
Else
wml = wml + " <go href=" + ic + cgi + "?" + Paramstring + ic + "/>" + vbCrLf
End If
wml = wml + "</do>" + vbCrLf
WMLFORM = RedirectWML + Replace(HTML, "</form>", wml, , , CompareMethod.Text)
End If
End Function
Private Function LCaseTags(ByRef HTML As String) As String
Dim NewHTML As String
Dim Char_Renamed As String
Dim i As Int32
Dim Intag As Boolean
Intag = False
For i = 1 To Len(HTML)
Char_Renamed = Mid(HTML, i, 1)
If Char_Renamed = "<" Then Intag = True
If Char_Renamed = ">" Then Intag = False
If Intag Then Char_Renamed = LCase(Char_Renamed)
NewHTML = NewHTML + Char_Renamed
Next
LCaseTags = NewHTML
End Function
Public Function RemoveEnclosure(ByRef HTML As String, ByRef StartTag As String, ByRef EndTag As String) As String
Dim ScriptEnd As Int32
Dim ScriptStart As Int32
Do
ScriptStart = InStr(1, HTML, StartTag, CompareMethod.Text)
ScriptEnd = InStr(1, HTML, EndTag, CompareMethod.Text)
If ScriptStart * ScriptEnd = 0 Then Exit Do
If ScriptEnd > ScriptStart Then
HTML = Left(HTML, ScriptStart - 1) & Mid(HTML, ScriptEnd + Len(EndTag))
Else
Exit Do
End If
Loop
RemoveEnclosure = HTML
End Function
Public Function MatchUP(ByRef HTML As String, ByRef Tag As String, Optional ByRef PreserveParam As String = Nothing) As String
Dim Preserved As Boolean
Dim theLink As String
Dim NextTag As Int32
Dim Char_Renamed As String
Dim i As Int32
Dim State As String
State = "/"
Do
i = InStr(i + 1, HTML, "<")
If i = 0 Then Exit Do
Char_Renamed = LCase(Mid(HTML, i, Len(Tag) + 2))
If Left(Char_Renamed, 2) = "<" & Tag Then
If State = "A" Then
NextTag = InStr(i, HTML, ">")
HTML = Left(HTML, i - 1) & Mid(HTML, NextTag + 1)
i = i - 1
Else
If Not IsNothing(PreserveParam) Then
theLink = GetParam(Mid(HTML, i), PreserveParam)
Preserved = " " & PreserveParam & "=""" & theLink & """"
End If
NextTag = InStr(i, HTML, ">")
HTML = Left(HTML, i - 1) & "<" & Tag & Preserved & ">" & Mid(HTML, NextTag + 1)
State = "A"
End If
End If
If Char_Renamed = "</" & Tag Then
If State = "/" Then
NextTag = InStr(i, HTML, ">")
HTML = Left(HTML, i - 1) & Mid(HTML, NextTag + 1)
i = i - 1
End If
State = "/"
End If
Loop
If State = "A" Then HTML = HTML & "</" & Tag & ">"
MatchUP = HTML
End Function
End Module