Code archives/BlitzPlus Gui/Html table ripper (b+)
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| Copy html table skeleton out of html text files. Paste html code inside the window and done | |||||
;
; HTML custom Table generator and Webpage structure ripper. By Nebula/Crom Design in 2003
;
;
;
Dim brik$(6024)
Dim countdown(10)
Dim keywords$(10)
;Include "commands.bb"
If CommandLine$() = "runfromeditor" Then ChangeDir("d:\blitzbasic\blitzplustutorials\")
Global f ; Is used for files
Global Textfield
winwidth = 640
winheight = 200
rows = 2
columns = 2
win = CreateWindow("TableGenerator and HTML structure ripper - By Nebula in 2003",Desktopcenterx()-winwidth/2,Desktopcentery()-winheight/2,640,200,Desktop(),1+8)
htmlviewer = CreateHtmlView(320,0,winwidth/2,winheight,win)
;
button1 = CreateButton("Rip Webstructure",0,0,150,20,win)
SetGadgetLayout button1,1,1,1,1
button2 = CreateButton("Generate Table",0,20,150,20,win)
SetGadgetLayout button2,1,1,1,1
tx1 = CreateTextField(150,20,30,20,win)
;SetGadgetLayout txt1,1,1,1,1
tx2 = CreateTextField(180,20,30,20,win)
;SetGadgetLayout txt2,1,1,1,1
Textfield = CreateTextArea(0,40,640-320-5,100,win)
;SetGadgetLayout textfield1,1,1,1,1
AddTextAreaText Textfield,"Place html source code in here and press Rip WebStructure."
SetStatusText win,CurrentDir()
While we<>$803
we = WaitEvent()
Select we
Case $401
If EventSource() = button1 Then
ripstructure
HtmlViewGo htmlviewer,CurrentDir()+"test.html"
End If
If EventSource() = button2 Then
a = TextFieldText(tx1)
b = TextFieldText(tx2)
If a>0 And a<100 Then
If b>0 And b<100 Then
createtablefile("tablefile.html",a,b)
HtmlViewGo htmlviewer,CurrentDir()+"tablefile.html"
Else Notify "incorrect rows"
End If
Else Notify "incorrect collumns"
End If
End If
End Select
Wend
End
Function Ripstructure()
keywords(0)="<table"
keywords(1)="<tr"
keywords(2)="<th"
keywords(3)="<td"
keywords(4)="</table>"
keywords(5)="</tr>"
keywords(6)="</th>"
keywords(7)="</td>"
a$ = Lower(TextAreaText(Textfield))
counter = 0
For i=1 To Len(a$)
b$ = Mid(a$,i,1)
If b$ = "<" Then
For ii=0 To 7
If Mid(a$,i,Len(keywords(ii))) = keywords(ii) Then
c = Instr(a$,">",i)
;If Confirm(Mid$(a$,i,c-i+1)) <> 1 Then End
brik$(counter) = Mid$(a$,i,c-i+1) :counter = counter+1
End If
Next
End If
Next
Notify counter/2 + " Structural Tags found."
f = WriteFile("test.html")
createhtmlheader(f)
For i=0 To counter
a$ = brik$(i)
If Left(a$,3) = "<td" Then a$ = a$ + "a$"+i
za = 0
za = Instr(a$,"border",1)
If za<>0 Then
For ii=za To za+12
zb$ = Mid(a$,ii,1)
If zb$="0" Then
zb$=Left(a$,ii-1)
zc$="1"
zd$=Right(a$,Len(a$)-ii)
a$=zb$+zc$+zd$
Exit
End If
Next
End If; <table border = 0></table>
;If za<>0 Then zb = Instr(a$,Chr(34),za)
;If zb<>0 Then a$=Replace(a$,Chr(34)+"0"+Chr(34),Chr(34)+"2"+Chr(34))
WriteLine f,a$
Next
WriteLine f,"</body>"
CloseFile(f)
End Function
Function createtablefile(filename$,rows,columns)
f = WriteFile(filename$)
;
createhtmlheader(f)
;
;
WriteLine(f,createtable$(100,"center",1))
;
For x=1 To rows
WriteLine(f,createtablerow$())
For y=1 To columns
WriteLine(f,createtabledata(" "))
WriteLine(f,"</td>")
Next
WriteLine(f,"</tr>")
Next
;
WriteLine(f,"</tbody></table>")
;
WriteLine(f,a07$)
;
CloseFile(f)
;
If FileType(filename$) <> 1 Then
a$ = CurrentDir$()
Notify "Could not create file : " + a$ + filename$
End If
End Function
Function createhtmlheader(file)
a01$ = "<!DOCTYPE HTML PUBLIC "+Chr(34)+"-//W3C//DTD HTML 4.0 Transitional//EN"+Chr(34)+">"
a02$ = "<HTML><HEAD><TITLE>Custom Code generated by HTML custom Table generator</TITLE>"
a03$ = "<META http-equiv=Content-Type content="+Chr(34)+"Text/html; charset=windows-1252"+Chr(34)+">"
a04$ = "<META content="+Chr(34)+"Description of this page"+Chr(34)+" name=description>"
a05$ = "<META content="+Chr(34)+"Games And Tool programming with Delphi And DelphiX"+Chr(34)+"name=keywords>"
a06$ = "<body>"
a07$ = "</body>"
;
WriteLine(f,a01$)
WriteLine(f,a02$)
WriteLine(f,a03$)
WriteLine(f,a04$)
WriteLine(f,a05$)
WriteLine(f,a06$)
End Function
Function createtable$(width="0",align$="0",borderwidth="0")
Return "<table align="+Chr(34)+align$+Chr(34)+" border="+Chr(34)+borderwidth+Chr(34)+" width="+Chr(34)+Str$(width)+"%"+Chr(34)+"> <tbody>"
End Function
Function createtabledata$(inhoud$,width = 0,height=0,background$="",bgColor$="")
;
a$ = "<td "
If width <> 0 Then a$ = Stradd(a$,"width = " + Chr(34) + width + "%"+Chr(34) + " ")
If width <> 0 Then a$ = Stradd(a$,"height = " + Chr(34) + height + "%"+Chr(34) + " ")
If background$ <> "" Then a$ = Stradd(a$,"background = " + Chr(34) + background$ + Chr(34) + " ")
If bgcolor$ <> "" Then a$ = Stradd(a$,"bgcolor = " + Chr(34) + bgcolor$ + Chr(34) + " ")
a$=a$+"> " + inhoud$
;
Return a$
;
End Function
Function createtablerow$(width=0,height=0,bgcolor$="0")
a$ = a$ + "<tr "
If width <> 0 Then a$=a$+"width = " + Chr(34) + width + "%" + Chr(34) + " "
If height <> 0 Then a$=a$+"height = " + Chr(34) + height + "%" + Chr(34) + " "
If bgcolor$ <> 0 Then a$=a$+"bgcolor = " + Chr(34) + bgcolor$ + Chr(34) + " "
a$ = a$ + "> "
Return a$
End Function
Function font$(col$)
Return "<font color="+Chr(34)+col$+Chr(34)+">"
End Function
Function closefont$()
Return "</font>"
End Function
Function center$()
Return "<center>"
End Function
Function closecenter$()
Return "</center>"
End Function
Function Desktopcenterx()
Return ClientWidth(Desktop())/2
End Function
Function Desktopcentery()
Return ClientHeight(Desktop())/2
End Function
Function stradd$(addstr$,add$)
Return addstr$+add$
End Function |
Comments
None.
Code Archives Forum
   |