$IF 0
Empfaenger : /FIDO/BASIC.SOURCEN.GER, /¯Wichtig
Antwort in : /FIDO/BASIC.SOURCEN.GER
Absender   : Stephan Eberle @ 2:2426/2310  (Discovery System, Oldenburg)
Betreff    : FidoMailer: Kleine PB-Source (halb halb fertig...)
Datum      : Mo 02.06.97, 07:09  (erhalten: 05.06.97)
Groesse    : 8018 Bytes
----------------------------------------------------------------------
Moin Alle ...

Hier das Ergebnis vierstndiger Portierungsversuche von Pascal
(EMSI.PAS) nach Powerbasic (Wenn mann CALL OPENWINDOW rausnimmt, dann isses
wohl auch mit anderen Dialekten zu kompilieren...)

$ENDIF

%Mouse = 0
$include "stdio.h"
'$Include "PB32.INC"
$include "win_man.h"

Type LogType
  Text as String * 80
end Type

Dim LogFile as Shared LogType

DIM VERSION AS SHARED STRING
VERSION = "0.0"

RINGCOUNTER% = 4
PORT% = 2
BAUD% = 9600

EMSI_INQ$ = "**EMSI_INQC816"
EMSI_REQ$ = "**EMSI_REQA77E"
EMSI_ACK$ = "**EMSI_ACKA490"
EMSI_NAK$ = "**EMSI_NAKEEC3"
SHARED EMSI_INQ$
SHARED EMSI_REQ$
SHARED EMSI_ACK$
SHARED EMSI_NAK$

SHARED Fingerprint$: FingerPrint$ = "{EMSI}"
SHARED SysNode$: SysNode$ = "{2:2426/2310.0}"
SHARED SYSPWD$: SysPwd$ = "{APOLLO}"
SHARED SysLnk$: SysLnk$ = "{8N1}"
SHARED SysProt$: SysProt$ = "{ZMO}"
SHARED SYSProd$: SYSProd$ = "{00}"
SHARED SYSMail$: SYSMail$ = "{MANSKI}"
SHARED SYSVer$: SYSVer$ = "{" + VERSION + "}"
SHARED SYSSer$: SYSSer$ = "{BETA 1}"

'SendEMSIDAT
'print Hexe( )
'End

' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' Div. Subs
' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
SUB SendEMSIDAT
  dim Crc as String * 4

  T$ = FingerPrint$ + SysNode$ + SysPWD$ + SYSLnk$ + SysProt$ + SysProd$ + SysMail$ + SysVer$ + SysSer$
  e$ = t$
  Crc = Hexe( CRC16( "EMSI_DAT" + Hexe( len( e$ )) + e$ ))
  t$ = "**EMSI_DAT" + Hexe( len( e$ )) + e$ + Crc
  Replace Chr$( 13 ) with "" in t$
  Replace chr$( 10 ) with "" in t$
  SendModem( T$ )
End Sub


Function Hexe( T as Word ) as String
dim l as Byte
dim h as byte
dim e as String*4

z$=MKWRD$(T)

l=asc(Left$(z$,1))
h=asc(Right$(z$,1))
shift right l,4
shift right h,4

mid$(e,1,1)=mkbyt$(h)
mid$(e,2,1)=mkbyt$(h and &hf)
mid$(e,3,1)=mkbyt$(l)
mid$(e,4,1)=mkbyt$(l and &hf)
Hexe=e
End Function

Function CRC16( text$ ) as Word
' Gibt einen CRC16 fr TEXT$ aus...
  Dim CRC as long
  Dim n as Word
  crc = 0
  For i = 1 to len( Text$ )
    n = asc( mid$( Text$, i, 1 ))
    Shift left n, 8
    crc = crc xor n
    for r = 0 to 7
      if ( crc and &h8000 ) > 0 then
        n = crc
        shift left n, 1
        crc = n xor &h1021
      else
        n = crc
        shift left n, 1
        crc = n
      end if
    next r
  next w
  CRC16 = ( Crc and &hFFFF )
End Function

