*************** This is the Form code ************************


Private Sub Command1_Click()
Call Main
End Sub

Private Sub Command2_Click()
' Stop and Exit
Timer1.Enabled = False
Timer2.Enabled = False
UnmapViewOfFile (SharedMemPointer)
CloseHandle (SharedMemHandle)
For T = 1 To 8
  If Inuse(T) = 1 Then
    Winsock1(T).Close
  End If
Next T
End

End Sub

Private Sub Timer1_Timer()
'  This procedure checks to make sure that all of
'  the clients are still connected.  If they
'  have disconnected, it frees up their socket
For T = 1 To 8
  If Inuse(T) = 1 Then
    If Winsock1(T).State <> 7 Then
      '  This socket has disconnected...close it
      Call AddText("Socket " + CStr(T) + " in use by " + CStr(Form1.Winsock1(T).RemoteHostIP) + " has disconnected.")
      Winsock1(T).Close
      Conx(T) = ""
      '  Release the socket id back to the application
      Inuse(T) = 0
    End If
  End If
Next T

End Sub

Private Sub Timer2_Timer()
CopyMemory F, ByVal SharedMemPointer, Len(F)
Packet(1) = "~01" + CStr(F.x)
Packet(2) = "~02" + CStr(F.y)
Packet(3) = "~03" + CStr(F.z)
Packet(4) = "~04" + CStr(F.xDot)
Packet(5) = "~05" + CStr(F.yDot)
Packet(6) = "~06" + CStr(F.zDot)
Packet(7) = "~07" + CStr(F.alpha)
Packet(8) = "~08" + CStr(F.beta)
Packet(9) = "~09" + CStr(F.gamma)
Packet(10) = "~10" + CStr(F.pitch)
Packet(11) = "~11" + CStr(F.roll)
Packet(12) = "~12" + CStr(F.yaw)
Packet(13) = "~13" + CStr(F.mach)
Packet(14) = "~14" + CStr(F.kias)
Packet(15) = "~15" + CStr(F.vt)
Packet(16) = "~16" + CStr(F.gs)
Packet(17) = "~17" + CStr(F.windOffset)
Packet(18) = "~18" + CStr(F.nozzlePos)
Packet(19) = "~19" + CStr(F.internalFuel)
Packet(20) = "~20" + CStr(F.externalFuel)
Packet(21) = "~21" + CStr(F.fuelFlow)
Packet(22) = "~22" + CStr(F.rpm)
Packet(23) = "~23" + CStr(F.ftit)
Packet(24) = "~24" + CStr(F.gearPos)
Packet(25) = "~25" + CStr(F.speedBrake)
Packet(26) = "~26" + CStr(F.epuFuel)
Packet(27) = "~27" + CStr(F.oilPressure)
Packet(28) = "~28" + CStr(F.lightBits)
For T = 1 To 28
  Packet(T) = Left$(Packet(T) + String$(30, " "), 16)
Next T
For T = 1 To 8
If Inuse(T) <> 0 Then
  If Winsock1(T).State = 7 Then
    Select Case Conx(T)
    Case "MF"
      Winsock1(T).SendData Packet(3) + Packet(7) + Packet(9) + Packet(10) + Packet(11) + Packet(12) + Packet(14) + Packet(18) + Packet(19) + Packet(20) + Packet(21) + Packet(22) + Packet(23) + Packet(26) + Packet(27)
    Case "AL"
      Winsock1(T).SendData Packet(3)
    End Select
  Else
    Call AddText("Socket " + CStr(T) + " in use by " + CStr(Form1.Winsock1(T).RemoteHostIP) + " has disconnected.")
    Winsock1(T).Close
    Inuse(T) = 0
    Conx(T) = ""
  End If
End If
Next T

End Sub

Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
For T = 1 To 8
  If Inuse(T) = 0 Then
    '  We've found an empty socket...let's use it.
    Winsock1(T).Accept requestID
    Call AddText("Socket " + CStr(T) + " allocated to " + CStr(Winsock1(T).RemoteHostIP))
    Inuse(T) = 1
    GoTo ValidSocket
  End If
