; German forum:
; Author:
; Date: 21. June 2003
; OS: Windows
; Demo: No
PrgName.s="HTML-Check"
Dim Tag.s(500,1) : Tags = -1
Repeat
Tags = Tags + 1
Read Tag.s(Tags,0) : Read Tag.s(Tags,1)
Until Tag.s(Tags,0) = "
"
Declare LeseDatei(DateiName.s) : Datei.s = ""
Declare DirectoryParameter(FileList.s) : DirectoryParameter(FileList.s)
Declare DateiTyp(Datei.s)
Declare SchreibeDatei()
Declare HTMLCheck()
Declare CreateAndCenterWindow(WindowNr.l,SizeW.l,SizeH.l)
If CreateAndCenterWindow(0, 1024, 768)
If CreateGadgetList(WindowID())
TextGadget(1, 3, 3, 1011, 14, "StatusInfo")
ButtonGadget(2,974,20,40,24,"PgUp")
ButtonGadget(3,974,50,40,24,"PgDn")
ButtonGadget(4,5,50,40,24,"Load")
ButtonGadget(5,52,50,40,24,"Save")
ButtonGadget(6,170,50,80,24,"HTML-Check")
Frame3DGadget(7, 5, 16, 960, 28, "", 0)
TextGadget(8, 9, 26, 950, 16, "Check:")
Debug "1"
FontID.l = LoadFont(0, "Courier", 12)
If FontID.l
SetGadgetFont(8,FontID.l)
EndIf
TextBox=StringGadget(0, 3, 80, 1014, 634,"", #PB_String_Multiline | #ES_AUTOVSCROLL | #WS_VSCROLL | #WS_HSCROLL)
Quit = #FALSE
Repeat
EventID.l = WaitWindowEvent()
Result=SendMessage_(TextBox,#EM_GetSel,@Anfang,@Ende)
AChar=Anfang : SChars=Ende
ALine=SendMessage_(TextBox,#EM_LINEFROMCHAR,AChar,0)
TLines=SendMessage_(TextBox,#EM_GETLINECOUNT,0,0)
Bytes=SendMessage_(TextBox,#WM_GETTEXTLENGTH,0,0)
CPos=SendMessage_(TextBox,#EM_LINEINDEX,ALine,0)
If AChar < SChars
CPosE.s = " (bis " + Str(SChars-CPos) + ")"
Else
CPosE.s = ""
EndIf
StatusInfo.s = "Zeichen " + Str(AChar-CPos) + CPosE.s + " in Zeile " + Str(ALine+1) + " (von " + Str(TLines) + ")"
StatusInfo.s = StatusInfo.s + " [absolut: " + Str(AChar) + "/" + Str(Bytes)+"] ƒ Datei '" + Datei.s + "'"
SetGadgetText(1,StatusInfo.s)
If EventID = #PB_Event_CloseWindow
Quit = #TRUE
ElseIf EventID = #PB_Event_Gadget
Select EventGadgetID()
Case 2
Zeile=SendMessage_(TextBox,#EM_SCROLL,#SB_PAGEUP,0)
Case 3
Zeile=SendMessage_(TextBox,#EM_SCROLL,#SB_PAGEDOWN,0)
Case 4
DateiName.s = OpenFileRequester(PrgName.s + ": Datei öffnen", Datei.s, FileList.s, DateiTyp(Datei.s))
If DateiName.s+DateiName.s
LeseDatei(DateiName.s)
EndIf
Case 5
SchreibeDatei()
Case 6
If Datei.s <> ""
HTMLCheck()
EndIf
EndSelect
EndIf
Until Quit
Else
MessageRequester(PrgName.s, "Allgemeiner Programmfehler !", #MB_ICONSTOP)
EndIf
CloseWindow(0) : CloseFont(0)
EndIf
Procedure.b CreateAndCenterWindow(WindowNr.l, SizeW.l, SizeH.l)
Shared PrgName.s
ok.b = #FALSE
ExamineDesktops()
If DesktopWidth(0) < SizeW.l Or DesktopHeight(0) < SizeH.l
MessageRequester(PrgName.s, "Min. Auflösung " + Str(SizeW.l) + " * " + Str(SizeH.l) + " erforderlich !", #MB_ICONASTERISK)
Else
OffsetW.l = 5 : OffsetH.l = 52 ; Border (+ Title + ToolBar)
w.l = SizeW.l - OffsetW.l : h.l = SizeH.l - OffsetH.l
If OpenWindow(WindowNr.l, 0, 0, w.l, h.l, #PB_Window_MinimizeGadget | #PB_Window_TitleBar, PrgName.s)
xPos = (DesktopWidth(0) - SizeW.l) / 2
yPos = (DesktopHeight(0) - SizeH.l) / 2
If xPos > 0 Or yPos > 0
MoveWindow(xPos, yPos)
EndIf
ok.b = #TRUE
Else
MessageRequester(PrgName.s, "Fehler beim Öffnen des Fensters !", #MB_ICONSTOP)
EndIf
EndIf
ProcedureReturn ok.b
EndProcedure
Procedure DirectoryParameter(FileList.s)
Shared FileList.s
FileList.s = "HyperTextMarkedLanguage, CSS, JS|*.html;*.htm;*.css;*.js"
FileList.s = FileList.s + "|HyperTextMarkedLanguage (*.html)|*.html"
FileList.s = FileList.s + "|HyperTextMarkedLanguage (*.HTM)|*.htm"
FileList.s = FileList.s + "|CascadingStyleSheets (*.css)|*.css"
FileList.s = FileList.s + "|JavaScript (*.js)|*.js"
FileList.s = FileList.s + "|PureBasic Source (*.pb)|*.pb"
FileList.s = FileList.s + "|Text (*.txt)|*.txt"
FileList.s = FileList.s + "|ASCII-Datei? (*.asc *.bas *.bat *.dat *.ini *.log)|*.asc;*.bas;*.bat;*.dat;*.ini;*.log"
FileList.s = FileList.s + "|Alle Dateien (*.*)|*.*"
EndProcedure
Procedure.b DateiTyp(Datei.s)
If Datei.s = ""
DateiTypNr.b = 0
ElseIf Right(LCase(Datei.s),5) = ".html"
DateiTypNr.b = 1
ElseIf Right(LCase(Datei.s),4) = ".htm"
DateiTypNr.b = 1
ElseIf Right(LCase(Datei.s),4) = ".css"
DateiTypNr.b = 4
ElseIf Right(LCase(Datei.s),3) = ".js"
DateiTypNr.b = 5
ElseIf Right(LCase(Datei.s),3) = ".pb"
DateiTypNr.b = 6
ElseIf Right(LCase(Datei.s),4) = ".txt"
DateiTypNr.b = 7
ElseIf Right(LCase(Datei.s),4) = ".asc" Or Right(LCase(Datei.s),4) = ".bas" Or Right(LCase(Datei.s),4) = ".bat"
DateiTypNr.b = 8
ElseIf Right(LCase(Datei.s),4) = ".dat" Or Right(LCase(Datei.s),4) = ".ini" Or Right(LCase(Datei.s),4) = ".log"
DateiTypNr.b = 8
Else
DateiTypNr.b = 9
EndIf
ProcedureReturn DateiTypNr.b
EndProcedure
Procedure LeseDatei(DateiName.s)
Shared Datei.s, PrgName.s, Textzeile.s, Zeilen, Text.s
If ReadFile(0, DateiName.s)
If Lof()<60000
Datei.s = DateiName.s
Text.s=""
Dim Textzeile.s(10000)
Zeilen = -1
While Eof(0) = #FALSE
Zeilen = Zeilen + 1
Textzeile.s(Zeilen) = ReadString()
Text.s = Text.s + Textzeile.s(Zeilen) + Chr(13)+Chr(10)
Wend
CloseFile(0)
SetGadgetText(0, Text.s)
Else
MessageRequester(PrgName.s, "Datei kann aufgrund Ihrer Länge nicht gelesen werden !", #MB_ICONINFORMATION)
EndIf
Else
MessageRequester(PrgName.s, "Datei '" + DateiName.s + "' kann nicht gelesen werden !", #MB_ICONASTERISK)
EndIf
EndProcedure
Procedure SchreibeDatei()
Shared PrgName.s, Datei.s, FileList.s, Text.s
Quit = #FALSE : speichern = #FALSE
Repeat
DateiName.s = SaveFileRequester(PrgName.s + ": Datei speichern", Datei.s, FileList.s, DateiTyp(Datei.s))
If DateiName.s
If ReadFile(0, DateiName.s)
CloseFile(0)
Result = MessageRequester(PrgName.s, "Die bereits bestehende Datei überschreiben ?", #MB_ICONQUESTION | #PB_MessageRequester_YesNoCancel | #MB_DEFBUTTON2)
If Result = #IDYES ; Ja = 6
Quit = #TRUE : speichern = #TRUE
ElseIf Result = #IDNO ; Nein = 7
; -> neue Auswahl
ElseIf Result = #IDCANCEL ; Abbruch (Abort) = 2
Quit = #TRUE
Else
MessageRequester(PrgName.s, "Unerwarteter AntwortCode: " + Str(Result), #MB_ICONHAND)
Quit = #TRUE
EndIf
Else
Quit = #TRUE : speichern = #TRUE
EndIf
Else
Quit = #TRUE
EndIf
Until Quit
If speichern
Text.s = GetGadgetText(0)
If Len(Text.s) >= 4999
MessageRequester(PrgName.s, "Datei kann aufgrund Ihrer Länge nicht gespeichert werden !", #MB_ICONINFORMATION)
Else
If CreateFile(0, DateiName.s)
WriteString(Text.s)
Datei.s = DateiName.s
CloseFile(0)
Else
MessageRequester(PrgName.s, "Datei konnte nicht angelegt werden !", #MB_ICONEXCLAMATION)
EndIf
EndIf
EndIf
EndProcedure
Procedure HTMLCheck()
Shared Tag.s, Tags, Text.s, Textzeile.s, Zeilen, PrgName.s
Kommentar = #FALSE : Scripte = #FALSE
tgsF = 0 : tgsC = 0 : tgsA = 0 : tgsB = 0 : komC = 0 : scrC = 0 : styC = 0 : nix$=""
For z = 0 To Zeilen
t$ = LCase(Textzeile.s(z)) : l = Len(t$)
For i = 1 To l
If Mid(t$,i,1) = "<"
If Mid(t$,i,4) = "", ""
Data.s ""
Data.s ""
Data.s "", ""
Data.s "", ""
Data.s "", ""
Data.s ""
Data.s "", ""
Data.s ""
Data.s "", "
"
Data.s ""
Data.s "
"
Data.s "