'********************************************************************
'*                                                                  *
'*  File:  zdb_weitere.vbs                                          *
'*  Autor: Ursula Schulz                                            *
'*  Datum: 22.10.2001, 18.07.2003                                   *
'*  Die Datei ersetzt die frühere Datei zdb_weitere.vbs und enthält *
'*  die Programme Feld7120 und Reziprok                             *
'*  Datum: 29.06.2004 Änderung in Sub EZB(), Andreas M. Heise       *
'*  Datum: 15.11.2004 Änderung in Function Klammern7120 Schulz      *
'*  Datum: 27.01.2005 Änderung Sub FELD7120             Schulz      *
'*  Datum: 15.11.2004 neu Function RegExtReplace        Schulz      *
'*  Datum: 27.01.2005 Änderung Sub Feldauf7120          Schulz      *
'*  Datum: 27.01.2005 neu Sub Komma71204024             Schulz      *
'*  Datum: 27.01.2005 neu Sub Punkt71204024             Schulz      *
'*                    Komma7120 und Punkt 7120 fallen weg            
'********************************************************************
'*  Die folgenden Namen werden hier definiert und dürfen in keiner  *
'*  weiteren .vbs-Datei verwendet werden:                           *
'***********************************************
'*  Sub               EZB                      *
'*  Sub               FELD7120                 *
'*  Sub               LINKURL                  *
'*  Sub               LOKURL                   *
'*  Sub               REZIPROK                 *
'*  - Function          Bindestrich7120        *
'*  - Function          DRUCKAUSGABE           *
'*  - Function          EZBNOTA                *
'*  - Function          Gleich7120             *
'*  - Function          Klammern7120           *
'*  - Function          Musterjahr7120         *
'*  - Function          RegExtReplace          *
'*  - Function          Vor7120                *
'*  - Function          Ziffern7120            *
'*  - Sub               Feldauf7120            *
'*  - Sub               Komma71204024          *
'*  - Sub               P3FELD                 *
'*  - Sub               Punkt71204024          *
'*  - Sub               Tilde7120              *
'*  - Sub               UrlFeld                *
'****************************************************
'=========================================================
Sub EZB()
'=========================================================

	On Error Resume Next
	Set ie5 = CreateObject("Internetexplorer.Application")
	Typeie5=TypeName(ie5)

'=========================================================

' Anzahl der Aufrufe des Internet-Explorers
' Bei ie_Aufruf > 1 wird quit ausgeführt
	ie_Aufruf=0 
'	url zur EZB
'	Dbform_url geändert, 29.06.04. Diese URL deckt beide Varianten ab
'	(IP- und Passwortzugang)
	Dbform_url="https://www.bibliothek.uni-regensburg.de/internal/ezeit/dbform.phtml?"
	Frontdoor="=u http://www.bibliothek.uni-regensburg.de/ezeit/?"
'	Dokumenttyp  8A: Vollanzeige, 7A: Kurzliste, MT: Fehler
	strScreen=Application.ActiveWindow.Variable("scr")
	If strScreen ="7A" Or strScreen ="8A" Then
		Application.ActiveWindow.Command "s d", False 
	Else
		msgbox "Script muss aus der Vollanzeige/Kurzliste aufgerufen werden",,"EZB"
		Exit Sub
	End If

	aufnahme=Application.ActiveWindow.Variable("P3GIP")
	Satzlaenge=Len(aufnahme)

'---Feld "2110" , Inhalt nach zdb_id
	P3Feld "2110 ",1,aufnahme,zdb_id
'---Feld "4000" , Inhalt nach title
	P3Feld "4000 ",1,aufnahme,title
'---Feld "4005" , Inhalt an title anhängen
	P3Feld "4005 ",1,aufnahme,unterreihe
	title=title & unterreihe
'---Feld "4030" , Inhalt nach publisher
	P3Feld "4030 ",1,aufnahme,publisher
'---Feld "2010" , Inhalt nach eissn
	P3Feld "2010 ",1,aufnahme,eissn
'---URL-Feld "4085" , Inhalt nach url, mehrere aneinander
	url=""
	i=0
	Do
	i=i+1
	P3Feld "4085 ",i,aufnahme,urli
	If urli <>"" And mid(urli,1,47) <> mid(Frontdoor,4,47) Then
		If url = "" Then
			url= urli
		Else
			url=url & "%0D%0A" & urli
		End If
	End If
	Loop Until urli=""
'---Feld "4025" , Inhalt nach volume1
	P3Feld "4025 ",1,aufnahme,volume1
'---Feld "5080" , Inhalt nach notation []
	P3Feld "5080 ",1,aufnahme,nsa
	nota1=EZBNota (nsa,1)
	nota2=EZBNota (nsa,2)
	nota3=EZBNota (nsa,3)

'---Feld fehlt
	If  title = "" Or _
		publisher="" Or _
		zdb_id="" Or _
		url="" Then
	Msgbox "Fehler: eines der Felder fehlt:" & Vbcr & _
	"title / publisher / zdb_id / url",,"EZB"
	Exit Sub
	End If

'---Druckausgabe: reziproke Verknüpfung und Druck-ISSN
	If Druckausgabe(aufnahme,pissn) = False Then
	'	4 bedeutet ja und nein; 6=ja 7=nein
		VbFrage=Msgbox ("reziproke Verknüpfung nicht möglich, weiter ?",4)
		If vbfrage=7 Then Exit Sub
	End If 

	EZB_Aufnahme= _
	"title=" & title & "&publisher=" & publisher & _
	"&eissn=" & eissn & "&pissn=" & pissn & _
	"&zdb_id=" & zdb_id & "&url=" & url & _
	"&volume1=" & volume1 & "&notation[]=" & nota1 & _
	"&notation[]=" & nota2 & "&notation[]=" & nota3

	ie5.Toolbar = True      'Toolbar anzeigen (True) oder nicht (False)
	ie5.Fullscreen = False	'nicht auf True setzen, da dann keine Eingabe mehr möglich ist
	ie5.Navigate Dbform_url & EZB_Aufnahme
	ie5.Visible = True
	ie_Aufruf=ie_Aufruf+1

