Garbo/Garbo.cdr/mac/hypercrd/hc1_2_x/hyperftp.sit/HyperFTP/background_2574.txt

Text File | 1990-09-07 | 38KB | 1,401 lines

-- background: 2574 from stack: in
-- bmap block id: 3300
-- flags: 4000
-- background id: 0
-- name: Main
----- HyperTalk script -----
-- HyperFTP background script.  ΓÇ£Most of the smarts is here.ΓÇ¥
-- by Douglas Hornig, @ 1990 by Cornell University

-- selectlineXCMD by Phil Beisel, © Apple Computer, Inc. 1989
-- FileName, NewFileName by Steve Maller, Andrew Gilmartin, Jon Pugh
--   © 1987 Apple Computer & Brown University
-- PopUpMenu by Andrew Gilmartin © Brown University 1989
-- TCPNameToAddr, TCPSend, TCPRecvUpTo, TCPState, TCPRelease, TCPClose,
--   TCPPassiveOpen by Harry Chesley © Apple Computer, Inc. 1989
-- Password, LeafName by Kevin Calhoun
--   ©1989 by the Trustees of Dartmouth College
-- TCPGetAddr, FTPxfer, FTPMacBinXfer, FTPhqXfer, TCPSendUrgent,
--   Translate by Douglas Hornig © Cornell University 1990
-- Thanks to Gaige B. Paulsen of NCSA, for sample MacBinary code.
-- Thanks to Doug Moore of Rice University, for sample BinHex code.

on idle
  global connID, dataID, sLine, partLine, diagTxt

  -- Release the data connection if it is closed
  if dataID is not empty then
    get TCPState( dataID )
    if it contains "close" then
      TCPRelease dataID
      put empty into dataID
    end if
  end if

  -- Check the status of the communications connection
  if connID is empty
  then get "no connection" else get TCPState( connID )
  checkState it
  if it is not "established" then exit idle

  -- Some messages from the host are received at idle time:
  repeat
    get TCPRecvUpTo( connID, linefeed, zero, partLine )
    if it = partLine then exit repeat -- no new messages
    diagMsg it -- display in diagnostic window

    if char 1 of it is "§" then -- error from MacTCP XCMD?
      TCPRelease connID -- abort the connection
      put empty into connID
      exit idle
    end if

    if char length( it ) of it is not linefeed then
      put it into partLine
      exit repeat -- partial line: wait for the rest
    end if
    put empty into partLine -- got a whole line

    get word 1 of it -- extract the FTP response code
    if it is 220 then askUser
    else if it is 221 then quitIt
    else if it is 230 then getDir
    else if it is 331 then askPass
    else if it is 530 then noUser
  end repeat

  -- Change the display depending on if an entry is selected or not:
  if sLine is zero then -- nothing selected
    set the textFont of bg btn "Receive…" to "Chicago Gray"
    set the textFont of bg btn "Display"  to "Chicago Gray"
    set the textFont of bg btn "Delete"   to "Chicago Gray"
    set the name of bg btn id 62 to "Set…"
  else
    set the textFont of bg btn "Receive…" to "Chicago"
    set the textFont of bg btn "Display"  to "Chicago"
    set the textFont of bg btn "Delete"   to "Chicago"
    if the short name of bg btn id 62 is not "Set" -- so selection won't flash
    then set the name of bg btn id 62 to "Set"
    if visible of bg fld "Full Dir"
    then get "Full Dir" else get "Dir List"
    selectlineXCMD "bkg fld" && quote & it & quote, sLine
  end if

  get the number of lines in diagTxt
  if it > 16 then delete line one to it - 16 of diagTxt
end idle

-- Handle changes in the communications state
on checkState theState
  global connID, sLine, diagTxt, diagScroll, partLine

  if theState = bg fld "State" then exit checkState -- no status change
  lock screen

  if theState is "no connection" then
    put empty into bg fld "Dir List"
    put empty into bg fld "Full Dir"
    put empty into bg fld "Path"
    put empty into bg fld "Diag"
    put empty into diagScroll
    put empty into partLine
    put zero into sLine

    set the name of bg btn id 29 to "Connect"
    set the lockText of bg fld "Host Name"  to false
    set the visible  of bg btn "Hide Xfers" to true

    set the textFont of bg btn "Send…"    to "Chicago Gray"
    set the textFont of bg btn "Receive…" to "Chicago Gray"
    set the textFont of bg btn "Display"  to "Chicago Gray"
    set the textFont of bg btn "Delete"   to "Chicago Gray"
    set the textFont of bg btn id 62      to "Chicago Gray" -- "Set"
    set the textFont of bg btn "Create…"  to "Chicago Gray"
    set the icon of bg btn "Parent Dir" to "Sml Up Arrow Gray"
  else
    set the lockText of bg fld "Host Name" to true
  end if

  if theState is "established" then
    set the name of bg btn id 29 to "Disconnect"
    set the visible of bg btn "Hide Xfers" to false

    set the textFont of bg btn "Send…"   to "Chicago"
    set the textFont of bg btn id 62     to "Chicago" -- "Set"
    set the textFont of bg btn "Create…" to "Chicago"
    set the icon of bg btn "Parent Dir" to "Sml Up Arrow"
  end if

  if theState contains "close" then
    TCPClose connID
    TCPRelease connID
    put empty into connID
  end if

  if theState contains "waiting"
  then set the name of bg btn id 29 to "Disconnect"

  put theState into bg fld "State"
  unlock screen