Next T
MsgBox ("No sockets are available")
End
ValidSocket:
End Sub

Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim StrData As String
Winsock1(Index).GetData StrData

' Registration of Client
If Left$(StrData, 3) = "(*)" Then
  Call IDClient(Index, StrData)
End If
End Sub


*************   This is the Module Code *********************

Public Type FlightData
  x As Single               'x
  y As Single               'y
  z As Single               'z
  xDot As Single            'xDot
  yDot As Single            'yDot
  zDot As Single            'zDot
  alpha As Single           'alpha
  beta As Single            'beta
  gamma As Single           'gamma
  pitch As Single           'pitch
  roll As Single            'roll
  yaw As Single             'yaw
  mach As Single            'mach
  kias As Single            'kias
  vt As Single              'vt
  gs As Single              'gs
  windOffset As Single      'windOffset
  nozzlePos As Single       'nozzlePos
  internalFuel As Single    'internalFuel
  externalFuel As Single    'externalFuel
  fuelFlow As Single        'fuelFlow
  rpm As Single             'rpm
  ftit As Single            'ftit
  gearPos As Single         'gearPos
  speedBrake As Single      'speedBrake
  epuFuel As Single         'epuFuel
  oilPressure As Single     'oilPressure
  lightBits As Integer      'lightbits
End Type

Global SharedMemHandle As Long, SharedMemPointer As Long, Conx(8) As String, Inuse(8), F As FlightData, Packet(28) As String


Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal numbytes As Long)
Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Sub Main()
Call AddText("Waiting for Falcon to Start")

StartMemCheck:
SharedMemHandle = OpenFileMapping(FILE_MAP_READ, True, "FalconSharedMemoryArea")
If SharedMemHandle Then
  SharedMemPointer = MapViewOfFile(SharedMemHandle, FILE_MAP_READ, 0, 0, 0)
Else
  CloseHandle (SharedMemHandle)
  Call Pause(2)
  GoTo StartMemCheck
End If

Call AddText("Connected to Falcon 4")


' Start timer for polling
' Timer 1 is for checking if a connection has dropped
Form1.Timer1.Interval = Val(GetInfo("Timer1", "Interval"))
Form1.Timer1.Enabled = True
'  Timer 2 is for the variable update routine
Form1.Timer2.Interval = Val(GetInfo("Timer2", "Interval"))
Form1.Timer2.Enabled = True

'  Zero is the Winsock instance we'll listen for connection
'  requests on.
Form1.Winsock1(0).LocalPort = 1001
Form1.Winsock1(0).Listen

' Make 8 instances available for use
For T = 1 To 8
  Load Form1.Winsock1(T)
  Call AddText("Connection " + CStr(T) + " ready.")
  DoEvents
Next T

End Sub

Sub AddText(TxtData)
  Form1.Text1.Text = Form1.Text1.Text + TxtData + Chr$(13) + Chr$(10)
End Sub

Sub Pause(S)
  S = S + Timer
  While Timer < S
    DoEvents
  Wend
End Sub

Function GetInfo(Key$, KeyVal$)
  RtVal$ = Space$(128)
  RtCode = GetPrivateProfileString(Key, KeyVal$, "", RtVal$, 128, "F4Server.ini")
  GetInfo = Left$(RtVal$, RtCode)
End Function

Sub IDClient(Index, StrData)
If StrData = "(*)MF" Then
  AddText ("MFD Client Registered")
  Conx(Index) = Mid$(StrData, 4)
End If
If StrData = "(*)AL" Then
  AddText ("Altimeter Client Registered")
  Conx(Index) = Mid$(StrData, 4)
End If
End Sub



****************  This is the F4Server.ini file *************************


[Timer1]
Interval = 3000

[Timer2]
Interval = 150