'	4 bedeutet ja und nein; 6=ja 7=nein
	VbFrage=Msgbox ( _
	"Bitte zur EZB-Aufnahme wechseln,        " & vbCr & _
	"danach wieder hierher zur WINIBW zurück " & vbCr & _
	"und die Frage beantworten:              " & vbCr & _
	"Ist die EZB-Aufnahme korrekt und        " & vbCr & _
	"soll die Frontdoor-url eingetragen werden?",4)
'	Frontdoor-Url eintragen
	If vbfrage=6 Then 
'	Press the "Korrigieren" button
	Application.ActiveWindow.Command "k d", False
'	Go to end of buffer without expanding the selection
	Application.ActiveWindow.Title.EndOfBuffer False
'	EZB-Frontdoor einfügen
 	Application.ActiveWindow.Title.InsertText "4085 " & Frontdoor
	Application.ActiveWindow.Title.InsertText Left(zdb_id,Len(zdb_id)-2)
	Application.ActiveWindow.Title.InsertText "=x F"
'	Press the <ENTER> key
 	Application.ActiveWindow.SimulateIBWKey "FR"

'	Dokumenttyp  8A: korrekt, MT: Fehler
	strScreen=Application.ActiveWindow.Variable("scr")
	If strScreen<>"8A" Then Msgbox "ZDB=" & zdb_id & " Korrektur nicht ausgeführt",,"EZB"
	End If

	If ie_Aufruf > 1 Then
		ie5.quit
		Set ie5 = Nothing
		ie_Aufruf=ie_Aufruf-1
	End If

	End Sub

'=========================================================
Public Function EZBNota(nsa,Pos)
'=========================================================

	EZBNota=""
	If pos=1 Then Anfang=1
	If pos=2 Then Anfang=5
	If pos=3 Then Anfang=9
	Vergleich=mid(nsa,Anfang,3)
	For i=0 To Anzahl
	If ZDBTab(I) = Vergleich Then
	EZBNota=EZBTab(I)
	Exit Function
	End If
	Next
	End Function


'=========================================================
'	Tabelle der Fachnotationen ZDB - EZB
'=========================================================

	Const Anzahl=111
	Dim ZDBTab(111), EZBTab(111)
	Dim ZDBFehler
	ZDBFehler=0

	ZDBTab(0)="000"
	EZBTab(0)="A"
	ZDBTab(1)="100"
	EZBTab(1)="A"
	ZDBTab(2)="110"
	EZBTab(2)="A"
	ZDBTab(3)="120"
	EZBTab(3)="A"
	ZDBTab(4)="125"
	EZBTab(4)="A"
	ZDBTab(5)="130"
	EZBTab(5)="A"
	ZDBTab(6)="135"
	EZBTab(6)="A"
	ZDBTab(7)="140"
	EZBTab(7)="A"
	ZDBTab(8)="150"
	EZBTab(8)="A"
	ZDBTab(9)="160"
	EZBTab(9)="ZP"
	ZDBTab(10)="170"
	EZBTab(10)="F"
	ZDBTab(11)="180"
	EZBTab(11)="N"	' oder  "B"
	ZDBTab(12)="200"
	EZBTab(12)="CA-CI"
	ZDBTab(13)="210"
	EZBTab(13)="CA-CI"
	ZDBTab(14)="220"
	EZBTab(14)="B"
	ZDBTab(15)="230"
	EZBTab(15)="B"
	ZDBTab(16)="232"
	EZBTab(16)="B"
	ZDBTab(17)="234"
	EZBTab(17)="B"
	ZDBTab(18)="236"
	EZBTab(18)="B"
	ZDBTab(19)="238"
	EZBTab(19)="B"
	ZDBTab(20)="260"
	EZBTab(20)="CL-CZ"
	ZDBTab(21)="280"
	EZBTab(21)="D"
	ZDBTab(22)="300"
	EZBTab(22)="N"
	ZDBTab(23)="305"
	EZBTab(23)="N"
	ZDBTab(24)="310"
	EZBTab(24)="N"	' oder  "LD-LG"
	ZDBTab(25)="320"
	EZBTab(25)="N"
	ZDBTab(26)="325"
	EZBTab(26)="N"
	ZDBTab(27)="330"
	EZBTab(27)="N"
	ZDBTab(28)="335"
	EZBTab(28)="N"
	ZDBTab(29)="340"
	EZBTab(29)="N"
	ZDBTab(30)="341"
	EZBTab(30)="N"
	ZDBTab(31)="342"
	EZBTab(31)="N"
	ZDBTab(32)="343"
	EZBTab(32)="N"
	ZDBTab(33)="360"
	EZBTab(33)="N"
	ZDBTab(34)="370"
	EZBTab(34)="N"
	ZDBTab(35)="390"
	EZBTab(35)="LA-LC"
	ZDBTab(36)="400"
	EZBTab(36)="E"
	ZDBTab(37)="405"
	EZBTab(37)="E"
	ZDBTab(38)="410"
	EZBTab(38)="H"
	ZDBTab(39)="420"
	EZBTab(39)="G"
	ZDBTab(40)="430"
	EZBTab(40)="F"
	ZDBTab(41)="440"
	EZBTab(41)="I"
	ZDBTab(42)="450"
	EZBTab(42)="K"
	ZDBTab(43)="460"
	EZBTab(43)="E"
	ZDBTab(44)="470"
	EZBTab(44)="LH-LO"
	ZDBTab(45)="480"
	EZBTab(45)="LP-LZ"
	ZDBTab(46)="490"
	EZBTab(46)="A"
	ZDBTab(47)="500"
	EZBTab(47)="P"
	ZDBTab(48)="510"
	EZBTab(48)="P"
	ZDBTab(49)="520"
	EZBTab(49)="P"
	ZDBTab(50)="530"
	EZBTab(50)="P"
	ZDBTab(51)="540"
	EZBTab(51)="P"
	ZDBTab(52)="550"
	EZBTab(52)="P"
	ZDBTab(53)="560"
	EZBTab(53)="P"
	ZDBTab(54)="570"
	EZBTab(54)="P"
	ZDBTab(55)="580"
	EZBTab(55)="P"
	ZDBTab(56)="600"
	EZBTab(56)="Q"	' oder  "MN-MS"
	ZDBTab(57)="601"
	EZBTab(57)="Q"	' oder  "MN-MS"
	ZDBTab(58)="605"
	EZBTab(58)="Q"	' oder  "MN-MS"
	ZDBTab(59)="615"
	EZBTab(59)="MN-MS"
	ZDBTab(60)="620"
	EZBTab(60)="MN-MS"
	ZDBTab(61)="630"
	EZBTab(61)="Q"
	ZDBTab(62)="631"
	EZBTab(62)="Q"
	ZDBTab(63)="640"
	EZBTab(63)="Q"
	ZDBTab(64)="650"
	EZBTab(64)="Q"
	ZDBTab(65)="655"
	EZBTab(65)="Q"
	ZDBTab(66)="656"
	EZBTab(66)="Q"
	ZDBTab(67)="658"
	EZBTab(67)="Q"
	ZDBTab(68)="660"
	EZBTab(68)="Q"
	ZDBTab(69)="670"
	EZBTab(69)="ZA-ZE"
	ZDBTab(70)="680"
	EZBTab(70)="MA-MM"
	ZDBTab(71)="682"
	EZBTab(71)="MA-MM"
	ZDBTab(72)="695"
	EZBTab(72)="MA-MM"
	ZDBTab(73)="700"
	EZBTab(73)="TA-TD"
	ZDBTab(74)="701"
	EZBTab(74)="TA-TD"
	ZDBTab(75)="705"
	EZBTab(75)="TA-TD"
	ZDBTab(76)="710"
	EZBTab(76)="U"
	ZDBTab(77)="720"
	EZBTab(77)="W"
	ZDBTab(78)="725"
	EZBTab(78)="W"
	ZDBTab(79)="730"
	EZBTab(79)="W"
	ZDBTab(80)="740"
	EZBTab(80)="V"
	ZDBTab(81)="760"
	EZBTab(81)="TE-TZ"
	ZDBTab(82)="761"
	EZBTab(82)="TE-TZ"
	ZDBTab(83)="764"
	EZBTab(83)="TE-TZ"
	ZDBTab(84)="766"
	EZBTab(84)="R"
	ZDBTab(85)="770"
	EZBTab(85)="U"
	ZDBTab(86)="790"
	EZBTab(86)="SA-SP"
	ZDBTab(87)="795"
	EZBTab(87)="SQ-SU"
	ZDBTab(88)="797"
	EZBTab(88)="SQ-SU"	' oder  "ZN"
	ZDBTab(89)="800"
	EZBTab(89)="WW-YZ"
	ZDBTab(90)="805"
	EZBTab(90)="WW-YZ"
	ZDBTab(91)="860"
	EZBTab(91)="WW-YZ"
	ZDBTab(92)="870"
	EZBTab(92)="WW-YZ"
	ZDBTab(93)="880"
	EZBTab(93)="WW-YZ"
	ZDBTab(94)="890"
	EZBTab(94)="WW-YZ"
	ZDBTab(95)="900"
	EZBTab(95)="ZG"
	ZDBTab(96)="905"
	EZBTab(96)="ZG"
	ZDBTab(97)="910"
	EZBTab(97)="ZL"
	ZDBTab(98)="920"
	EZBTab(98)="ZN"
	ZDBTab(99)="930"
	EZBTab(99)="ZG"
	ZDBTab(100)="935"
	EZBTab(100)="ZL"
	ZDBTab(101)="940"
	EZBTab(101)="V"	' oder  "ZM"
	ZDBTab(102)="945"
	EZBTab(102)="TE-TZ"	' oder  "ZH-ZI"
	ZDBTab(103)="950"
	EZBTab(103)="ZL"
	ZDBTab(104)="960"
	EZBTab(104)="ZH-ZI"
	ZDBTab(105)="970"
	EZBTab(105)="ZP"
	ZDBTab(106)="980"
	EZBTab(106)="ZX-ZY"
	ZDBTab(107)="981"
	EZBTab(107)="A"
	ZDBTab(108)="982"
	EZBTab(108)="A"
	ZDBTab(109)="984"
	EZBTab(109)="A"
	ZDBTab(110)="986"
	EZBTab(110)="A"
	ZDBTab(111)="988"
	EZBTab(111)="A"

