'MacroName:MarcCopy
'MacroDescription:Copy OCLC data to windows clipboard in Libs+ format
'Written by: Joel Hahn, Niles Public Library District

'$Include "NIKUTILS!IncludeFunctions"

Dim subf as Integer

Declare Function LCCN(indata$)
Declare Function DoubleO(indata$)
Declare Function NineTen(indata$)
Declare Function LDR(indata$)

sub main
  Dim CS As Object
  Set CS = CreateObject("CatME.Application")
  
  Clipboard.Clear
  
  Err = 0
  On Error Resume Next
  CS.GetActiveRecord
  If Err>0 Then
    MsgBox "There is not an active record in the display"
    Goto Done
  End If
  On Error Goto 0

  bool = CS.GetSelectedText(InText$)

  Buffer$ = ChopLeft(InText$, 1)
  For y = 1 to Len(Buffer$)
    If Mid(Buffer$, y, 1) = Chr(255) Then Mid(Buffer$, y, 1) = Chr(220)
  Next y

  'If Right(Buffer$, 2) = BadEndTest$ Then Buffer$ = ChopRight(Buffer$, 2)
  'If Right(Buffer$, 3) = BadEndTest$ + Chr(220) Then Buffer$ = ChopRight(Buffer$, 3)
  If Right(Buffer$, 1) = Chr(220) Then 
    Buffer$ = ChopRight(Buffer$, 1)
  'Else
  '  Buffer$ = ChopRight(Buffer$, 2)
  End If
  
  '************************************************************************

Lines=1
For h=1 to LEN(Buffer$)
  if mid(Buffer$, h, 1)=CHR$(220) then Lines=Lines+1
Next h

li=1 '2
Do While li<=Lines
    a$ = a$ + Chr(13) 'CCSSession.Send "\r"
  b$=GetField(Buffer$, li, CHR$(220))
  If b$ = "" Then b$ = Buffer$
  If Asc(Right(b$, 1))<32 Then b$ = ChopRight(b$, 2)
  If Left(b$, 3) = "005" Then
    a$ = ChopRight(a$, 1)
  End If

GetLine:
  dim c$
  dim d$
  dim delim as String
  delim=CHR$(223)

  subf=0  '# of subfields
  subc=0  'subfield progress counter
  de=0    '0=1st subfield is $a; 1=1st subfield is not $a

  'Get tag & indicators; jump to special line handler for
  'lines not handled in the standard way
  If Left(b$, 3) = "005" Then 
    Goto SkipTab
  ElseIf Left(b$, 2)="00" Then 'Mid(b$, 8, 2)="00" Then
    'Goto DoubleO
    a$ = a$+DoubleO(b$)
    Goto Retn
  ElseIf Left(b$, 3)="010" Then 'Mid(b$, 8, 3)="010" Then 
    'Goto LCCN
    a$ = a$+ LCCN(b$)  
    Goto Retn
  ElseIf Left(b$, 3)="910" Then 'Mid(b$, 8, 3)="910" Then
    'Goto NineTen
    a$ = a$+NineTen(b$)
    Goto Retn
  ElseIf Left(b$, 3)="LDR" Then
    a$ = LDR(b$)
    Goto Retn
  Else
    a$=a$ + Left(b$, 3) + Mid(b$, 5, 2) 'Mid(b$, 8, 3)+Mid(b$, 12, 2)
  End If
  If Mid(b$, 8, 1)<>delim Then
    a$=a$+"a"
    de=0
  Else
    de=1
  End If

SubfieldCount:
  For i=8 to Len(b$)
    If Mid(b$, i, 1)=delim Then subf=subf+1
    If subf=0 Then subf=1
  Next i
  If de=1 then subf=subf+1

