Diskussion:Medizinische Fachzeitschriften (Liste mit Links zu freiem Volltext und Signaturenverzeichnis der ZBMed Köln)

Bzgl. der Kölner Signaturen: Tippfehlerquote <3%; Anteil der hier erfaßten an den dort vorhandenen Beständen vielleicht 20%. Keine Angabe von Verfügbarkeitszeiträumen. Eine Liste ist halt immer noch die bequemere Art, ansonsten gilt: hier findet man alles

Hier der Transformations Quellcode:

 Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click
       Dim pm As String
       Dim pmm As String
       Dim pmt As String
       Dim pmti As Integer
       Dim pmj As String
       Dim pmk As String
       Dim dmm As String
       Dim lin2 As Integer
       Dim lin1 As Integer
       Dim odoa As String = Chr(13) + Chr(10)
       pm = infilestr("c:/MEDLINE/free2.txt")
       pm = pm
       lin1 = 0
       Do While lin1 > -1
           lin2 = pm.IndexOf(odoa)
           If lin2 > 2 Then
               pmm = pm.Substring(lin1, lin2 - lin1)
               pmm = pmm + "ü"
               pmt = pmm.Substring(8, 20) + "."
               pmti = pmt.IndexOf(".")
               pmt = pmt.Substring(0, pmti)
               If pmm.Length > 42 Then
                   pmj = pmm.Substring(38, 4)
                   If pmj = "    " Then pmj = "----"
               Else : pmj = "----"
               End If
               If lin2 > 43 Then pmk = pmm.Substring(43, lin2 - 43) Else pmk = ""
               dmm = dmm + " " + "%22" + morphcstr(pmt, " ", "-") + "%22%5BJournal%5D " + morphcstr(pmt, " ", "-") + " " + deltacstr(25, pmt, " ") + "[ " + pmj + "]" + deltacstr(8, pmt, " ") + pmk + odoa
               pm = pm.Substring(lin2 + 2)
           Else
               lin1 = -1
           End If
       Loop
       Clipboard.SetText(dmm)
       Stop
   End Sub
Function deltacstr(ByVal lenn As Integer, ByVal texxt As String, ByVal texxp As String) As String
       Dim nn As Integer
       Dim nm As Integer
       nn = lenn - texxt.Length
       For nm = 1 To nn
           deltacstr = deltacstr + texxp
       Next
   End Function
   Function morphcstr(ByVal texxt As String, ByVal crweg As String, ByVal crneu As String)
       Dim nm As Integer
       Dim nn As Integer
       Dim ni As String
       nn = texxt.Length
       For nm = 0 To nn - 1
           ni = texxt.Substring(nm, 1)
           If ni <> crweg Then morphcstr = morphcstr + ni Else morphcstr = morphcstr + crneu
       Next
   End Function
Private Function infilestr(ByVal path As String)
       Dim vart1 As Integer
       Dim idir1 As String
       Dim ifil1 As String
       Dim ifil2 As String
       vart1 = path.LastIndexOf("\")
       idir1 = path.Substring(0, vart1 + 1)
       ifil1 = path.Substring(vart1 + 1)
       ifil2 = "bla|" + ifil1
       OpenFileDialog1.InitialDirectory = idir1
       OpenFileDialog1.Filter = ifil2
       OpenFileDialog1.FileName = ifil1
       OpenFileDialog1.FileName = idir1 + ifil1
       If OpenFileDialog1.CheckFileExists() = True Then
           Using sr As New StreamReader(path)
               infilestr = sr.ReadToEnd.ToString
               sr.Close()
           End Using
       Else
           infilestr = "nichtda"
       End If
   End Function