Sub Feldauf7120(Inhalt8032, Inhalt7120, Feldnummer)
'==================================================
' Änderung Januar 2005 Schulz
' Auswertung von Heftnummern für Feld 4024
'   Komma7120 --> Komma71204024
'   Punkt7120 --> Punkt71204024
'==================================================

    Dim Pos(100), Feld(100), i
    Hilfsfeld = Inhalt8032
    Inhalt7120 = ""
'   Klammern entfernen
    Hilfsfeld = Klammern7120(Hilfsfeld)
'   Vortexte löschen
    Hilfsfeld = Vor7120(Hilfsfeld)
'   Ziffer,Punkt,Ziffer durch * ersetzen
    For i = 2 To Len(Hilfsfeld) - 1
    If Mid(Hilfsfeld, i, 1) = "." Then
        If IsNumeric(Mid(Hilfsfeld, i - 1, 1)) And IsNumeric(Mid(Hilfsfeld, i + 1, 1)) Then _
        Hilfsfeld = Mid(Hilfsfeld, 1, i - 1) & "*" & Mid(Hilfsfeld, i + 1)
        If Mid(Hilfsfeld, i + 1, 1) = " " And _
        IsNumeric(Mid(Hilfsfeld, i - 1, 1)) And IsNumeric(Mid(Hilfsfeld, i + 2, 1)) Then _
        Hilfsfeld = Mid(Hilfsfeld, 1, i - 1) & "*" & Mid(Hilfsfeld, i + 2)
    End If
    Next
'   Bindestrich mit Blank durch ~ ersetzen
    Hilfsfeld = Bindestrich7120(Hilfsfeld)
'   Blanks und Texte entfernen
    Hilfsfeld = Replace(Hilfsfeld, " ", "")
    Hilfsfeld = Replace(Hilfsfeld, "SS", "")
    Hilfsfeld = Replace(Hilfsfeld, "WS", "")
    Hilfsfeld = Replace(Hilfsfeld, "Nr.", "")
    Hilfsfeld = Replace(Hilfsfeld, "u.", ",")
    Hilfsfeld = Replace(Hilfsfeld, "Nachgewiesen", "")
    Hilfsfeld = Replace(Hilfsfeld, "nachgewiesen", "")
    Hilfsfeld = Replace(Hilfsfeld, ".Danachabbestellt", "")
