' MacroName: MarcCopy
' MacroDescription: Copy a MARC tag to the clipboard
' Written by: Joel Hahn, Niles Public Library District

Option Explicit

Const CF_TEXT = 1
Const GMEM_SHARE = &H2000  'optional
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const FOR_CLIPBOARD = GMEM_MOVEABLE Or GMEM_ZEROINIT Or GMEM_SHARE  
'may omit GMEM_SHARE

Declare Function OpenClipboard Lib "user.dll" (ByVal hwnd As Integer) _
    As Integer
Declare Function CloseClipboard Lib "user.dll" () As Integer
Declare Function EmptyClipboard Lib "user.dll" () As Integer
Declare Function SetClipboardData Lib "user.dll" (ByVal wFormat As _
    Integer, ByVal hMem As Integer) As Integer
Declare Function GetClipboardData Lib "user.dll" (ByVal wFormat As Integer) _
    As Integer
    
Declare Function GlobalAlloc Lib "krnl386.exe" (ByVal wFlags As Integer, _
    ByVal dwBytes As Long) As Integer
Declare Function GlobalLock Lib "krnl386.exe" (ByVal hMem As Integer) As Long
Declare Function GlobalUnlock Lib "krnl386.exe" (ByVal hMem As Integer) As _
    Integer
Declare Function GlobalFree Lib "krnl386.exe" (ByVal hMem As Long) As Integer

Declare Sub CopyMemory Lib "krnl386.exe" Alias "hmemcpy" (hpvDest _
    As Any, hpvSource As Any, ByVal cbCopy As Long)

sub main
'WARNING! Does not get any fields continued on next page of record!
  Dim nTimeOut as Integer
  Dim CurRow, CurCol, TotalChars, row2, LineLen, ijk, count, j
  Dim CurTag$, MarcData$, MarcTag$, RestOfLine$, InData$, text2$, Indicats$, Subfield$
  Dim i%, NextTest%
  
  Dim CS as Session
  Set CS = CurrentSession

    ' The default timeout for each command is 3 minutes.
    ' Increase this value if your host requires more time
    ' for each command.
    nTimeOut = 10 '180

  CurRow=CS.CursorRow
  CurCol=CS.CursorColumn
  'MsgBox CurRow & "/" & CurCol
  If CurCol>=17 And CurCol<=19 Then
    'CurTag$=Session.ScreenText(CurRow, 17, 1, 3)
    CS.GetTextInRegion CurTag$, CurRow, 17, CurRow, 19
    If Left(CurTag$, 2)="00" Then
      TotalChars=63
      'MarcData$=RTrim(Session.ScreenText(CurRow, 17, 1, TotalChars))
      CS.GetTextInRegion MarcData$, CurRow, 17, CurRow, 79
      MarcData$ = RTrim(MarcData$)
      MarcTag$=Left(MarcData$, 3)
      RestOfLine$=Right(MarcData$, Len(MarcData$)-10)
      InData$=Chr(10)+Chr(13)+MarcTag$+RestOfLine$
      Goto WriteToClipboard
    ElseIf CurTag$="505" Then
      MsgBox "Macro cannot handle 505 fields.  Sorry."
      Goto Done
    End If

    CS.Send Chr(27)+"[B"
    ' Wait for response from host.
    CS.Receive nTimeout, "[?25h"

  text2$="   "
  row2=CS.CursorRow 'row1
  Do Until text2$<>"   "
    row2=row2-1
    'CCS.GetTextInRegion text2$, row2, col1, row2, col1+2
    'text2$=Session.ScreenText(row2, 17, 1, 3)
    CS.GetTextInRegion text2$, row2, 17, row2, 19
  Loop
  'CCS.GetTextInRegion text3$, row2, col1, row1-1, col1+60
  'CCS.GetTextInRegion text3$, row2, col1, CCS.CursorRow-1, col1+60
   LineLen=CS.CursorRow-row2-1
   
DataHandler:
'    LineLen=LastRow-CurRow-1
    TotalChars=63+(LineLen*80)
    
    ''MarcData$=Session.ScreenText(CurRow, 17, 1, TotalChars)
    'MarcData$=Session.ScreenText(row2, 17, 1, TotalChars)
    CS.GetTextInRegion MarcData$, row2, 17, row2+LineLen, 79

    i%=1
    Dim InLin()
    ReDim InLin(100)
    Do
      InLin(i%)=Trim(GetField(MarcData$, (i% * 2) - 1, "ÐÐ")) 'i%, "||"))
      'If i%>1 Then InLin(i%)=Trim(Right(InLin(i%), Len(InLin(i%))-1))
      i%=i%+1
      NextTest%=InStr(NextTest%+1, MarcData$, "ÐÐ") '"||")
    Loop While NextTest%<>0
    count=UBound(InLin)
    j=1
    Do
      If j=1 Then
        MarcTag$=Left(InLin(j), 3)
        Indicats$=Mid(InLin(j), 5, 2)
        Subfield$=Mid(InLin(j), 9, 1)
        RestOfLine$=Right(InLin(j), Len(InLin(j))-10)
        InData$=Chr(10)+Chr(13)+MarcTag$+Indicats$+Subfield$+RestOfLine$
      ElseIf Left(InLin(j), 3) Like "[$][0-9,a-z][ ]" Then
        Subfield$=Mid(InLin(j), 2, 1)
        RestOfLine$=Right(InLin(j), Len(InLin(j))-3)
        InData$=InData$+Chr(10)+Chr(13)+Subfield$+RestOfLine$
      ElseIf InLin(j)="" Then
        Exit Do
      Else
        RestOfLine$=InLin(j)
        InData$=Indata$+RestOfLine$
      End If
      j=j+1
    Loop Until j>count
  End If
  'aa$=InputBox$("InData$:",,InData$)
  For ijk=1 To LineLen+1
    InData$ = InData$ + chr(27)+"[A"
  Next ijk
  InData$ = InData$ + Chr(9)

  CS.Send Chr(27)+"[A"
  CS.Receive nTimeout, "[?25h"

WriteToClipboard:
    Dim hMem As Integer
    Dim pMem As Long
    Dim retval As Integer

    If OpenClipboard(0) Then
       retval = EmptyClipboard()
       hMem = GlobalAlloc(FOR_CLIPBOARD, Len(InData$))
       pMem = GlobalLock(hMem)
       CopyMemory ByVal pMem, ByVal InData$, Len(InData$)
       retval = SetClipboardData(CF_TEXT, hMem)
       retval = GlobalUnlock(hMem)
       retval = GlobalFree(pMem)
       retval = CloseClipboard()
    Else
      MsgBox "There was an error opening the Clipboard.  Exiting..."
    End If


  MsgBox "Copied.  Use the MarcPaste macro to paste into a Passport CCS session."

Done:
end sub