Code: Alles auswählen
Macro Happy
;-)
EndMacro
Happy End
Code: Alles auswählen
Define source$, exe$=GetTemporaryDirectory()+"pb-executable_"+RemoveString(script_filename$, "/")
Code: Alles auswählen
Procedure.s nl2br(string.s)
string = ReplaceString(string, #CRLF$, "<br />")
string = ReplaceString(string, #LF$, "<br />")
ProcedureReturn ReplaceString(string, #CR$, "<br />")
EndProcedure
;[...]
;Zeile 136 bei mir
If Not compiler
error("Compiler could not be started." + "<br />" + "Pfad: " + GetPathPart(ProgramFilename())+"compilers/pbcompiler")
EndIf
Code: Alles auswählen
Compilation process did not finish correctly. Error:
******************************************
PureBasic 4.30 (Windows - x86)
******************************************
Compiling C:\WINDOWS\pb-executable_Cxampphtdocspbtesttest.pb.pb
Loading external libraries...
Starting compilation...
4 lines processed.
Creating executable.
- Feel the ..PuRe.. Power -
Code: Alles auswählen
#!C:/xampp/purebasic/interpreter.exe -w
OpenConsole()
PrintN("Content-Type: text/html"+#LF$)
Print("Hallo Welt!")
Code: Alles auswählen
Seite
-> source
->templates
-> index.tpl
-> index.pb
-> compiled
-> index
Code: Alles auswählen
Serverfehler!
Die Anfrage kann nicht beantwortet werden, da im Server ein interner Fehler aufgetreten ist.
Fehlermeldung:
Premature end of script headers: test.pb
Sofern Sie dies für eine Fehlfunktion des Servers halten, informieren Sie bitte den Webmaster hierüber.
Error 500
192.168.0.160
08.06.2009 20:12:13
Apache/2.2.8 (Win32) DAV/2 mod_ssl/2.2.8 OpenSSL/0.9.8g mod_autoindex_color PHP/5.2.5 mod_perl/2.0.3 Perl/v5.8.8
Code: Alles auswählen
; circumvent a bug in ProgramRunning() (this command always returns 1),
; see http://www.purebasic.fr/english/viewtopic.php?t=37273
If ProgramExitCode(program) <> -1 : Break : EndIf
Code: Alles auswählen
; Copyright: Blackskyliner, 2009
; E-Mail: blackskyliner@gmx.de
; This is a simple template parser which is able to
; parse every given file to PrintN() function calls.
; It also can replace some variable and function placeholder
; The last one, the function placeholder are executed and then
; the return value will be written inside the PrintN()
EnableExplicit
; Just a little helper function for developer
Procedure.s nl2br(string.s)
string = ReplaceString(string, #CRLF$, "<br />")
string = ReplaceString(string, #LF$, "<br />")
ProcedureReturn ReplaceString(string, #CR$, "<br />")
EndProcedure
; Sorry but i couldn't think of another name....
Structure replaceStruct
search.s
replace.s
EndStructure
Structure functionStruct
search.s
*replace.i ;x64 compatible
EndStructure
Enumeration
#Compare
EndEnumeration
#LDELIM$ = "<<"
#RDELIM$ = ">>"
Procedure.s parseTemplate(file.s, List replacer.replaceStruct(), List callableFunctions.functionStruct())
Define.s currentLine, output, currentVar
Define.i foundExpressions = 0, k
Dim expressions.s(0)
If ReadFile(0, file)
If CreateRegularExpression(#Compare, #LDELIM$+"(.*)"+#RDELIM$) = 0
ProcedureReturn "Internal Error[Compare_Init_parseTemplate]: " + RegularExpressionError()
EndIf
While Eof(0) = 0
currentLine = ReadString(0)
If MatchRegularExpression(#Compare, currentLine)
foundExpressions = ExtractRegularExpression(#Compare, currentLine, expressions())
For k = 0 To foundExpressions-1
;Debug Mid(expressions(k), 1, 2 + Len(#LDELIM$))
If Mid(expressions(k), 1, 2 + Len(#LDELIM$)) = #LDELIM$+"f:"
;proccess functions
currentVar = Mid(expressions(k), 3 + Len(#LDELIM$), Len(expressions(k))- (2 + Len(#LDELIM$) + Len(#RDELIM$)))
Debug "Function: " + currentVar
ResetList(callableFunctions())
ForEach callableFunctions()
If callableFunctions()\search = currentVar
;call function and fill the function placeholder with the return data
If callableFunctions()\replace <> #Null
currentLine = ReplaceString(currentLine, expressions(k), PeekS(CallFunctionFast(callableFunctions()\replace)))
EndIf
EndIf
Next
Else
;proccess variables
currentVar = Mid(expressions(k), 1 + Len(#LDELIM$), Len(expressions(k)) - (Len(#LDELIM$) + Len(#RDELIM$)))
Debug "Variable: " + currentVar
ResetList(replacer())
ForEach replacer()
If replacer()\search = currentVar
currentLine = ReplaceString(currentLine, expressions(k), replacer()\replace)
EndIf
Next
EndIf
Next
EndIf
output = output + "PrintN("+#DQUOTE$+currentLine+#DQUOTE$+")"+#CRLF$
Wend
FreeRegularExpression(#Compare)
CloseFile(0)
Else
output = "File " + file + " not found."
EndIf
ProcedureReturn output
EndProcedure
Procedure.s cleanPlaceholder(out.s)
Define.i foundExpressions = 0, k
Dim expressions.s(0)
If CreateRegularExpression(#Compare, #LDELIM$+"(.*)"+#RDELIM$) = 0
ProcedureReturn "Internal Error[Compare_Init_cleanPlaceholder_1]: " + RegularExpressionError()
EndIf
If MatchRegularExpression(#Compare, out)
foundExpressions = ExtractRegularExpression(#Compare, out, expressions())
For k = 0 To foundExpressions-1
out = ReplaceString(out, expressions(k), "")
Next
EndIf
FreeRegularExpression(#Compare)
; all empty PrintN are filtered out here...
; Maybe buggy because I only kill the TAB's
If CreateRegularExpression(#Compare, "PrintN\("+#DQUOTE$+"(\t*)"+#DQUOTE$+"\)") = 0
ProcedureReturn "Internal Error[Compare_Init_cleanPlaceholder_2]: " + RegularExpressionError()
EndIf
If MatchRegularExpression(#Compare, out)
foundExpressions = ExtractRegularExpression(#Compare, out, expressions())
For k = 0 To foundExpressions-1
out = ReplaceString(out, expressions(k), "")
Next
EndIf
FreeRegularExpression(#Compare)
ProcedureReturn out
EndProcedure
; -- Test
; Procedure.s test_function()
; ProcedureReturn "Hallo aus einer Funktion!"
; EndProcedure
;
; NewList r.replaceStruct()
; NewList f.functionStruct()
;
; AddElement(r())
; r()\search = "festVar"
; r()\replace = "Hallo Welt aus einem Replacer"
;
; AddElement(f())
; f()\search = "testFunc"
; f()\replace = @test_function()
;
;
; OpenConsole()
;
; Print(cleanPlaceholder(parseTemplate("C:\test.tpl",r(),f())))
;
; Input()
; test.tpl
;
; <html>
; <head>
; <title>Parser Test</title>
; </head>
;
; <body>
; Hallo Welt aus einem Template!<br/>
; <<f:testFunc>>
; <<f:testFunc2>>
; <<festVar>>
; <<f:testFunc3>>
; <<f:testFunc4>>
; </body>
; </html>
Code: Alles auswählen
#!C:/xampp/purebasic/interpreter.exe -w -t "C:/Windows/Temp/"Code: Alles auswählen
Macro Happy
;-)
EndMacro
Happy End
Code: Alles auswählen
OpenConsole()
Print("<<multiline
<html>
<head>
<title>My Website</title>
</head>
<body>
This is HTML code
</body>
</html>
<<")Ergebnis hat geschrieben:OpenConsole()
Print("<html>"+#LF$+"<head>"+#LF$+" <title>My Website</title>"+#LF$+"</head>"+#LF$+"<body>"+#LF$+" This is HTML code"+#LF$+"</body>"+#LF$+"</html>")
Code: Alles auswählen
Macro Happy
;-)
EndMacro
Happy EndCode: Alles auswählen
Procedure.s EncloseString (instring.s)
ProcedureReturn Chr(34) + instring.s + Chr(34)
EndProcedure
Procedure.s HTML_DocType(doctype.s)
dtype.s = ""
If doctype.s = "XHTML 1.0"
dtype + "<!DOCTYPE html PUBLIC "
dtype + EncloseString("-//W3C//DTD XHTML 1.0 Transitional//EN") + " "
dtype + EncloseString("http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd") + ">" + " "
EndIf
ProcedureReturn dtype.s
EndProcedure
Macro HTML_Initialize(xmldoc,xmlroot,xmlmain,doctype,html)
xmldoc = CreateXML(#PB_Any,#PB_UTF8)
xmlroot = RootXMLNode(xmldoc)
xmlmain = MainXMLNode(xmldoc)
doctype = CreateXMLNode(xmlroot,0,#PB_XML_DTD)
SetXMLNodeText(doctype, HTML_DocType("XHTML 1.0"))
html = CreateXMLNode(xmlroot,-1)
SetXMLNodeName(html, "html")
SetXMLAttribute(html, "xmlns", "http://www.w3.org/1999/xhtml")
SetXMLAttribute(html, "xml:lang", "de")
EndMacro
Macro HTML_Head(head,html)
head = CreateXMLNode(html,0)
SetXMLNodeName(head, "head")
EndMacro
Macro HTML_Title(head,title,text="")
title = CreateXMLNode(head,0)
SetXMLNodeName(title,"title")
SetXMLNodeText(title, text)
EndMacro
Macro HTML_Body(html,body,class="")
body = CreateXMLNode(html,-1)
SetXMLNodeName(body, "body")
SetXMLAttribute(body, "class", class)
EndMacro
Macro HTML_Style(head,style)
style = CreateXMLNode(head,-1)
SetXMLNodeName(style,"style")
SetXMLAttribute(style,"type","text/css")
EndMacro
Macro HTML_AddStyleClass(style,classname="",content="")
dummy$ = GetXMLNodeText(style)
SetXMLNodeText(style,dummy$+CRLF$+"."+classname+"{"+content+";}")
EndMacro
Macro HTML_AddStyle(style,elementname="",content="")
dummy$ = GetXMLNodeText(style)
SetXMLNodeText(style,dummy$+CRLF$+elementname+CRLF$+"{"+content+";}"+CRLF$)
EndMacro
Macro HTML_AddNode(parent,node,nodename,class="")
node = CreateXMLNode(parent,-1)
SetXMLNodeName(node,nodename)
SetXMLAttribute(node,"class",class)
EndMacro
Code: Alles auswählen
HTML_Initialize(xmldoc,*xmlroot,*xmlmain,*doctype,*html)
HTML_Head(*head,*html)
HTML_Title(*head,*title,"OSPS - Startseite")
HTML_Body(*html,*body,"osp_body")
HTML_Style(*head,*style)
HTML_AddStyleClass(*style,"osp_body","font-family:Verdana; font-size:12px;background-color:#003333")
HTML_AddStyleClass(*style,"osp_h1","font-size:18px;color:#ffffff;margin-bottom:0px")
HTML_AddStyleClass(*style,"osp_h2","font-size:14px;color:#000000")
HTML_AddStyleClass(*style,"osp_h3","font-size:14px;color:#000000")
HTML_AddStyle(*style,"a:link, a:visited, a:active, a:hover","text-decoration:underline;font-weight:bold;color:#ffffff;font-size:12px")
HTML_AddStyle(*style,"a:active, a:hover","color:#ff9200")
HTML_AddStyle(*style,"a.menu:link, a.menu:visited","color:#ff9200")
HTML_AddStyle(*style,"a.menu:active, a.menu:hover","color:#eeeeee")
HTML_AddStyleClass(*style,"osp_title","padding-top:15px;height:24px")
HTML_AddStyleClass(*style,"osp_menu","color:#ffffff;text-align:center;padding:10px 0px;border-top:1px solid #669999;clear:left")
HTML_AddStyleClass(*style,"osp_menu","border:1px solid #ffffff;background-color:#669999;padding:5px;color:#ffffff")
HTML_AddNode(*body,*p1,"p","osp_h1")
SetXMLNodeText(*p1, "Diese Seite gibt es nicht.")
HTML_AddNode(*body,*p2,"p","osp_h2")
SetXMLNodeText(*p2, "Wirklich nicht.")
Dim pp.l(100)
For i=0 To 99
HTML_AddNode(*body,pp(i),"p","osp_h3")
SetXMLNodeText(pp(i), "Diese Seite gibt es nicht.")
Next i
Dim pp.l(0)
Code: Alles auswählen
Macro Happy
;-)
EndMacro
Happy EndCode: Alles auswählen
Macro Happy
;-)
EndMacro
Happy End