'   bei Semikolon zerlegen
    j = 0
    posi = 2
    Pos(0) = 1
Do While posi > 0
    posi = InStr(posi, Hilfsfeld, ";")
    If posi > 0 Then
        j = j + 1
        posi = posi + 1
        Pos(j) = posi
    End If
Loop
    j = j + 1
    Pos(j) = Len(Hilfsfeld) + 2
    jende=j
'   über alle Teile zwischen Semikolon
For j = 1 To jende
    Feld(j) = Mid(Hilfsfeld, Pos(j - 1), Pos(j) - Pos(j - 1) - 1)
    Tilde7120 Feld(j), Teil1, Teil2
    Band1 = "" : Jahr1 = "" : Heft1 = ""
    Band2 = "" : Jahr2 = "" : Heft2 = ""
    Punkt71204024 Teil1, Band1, Jahr1, Heft1
    If Teil2 <> "-" Then Punkt71204024 Teil2, Band2, Jahr2, Heft2
    If Inhalt7120 <> "" And Band1 & Jahr1 & Band2 & Jahr2 <> "" Then _
    Inhalt7120 = Inhalt7120 & "; "
    If Feldnummer = "7120 " Then
' ----Feld 7120 aufbauen
        If Band1 <> "" Then Inhalt7120 = Inhalt7120 & "/v" & Band1
        If Jahr1 <> "" Then Inhalt7120 = Inhalt7120 & "/b" & Jahr1
        If Band2 <> "" Then Inhalt7120 = Inhalt7120 & "/V" & Band2
        If Jahr2 <> "" Then Inhalt7120 = Inhalt7120 & "/E" & Jahr2
    Else
' ----Feld 4024 aufbauen
        If Heft1 <> "" Then Inhalt7120 = Inhalt7120 & "/a" & Heft1
        If Jahr1 <> "" Then
            Inhalt7120 = Inhalt7120 & "/b" & Jahr1
        Else
            If Band1 <> "" Then Inhalt7120 = Inhalt7120 & "/v" & Band1
        End If
        If Heft2 <> "" Then Inhalt7120 = Inhalt7120 & "/A" & Heft2
        If Jahr2 <> "" Then
            Inhalt7120 = Inhalt7120 & "/E" & Jahr2
        Else
            If Band2 <> "" Then Inhalt7120 = Inhalt7120 & "/V" & Band2
        End If
    End If
' ---- laufend anhängen
    If Teil2 = "-" Then Inhalt7120 = Inhalt7120 & "-"
Next
End Sub


'=========================================================
Sub LinkUrl()
'=========================================================

'	Dokumenttyp  8A: Vollanzeige, 7A: Kurzliste, MT: Fehler
	strScreen=Application.ActiveWindow.Variable("scr")
	If strScreen = "8A" Then
		Application.ActiveWindow.Command "s d" , False
	Else
		msgbox "Script muss aus der Vollanzeige aufgerufen werden",,"LinkUrl"
		Exit Sub
	End If

	aufnahme=Application.ActiveWindow.Variable("P3GIP")
	Satzlaenge=Len(aufnahme)
'
	Feld="4085 "
	Satztyp = left(Application.ActiveWindow.DocType,2)
	If Satztyp="Tb" Then Feld="485 "	'Körperschaft
	If Satztyp="Tw" Then Feld="750 "	'Bibliothekssatz
	position=1
	Zahl_url=-1
	If Feld <> "750 " Then
		Do
		Zahl_url=Zahl_url+1
		UrlFeld Feld,Zahl_url+1,aufnahme,URL
		Loop Until URL=""
	Else
		UrlFeld "750 ",1,aufnahme,URL
		If URL <> "" Then Zahl_url=1
	End If


	If Zahl_url<=0 Then
		Msgbox "Fehler, keine url gefunden !" ,,"LinkUrl"
		Exit Sub

	Elseif Zahl_url >1 Then
		position=inputbox _
		("Diese Aufnahme enthält " & zahl_url & _
		" urls, welche soll benutzt werden ?", "URL",1)
	Elseif Feld="750 " Then
	position=inputbox _
		("Welche url aus Feld 750 soll benutzt werden ?" & vbcr & "1 =e  oder 2 =f", "URL",1)
	End If

'	URL-Feld "4085" oder "485" oder "750" suchen, Inhalt nach URL
	UrlFeld Feld,position,aufnahme,URL
	If URL ="" Then
		Msgbox "Fehler, keine url gefunden !" ,,"LinkUrl"
		Exit Sub
	End If
	Set ie5 = CreateObject("Internetexplorer.Application")
	ie5.Toolbar = True      'Toolbar anzeigen (True) oder nicht (False)
	ie5.Fullscreen = False	'nicht auf True setzen, da dann keine Eingabe mehr möglich ist

	ie5.Navigate URL

	ie5.Visible = True
End Sub

'=========================================================
Sub LokUrl()
'=========================================================

'	Dokumenttyp  8A: Vollanzeige, 7A: Kurzliste, MT: Fehler
	strScreen=Application.ActiveWindow.Variable("scr")
	If strScreen <> "8A" Then
		msgbox "Script muss aus der Vollanzeige aufgerufen werden",,"LokUrl"
		Exit Sub
	End If

	aufnahme=Application.ActiveWindow.Variable("P3GIP")
	Satzlaenge=Len(aufnahme)

	Feld7135="7135 "
	position=1
	Zahl_url=-1
	Do
		Zahl_url=Zahl_url+1
		UrlFeld Feld7135,Zahl_url+1,aufnahme,URL
	Loop Until URL=""

	If Zahl_url<=0 Then
	Msgbox ("Fehler, keine url gefunden !")
	Exit Sub

	Elseif Zahl_url >1 Then
	position=inputbox _
		("Diese Aufnahme enthält " & zahl_url & _
		" lokale urls, welche soll benutzt werden ?", "URL",1)
	End If

'	URL-Feld 7135 suchen und Inhalt nach URL
	UrlFeld Feld7135,position,aufnahme,URL

	Set ie5 = CreateObject("Internetexplorer.Application")
	ie5.Toolbar = True      'Toolbar anzeigen (True) oder nicht (False)
	ie5.Fullscreen = False	'nicht auf True setzen, da dann keine Eingabe mehr möglich ist

	ie5.Navigate URL
	ie5.Visible = True