end checkState

-- Initialize various things
on openStack
  global connID, dataID, partLine

  if the version < 1.2 then -- check the HyperCard version
    answer "You must have HyperCard version 1.2 or later."
    go back
    exit openStack
  end if

  lock screen
  put empty into connID
  put empty into dataID
  put empty into partLine
  put empty into bg fld "State" -- set "no connection" state on idle
  put "ASCII" into bg fld "Mode" -- default to ASCII xfer mode

  if item 2 of the loc of card window Γëñ 20 then hide menuBar
  hide msg box
end openStack

-- Finish up various things
on closeStack
  global connID, dataID

  if connID is not empty then
    TCPRelease connID
    put empty into connID
  end if

  if dataID is not empty then
    TCPRelease dataID
    put empty into dataID
  end if

  if the freeSize of this stack ≥ 40960 then -- 40K free space?
    diagMsg "Compacting the stack…"
    put the userLevel into saveLevel
    if saveLevel < 3 then set the userLevel to 3
    send "doMenu Compact Stack" to HyperCard
    set the userLevel to saveLevel
  end if

  show menuBar -- restore the menuBar in case we hid it
end closeStack

-- Open a data connection for transferring a file.
-- Tells the host the data conn. port address and the transfer type.
-- The type code is "A"(ASCII), "I"(image), "M"(MacBinary), "H"(BinHex)
on openData typeCode
  global dataID

  -- MacBinary = Binary and BinHex = ASCII for our purposes here:
  if typeCode is "M" then put "I" into typeCode
  else if typeCode is "H" then put "A" into typeCode

  -- Make sure any previous data connection is released
  repeat until dataID is empty
    idleCursor
    idle
  end repeat

  put TCPPassiveOpen( 0, 0, 0 ) into dataID -- create a new data conn.

  if dataID contains "fail" then
    diagMsg dataID -- display the error msg
    put empty into dataID
    exit to HyperCard -- don't continue with file transfer
  end if

  wait until TCPState( dataID ) contains "waiting" -- happens asynch.

  sendLine "PORT" && TCPGetAddr( dataID, "local" ) -- get local address
  put char 1 of getLine() into resp
  if resp is "2" then
    sendLine "TYPE" && typeCode -- specify the transfer mode
    put char 1 of getLine() into resp

    if resp is "2" and typeCode is "I" then
      sendLine "TYPE L 8" -- set byte length to 8 for Binary
      get getLine() -- ignore the response
    end if
  end if

  if resp is not "2" then
    beep
    TCPClose dataID
    exit to HyperCard -- don't continue with file transfer
  end if
end openData

-- Call when we're done with a data connection (transfer completed)
on closeData
  global dataID

  TCPClose dataID -- close and let idle handler take care of release
  if the result is not empty then diagMsg the result
end closeData

-- Hang out while the data connection is being established
function WaitForDataCon
global dataID

repeat until TCPState( dataID ) is "established"
  if TCPState( dataID ) contains "close" then return false
  idleCursor
end repeat

return true -- signal connection is established
end WaitForDataCon

-- Return a line from the communications conn. 15 second time limit.
function getLine
global connID

repeat 15 times
  set the cursor to busy
  get TCPRecvUpTo( connID, linefeed, 60, empty )
  if it is not empty then exit repeat
end repeat

diagMsg it -- display the message
return it
end getLine

-- Send some text (with return & linefeed) over comm. connection
on sendLine text
  global connID

  TCPSend connID, text & return & linefeed
end sendLine

-- Call idleCursor repeatedly while waiting for something.
on idleCursor
  global lastTurn

  get the seconds
  if it Γëá lastTurn then
    set the cursor to busy -- spin the ball
    put it into lastTurn
  end if