SUB Purge STATIC
'L”scht Tastatur- und RS232 - Puffer
  DO
    a$ = INKEY$
  LOOP UNTIL LEN( a$ ) = 0
  IF Port = 0 THEN EXIT SUB
  WHILE NOT EOF( 1 )
    a$ = INPUT$( LOC( 1 ), #1 )
  WEND
END SUB


SUB AddLog( text$ )
' Fgt eine Logzeile an.
  OPEN "MANSKI.LOG" for random as #5 len = Len( LogFile )
  if lof( 5 ) > 0 then
    Seek #5, lof( 5 ) / len( LogFile ) + 1
  end if
  replace chr$( 13 ) with "" in Text$
  replace chr$( 10 ) with "" in Text$
  If Text$ > "" then
    LogFile.Text = Time$ + "  " + Text$
  else
    LogFile.Text = ""
  end if
  Put #5,, LogFile.Text
  if lof( 5 ) / Len( LogFile ) > 15 then
    Seek #5, Lof( 5 ) / Len( LogFile ) - 15
  else
    If Lof( 5 ) > 0 then Seek #5, 1
  end if

  For w = 9 to 24
    Get #5,, LogFile
    Color 7, 0
    Locate w, 1: print LogFile.Text;
  Next w
  close #5
END SUB

SUB SendModem( Strng$ )
  ' Sendet String mit Chr$(13) (ENTER) an Modem
  For i = 1 to len( strng$ )
    PRINT #1, mid$( Strng$, i, 1 );
    Delay .01
  next
  Print #1, chr$( 13 )
End Sub

SUB MAINWIN
  Color 7, 0
  Cls
  Locate 1, 1: color 4, 7: print Space$( 80 );
  Locate 25, 1: color 4, 7: print Space$( 80 );
  Locate 1, 1: print "MANSKI v" + VERSION;
  Color 0, 7: Locate 25, 1: print "ESC - ENDE³";
  Call OpenWindow( 2, 1, 6, 80, colattr%( 11, 3 ), 1, 0 )
  COLOR 7, 0
END SUB

Function GetEMSIREQ as Integer
  Temp$ = ""
  Purge
  Do
    IF NOT EOF( 1 ) THEN IF LOC( 1 ) THEN A$ = INPUT$( 1, #1 )
    Delay .03
    if a$ < > chr$( 10 ) or a$ < > chr$( 13 ) then Temp$ = Temp$ + a$
  loop until len( Temp$ ) = len( EMSI_REQ$ )

  If UCase$( Temp$ ) = Ucase$( EMSI_REQ$ ) then GetEMSIREQ = %TRUE else GetEMSIREQ = %FALSE

End Function

Function GetEMSIACK as Integer
  Temp$ = ""
  Purge
  Do
    IF NOT EOF( 1 ) THEN IF LOC( 1 ) THEN A$ = INPUT$( 1, #1 )
    Delay .03
    If a$ < > chr$( 10 ) or a$ < > chr$( 13 ) then Temp$ = Temp$ + a$
  loop until len( Temp$ ) = len( EMSI_ACK$ )

  If UCase$( Temp$ ) = Ucase$( EMSI_ACK$ ) then GetEMSIACK = %TRUE else GetEMSIACK = %FALSE

End Function

SUB ShowTime
  Static Tim$
  y = csrlin
  x = pos( x )
  If Tim$ < > Time$ then
    color 4, 7
    locate 25, 73: print Time$;
    tim$ = Time$
    locate y, x
    color 7, 0
  end if
End Sub

Function GetBaudStr as String
' Aus dem TIP-Verzeichnis... Ist mal ganz nett...
  OUT &H2FB, &B10000011 'Line-Steuerregister laden
                        '--- Baudrate einlesen
  LoBaud? = INP( &H2F8 )
  HiBaud? = INP( &H2F9 )
                        '--- Register 0 und 1 in den Datenmodus zurckschalten
  OUT &H2FB, &B00000011 'Line-Steuerregister laden

  getBaudStr = Using$( "######",( 115200 / (( HiBaud? * 256 ) + LoBaud? )))
End function

' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' Hauptteil
' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

Call MainWIN
AddLog ""
Addlog "MANSKI v" + VERSION + " coming up."
Addlog "Initializing modem"

OPEN "COM2: 9600,N,8,1,ds" for random as #1
SendModem( "ATS0=0" )

CONNECTED = %FALSE  ' Dies sind Status Flags, die dem Programm anzeigenm in
DIALING = %FALSE    ' Welche Richtung es funktionieren soll... Anrufen etc.

do
  color 15, 7
  y = csrlin
  x = pos( x )
  If Carrier( 2 ) = %TRUE then
    locate 1, 77: print "CAR";         ' Steht fr CARRIER
  else
    locate 1, 77: print "   ";
    If CONNECTED = %TRUE then
      CONNECTED = %FALSE
      locate y, x
      Addlog "CARRIER LOST"
    end if
  end if
  locate y, x
  Color 7, 0
  ShowTime
  c$ = inkey$
  if c$ = "C" then
    Addlog "Dialing"
    SendModem( "atdt*16" )
    DIALING = %TRUE
  end if
  if c$ = chr$( 27 ) then
    if CONNECTED = %TRUE then
      Addlog "HANG UP THE LINE..."
'      Call SetDTR( 2, - 1 )         ' Auflegen durch DTR senken...
      Delay .5                      ' A bissel warten
'      Call SetDTR( 2, 0 )           ' DTR wieder normal...
      Addlog "Ok"
    else
      CLOSE #1
      end
    end if
  end if

  IF NOT EOF( 1 ) THEN IF LOC( 1 ) THEN A$ = INPUT$( 1, #1 )
  IF A$ = CHR$( 10 ) THEN A$ = "" 'Lienfeeds herausfiltern
     'IF A$=CHR$(13) THEN A$=CHR$(13)+CHR$(10)
  IF A$ = CHR$( 8 ) THEN A$ = CHR$( 8 ) + " " + CHR$( 8 ) 'Backspace durchfhren
  If a$ > "" then
    delay .03
    T$ = T$ + A$ ' Eingabe String zusammenbauen
  end if
  If eof( 1 ) then
    if t$ > "" then
      replace chr$( 13 ) with "" in t$
      replace chr$( 10 ) with "" in t$
      if instr( t$, "OK" ) then Addlog "OK"
      if t$ = "RING" then
        Addlog "RING"
        incr r
        if r = RINGCOUNTER% then
          print #1, "ATA"
          r = 0
        end if
      end if
      if instr( t$, "CONNECT" ) then
        Addlog "CONNECT þ SPEED = " + GetBaudStr
        Delay 1
        CONNECTED = %TRUE
        If DIALING = %TRUE then
          addlog "Waiting for EMSI..."
          Tries = 0
          Do
            SendModem( EMSI_INQ$ )
            Delay 1
            Incr Tries
            If Tries > 5 then exit loop
          Loop Until GetEMSIREQ = %TRUE
          Addlog "Yo. Let's use EMSI. Sending our data."
          delay .5

          SendEMSIDAT

          Do
          Loop Until GetEMSIACK = %TRUE

        end if
      end if
      t$ = ""
    end if
  end if
loop
close #1
end