SubfieldLoop:
  Dim subx as Integer
  Dim lenD as Integer
  subx=0
  subc=1
  Do
    c$=GetField(b$, subc, delim)
    If c$ = "" Then c$ = b$
    If (subc<>1) or (de=1) Then d$=Mid(c$, 3, Len(c$)-2)
    If subc<>1 Then 
      a$=a$+Mid(c$, 1, 1)
      If Len(d$)>50 Then
        lenD=Len(d$)
        subx=lenD\50  'should be same as Int(.../50)
        If (lenD MOD 50)=0 Then
          subx=subx-1
        End If
      End If
    Else
      If de=1 Then
        Goto Looper
      Else
        d$=RTrim(Mid(c$, 8, Len(c$)-7))
        If Len(d$)>50 Then
          lenD=Len(d$)
          subx=lenD\50  'should be same as Int(.../50)
          If (lenD MOD 50)=0 Then
            subx=subx-1
          End If
        End If
      End if
    End if
    a$=a$+d$
    If subc<>subf Then a$=a$+Chr(13) '"\r"
Looper:
    subc=subc+1
  Loop While subc<=subf

Retn:
  'CCSSession.Send a$
  If li<=Lines Then
    If de=1 then subf=subf-1
    For i=1 to (subf+subx)
      a$ = a$ + Chr(27) + "[A" 'CCSSession.Send "\x1B[A"
    Next
    If Left(b$, 3)<>"LDR" Then
      a$ = a$ + Chr(9) ' CCSSession.Send "\x09"
    End If
  End If
SkipTab:
  li=li+1
Loop

  '************************************************************************

  Clipboard.SetText a$

Done:
end sub


'***************************************************
Function DoubleO(b$)
b$=RTrim(b$)
a$=Left(b$, 3) 'Mid(b$, 8, 3)

If Left(b$, 3) = "006" Then 'Mid(b$, 8, 3)="006" Then
  c$=Trim(Mid(b$, 8)) 'Right(Left(b$, Len(b$)-1), Len(b$)-7)
  a$=a$+c$
  subf=1
ElseIf Left(b$, 3) = "007" Then

SubfieldCount2:
delim=Chr$(223)
subf=1
  For i=8 to Len(b$)
    If Mid(b$, i, 1)=delim Then subf=subf+1
  Next i

SubfieldLoop2:
subc=1
del1=0
Do
  c$=GetField(b$, subc, CHR$(223))
  If c$="" Then c$ = b$
  If subc=1 Then
    del2=1
    d$=Mid(c$, 8, 1) ' Len(c$)-16)
  Else
    del2=ASC(Mid(c$, 1, 1))-96
    d$=Mid(c$, 3, 1)  ' Len(c$)-3)
  End if
  If del2<>del1+1 Then
    If del2=4 Then 
      a$=a$+"u"
    Else
      dash=del2-(del1+1)
        For k=1 to dash
          a$=a$+"-"
        Next k
    End If
  End If
  a$=a$+d$
  del1=del2
  subc=subc+1
Loop While subc<=subf
Else 'Headers
  If Left(b$, 3) = "001" Then
    a$ = a$ + "ocm"
    d$=Right("00000000" + Mid(b$, 8), 8)
  Else
    d$ = Mid(b$, 8)
  End If
  a$ = a$ + d$
  If Left(b$, 3) = "001" Then
    a$ = a$ + Chr(13) + "003OCoLC"
  End If
End If : subf=1
DoubleO = a$
End Function

'***************************************************
Function LCCN(b$)
  dim lc$
  dim ln$

  If Mid(b$, 8, 1)<>delim Then
    a$=Left(b$, 3)+"  a" 'Get Marc tag
    de=0
  Else
    de=1
  End If

SubfieldCountLCCN:
  For i=8 to Len(b$)
    If Mid(b$, i, 1)=delim Then subf=subf+1
    If subf=0 Then subf=1
  Next i
  If de=1 then subf=subf+1

