Comment
==========================================================

Copyright 1992-94 by Marc Perkel * All right reserved.

This program is a sample communications program in Marxmenu.
It isn't as good as Procomm, but it isn't half bad for a few
pages of code.

=========================================================
EndComment

Var
  InitString
  Compuserve
  StartTime
  LastFile
  SendingFile


ComPort = Com1             ;your com port
InitString = 'ATZ'         ;your init string
Compuserve = False         ;set to true if accessing Compuserve
ComInitPort(38400,8,'N',1)
if ComResult <> 0
   StandardIO
   Writeln
   Writeln "Can't initialize serial port!"
   ExitMenu
endif
Setup

Writeln 'MarxCom * Copyright 1992-94 by Marc Perkel'
Writeln
Writeln 'Alt-X to Exit * Alt-H to HangUp * PgUp to Upload * PgDn to Download
Writeln
ComWrite InitString CR

Terminal

;----- Set up Communications

Procedure Setup
   Explode Off
   ClearScreenOnExit Off
   BlankTime = 0
   Mouse Off
   NoBoxBorder
   AnsiWindows
   DrawBox 1 1 ScreenWidth ScreenHeight
   Cursor On
   WordStarKeys Off

   ComWriteRecChar On
   ComSendKbdChar On

   if Compuserve
      ComStripHighBit
   endif

   {Set up event logic}

   KeyEvent(PgDnKey) = loc DownLoad
   KeyEvent(PgUpKey) = loc UpLoad
   KeyEvent(AltX)  = loc ExitProgram
   KeyEvent(AltH)  = loc Hangup
   ComXmitAbortProgram = loc XmitAbort
   ComXmitStatusProgram = loc XmitStatus
   ComAcceptFileProgram = loc AcceptFile
   if NovDefaultServer = 'MARX'
      ComNewLineProgram = loc ExamineLastLine
   endif
EndProc


;----- This is the main terminal loop

Procedure Terminal
   repeat
      ComCheckActivity
   forever
EndProc


;----- Exit the Menu

Procedure ExitProgram
   ExitMenu
EndProc


;----- Download Menu

Procedure DownLoad
var FileName Proto
   Proto = PickProtocol
   if Proto = Esc
      Return

   elseif Proto = '1'
      FileName = AskForFileName
      if FileName = '' then return
      ComRecXModem(FileName)

   elseif Proto = '2'
      FileName = AskForFileName
      if FileName = '' then return
      ComRec1kXModem(FileName)

   elseif Proto = '3'
      ComRecYModem

   elseif Proto = '4'
      ComRecYModemG

   elseif Proto = '5'
      ComZRecover On
      ComRecZModem

   elseif Proto = '6'
      ComRecKermit

   endif
   if ComResult <> 0
      Writeln 'Error Status: ' ComResult
      Wait 400
   endif
EndProc


;----- UpLoad Menu

Procedure UpLoad
var FileName Proto
   FileName = AskForFileName
   if (FileName > '') and ExistFile(FileName)
      Proto = PickProtocol
      if Proto = Esc then Return

      SendingFile
      FileName = CleanFileName(FileName)
      Writeln

      if Proto = '1'
         ComSendXModem(FileName)

      elseif Proto = '2'
         ComSend1kXModem(FileName)

      elseif Proto = '3'
         ComSendYModem(FileName)

      elseif Proto = '4'
         ComSendYModemG(FileName)

      elseif Proto = '5'
         ComSendZModem(FileName)

      elseif Proto = '6'
         ComSendKermit(FileName)

      endif

   endif
   SendingFile Off
EndProc


Procedure AskForFileName
var FileName
   DoubleLineBox
   BoxBorderColor LCyan Mag
   BoxInsideColor Yellow Mag
   InverseColor Yellow Red
   DrawBox 10 20 60 3
   Write ' FileName: '
   FileName = Readln
   EraseTopWindow
   Return FileName
EndProc