End Sub


'============================================================
Public Sub P3Feld(nummer,position,xaufnahme,feldinhalt)
'============================================================
' 
' Das Kaufmanns & wird umcodiert in %26
' das Prozentzeichen in %25

	aufnahme=xaufnahme & vbcr
	Satzlaenge=Len(aufnahme)
	feldinhalt=""
	Pos=0
	position1=position
'	Zuerst wird festgestellt, ob das x-te Feld auch vorhanden ist
	If nummer = "750 " Then position1=1
	For i=1 To position1
	Pos=InStr(Pos+1,aufnahme,nummer,1)
	If Pos <= 0 Then Exit Sub
	Next

	pos=pos+Len(nummer)
	ende=Instr(pos,aufnahme,vbCr,0)
	feldinhalt=mid(aufnahme,pos,ende-pos)
'	Umcodieren (Versuch)
	While pos>0
	pos=Instr(1,feldinhalt,"ÿ",0)
	If pos>0 Then weg=mid(feldinhalt,pos,2)
	feldinhalt=replace (feldinhalt,weg,"")
	Wend
'	Sonderfall url ,Felder 4085 oder 485 oder 7135 oder 750
	Feldlaenge=Len(feldinhalt)
	If mid(nummer,1,4)="4085" Or mid(nummer,1,3)="485" Or mid(nummer,1,4)="7135" Then
'	u ist url, g ist urn
		Pos=Instr(1,Feldinhalt,"=u ",0)
		if Pos <= 0 Then Pos=Instr(1,Feldinhalt,"=g ",0)
		If pos > 0 Then
		feldinhalt=Right(feldinhalt,Feldlaenge-Pos-2)
		Pos=InStr(1,feldinhalt,"=x ",0)
		If pos <= 0 Then Pos=InStr(1,feldinhalt,"=z ",0)
		If Pos > 1 Then feldinhalt=Left(feldinhalt,Pos-1)
		Else
		feldinhalt=""
		End If
	Elseif mid(nummer,1,3)="750" Then
		If (position = 1) Then	Pos=InStr(1,feldinhalt,"=e ",0)
		If (position = 2) Then	Pos=InStr(1,feldinhalt,"=f ",0)
		If Pos > 1 Then
			feldinhalt=Right(feldinhalt,Feldlaenge-Pos-2)
		Elseif Pos <= 0	Then
			Feldinhalt=""
			Exit Sub
		End If
		Pos=InStr(1,feldinhalt," =",0)
		If Pos > 1 Then	feldinhalt=Left(feldinhalt,Pos-1)
'---Sonderfall ISSN
	Elseif mid(nummer,1,4)="2010" Then	feldinhalt=Left(feldinhalt,9)
'-----------------------
'---Sonderfall Feld 4000
'-----------------------
	Elseif mid(nummer,1,4)="4000" Then
'	Ende bei _:_ bzw _=_
		pos1=instr(1,feldinhalt," : ",0)
		pos2=instr(1,feldinhalt," = ",0)
		pos=0
		If pos1 = 0 Then pos=pos2
		If pos2 = 0 Then pos=pos1
		If Pos1 * Pos2 >0 Then
		If pos1 < pos2 Then pos=pos1
		If pos1 >=pos2 Then pos=pos2
		End If
		If pos >1 Then feldinhalt=left(feldinhalt,pos-1)
'	"Elektronische Ressource" entfernen
		feldinhalt=replace (feldinhalt," [[Elektronische Ressource]]","")
'	2 Schraegstriche durch einen ersetzen
		feldinhalt=replace (feldinhalt,"//","/")
'	Nichtsortierzeichen
		nichtsor=""
		Pos=instr(1,feldinhalt," @",0)
		If Pos > 0 Then
			nichtsor=Left(feldinhalt,Pos-1)
			feldinhalt=Right(feldinhalt,Len(feldinhalt)-Pos+-1) & _
			", " & nichtsor
		End If
'--------------------------------------------
'---Sonderfall Unterreihe, Klammern entfernen
'--------------------------------------------
	Elseif mid(nummer,1,4)="4005" Then
		If feldinhalt <> "" Then
			feldinhalt=replace(feldinhalt,"{",". ")
			feldinhalt=replace(feldinhalt,"}","")
		End If
	End If
'--------------------------------------------
'---Prozent und Kaufmannsund als Hexa
'--------------------------------------------
feldinhalt=replace (feldinhalt,"%","%25")
feldinhalt=replace (feldinhalt,"&","%26")
End Sub



'=========================================================
	Public Function Druckausgabe(Aufnahme,pissn)
'=========================================================

'	In der Aufnahme wird nach "4243 Druckausg!" gesucht
'	evt. wird die Druckausgabe aufgerufen
'	die reziproke Verknüpfung wird erzeugt
'	die Druck-ISSN wird ermittelt und zurückgeliefert
'
	ZDBFehler=0
	Druckausgabe=True
	pissn=""
	PicaId = Application.ActiveWindow.Variable("P3GPP")
'---4243 Druckausg suchen
	P3Feld "4243 Druckausg.!",1,Aufnahme,druckausg
	If druckausg <> "" Then
		Application.ActiveWindow.Command "f idn " & left(druckausg,9), False
'		DocType = 1. Zeichen im Feld 0500
		Druckausgabe = left(Application.ActiveWindow.DocType,1)="A"
		Application.ActiveWindow.SimulateIBWKey "F7"
		Application.ActiveWindow.Title.StartOfBuffer False
		lgef=Application.ActiveWindow.Title.Find("!" & PicaId & "!", True, False)
		If lgef = False And Druckausgabe Then
			Application.ActiveWindow.Title.EndOfBuffer False
			Application.ActiveWindow.Title.InsertText _
			"4243 Internetausg.!" & PicaId & "!" & vbCr
'	Press the <ENTER> key
  			Application.ActiveWindow.SimulateIBWKey "FR"
'	Korrektur ausgeführt, dann ist der Titel im diagn. Format
'	sonst im Korrekturformat
			If Application.ActiveWindow.Title Is Nothing Then
			Else
		    Druckausgabe=False
			End If
		End If