end idleCursor

-- Request a user ID.
on askUser
  ask "User name:" with "anonymous"
  if it is not empty then sendLine "USER" && it
end askUser

-- Request a user password
on askPass
  lock screen
  get Password( "Enter the password:" )
  unlock screen
  if it is not empty then sendLine "PASS" && it
end askPass

-- Host requested end of session
on quitIt
  global connID

  TCPClose connID
  if the result is not empty then diagMsg the result
end quitIt

-- called by getDir with a parameter "short" or "long".
-- "short" puts an NLST file list into the field "Dir List",
-- "long" puts a LIST file list into the field "Full DIr"
on readDir shtLng -- shtLng = short or long
  global dataID

  put empty into DirList
  openData "A" -- use ASCII mode transfer
  if shtLng is "long" then sendLine "LIST" else sendLine "NLST"

  if char 1 of getLine() is "1" then
    if WaitForDataCon() then
      FTPxfer dataID, "receive", "ascii" -- get the directory list
      get the result

      if char 1 of it is not "§" then put it into DirList
      else diagMsg it
    end if
  end if

  closeData -- close the data port
  lock screen
  if shtLng is "long" then
    get line one of DirList
    if word one of it is "Total" or offset( ":<", it ) is not zero
    then delete line one of DirList -- Unix and Tops-20 add a top line

    put "Full Dir" into fldName
  else put "Dir List" into fldName -- shtLng is "short"

  get length( DirList )
  if it >= 29900 then delete char 29900 to it of DirList
  put DirList into bg fld fldName
  set the scroll of bg fld fldName to zero
  unlock screen

  if DirList is not empty then get getLine() -- get final response
end readDir

-- Get a new directory list from the host.  Also requests path.
on getDir
  global PWDcmd, sLine

  put zero into sLine -- no entry is selected
  put empty into bg fld "Full Dir"
  readDir "short"
  if visible of bg fld "Full Dir" then readDir "long"

  -- Update the path name field: Try both "PWD" and "XPWD" commands.
  if PWDcmd is empty then put "PWD" into PWDcmd

  repeat 2 times -- may have to try both "PWD" and "XPWD"
    sendLine PWDcmd -- send the command
    put getLine() into pathMsg -- get the result

    get word 1 of pathMsg
    if it is 226 or it is 250
    then put getLine() into pathMsg -- skip any left-over msg from NLST

    if char 1 of pathMsg is "2" then exit repeat

    if PWDcmd is "PWD" -- try the other command
    then put "XPWD" into PWDcmd
  else put "PWD"  into PWDcmd
end repeat

get offset( quote, pathMsg ) -- extract the path name (hopefully)
if it is not zero then
  delete char 1 to it of pathMsg
  get offset( quote, pathMsg )
  put char 1 to it-1 of pathMsg into bg fld "Path"
else
  put empty into bg fld "Path" -- couldn't get the path
end if
end getDir

-- Host didn't get user ID
on noUser
  send mouseUp to bg btn "Disconnect"
end noUser

-- Request new directory on the host
function changeDir remoteFile
put offset( ".dir", remoteFile ) into dirOffset
if dirOffset Γëá 0 then
  get char dirOffset + 4 of remoteFile
  if it is ";" or it is empty -- fix VMS directory names
  then delete char dirOffset to length( remoteFIle ) of remoteFile
end if

sendLine "CWD" && remoteFile

get char 1 of getLine()
if it is "2" or it is "3" then -- positive response?
  getDir -- update the Entries and Path fields
  return true
end if

return false -- didn't work
end changeDir

-- Delete a file or directory on the host
on deleteFile remoteFile
  answer "Really delete ΓÇÿ" & remoteFile & "ΓÇÖ?" with "OK" or "Cancel"
  if it is "Cancel" then exit deleteFile

  sendLine "DELE" && remoteFile
  if char 1 of getLine() is "2" then getDir
end deleteFile

-- Display a file from the host
on showText remoteFile, theText
  lock screen
  go card "Show Text"
  put theText into cd fld "The Text"
  set the scroll of cd fld "The Text" to zero
  put remoteFile into cd fld "File Name"
  set the visible of cd fld "Too Long" to ( length( theText ) ≥ 29900 )
  unlock screen with visual effect iris open fast
end showText

-- Return a single-character flag for transfer mode.
function xferType
get bg fld "Mode"
if it is "ASCII"     then return "A"
if it is "Binary"    then return "I" -- Image
if it is "MacBinary" then return "M"
return "H" -- must be BinHex
end xferType

