HTML linking code parser
Source code
To download this as a .bas file click here.
' compile with -lang qb
Dim Filehandle As Integer
Dim strinput As String
Dim strfinal As String
Dim stroutput As String
Dim strAnchor As String
Dim strAnchortemp As String
Dim strword1 As String
Dim strword2 As String
Dim strword2temp As String
Dim strword3 As String
Dim loopcomplete As Integer
Dim progress As Integer
Dim temp As String
Dim notides As Integer
On Error Goto HandleErrors
progress = 0
Filehandle = FreeFile
Open "a.txt" For Input As #filehandle
Do Until Eof(filehandle)
progress = progress + 1
If Lof(filehandle) > 0 Then
Line Input #filehandle, strinput
Else
Goto HandleErrors
End If
' ##########################################Process here
' First I need to work out how many -s there are
For aaa = 1 To Len(strinput)
If Right(Left(strinput,aaa),1) = "-" Then
notides = notides + 1
End If
'Print "Input text > " & strinput
'Print "Current Char >" & Right(Left(strinput,aaa),1)
'Print "Current Len > " & Len(strinput)
Next aaa
' #########################################Now act
If notides = 0 Then ' #### DONE - one word
strAnchortemp = Right(Left(strinput,Len(strinput)-4),Len(strinput) -5)
stranchor = UCase(Left(strinput,1)) & strAnchortemp
End If
If notides = 1 Then ' ### Done- two words
For aaa = 1 To Len(strinput)
If Right(Left(strinput,aaa),1) = "-" Then
'we have now found a break between the words
strword1 = Left(strinput,aaa - 1)
strword2 = Left(Right(strinput,Len(strinput) - aaa),Len(strinput) - aaa - 4)
stranchor = UCase(Left(strword1,1)) & Right(strword1, Len(strword1) - 1) & " " & UCase(Left(strword2,1)) & Right(strword2, Len(strword2) - 1)
Exit For
End If
Next aaa
End If
If notides = 2 Then ' ### done - three words
For aaa = 1 To Len(strinput)
If Right(Left(strinput,aaa),1) = "-" Then
'we have now found a break between the words
strword1 = Left(strinput,aaa - 1)
strword2temp = Right(strinput,Len(strinput) - aaa) ' no need for minus .php
' # Now we have first word And second section.
For bbb = 1 To Len(strword2temp)
If Right(Left(strword2temp,bbb),1) = "-" Then
'we have now found a break between the words
strword2 = Left(strword2temp,bbb - 1) ' section one minus the -
strword3 = Left(Right(strword2temp,Len(strword2temp)-bbb), Len(strword2temp)-bbb - 4)
loopcomplete = 11
' ? strword1
' ? strword2temp
' ? strword2 ' a bit of error checking here
' ? strword3
' ? " _"
Exit For
End If
Next bbb
If loopcomplete = 11 Then
' we are done. Close the loop
Exit For
End If
End If
Next aaa
' Words have been found and entered into strword1 - 3
stranchor = UCase(Left(strword1,1)) & Right(strword1, Len(strword1) - 1) & " " & UCase(Left(strword2,1)) & Right(strword2, Len(strword2) - 1) & " " & UCase(Left(strword3,1)) & Right(strword3, Len(strword3) - 1)
End If
Rem add tags
strfinal = "<tr><td><a href=" & Chr(34) & strinput & Chr(34) & ">" & stranchor & "</a></td></tr>" & Chr(10)
Rem add To Output
Locate 1,1 : ? "File name processor and HTML code generator by Konrad Strachan"
Locate 2,1,0
Print " Input : "
Print " Anchor : "
Print " Final : "
Print " "
Locate 8,1
Print "Processed : "
Print "Number of - : "
Print " "
Print " "
Print " For support email ksdod@gawab.com or visit www.totms.co.uk"
Print " Build Date : 28-Sept-2007 "
'###
Locate 2,11: ? strinput
Locate 3,11: ? stranchor
Locate 4,10: ? strfinal
Locate 8,1
Print "Processed > " & progress
Print "Number of - >" & notides
stroutput = stroutput & strfinal
notides = 0
strinput = ""
stranchor = ""
strfinal = ""
strword1 = ""
strword2 = ""
strword3 = ""
Loop
Close #filehandle
Open "output.txt" For Output As #1
Print #1, stroutput
Close #1
Input a$
End
HandleErrors:
Print "Error."
Print " As per default - the program loads a.txt in the program directory,"
Print " taking files in the form x.php xyz-abc.php and xyz-abc-ghj.php and"
Print " exports them into X Xyz Abc And Xyz Abc Ghj table listings in a file"
Print " called output.txt."
Print " "
Print " "
Print " For support email ksdod@gawab.com or visit www.totms.co.uk"
Print " Build Date : 28-Sept-2007 "
input a$
Resume Next
|