'---Feld "2010" , Inhalt nach pissn
		Application.ActiveWindow.Command "s d", False
		aufnahme1=Application.ActiveWindow.Variable("P3GIP")
		P3Feld "2010 ",1,aufnahme1,pissn
'---zurück zur elektronischen Aufnahme
		Application.ActiveWindow.Command "f idn " & PicaId, False
	End If
End Function
'=====================================================================
Sub Reziprok()
'=====================================================================

'	Sub Reziprok

'=====================================================================
'   Datum: 20. 4. 2000 / Schulz
'   Skript muss bei reziprokem Verknuepfungsfeld aufgerufen werden
'   und erzeugt an der Gegenaufnahme eine Verknüpfung.
'   Zulässige Felder: Quelle (0...7)
'   Ergebnis in Ziel (0...7)
'=====================================================================
	Dim Quelle(7) 
	Dim Ziel(7)
	Quelle(0)= "450 |a|"
	Quelle(1)= "450 |c|"
	Quelle(2)= "4244 f#"
	Quelle(3)= "4244 s#"
	Quelle(4)= "4244 z#"
	Quelle(5)= "4241 "
	Quelle(6)= "4242 "
	Quelle(7)= "4243 "

	Ziel(0)=   "450 |c|"
	Ziel(1)=   "450 |a|"
	Ziel(2)=   "4244 s#"
	Ziel(3)=   "4244 f#"
	Ziel(4)=   "4244 z#"
	Ziel(5)=   "4242 "
	Ziel(6)=   "4241 "
	Ziel(7)=   "4243 "

	On Error Resume Next

'----------Quell-Id-Nummer
	Id1 = Application.ActiveWindow.Variable("P3GPP")
	Application.ActiveWindow.Title.StartOfField False
	Application.ActiveWindow.Title.CharRight 7, True
	If Err.number  <> "0" Then
		Msgbox "Script muss auf dem Korrekturbildschirm aufgerufen werden !"
		Exit Sub
	End If
	Feldnummer=Application.ActiveWindow.Title.GetSelection()
	For index = 0 To 4 
	If Feldnummer =Quelle(index) Then
		Rezi_Feld=Ziel(index)
	End If
	Next 
	For index = 5 To 7 
	If Mid(Feldnummer,1,5) =Quelle(index) Then
		Rezi_Feld=Ziel(index)
'----------2 Zeichen nach links 
		Application.ActiveWindow.Title.CharLeft 2, False
	End If
	Next 
	If Rezi_Feld= "" Then
	Msgbox "Script muss beim richtigen Feld aufgerufen werden !"_
	 & vbCr & "Feld: " & Feldnummer
	Exit Sub
	End If
'----------Ausrufzeichen suchen
	Application.ActiveWindow.Title.CharRight 1, False
	Application.ActiveWindow.Title.CharLeft 1, False
	Application.ActiveWindow.Title.EndOfField True
	Text=Application.ActiveWindow.Title.GetSelection()
	index=1
	While index< Len(Text) And  mid(text,index,1) <>"!"
	index=index+1
	Wend
'----------kein ! gefunden
	If index>=Len(Text) Then
	Msgbox "keine Verknüpfungs-Id-Nummer"
	Exit Sub
	End If
'----------Ziel-Id-Nummer
	ID2=mid(Text,index+1,9)
'----------Send the command to the system and display the data in a new window
	Application.ActiveWindow.Command "f idn " & Id2, True
'----------Press the "Korrigieren" button
	Application.ActiveWindow.SimulateIBWKey "F7"
	Application.ActiveWindow.Title.StartOfBuffer False
	Application.ActiveWindow.Title.Find "!" & Id1 & "!", False, False
	Gefunden=Application.ActiveWindow.Title.GetSelection()
	If gefunden="!" & Id1 & "!" Then
		Msgbox "Verknuepfung bereits vorhanden!"
		Exit Sub
	Else
	Application.ActiveWindow.Title.EndOfBuffer False
	Application.ActiveWindow.Title.InsertText Rezi_feld & "!" & Id1 & "!" & vbCr
	End If
End Sub
'=============================================================================
'
Dim Fehlerin7120
'
'
Sub Feld7120()
'=============================================================================
'	Das Script muss im Editierbildschirm aufgerufen werden im Feld 8032
'	oder 7121 oder 4025.
'	Das Feld 7120 (oder 4026) wird erzeugt und über dem Feld ausgegeben.
'	Schulz, 14.1.2003
'=============================================================================
'	Edit-Bildschirm ? scr= IT, MT, IE, ME
	Schirm=Application.ActiveWindow.variable("scr")
	If Schirm <> "IE" and Schirm <> "IT" and Schirm <> "ME" and Schirm <> "MT" Then
	MsgBox "Das Script muss aus dem Edit-Bildschirm für Titel oder Exemplare aufgerufen werden" , , "Feld7120"
	Exit Sub
	End If
	Fehlerin7120 = ""
'	Feld 8032 markieren
	Application.ActiveWindow.Title.StartOfField False
	Application.ActiveWindow.Title.EndOfField True
	Feld8032 = Application.ActiveWindow.Title.GetSelection()
	Feldnummer=Left(Feld8032,4)
	If Feldnummer = "8032" or Feldnummer = "7121" then
		Feldnummer="7120 "
	ElseIf Feldnummer = "4025" then
		Feldnummer="4024 "
	else
		MsgBox "Das Script darf für dieses Feld nicht aufgerufen werden: " & _
	Feldnummer , , "Feld7120"
	Exit Sub
	End If 
	Inhalt8032=Right(Feld8032,len(Feld8032)-5)
'	Leerzeile vor 8032
	Application.ActiveWindow.Title.StartOfField False
	Application.ActiveWindow.Title.InsertText vbCr
	Application.ActiveWindow.Title.LineUp 1, False
	Feldauf7120 Inhalt8032, Inhalt7120, Feldnummer
'	Feld 7120 ausgeben
	Application.ActiveWindow.Title.InsertText Feldnummer & Inhalt7120
	Application.ActiveWindow.ShowMessage Fehlerin7120,1
End Sub


Function Bindestrich7120(Feld)
'=============================
Hilfsfeld = Feld
kommada = False
Bindestrich7120 = ""
'   ff. am Ende durch - ersetzen
    If Len(Hilfsfeld) > 3 Then If Mid(Hilfsfeld, Len(Hilfsfeld) - 2, 3) = "ff." Then _
    Hilfsfeld = Left(Hilfsfeld, Len(Hilfsfeld) - 3) & "-"