Procedure PickProtocol
var Ch
   DoubleLineBox
   BoxBorderColor LCyan Mag
   BoxInsideColor Yellow Mag
   InverseColor Yellow Red
   DrawBox 50 7 20 8
   UseArrows On
   Writeln '  1 - XModem'
   Writeln '  2 - XModem 1k'
   Writeln '  3 - YModem'
   Writeln '  4 - YModem G'
   Writeln '  5 - ZModem'
   Write   '  6 - Kermit'
   Ch = ReadKey
   UseArrows Off
   EraseTopWindow
   Return Ch
EndProc


;----- Hangup Modem

Procedure HangUp
   Writeln
   Writeln
   Writeln 'Hanging Up'
   Writeln
   ComDTR Off
   Wait 50
   ComDTR
EndProc


;----- ESC aborts UpLoad or Download

Procedure XmitAbort
var Ch
   if not ComCD then Return True
   if not KbdReady then Return False
   Ch = ReadKey
   if Ch <> Esc then Return False
   Return True
EndProc


;----- Display file transfer status

Procedure XmitStatus
var Progress ProgAdjust BarSize X
   if ComXmitStarting
      DoubleLineBox
      BoxBorderColor LCyan Mag
      BoxInsideColor White Mag
      BoxHeaderColor Yellow Cyan
      BoxHeader ' Transfer Status - ' + ComProtocol + ' '
      DrawBox 43 6 35 11

   elseif ComXmitEnding
      EraseTopWindow
      LastFile = ''
   else

      BarSize = WindowWidth - 9
      if ComFileName <> LastFile
         LastFile = ComFileName
         StartTime = Now
      endif

      GotoXY 1 1
      Write '         File Name: ' ComFileName
      ClearLine
      Writeln

      Write ' Bytes Transferred: ' ComBytesTransferred
      ClearLine
      Writeln

      Write '   Bytes Remaining: ' ComBytesRemaining
      ClearLine
      Writeln

      Write '               CPS: '
      if Now > StartTime
         X = ComBytesTransferred / (Now - StartTime)
         if X / 20 > 0
            X = X / (X / 20) * (X / 20)
         endif
         Write X
      else
         Write '0'
      endif
      ClearLine
      Writeln

      Write '         File Size: ' ComFileSize
      ClearLine
      Writeln

      Write '        Block Size: ' ComBlockSize
      ClearLine
      Writeln

      Write '      Block Errors: ' ComBlockErrors
      ClearLine
      Writeln

      Write '      Total Errors: ' ComTotalErrors
      ClearLine

      if ComFileSize > 0
         ProgAdjust = ComFileSize / BarSize / 2
         Progress = ComBytesTransferred + ProgAdjust * BarSize / ComFileSize
         Writeln
         Write ' ['
         Loop Progress
            Write '°'
         endloop
         Loop BarSize - Progress
            Write ' '
         endloop
         Write '] ' ComBytesTransferred * 100 / ComFileSize '%'
         ClearLine
      endif

   endif
EndProc


;----- Ask to overwrite existing file

Procedure AcceptFile
var Ch
   if ExistFile ComFullFileName
      DoubleLineBox
      BoxBorderColor LCyan Mag
      BoxInsideColor Yellow Mag
      InverseColor Yellow Red
      DrawBox 3 2 length(ComFileName) + 37 3
      UseArrows Off
      Write ' File ' ComFileName ' exists. Replace it? (Y/n) '
      Ch = UpperCase(ReadKey)
      EraseTopWindow
      if Ch = 'N'
         Return False
      else
         DelFile ComFullFileName
         Return True
      endif
   endif
   Return True
EndProc


;----- When calling my BBS I syncronize my server clock to the office.

Procedure ExamineLastLine
var P
   P = pos('Time Sync:',ComLastLine)
   if P = 0 then Return
   ComRTS Off
   NovServerTime = TimeOf(mid(ComLastLine,P + 11,17))
   ComNewLineProgram = Nil
   ComRTS On
EndProc