URL4083Aufrufen

Funktion

Beschreibung

Zeile 5714 - 5789

Code in WinIBW2 (Makro/VBScript)Sub

Sub URL4083Aufr()
'******************************************************************************
'Funktion ruft Link aus 4083 im Standardbrowser auf.
'Falls 4083 mit =A $ belegt ist, wird automatisch Link zum NP-Repository Rome erzeugt
'und aufgerufen.
'Anforderung von C. Diebel.
'S. Grund, DNB, Maerz 2008
dim url()
boxtitel = "Link 4083 aufrufen"
idn = Application.ActiveWindow.Variable("P3GPP")
  If idn = "" then
  MsgBox "Diese Funktion kann erst ausgeführt werden, wenn der Titel über eine IDN verfügt.", vbCritical, boxtitel
  Exit Sub
  End If
kat4083 = katEinlesen("4083")
  if isArray(kat4083) then
  z = UBound(kat4083)
    for y = 1 to z
      If InStr(kat4083(y),"=A $") > 1 then
      'URL erzeugen
      redim preserve url(y)
      url(y) = "http://d-nb.info/" & idn & "/34"
      text_url = "=A $ (-> " & url(y) & ")"
      Else
      'URL aus 4083 bearbeiten
      u = Mid(kat4083(y),1)
      url_beg = InStr(u,"http://")
      url_end = url_beg
        Do
        url_end = InStr(url_end,u,"=")
          if url_end <> 0 then
            if Mid(u,url_end+2,1) <> " " then
            url_end = url_end +2
            else
            Exit Do
            End If
          Else
          url_end = len(u)
          End If
        Loop until url_end = 0 or url_end = len(u)
      url_end = url_end-url_beg
      redim preserve url(y)
      url(y) = Mid(u,url_beg,url_end)
      text_url = url(y)
      End If
    text = text & vbCrLf & y & "-->" & Mid(text_url,1,40) & "..."
    next
    'Wenn mehrere 4083 vorhanden sind, Auswahlfenster
    If z > 1 then
      Do
      strMeld = err_text & "Welchen Link wollen Sie aufrufen?" & vbCrLf & text & vbCrLf & vbCrLf & "Bitte geben Sie die Ziffer des gewünschten Links ein " &_
       "und klicken Sie auf 'OK'"
      url_nr = InputBox (strMeld,boxtitel)
        If url_nr > CStr(z) then
        err_text = "!!! " & url_nr & " existiert nicht." & " !!!" & vbCr & "Bitte eine Ziffer zwischen 1 und " & y & " eingeben oder abbrechen." & vbLf & vbLf
        End If
      loop until url_nr = 0 or (url_nr > 0 and url_nr < CStr(z+1))
     Else
     url_nr = 1
    End If
  Else
  MsgBox "Es ist keine Kategorie 4083 vorhanden.",vbCritical, boxtitel
  End If
 
  If url_nr = 0 then Exit Sub
 
  Application.ShellExecute url(url_nr)
  End Sub

Code in WinIBW3 (Javascript)

Erforderliche Änderungen / Ergänzungen