PureBoard

Code: Alles auswählen

#OLECMDID_COPY = 12
#OLECMDEXECOPT_DONTPROMPTUSER = 2
#Web_400 = 0
Ankername.s = "Anker"
Quelldatei.s = "D:\Quelle.htm"
Zieldatei.s = "D:\Ziel.htm"

Procedure SetAnkerIntoHTML(source.s, destination.s, text.s, anker.s)
  If Not text Or Not anker : ProcedureReturn 2 : EndIf          ;Parameter Prüfen
  If Not source Or Not destination : ProcedureReturn 1 : EndIf  ;Parameter Prüfen
  If Not ReadFile(0, source)  ;Quelle öffnen
    ProcedureReturn 1
  EndIf
  html.s = Space(Lof(0)) ;Speicher reservieren
  ReadData(0, @html, Lof(0))  ;Daten Lesen
  CloseFile(0)  
  cnt = CountString(html, text) ;Text zählen (darf nur einmal vorkommen
  If cnt = 0 : ProcedureReturn 2 : EndIf
  If cnt > 1 : ProcedureReturn 3 : EndIf
  pos = FindString(html, text, 1) ;Text position ermitteln
  If pos = 0 : ProcedureReturn 2 : EndIf
  outhtml.s = Left(html, pos-1) + "<a name="+Chr(34)+anker+Chr(34)+">" ;Teil vor dem text + anker anfang
  outhtml = outhtml + Mid(html, pos, Len(text)) + "</a>"  ;Text + Anker ende
  outhtml = outhtml + Right(html, Len(html)-Len(text)-(pos-1)) ;Teil nach dem Text
  If Not CreateFile(0, destination) ;Ziel datei erstellen
    ProcedureReturn 1
  EndIf
  WriteData(0, @outhtml, Len(outhtml)) ;HTML code reinschreiben
  CloseFile(0)  ;fertig...
  ProcedureReturn 0
EndProcedure


If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
  WebGadget(#Web_400, 10, 10, 580, 280, Quelldatei)
  timestamp = ElapsedMilliseconds()+5000
  While GetGadgetAttribute(#Web_400, #PB_Web_Busy) Or ElapsedMilliseconds() < timestamp
    WindowEvent()
  Wend
  
  SetClipboardText("") ;Zwischenablge leeren
  WebObject.IWebBrowser2 = GetWindowLong_(GadgetID(#Web_400), #GWL_USERDATA) ;Pointer zum Interface holen
  WebObject\ExecWB(#OLECMDID_COPY, #OLECMDEXECOPT_DONTPROMPTUSER, 0, 0) ;Markierten text kopieren
  Sprungziel.s = GetClipboardText() ;Zwischenablage auslesen
  res = SetAnkerIntoHTML(Quelldatei, Zieldatei, Sprungziel, Ankername) ;Text Suchen und Anker einbinden
  If res = 1 ;File Error
    MessageRequester("Fehler", "File Error!", #MB_ICONERROR)
  ElseIf res = 2 ;Text nicht gefunden
    MessageRequester("Fehler", "Text konnte nicht im HTML-Code gefunden werden!", #MB_ICONERROR)
  ElseIf res = 3 ;Text zu oft
    MessageRequester("Fehler", "Text wurde zu oft im HTML-Code gefunden!", #MB_ICONERROR)
  Else
    SetGadgetText(#Web_400, Zieldatei+"#"+Ankername) ;HTML Code Laden
  EndIf


  Repeat 
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf