'==============================================================
'********************************************************************
'*                                       
'*  File:    allgemein.vbs                  
'*  Autoren: Ursula Schulz / Marcus Klein
'*  Inhalt:  Standardfunktionen
'*  Datum:   12.12.2001 (zusammengestellt von Bernd Althaus)
'*           14.10.2003  / Schulz
'********************************************************************
'
'==============================================================
Sub AutomatischeSuchBox()
'==============================================================
on error resume next
Anfangsfenster=Application.ActiveWindow.WindowID
Eingabe=inputbox("Bitte Suchanfrage","Automatische Suche")
Application.ActiveWindow.Command "f " & Eingabe, True
End Sub


Sub AutomatischeSuche()
	on error resume next
	Application.ActiveWindow.Title.StartOfField
	Application.ActiveWindow.Title.WordRight 1
	Application.ActiveWindow.Title.EndOfField True
	Application.ActiveWindow.ClipBoard = Application.PicaToLatin(Application.ActiveWindow.Title.GetSelection())
	Application.ActiveWindow.Title.DeleteSelection
	Application.ActiveWindow.Command "f " + Application.ActiveWindow.ClipBoard, True
End Sub



'==============================================================
Sub HoleIDN()
'==============================================================
on error resume next
PPN = Application.ActiveWindow.Variable("P3GPP")
Application.ActiveWindow.CloseWindow
For a=0 To (Application.Windows.Count - 1)
If application.windows(a).Windowid= Anfangsfenster Then
Application.Windows(a).Maximize
Application.ActivateWindow Anfangsfenster 
Application.ActiveWindow.Title.InsertText "!" & PPN & "!"
Exit Sub
End If
Next
msgbox "Fehler, keine IDN oder Erfassungsfenster nicht offen ",,"Hole_IDN"
End Sub


'==============================================================
Sub Merke_IDN()
'==============================================================
on error resume next
Application.ActiveWindow.ClipBoard = "!" & Application.ActiveWindow.Variable("P3GPP") & "!"
End Sub

'==============================================================
Sub Normdaten_Kopie()
'==============================================================
on error resume next
Set A=Application.ActiveWindow
Application.bOverwrite = False
PPN = A.variable("P3GPP")
Typ = A.variable("P3VMC")
A.Command "show d"
A.CopyTitle
A.Command "ein n", False
A.Title.InsertText " *** Normdatenkopie ***" & VbCr
A.PasteTitle
A.Title.EndOfBuffer False
if Typ = "Tb" Then A.Title.InsertText "??? ||!" & PPN & "!"
A.Title.StartOfBuffer False
End Sub

'==============================================================
Sub Titeldaten_Kopie()
'==============================================================
on error resume next
Set A=Application.ActiveWindow
Application.bOverwrite = False
PPN = A.variable("P3GPP")
A.Command "show d"
Kopie=A.CopyTitle
A.Command "ein t", False
A.Title.InsertText " *** Titeldatenkopie ***" & VbCr
A.PasteTitle
A.Title.EndOfBuffer False
A.Title.InsertText "???? !" & PPN & "!"
A.Title.StartOfBuffer False
A.ClipBoard = PPN
End Sub

'==============================================================
Function Datensatzkopie(Typ)
'==============================================================
	Dim Satztyp, Kopie, Schirm
	Schirm = Application.ActiveWindow.Variable("scr")
	Select Case Typ
	Case 1 'Edit-Schirm
		'wegen Zeichensatzproblemen bei *CopyTitle* (GKD-Skripts)
		If  Schirm <> "7A" And Schirm <> "8A" Then
			Fehler "Es liegt kein Datensatz in Kurz- oder Vollanzeige vor!"
		Else
			Application.ActiveWindow.Command "k", False
			Application.ActiveWindow.Title.StartOfBuffer False
			Application.ActiveWindow.Title.EndOfBuffer True
			Kopie = Application.ActiveWindow.Title.GetSelection()
			Application.ActiveWindow.SimulateIBWKey "FE"
		End If
	Case 2 'CopyTitle
		'richtiger Zeichensatz beim Einfuegen nur ueber *PasteTitle*
		If  Schirm <> "8A" Then
			Fehler "Es liegt kein Datensatz in Vollanzeige vor!"
		Else
			Satztyp = left(Application.ActiveWindow.DocType,1)
			'msgbox "Satztyp: " & Satztyp
			Kopie = Application.ActiveWindow.CopyTitle
			Select Case Satztyp
			Case "A"
				Kopie = Mid(Kopie,InStr(Kopie,"0500 "))
			Case "T"
				Kopie = Mid(Kopie,InStr(Kopie,"005 "))
			End Select
		End If
	End Select
	'msgbox Kopie
	Datensatzkopie = Kopie
End Function