'  lc$=RTrim(Mid(b$, 16, Len(b$)-16))
'  asci=ASC(Left(lc$, 1))
'  If ASC(Left(lc$, 1))>97 and ASC(Left(lc$, 1))<123 Then
'    a$=a$+Left(lc$, 2)+" "
'    lc$=Right(lc$, Len(lc$)-2)
'  Else
'    a$=a$+"   "
'  End If
'  a$=a$+Left(lc$, 2)
'
'  lc$=Right(lc$, Len(lc$)-3)
'  j=1
'  Do While j<=Len(lc$)
'    check=ASC(Mid(lc$, j, 1)) 
'    If check<48 or check>57 Then
'        ln$=LTrim(Mid(lc$, j, Len(lc$)-(j-1)))
'        lc$=Left(lc$, j-1)
'        Exit Do
'    End If
'    j=j+1
'  Loop
'
'  If 6-Len(lc$)<>0 Then
'    For i=1 to (6-Len(lc$))
'      lc$="0"+lc$
'    Next i
'  End if
'  subf=1
'  a$=a$+lc$+" "+ln$

SubfieldLoopLCCN:
'  Dim subx as Integer
'  Dim lenD as Integer
  subx=0
  subc=1
  Do
    lc$="" : ln$=""
    c$=GetField(b$, subc, CHR$(223))
    If c$ = "" Then c$ = b$
    If (subc<>1) or (de=1) Then d$=Mid(c$, 3, Len(c$)-2)
    If subc<>1 Then 
      a$=a$+Mid(c$, 1, 1)
      If Len(d$)>50 Then
        lenD=Len(d$)
        subx=lenD\50  'should be same as Int(.../50)
        If (lenD MOD 50)=0 Then
          subx=subx-1
        End If
      End If
    Else
      If de=1 Then
        Goto LooperLCCN
      Else
        d$=RTrim(Mid(c$, 8, Len(c$)-7))
        If Len(d$)>50 Then
          lenD=Len(d$)
          subx=lenD\50  'should be same as Int(.../50)
          If (lenD MOD 50)=0 Then
            subx=subx-1
          End If
        End If
      End if
    End if

  lc$=d$ 'RTrim(Mid(b$, 16, Len(b$)-16))
  asci=ASC(Left(lc$, 1))
  If ASC(Left(lc$, 1))>96 and ASC(Left(lc$, 1))<123 Then
    If ASC(Mid(lc$, 2, 1))>96 and ASC(Mid(lc$, 2, 1))<123 Then
      a$=a$+Left(lc$, 2)+" "
      lc$=Right(lc$, Len(lc$)-2)
    Else
      a$=a$+Left(lc$, 1)+"  "
      lc$=Right(lc$, Len(lc$)-1)
    End If
  Else
    a$=a$+"   "
  End If
  a$=a$+Left(lc$, 2)

  lc$=Right(lc$, Len(lc$)-3)
  j=1
  Do While j<=Len(lc$)
    check=ASC(Mid(lc$, j, 1)) 
    If check<48 or check>57 Then
        ln$=LTrim(Mid(lc$, j, Len(lc$)-(j-1)))
        lc$=Left(lc$, j-1)
        Exit Do
    End If
    j=j+1
  Loop

  If 6-Len(lc$)<>0 Then
    For i=1 to (6-Len(lc$))
      lc$="0"+lc$
    Next i
  End if
  'subf=1
  a$=a$+lc$+" "+ln$

    If subc<>subf Then a$=a$+"\r"
LooperLCCN:
    subc=subc+1
  Loop While subc<=subf
LCCN = a$
End Function

'***************************************************
Function NineTen(b$)
  a$=Left(b$, 3)+"00a" 'Get Marc tag & Libs+ indicators & subfield
  c$=RTrim(Mid(b$, 8, Len(b$)-7))
  a$=a$+c$+"000"
  subf=1
  NineTen = a$
End Function

Function LDR(b$)
  LDR = Chr(1) + "g" + Mid(b$, 8, 3) + Mid(b$, 12, 2) + Chr(1) + "J"
End Function