Hello,
I've made a simple GUI interface that is able to load an XML database.
It is oriented to hold snippets script code.
Here's a capture of the project :
And now the source code :
' ---------------------------------------------
' XML data base reader by Gerome GUILLEMIN
' Cool XML DOM documentation can be found there :
' http://www.devguru.com/Technologies/xmldom/quickref/xmldom_index.html
' ---------------------------------------------
$Apptype GUI
#Option Explicit
ComWarnings(False)
'$Trace On
Dim %obj, %cnodes, %wdrange, $S1, %i, %j, %k, $strerr, %NodeList, %numNodes, %bLoad, %bLastEntity
Dim %TopWin, %leftWin, %RightWin, %BottomWin, %NodeListCount, $fp, %mb
LoadLibrary("Riched20.dll")
Macro CRichEdit( Caption, hWnd, ID, X, Y, Height, Width ) = FBSL_Control (_
"richedit20a", hWnd, Caption, ID, X, Y, Height, Width,_
WS_CHILD + WS_CLIPSIBLINGS + WS_VISIBLE + WS_HSCROLL + WS_VSCROLL + ES_MULTILINE + _
ES_AUTOVSCROLL + ES_AUTOHSCROLL + WS_TABSTOP + ES_WANTRETURN , WS_EX_CLIENTEDGE )
Macro CInput( Caption, hWnd, ID, X, Y, Height, Width ) = FBSL_Control (_
"edit", hWnd, Caption, ID, X, Y, Height, Width,_
WS_CHILD + WS_CLIPSIBLINGS + WS_VISIBLE + WS_TABSTOP + ES_LEFT + ES_AUTOHSCROLL + ES_MULTILINE, WS_EX_CLIENTEDGE )
'// Label
Macro CLabel( Caption, hWnd, ID, X, Y, Height, Width ) = FBSL_Control (_
"static", hWnd, Caption, ID, X, Y, Height, Width,_
WS_CHILD + SS_NOTIFY + SS_CENTER + WS_VISIBLE, WS_EX_CLIENTEDGE )
FBSL_SetText(Me, "FBSL XML database")
ReSize(Me, 0, 0, 640, 480)
Center(Me)
Begin Enum
IDB_OPEN = 1000
IDB_PREV
IDB_NEXT
IDB_LBL
IDB_XML
IDB_RICH
End Enum
Begin Const
OUTFILE = ".\_MySamplesNEW.xml"
hEdit = CRichEdit( "", Me, IDB_RICH, 0, 0, 800, 600 )
hStatus = FBSL_Control("MSCtls_StatusBar32", Me, "", 0, 0, 0, 0, 0, 0, 0)
BUT = 60
CARTOUCH = "XML Files(*.xml)|*.xml"
hBtn1 = FBSL_Control("Button", Me, "&Open", IDB_OPEN, 10, 20, BUT, 20, WS_Child + WS_Visible + WS_TabStop, 0)
hBtn2 = FBSL_Control("Button", Me, "<<", IDB_PREV, 10+BUT*1, 20, BUT, 20, WS_Child + WS_Visible + WS_TabStop, 0)
hBtn3 = FBSL_Control("Button", Me, ">>", IDB_NEXT, 10+BUT*2, 20, BUT, 20, WS_Child + WS_Visible + WS_TabStop, 0)
hBtn4 = FBSL_Control("Button", Me, "&New XML DB", IDB_XML, 10+BUT*8+60, 20, BUT+20, 20, WS_Child + WS_Visible + WS_TabStop, 0)
hLbl1 = CLabel( "Nothing loaded yet...", Me, IDB_LBL, 10+BUT*3+10, 20, BUT+BUT, 20 )
End Const
FBSL_SetFont(hEdit, "Arial", 10, FW_BOLD, 0 ,0 ,0)
EnableWindow( hBtn3, False )
EnableWindow( hBtn2, False )
k = 1: bLastEntity = -1
GoSub ResizeMe
Show(Me)
Begin Events
Select Case CBMsg
Case WM_Close
Gosub MYReleaseObjects
GoSub WriteLastEntity
Exitprogram(0)
Case WM_Command
Select Case CBCTL
Case IDB_OPEN
GoSub LoadXml
If bLoad = True Then GoSub ClickPrevious
Case IDB_PREV
If bLoad = True Then GoSub ClickPrevious
Case IDB_NEXT
If bLoad = True Then GoSub ClickNext
Case IDB_XML
fp = FileLoad( FBSL_GetFileName( "Open", _
"FBSL Files(*.fbs)|*.fbs|Text Files(*.txt)|*.txt|CSV Files(*.csv)|*.csv|All Files(*.*)|*.*", 0 ) )
GoSub FillingXmlDB
End Select
Case WM_Size
GoSub ResizeMe
End Select
End Events
:ClickPrevious
If obj <> 0 Then
If k > 1 Then k = k - 1
If k = 1 Then
EnableWindow( hBtn2, False )
EnableWindow( hBtn3, True )
End If
GoSub GetNodeListCount
GoSub GetNodeListItem
End If
Fbsl_SetText( hLbl1, $k & "/" & $NodeListCount & " entries" )
Return
:ClickNext
If obj <> 0 Then
If k < NodeListCount Then k = k + 1
If k = NodeListCount Then
EnableWindow( hBtn3, False )
EnableWindow( hBtn2, True )
End If
GoSub GetNodeListCount
GoSub GetNodeListItem
End If
Fbsl_SetText( hLbl1, $k & "/" & $NodeListCount & " entry" )
Return
:LoadXml
k = 1: bLoad = False
If obj <> 0 Then GoSub MYReleaseObjects
obj = CreateObject("Microsoft.XMLDOM")
PutValue(obj, ".async(%b)", False)
PutValue( obj, "ValidateOnParse = %b", True )
If StrLen(FBSL_GetFileName( "Open", CARTOUCH, 0 )) > 0 Then
CallMethod( obj, ".Load(%s)", FBSL_GetFileName )
If GetValue( "%d", obj, ".parseError.errorCode" ) <> 0 then
strerr = "Error at line : " & GetValue( "%d", obj, ".parseError.line" ) & _
GetValue( "%s", obj, ".parseError.srcText" )
Msgbox( Null, strerr, "XML ERROR!", MB_OK + MB_ICONSTOP )
Else
bLoad = True
End If
End If
Return
:GetNodeListCount
If NodeList <> 0 Then ReleaseObject(NodeList)
Set NodeList = GetValue( "%o", obj, ".getElementsByTagName(%s)", "Sample")
NodeListCount = GetValue( "%d", NodeList, ".Length" )
If NodeListCount = 0 Then
MsgBox( Me, "Error : bad XML file format !", "Error", MB_ICONWARNING + MB_APPLMODAL )
GoSub MYReleaseObjects
End If
Return
:GetNodeListItem
Fbsl_SetText( hEdit, GetValue( "%s", NodeList, ".item(%d).text", k-1 ) )
Return
:MYReleaseObjects
ReleaseObject(NodeList)
ReleaseObject(obj)
ReleaseObject(cnodes)
Return
:ResizeMe
GetClientRect(Me, TopWin, leftWin, RightWin, BottomWin )
Resize( hEdit, 10, 50, RightWin - 25, BottomWin - 100 )
Resize( hStatus, 10, 10, RightWin-25, 0)
Return
:FillingXmlDB
If Strlen(fp) > 0 Then
fp = Replace( fp, "&", "&" ): fp = Replace( fp, "<", "<" )
fp = Replace( fp, ">", ">" ) : fp = Replace( fp, " ", " " )
mb = MsgBox( Null, "Click NO to just add this sample" & _
Crlf & "Click YES to add this sample and to complete the XML database", _
"Adding ending tag or not...", MB_YESNOCANCEL + MB_APPLMODAL + MB_ICONWARNING + MB_DEFBUTTON2 )
If mb = IDCANCEL Then Return
FileOpen( OUTFILE, Append )
If FileLen(OUTFILE) = 0 Then
FilePrint( FileOpen, "<?xml version=""1.0"" encoding=""ISO-8859-1""?>")
FilePrint( FileOpen, "<Fbsl_Samples>" & CrLf & Tab & "<Content>" )
End If
If Asc(fp{StrLen(fp)}) = 10 Then
If Asc(fp{0}) = 10 Or Asc(fp{0}) = 13 Then
FilePrint( FileOpen, Tab & Tab & "<Sample>" & fp & Tab & Tab & "</Sample>" )
Else
FilePrint( FileOpen, Tab & Tab & "<Sample>" & CrLf & fp & Tab & Tab & "</Sample>" )
End if
Else
If Asc(fp{0}) = 10 Or Asc(fp{0}) = 13 Then
FilePrint( FileOpen, Tab & Tab & "<Sample>" & fp & CrLf & Tab & Tab & "</Sample>" )
Else
FilePrint( FileOpen, Tab & Tab & "<Sample>" & CrLf & fp & CrLf & Tab & Tab & "</Sample>" )
End If
End If
bLastEntity = 0
If mb = IDYES Then
bLastEntity = 1
FilePrint( FileOpen, Tab & "</Content>" & CrLf & "</Fbsl_Samples>")
End if
FileClose(FileOpen)
End If
Return
:WriteLastEntity
If bLastEntity = 0 Then
FileOpen( OUTFILE, Append )
FilePrint( FileOpen, Tab & "</Content>" & CrLf & "</Fbsl_Samples>")
FileClose(FileOpen)
End If
Return