'Bindestrich ohne Komma davor durch ~ ersetzen
For i = 1 To Len(Hilfsfeld)
Zeich = Mid(Hilfsfeld, i, 1)
If Zeich = ";" Then kommada = False
If Zeich = "," Then kommada = True
If Zeich = "-" And kommada = False Then
    Bindestrich7120 = Bindestrich7120 & "~"
Else
    Bindestrich7120 = Bindestrich7120 & Zeich
End If
Next
'   Bindestrich mit Blank durch ~ ersetzen
    Bindestrich7120 = Replace(Bindestrich7120, " - ", "~")
    Bindestrich7120 = Replace(Bindestrich7120, "- ", "~")
    Bindestrich7120 = Replace(Bindestrich7120, " -", "~")
    If Right(Bindestrich7120, 3) = "ff." _
    Then Bindestrich7120 = Left(Bindestrich7120, Len(Bindestrich7120) - 3) & "~"
    If Right(Bindestrich7120, 1) = "-" _
    Then Bindestrich7120 = Left(Bindestrich7120, Len(Bindestrich7120) - 1) & "~"

End Function


Sub Punkt71204024(Feld, Band, Jahr, Heft)
'========================================
Band = ""
Jahr = ""
Heft = ""
'   zu mit Text davor entfernen
    posi = InStr(1, Feld, "zu")
    If posi > 0 And posi < Len(Feld) Then Feld = Right(Feld, Len(Feld) - posi - 1)
'   F. mit Text davor entfernen
    posi = InStr(1, Feld, "F.")
    If posi > 0 And posi < Len(Feld) Then Feld = Right(Feld, Len(Feld) - posi - 1)
'   S. mit Text davor entfernen
    posi = InStr(1, Feld, "S.")
    If posi > 0 And posi < Len(Feld) Then Feld = Right(Feld, Len(Feld) - posi - 1)
'   Ser. mit Text davor entfernen
    posi = InStr(1, Feld, "Ser.")
    If posi > 0 And posi < Len(Feld) Then Feld = Right(Feld, Len(Feld) - posi - 3)
'   Trim. mit Text davor entfernen
    posi = InStr(1, Feld, "Trim.")
    If posi > 0 And posi < Len(Feld) Then Feld = Right(Feld, Len(Feld) - posi - 4)
    posi = InStr(1, Feld, "*")
    If posi = 0 Then
        Jahr = Feld
    ElseIf posi = Len(Feld) Then
        Band = Feld
    Else
        Band = Left(Feld, posi - 1)
        Jahr = Right(Feld, Len(Feld) - posi)
    End If
    If Band <> "" Then Band = Gleich7120(Band)
    If Band <> "" Then Komma71204024 Band, Heft
    If Band <> "" Then Band = Ziffern7120(Band)
    If Jahr <> "" Then Jahr = Gleich7120(Jahr)
    If Jahr <> "" Then Komma71204024 Jahr, Heft
    If Jahr <> "" Then Jahr = Ziffern7120(Jahr)
    If Heft <> "" Then Heft = Ziffern7120(Heft)
    If Band = "" And (IsNumeric(Mid(Jahr, 1, 4)) = False Or Len(Jahr) < 4) Then
        Band = Jahr
        Jahr = ""
    End If
'   einige Prüfungen an den Zahlen
    Jahr = Musterjahr7120(Jahr)
    lMaxJahr = 4
End Sub

Function Gleich7120(Feld)
'========================
'   Alles hinter Gleichheitszeichen bis Schrägstrich oder Komma oder
'   Zeilenende weglassen
Gleich7120 = Feld
posi = InStr(1, Gleich7120, "=")
If posi > 0 Then
    i = posi + 1
    zahlende = False
    Do While i <= Len(Gleich7120) And zahlende = False
    Zeich = Mid(Gleich7120, i, 1)
    If Zeich = "/" Or Zeich = "," Then zahlende = True
    i = i + 1
    Loop
    Gleich7120 = Left(Gleich7120, posi - 1)
    If Len(Gleich7120) - i > 1 Then Gleich7120 = Gleich7120 & Right(Gleich7120, Len(Gleich7120) - i - 1)
End If
End Function

Function Klammern7120(Feld)
'==========================
' Schulz, 20.10.2004
Klammern7120=Feld

' Runde Klammern und Inhalt weglassen
Klammern7120 = RegExtReplace(Klammern7120,"\([^)]*\)","")

' Geschweifte Klammern und Inhalt weglassen
Klammern7120 = RegExtReplace(Klammern7120,"\{[^)]*\}","")

' Nummernzeichen und Inhalt weglassen
Klammern7120 = RegExtReplace(Klammern7120, "#[^)]*#","")

' Muster = 4 Ziffern oder 4 Ziffern, Bindestrich, 2 Ziffern

' Eckige Klammern mit Inhalt Fragezeichen weglassen
Klammern7120 = Replace(Klammern7120,"[?]", "")

' Eckige Klammern mit Inhalt: Muster, Semikolon weglassen
Klammern7120 = RegExtReplace(Klammern7120,"\[\d{4}];|\[\d{4}\/\d\d];", ";")

' Eckige Klammern mit Inhalt: Muster, Bindestrich, Blank weglassen
Klammern7120 = RegExtReplace(Klammern7120,"\[\d{4}]- |\[\d{4}\/\d\d]- "," -")

' Eckige Klammern mit Inhalt: Muster am Feldende weglassen
Klammern7120 = RegExtReplace(Klammern7120,"\[\d{4}]$|\[\d{4}\/\d\d]$", "")

' öffnende eckige Klammern weglassen
Klammern7120 = Replace(Klammern7120,"]","")

' schließende eckige Klammern weglassen
Klammern7120 = Replace(Klammern7120,"[","")

End Function



Sub Komma71204024 (Feld,Heft)
'============================
Heft = ""
posi = InStr(1, Feld, ",")
If posi > 0 Then
	Heft = Right(Feld,Len(Feld)-Posi)
	Feld = Left(Feld, posi - 1)
End if
End Sub