'==============================================================
Private Sub HB_Zugang(Text)
'==============================================================
	If Text = "" Then
		Text = "ZENTRALKATALOG Hauptbestand wird geöffnet ..."
	End If
	Info Text,5
	Application.ActiveWindow.NewWindow
	Application.ActiveWindow.ProcessURL "LASP:///ibw/Host=neptun.ddb.de&Port=1036/start", "GET"
End Sub

'==============================================================
Sub ILTISseiten()
'==============================================================
	Set ie5 = CreateObject("internetexplorer.application")
	ie5.visible = True	
	ie5.navigate2 ("http://support.ddb.de/iltis/inhalt.htm")
	Set ie5 = Nothing
End Sub

Sub LinkTrunc()
' früher ANV-Trunk
	Dim strSatztyp
	Dim strSearchTerm, Temp
	Dim bSuche

	on error resume next
	Anfangsfenster=Application.ActiveWindow.WindowID
	strSatztyp = left(Application.ActiveWindow.DocType,2)
	' Go to start of field and expand the selection
	Application.ActiveWindow.Title.StartOfField True
	' Copy selection to the clipboard
	strSearchTerm = Application.ActiveWindow.Title.GetSelection()
	strSearchTerm = Application.PicaToLatin(strSearchTerm) ' Umlaute konvertieren
	' Go to start of field without expanding the selection
	Application.ActiveWindow.Title.StartOfField False
	' Go word right without expanding the selection
	Application.ActiveWindow.Title.WordRight 1, False
	' Go to end of field and expand the selection
	Application.ActiveWindow.Title.EndOfField True
	' Delete selection
	Temp = Application.ActiveWindow.Title.GetSelection()
	Application.ActiveWindow.Clipboard = Application.PicaToLatin(Temp)
	Application.ActiveWindow.Title.DeleteSelection
	If Len(strSatzTyp) = 0 Then ' Suche nach Kat 0500
		Application.ActiveWindow.Title.InsertText "xxxx"	 ' Pseudotext zur anschließenden Suche
		Application.ActiveWindow.Title.FindTag "0500",0,False,True
		Application.ActiveWindow.Title.CharRight 2,True
		strSatzTyp = Application.ActiveWindow.Title.GetSelection
		Application.ActiveWindow.Title.StartOfBuffer,False
		bSuche = Application.ActiveWindow.Title.Find("xxxx",True,False,False)
		If bSuche = True Then
			Application.ActiveWindow.Title.DeleteSelection
		End If
	End If

	LnkCmd = "\LNK " & strSatztyp & " " & "D " & strSearchTerm
	Application.ActiveWindow.Command LnkCmd , True

End Sub

Sub LinkExact()
' früher ANV-Suche
	Dim strSatztyp
	Dim strSearchTerm
	Dim bSuche, NormsatzIDN
	Dim WinID1,WinID2
	Dim Temp,Fehlermeldung
	Dim boolFehler

	on error resume next
	WinID1 = Application.ActiveWindow.WindowID ' aktuelle Fenster-ID sichern
	strSatztyp = left(Application.ActiveWindow.DocType,2)
	' Go to start of field and expand the selection
	Application.ActiveWindow.Title.StartOfField True
	' Copy selection to the clipboard
	strSearchTerm = Application.ActiveWindow.Title.GetSelection()
	strSearchTerm = Application.PicaToLatin(strSearchTerm) ' Umlaute konvertieren
	' Go to start of field without expanding the selection
	Application.ActiveWindow.Title.StartOfField False
	' Go word right without expanding the selection
	Application.ActiveWindow.Title.WordRight 1, False
	' Go to end of field and expand the selection
	Application.ActiveWindow.Title.EndOfField True
	Temp = Application.ActiveWindow.Title.GetSelection()
	Application.ActiveWindow.Clipboard = Application.PicaToLatin(Temp)
	' Delete selection
	Application.ActiveWindow.Title.DeleteSelection
	WinID2 = WinID1
	If Len(strSatzTyp) = 0 Then ' Suche nach Kat 0500
		Application.ActiveWindow.Title.InsertText "xxxx"	 ' Pseudotext zur anschließenden Suche
		Application.ActiveWindow.Title.FindTag "0500",0,False,True
		Application.ActiveWindow.Title.CharRight 2,True
		strSatzTyp = Application.ActiveWindow.Title.GetSelection
		Application.ActiveWindow.Title.StartOfBuffer,False
		bSuche = Application.ActiveWindow.Title.Find("xxxx",True,False,False)
		If bSuche = True Then
			Application.ActiveWindow.Title.DeleteSelection
		End If
	End If
	LnkCmd = "\LNK " & strSatztyp & " " & "D " & chr(34) & strSearchTerm & chr(34)
	Application.ActiveWindow.Command LnkCmd , True
	WinID2 = Application.ActiveWindow.WindowID
	If WinID1 = WinID2 Then
		 Application.ActiveWindow.Title.InsertText Application.LatinToPica(Application.ActiveWindow.Clipboard)
	End If
End Sub	' ----- LinkExact ----