-- Send an ABORT command to the host.  Ir must be preceeded by a Telnet
-- Interrupt Process and a Synch (Data Mark in an Urgent packet.
on sendABOR
  global connID, dataID

  TCPSendUrgent connID, NumToChar(255) & NumToChar(244) & NumToChar(255) & NumToChar(242) -- send urgent IP & synch
  sendLine "ABOR" -- then send abort command
  repeat while TCPState( dataID ) is "established"
    if TCPRecvUpTo( dataID, empty, zero, empty ) is not empty
    then set cursor to busy -- read any left over data
  end repeat
end sendABOR

-- Transfer a file from the host.
-- Pass "file" or "memory" in fileMemory.
on receiveFile remoteName, fileMemory
  global dataID

  if fileMemory is "memory" then
    put "A" into xType
    put empty into localFile -- signal receive into memory
  else -- fileMemory is "file"
    put bg fld "Mode" into theMode
    put empty into otherMode
    get length( remoteName )
    get char it-2 to it of remoteName -- get last 3 chars of remoteName

    if it is "bin" and theMode is not "MacBinary"
    then put "MacBinary" into otherMode
  else if it is "hqx" and theMode is not "BinHex"
  then put "BinHex" into otherMode
else if it is not "bin" and it is not "hqx" and ( theMode is "MacBinary" or theMode is "BinHex" )
then put "ASCII" into otherMode

if otherMode is not empty then
  answer "Use" && theMode && "or" && otherMode && "transfer mode?" with theMode or otherMode or "Cancel"
  if it is "Cancel" then exit receiveFile
  put it into bg fld "Mode"
end if
put xferType() into xType

if xType is "A" or xType is "I" then
  -- Note: MacBinary and BinHex ask for their own localFile name
  put remoteName into namePrompt
  put NewFileName( "Save as:", namePrompt ) into localFile
  if localFile is empty then exit receiveFile -- pressed cancel
end if
end if

openData xType -- open data port using selected xfer type
sendLine "RETR" && remoteName

if char 1 of getLine() is "1" then
  if WaitForDataCon() then
    if xType is "M" then FTPMacBinXfer dataID, "receive" -- MacBinary
    else if xType is "H" then FTPhqXfer dataID, "receive" -- BinHex
    else FTPxfer dataID, "receive", xType, localFile -- ASCII or Bin
    put the result into xferResult

    if char 1 of xferResult is "§"
    then
    answer xferResult -- must be important
    sendABOR -- send abort command to the host
  else if fileMemory is "memory"
  then showText remoteName, xferResult -- display the file
end if
end if

closeData  -- close data port
end receiveFile

-- Transfer a file to the host
on sendFile fileMemory, remName, sendText
  global dataID

  if fileMemory is "memory" then
    put "A" into xType
    put empty into localName
  else -- fileMemory is "file"
    put xferType() into xType
    if xType is "A" -- ASCII transfer?
    then put FileName( "TEXT" ) into localName -- show only TEXT files
  else put FileName()         into localName -- show all files
  if localName is empty then exit sendFile

  put Translate( " ;|\,/{}[]<>!@#$%^&*()~`+='" & quote, "_", LeafName( localName ) ) into remName -- remove path & weird chars

  if xType is "M" then put ".bin" after remName
  else if xType is "H" then put ".hqx" after remName
end if

ask "Name to save as on the host:" with remName
if it is empty then exit sendFile
put it into remName

openData xType -- open data port using selected xfer type
sendLine "STOR" && remName

if char 1 of getLine() is not "1" then
  closeData -- just close the data port

else
  if WaitForDataCon() then
    if xType is "M" -- MacBinary?
    then FTPMacBinXfer dataID, "send", localName
  else if xType is "H" -- BinHex?
  then FTPhqXfer dataID, "send", localName
else FTPxfer dataID, "send", xType, localName, sendText

if char 1 of the result is "§" -- an error?
then answer the result

closeData -- close the data port
if char 1 of getLine() is "2" then getDir -- refresh the Dir List
end if
end if
end sendFile

-- Change to the parent directory on the host.
-- Some FTP servers use CDUP and others use XCUP so try them both.
-- If neither works then try ΓÇÿCWD ..ΓÇÖ
on cdup
  global CDUPcmd

  if CDUPcmd is empty then put "CDUP" into CDUPcmd -- first try "CDUP"

  repeat 3 times
    sendLine CDUPcmd -- change to parent directory
    if char 1 of getLine() is "2" then -- did it work?
      getDir -- update Entries and Path fields
      exit repeat
    end if

    -- didn't work so try the other commands
    if CDUPcmd is "CDUP" then put "XCUP" into CDUPcmd
    else if CDUPcmd is "XCUP" then put "CWD .." into CDUPcmd
    else put "CDUP" into CDUPcmd
  end repeat
end cdup

-- Clicking the mouse in the bkgrd will deselect a Dir List entry:
on mouseUp
  global sLine
  put zero into sLine
end mouseUp

on diagMsg theMsg
  global diagTxt, diagScroll

  get line one of theMsg
  put it & return after diagTxt
  put empty into diagScroll
  put it into bg fld "Diag"
end diagMsg

-- Pressing up/down arrows will select previous/next entry.
-- Except that option-uparrow with perform a CDUP.
on arrowKey whichKey
  global sLine

  if whichKey is up and ( the optionKey is down or sLine is zero ) then
    cdup -- change to the parent directory on the host
    exit arrowKey
  end if

  if sLine is not zero then -- any line selected?
    if whichKey is up and sLine > 1 then subtract 1 from sLine
    else if whichKey is down and sLine < the number of lines in bg fld "Dir List" then add 1 to sLine
  end if
end arrowKey

--  Pressing return is like clicking on the Connect button.
on returnKey
  autoConnect
end returnKey

on autoConnect
  if the short name of bg btn id 29 is "Connect" then
    set the hilite of bg btn id 29 to true
    wait 15 ticks
    set the hilite of bg btn id 29 to false
    send "connect" to bg btn id 29
  end if
end autoConnect

-- dirZoom is called by the Directory list 'zoom' box buttons.
on dirZoom inOut -- inOut is "in" or "out"
  set the icon of the target to "Zoom Box Star"

  repeat while the mouse is down
    if the mouseLoc is within the rect of the target
    then set the icon of the target to "Zoom Box Star"
  else set the icon of the target to "Zoom Box"
end repeat

set the icon of the target to "Zoom Box" -- reset icon on mouseUp
if the mouseLoc is not within the rect of the target then exit dirZoom

put ( inOut = "out" ) into fullDisp
if bg fld "Full Dir" is empty and fullDisp is true then readDir "long"

lock screen
set the visible of bg fld "Full Dir" to fullDisp
set the visible of bg btn "Zoom In"  to fullDisp

if fullDisp then
  set the scroll of bg fld "Full Dir" to the scroll of bg fld "Dir List"
  unlock screen with visual iris open fast
else
  set the scroll of bg fld "Dir List" to the scroll of bg fld "Full Dir"
  unlock screen with visual iris close fast
end if
end dirZoom

-- Take care of a click on a line.  Select it if it's the first click.
-- If the second click either change to it if it's a directory
-- or retrieve it if it's a file.
on lineClick
  global sLine

  get ( ( the clickV - top of the target + scroll of the target ) div textHeight of the target ) + 1

  if it = sLine then getFile -- a double-click
  else
    if it > the number of lines of the value of the target then get zero
    put it into sLine -- single-click: just select the line
  end if
end lineClick

-- Receive a file or change to a directory:
-- (called by lineClick or by pressing return in a field)
on getFile
  global sLine

  get line sLine of bg fld "Dir List"
  if not changeDir( it ) then receiveFile it, "receive"
end getFile

-- The FTP XCMDs generate FTPprogress messages every 10K bytes or so.
on FTPprogress bytes
  set cursor to busy
  put "Bytes transferred:" && bytes into bg fld "Diag"
end FTPprogress

-- The FTP XCMDs generate an FTPrate message at the end of a transfer.
-- For HC1.2, FTPMacBinXfer and FTPhqXfer set the global stdOpnTicks.
on FTPrate bytes, elapTicks
  global stdOpnTicks

  if stdOpnTicks is not empty then subtract stdOpnTicks from elapTicks
  put elapTicks / 60 into elapSecs
  if elapSecs is zero then leave FTPrate

  put numberFormat into numFormat
  set numberFormat to "0.#"
  diagMsg bytes && "bytes in" && elapSecs && "seconds =" && bytes / elapSecs && "bytes per second"
  set numberFormat to numFormat
  put empty into stdOpnTicks
end FTPrate


-- part 45 (field)
-- low flags: 01
-- high flags: 0002
-- rect: left=13 top=320 right=334 bottom=484
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: Diag


-- part 29 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=345 top=18 right=47 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Connect
----- HyperTalk script -----
-- this button can have one of two names and is set by the bg script
on mouseUp
  do the short name of me -- "connect" or "disconnect"
end mouseUp

-- establish a connection with a host
on connect
  global connID

  if bg fld "Host Name" is empty then
    diagMsg "Please enter a host name or address"
    exit connect
  end if

  diagMsg "Finding the address for host ΓÇÿ" & bg fld "Host Name" & "ΓÇÖ"
  set cursor to busy -- this may take a while…
  get TCPNameToAddr( bg fld "Host Name" )

  if char 1 of it is "§" then
    if it contains "couldn't open resource"
    then diagMsg "MacTCPΓäó has not been installed."
  else diagMsg "Can't get the IP address for ΓÇÿ" & bg fld "Host Name" & "ΓÇÖ"
  exit connect
end if

diagMsg "Opening FTP connection"
put TCPActiveOpen( item 1 of it, 21, 0 ) into connID -- 21 = ftp

if connID contains "fail" then
  diagMsg connID
  put empty into connID
end if
end connect

-- Close the communication connection
on disconnect
  global connID

  if bg fld "State" is "established" then
    sendLine "QUIT" -- be nice and send a quit cmd to the host
    if getLine() is not empty then exit disconnect -- wait for close
  end if

  TCPClose connID -- something must be wrong so just close it
end disconnect



-- part 37 (field)
-- low flags: 01
-- high flags: 0004
-- rect: left=148 top=35 right=55 bottom=307
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 2
-- text size: 12
-- style flags: 512
-- line height: 16
-- part name: State


-- part 53 (field)
-- low flags: 00
-- high flags: 0002
-- rect: left=54 top=12 right=30 bottom=305
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Host Name
----- HyperTalk script -----
-- Make pressing return or enter in the Host Name field
-- automatically connect to the host.
-- It also prevents return chars from getting into the field text.

on returnInField
  autoConnect -- send msg to background
end returnInField

on enterInField
  autoConnect -- send msg to background
end enterInField


-- part 54 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=387 top=111 right=127 bottom=485
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 111
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Send╔
----- HyperTalk script -----
on mouseUp
  sendFile "file" -- send message to background handler
end mouseUp



-- part 62 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=387 top=202 right=218 bottom=471
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 111
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Set╔
----- HyperTalk script -----
-- Set the current directory on the host.
on mouseUp
  global sLine

  if sLine is not zero and the optionKey is up then
    get line sLine of bg fld "Dir List" -- use selected entry name
  else
    ask "Change directory to:" with bg fld "Path" -- else prompt w/ path
    if it is empty then exit mouseUp
  end if

  get changeDir( it ) -- send message to background script
end mouseUp



-- part 64 (field)
-- low flags: 01
-- high flags: 0004
-- rect: left=91 top=75 right=95 bottom=492
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 12
-- style flags: 512
-- line height: 16
-- part name: Path
----- HyperTalk script -----
-- Update Entries and Directory fields.
-- It should not be necessary to do but it can come in handy sometimes.
on mouseUp
  global connID

  if connID is not empty then -- must be connected to a host
    put empty into bg fld "Path"
    put empty into bg fld "Dir List"
    getDir -- request new dir info from the host
  end if
end mouseUp



-- part 66 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=387 top=129 right=145 bottom=485
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 111
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Receive╔
----- HyperTalk script -----
on mouseUp
  global sLine

  if sLine is not zero
  then put line sLine of bg fld "Dir List" into remoteName
else put empty into remoteName

if the optionKey is down then
  ask "Name of the file to receive:" with remoteName
  if it is empty then exit mouseUp
  put it into remoteName
end if

if remoteName is empty then
  beep
  exit mouseUp
end if

receiveFile remoteName, "file" -- call bg script
end mouseUp



-- part 67 (button)
-- low flags: 00
-- high flags: 0000
-- rect: left=463 top=12 right=30 bottom=481
-- title width / last selected line: 0
-- icon id / first selected line: 26635 / 26635
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Help
----- HyperTalk script -----
on mouseUp
  global showFullDir

  lock screen
  get the hilite of me
  set the hilight of me to not it

  if it is true then
    set the visible of bg fld "Full Dir" to showFullDir
    set the visible of bg btn "Zoom In"  to showFullDir
    put empty into showFullDir
    go card "Main"
  else
    put the visible of bg fld "Full Dir" into showFullDir
    set the visible of bg fld "Full Dir" to false
    set the visible of bg btn "Zoom In"  to false
    go card "Info"
  end if

  unlock screen with visual effect dissolve fast
end mouseUp



-- part 71 (button)
-- low flags: 00
-- high flags: 0004
-- rect: left=307 top=12 right=30 bottom=327
-- title width / last selected line: 0
-- icon id / first selected line: 11893 / 11893
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Host List
----- HyperTalk script -----
-- Display the Host List pop-up menu.
-- Select an entry and it will be put into the Host Name field and
-- the Connect button will be pressed.  Select Edit Host List from the
-- menu to modify the menu contents.

on mouseDown
  put bg fld "Host Name" into HostName
  if HostName is not empty
  then put "!" & NumToChar(18) & HostName & ";-;" into HostName
  put cd fld "Host List" of card "Host List" into HostList
  put HostList into xHostList
  if HostList is not empty then put ";-;" after xHostList

  get PopUpMenu( HostName & xHostList & "<IEdit Host List…", empty, left of card window + left of me + 1, top  of card window + top  of me + 1 )

  if it is empty then exit mouseDown -- no menu item was chosen
  if HostName is not empty then subtract 2 from it
  if it < 1 then get bg fld "Host Name"
  else get word 1 of line it of HostList -- get the host name

  if it is empty then -- edit host list?
    visual effect iris open fast
    go card "Host List"
  else
    if the short name of bg btn id 29 is "Disconnect" then
      beep
      answer "Disconnect before choosing another host"
    else
      put it into bg fld "Host Name"
      if the optionKey is not down then autoConnect
    end if
  end if
end mouseDown

on mouseUp
  -- don't send mouseUp to bg
end mouseUp



-- part 74 (button)
-- low flags: 00
-- high flags: 2000
-- rect: left=460 top=33 right=53 bottom=485
-- title width / last selected line: 0
-- icon id / first selected line: 21700 / 21700
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Home
----- HyperTalk script -----
on mouseUp
  go home
end mouseUp



-- part 75 (button)
-- low flags: 00
-- high flags: 2000
-- rect: left=473 top=204 right=218 bottom=487
-- title width / last selected line: 0
-- icon id / first selected line: 21012 / 21012
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Parent Dir
----- HyperTalk script -----
-- Change to the parent directory on the host.
on mouseUp
  cdup -- send msg to bkg script
end mouseUp



-- part 76 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=387 top=147 right=163 bottom=485
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 111
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Display
----- HyperTalk script -----
on mouseUp
  global sLine

  if sLine is not zero
  then put line sLine of bg fld "Dir List" into remoteName
else put empty into remoteName

if the optionKey is down then
  ask "Name of the file to display:" with remoteName
  if it is empty then exit mouseUp
  put it into remoteName
end if

if remoteName is empty then
  beep
  exit mouseUp
end if

receiveFile remoteName, "memory" -- call bg script
end mouseUp



-- part 77 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=387 top=165 right=181 bottom=485
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 111
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Delete
----- HyperTalk script -----
-- Delete a file or directory from the host:
on mouseUp
  global sLine

  if sLine is not zero
  then put line sLine of bg fld "Dir List" into remoteName
else put empty into remoteName

if the optionKey is down then
  ask "Name of the file to delete:" with remoteName
  if it is empty then exit mouseUp
  put it into remoteName
end if

if remoteName is empty then
  beep
  exit mouseUp
end if

answer "Really delete ΓÇÿ" & remoteName & "ΓÇÖ?" with "Delete" or "Cancel"
if it is "Delete" then
  sendLine "DELE" && remoteName
  if char 1 of getLine() is "2" then getDir -- refresh the dir list
end if
end mouseUp



-- part 78 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=387 top=220 right=236 bottom=485
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 111
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Create╔
----- HyperTalk script -----
-- Create a new directory on the host.
-- Some FTP servers use MKD and others use XMKD so try them both.

on mouseUp
  global MKDcmd

  ask "New directory name:"
  if it is empty then exit mouseUp
  put it into newDir

  if MKDcmd is empty then put "MKD" into MKDcmd -- first try "MKD"

  repeat 2 times
    sendLine MKDcmd && newDir -- create the directory
    if char 1 of getLine() is "2" then -- did it work?
      get changeDir( newDir ) -- change to the new dir
      exit repeat
    end if

    if MKDcmd is "MKD" -- didn't work so try the other command
    then put "XMKD" into MKDcmd
  else put "MKD"  into MKDcmd
end repeat
end mouseUp



-- part 73 (button)
-- low flags: 00
-- high flags: 0000
-- rect: left=381 top=105 right=240 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Hide Xfers
----- HyperTalk script -----
-- this button is made visible while there is no connection
-- in order to disable the buttons underneath it.
on mouseUp
  diagMsg "First enter a host name and press the Connect button"
  beep
end mouseUp



-- part 79 (field)
-- low flags: 03
-- high flags: 0007
-- rect: left=91 top=104 right=288 bottom=371
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 12
-- style flags: 0
-- line height: 14
-- part name: Dir List
----- HyperTalk script -----
-- Take care of a click on a line.  Select it if it's the first click.
-- If the second click either change to it if it's a directory
-- or retrieve it if it's a file.
on mouseUp
  lineClick
end mouseUp

-- Pressing the Return key is just like double-clicking on an Entry
on returnInField
  getFile
end returnInField



-- part 80 (field)
-- low flags: 01
-- high flags: 0002
-- rect: left=387 top=262 right=280 bottom=478
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Mode
----- HyperTalk script -----
-- Display a pop-up menu when the Mode field is selected.

on mouseDown
  put "ASCII,Binary,MacBinary,BinHex" into menuItems
  if me is "ASCII" then put 1 into curItem
  else if me is "Binary" then put 2 into curItem
  else if me is "MacBinary" then put 3 into curItem
  else put 4 into curItem -- must be BinHex

  get PopUpMenu( menuItems, curItem, left of card window + left of me + 1, top of card window + top of me + 1 ) -- display the pop-up menu

  if it is empty then exit mouseDown -- nothing was selected

  put item it of menuItems into me -- replace the contents of the field
end mouseDown

on mouseUp
  -- don't pass mouseUp to bg script
end mouseUp


-- part 81 (button)
-- low flags: 00
-- high flags: 0002
-- rect: left=341 top=106 right=118 bottom=353
-- title width / last selected line: 0
-- icon id / first selected line: 9018 / 9018
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Zoom Out
----- HyperTalk script -----
on mouseDown
  if bg fld "State" is not "established" then exit mouseDown
  dirZoom "out"
end mouseDown

on mouseUp
end mouseUp


-- part 83 (field)
-- low flags: 81
-- high flags: 0007
-- rect: left=11 top=104 right=288 bottom=497
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 4
-- text size: 9
-- style flags: 0
-- line height: 14
-- part name: Full Dir
----- HyperTalk script -----
-- Take care of a click on a line.  Select it if it's the first click.
-- If the second click either change to it if it's a directory
-- or retrieve it if it's a file.
on mouseUp
  lineClick
end mouseUp

-- Pressing the Return key is just like double-clicking on an Entry
on returnInField
  getFile
end returnInField



-- part 82 (button)
-- low flags: 80
-- high flags: 0002
-- rect: left=467 top=106 right=118 bottom=479
-- title width / last selected line: 0
-- icon id / first selected line: 9018 / 9018
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Zoom In
----- HyperTalk script -----
on mouseDown
  dirZoom "in"
end mouseDown

on mouseUp
end mouseUp


-- part 84 (button)
-- low flags: 00
-- high flags: 2000
-- rect: left=486 top=311 right=323 bottom=498
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Diag Up
----- HyperTalk script -----
-- Scroll up through the recent diagnostic lines
on mouseDown
  global diagTxt, diagScroll

  if diagScroll is empty
  then put the number of lines in diagTxt into diagScroll
  put zero into time2scroll -- scroll once right away
  put 45 into scInterval -- first scroll interval

  repeat while diagScroll > one
    get the ticks
    if it ≥ time2scroll then
      put it + scInterval into time2scroll -- set next time to scroll
      put 15 into scInterval -- set scroll interval from now on
      subtract one from diagScroll
      put line diagScroll of diagTxt into bg fld "Diag"
    end if

    if the mouse is up then exit repeat -- check mouse after loop
  end repeat
end mouseDown

on mouseUp
  -- don't pass mouseUp msg
end mouseUp


-- part 85 (button)
-- low flags: 00
-- high flags: 2000
-- rect: left=486 top=322 right=334 bottom=498
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Diag Down
----- HyperTalk script -----
-- Scroll down through the recent diagnostic lines
on mouseDown
  global diagTxt, diagScroll

  put the number of lines in diagTxt into numLines
  if diagScroll is empty then put numLines into diagScroll
  put zero into time2scroll -- scroll once right away
  put 45 into scInterval -- first scroll interval

  repeat while diagScroll < numLines
    get the ticks
    if it ≥ time2scroll then
      put it + scInterval into time2scroll -- set next time to scroll
      put 15 into scInterval -- set scroll interval from now on
      add one to diagScroll
      put line diagScroll of diagTxt into bg fld "Diag"
    end if

    if the mouse is up then exit repeat -- check mouse after loop
  end repeat
end mouseDown

on mouseUp
  -- don't pass mouseUp msg
end mouseUp