Function Musterjahr7120(Feld)
'============================
    Musterjahr7120 = Feld
    If Len(Feld) = 0 Then
         Exit Function
    ElseIf Len(Feld) = 4 Then
        If IsNumeric(Feld) = True Then
            Exit Function
        Else
            Fehlerin7120 = Fehlerin7120 & "7120: falsche Jahreszahl: " & Feld & vbLf
        End If
    ElseIf Len(Feld) > 4 Then
        If IsNumeric(Mid(Feld, 1, 4)) = False Then
            Fehlerin7120 = Fehlerin7120 & "7120: falsche Jahreszahl: " & Feld & vbLf
            Exit Function
        Else
            If Len(Feld) > 4 And Mid(Feld, 5, 1) <> "/" Then
                Musterjahr7120 = Left(Feld, 4)
                Fehlerin7120 = Fehlerin7120 & "7120: Jahreszahl abgeschnitten: " & Feld & vbLf
                Exit Function
            Else
                If IsNumeric(Mid(Feld, 6)) = False Then
                    posi = InStr(6, Feld, "/")
                    If posi > 6 Then
                    Musterjahr7120 = Left(Feld, posi - 1)
                    Fehlerin7120 = Fehlerin7120 & "7120: Jahreszahl abgeschnitten: " & Feld & vbLf
                    Exit Function
                    End If
                End If
            End If
        End If
    Else
        Fehlerin7120 = Fehlerin7120 & "7120: Jahreszahl ist zu kurz " & Feld & vbLf
    End If
End Function



Sub Tilde7120(Feld, Teil1, Teil2)
'================================
'   Feld bei Tilde in Teil1 und Teil2 zerlegen
    posi = InStr(1, Feld, "~")
    If posi = 0 Then
        Teil1 = Feld
        Teil2 = ""
    ElseIf posi = Len(Feld) Then
        Teil1 = Left(Feld, Len(Feld) - 1)
        Teil2 = "-"
    Else
        Teil1 = Left(Feld, posi - 1)
        Teil2 = Right(Feld, Len(Feld) - posi)
     End If
    
End Sub

'============================================================
Public Sub UrlFeld(nummer,position,xaufnahme,feldinhalt)
'=======================================================

	aufnahme=xaufnahme & vbcr
	Satzlaenge=Len(aufnahme)
	feldinhalt=""
	Pos=0
	position1=position
'	Zuerst wird festgestellt, ob das x-te Feld auch vorhanden ist
	If nummer = "750 " Then position1=1
	For i=1 To position1
		Pos=InStr(Pos+1,aufnahme,nummer,1)
		If Pos <= 0 Then Exit Sub
	Next
'	Feldende bei Zeilenumbruch (13) bzw. Steuerzeichen (27)
	pos=pos+Len(nummer)
	ende=Instr(pos,aufnahme,Chr(13),0)
	feldinhalt=mid(aufnahme,pos,ende-pos)
	ende=Instr(1,Feldinhalt,Chr(27),0)
	if ende>0 then feldinhalt=left(Feldinhalt,ende-1)
	Feldlaenge=Len(feldinhalt)
'	url ,Felder 4085 oder 485 oder 7135 oder 750
	If mid(nummer,1,4)="4085" Or mid(nummer,1,3)="485" Or mid(nummer,1,4)="7135" Then
'	u ist url, g ist urn
		Pos=Instr(1,Feldinhalt,"=u ",0)
		if Pos <= 0 Then Pos=Instr(1,Feldinhalt,"=g ",0)
		If pos > 0 Then
			feldinhalt=Right(feldinhalt,Feldlaenge-Pos-2)
			Pos=InStr(1,feldinhalt,"=x ",0)
			If pos <= 0 Then Pos=InStr(1,feldinhalt,"=z ",0)
			If Pos > 1 Then feldinhalt=Left(feldinhalt,Pos-1)
		Else
			feldinhalt=""
		End If
	Elseif mid(nummer,1,3)="750" Then
		If (position = 1) Then	Pos=InStr(1,feldinhalt,"=e ",0)
		If (position = 2) Then	Pos=InStr(1,feldinhalt,"=f ",0)
		If Pos > 1 Then
			feldinhalt=Right(feldinhalt,Feldlaenge-Pos-2)
		Elseif Pos <= 0	Then
			Feldinhalt=""
			Exit Sub
		End If
		Pos=InStr(1,feldinhalt," =",0)
		If Pos > 1 Then	feldinhalt=Left(feldinhalt,Pos-1)
	End If
End Sub


Function RegExtReplace( Zeichenfolge, Suchmuster, Ersatz)
'========================================================
' Schulz, 20.10.2004
' In der Zeichenfolge wird das Suchmuster durch Ersatz ersetzt
RegExtReplace = Zeichenfolge
Dim regAusdr				' Erstellt Variable.
Set regAusdr = New RegExp		' Erstellt einen regulären Ausdruck.
regAusdr.Pattern = Suchmuster		' Setzt das Muster.
regAusdr.IgnoreCase = True		' Groß / Klein.
regAusdr.Global = True			' Legt globales Anwenden fest.
RegExtReplace = regAusdr.replace(Zeichenfolge,Ersatz)
Set regAusdr = nothing
End Function



Function Vor7120(Feld)
'=====================
'   Vom Anfang her alles vor 1. Ziffer löschen
    Vor7120 = Feld
    Do While Len(Vor7120) > 0
    If IsNumeric(Mid(Vor7120, 1, 1)) = False Then
        Vor7120 = Right(Vor7120, Len(Vor7120) - 1)
    Else
        Exit Function
    End If
    Loop
    Vor7120 = ""
End Function


Function Ziffern7120(Feld)
'=========================
Falschezeichen = ""
For i = 1 To Len(Feld)
Zeich = Mid(Feld, i, 1)
If Zeich = "~" Then Zeich = "-"
If Zeich = "*" Then Zeich = "."
If IsNumeric(Zeich) Then
    Ziffern7120 = Ziffern7120 & Zeich
ElseIf Zeich = "/" And i > 1 Then
    Ziffern7120 = Ziffern7120 & Zeich
Else
    Falschezeichen = Falschezeichen & Zeich
    Ziffern7120 = ""
End If
Next
If Falschezeichen <> "" Then
Fehlerin7120 = Fehlerin7120 & "7120: Zeichen weggelassen: " & Falschezeichen & vbLf
End If
End Function