VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000005&
   Caption         =   "Vernier UV-Vis Spectrometer"
   ClientHeight    =   9375
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   16500
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   12
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MinButton       =   0   'False
   ScaleHeight     =   625
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   1100
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   60000
      Left            =   10440
      Top             =   0
   End
   Begin VB.CommandButton ClearGraph 
      Appearance      =   0  'Flat
      Caption         =   "Next User"
      BeginProperty Font 
         Name            =   "Calibri"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   7440
      TabIndex        =   8
      Top             =   5640
      Width           =   3375
   End
   Begin VB.ListBox List1 
      BeginProperty Font 
         Name            =   "Calibri"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   6135
      Left            =   10920
      TabIndex        =   7
      Top             =   1320
      Width           =   3015
   End
   Begin VB.TextBox DirectoryBox 
      BeginProperty Font 
         Name            =   "Calibri"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   10920
      TabIndex        =   6
      Top             =   840
      Width           =   3015
   End
   Begin VB.PictureBox Graph 
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4455
      Left            =   240
      ScaleHeight     =   -111
      ScaleLeft       =   250
      ScaleMode       =   0  'User
      ScaleTop        =   110
      ScaleWidth      =   650
      TabIndex        =   3
      Top             =   840
      Width           =   10575
   End
   Begin VB.CommandButton Blank 
      Appearance      =   0  'Flat
      Caption         =   "Blank"
      BeginProperty Font 
         Name            =   "Calibri"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   2
      Top             =   5640
      Width           =   3375
   End
   Begin VB.CommandButton ScanSample 
      Appearance      =   0  'Flat
      Caption         =   "Scan"
      BeginProperty Font 
         Name            =   "Calibri"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3840
      TabIndex        =   1
      Top             =   5640
      Width           =   3375
   End
   Begin VB.CommandButton Exit 
      BackColor       =   &H80000005&
      Caption         =   "X"
      BeginProperty Font 
         Name            =   "Calibri"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   13800
      MaskColor       =   &H00FFFFFF&
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   0
      Width           =   255
   End
   Begin VB.Label Label8 
      Alignment       =   2  'Center
      BackColor       =   &H8000000E&
      Caption         =   "versus"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   5160
      TabIndex        =   16
      Top             =   480
      Width           =   735
   End
   Begin VB.Label Label7 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Wavelength (nm )"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   6240
      TabIndex        =   15
      Top             =   405
      Width           =   2295
   End
   Begin VB.Label Label6 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Absorbance ( )"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   2520
      TabIndex        =   14
      Top             =   405
      Width           =   2295
   End
   Begin VB.Label Label5 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "WaveNumber (1/cm)"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   9000
      TabIndex        =   13
      Top             =   480
      Width           =   1815
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Transmittance (%)"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   480
      Width           =   1815
   End
   Begin VB.Label DateLabel 
      BackColor       =   &H8000000E&
      Caption         =   "Date"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2640
      TabIndex        =   11
      Top             =   120
      Width           =   1815
   End
   Begin VB.Label Label3 
      BackColor       =   &H8000000E&
      Caption         =   "ICN DATA COLLECTION:"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   120
      Width           =   2295
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "   Enter ICN Account Name  in the text box below"
      BeginProperty Font 
         Name            =   "Calibri"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   10920
      TabIndex        =   9
      Top             =   120
      Width           =   3015
   End
   Begin VB.Label HelpLine 
      BackColor       =   &H80000005&
      Caption         =   "Help Line"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2295
      Left            =   240
      TabIndex        =   5
      Top             =   6240
      Width           =   10575
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label1 
      BackColor       =   &H80000005&
      Caption         =   "250"
      BeginProperty Font 
         Name            =   "Calibri"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   5280
      Width           =   10695
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Dim PixelNumber As Integer ' pixel number from the edit box
Dim StopScanning As Integer ' stop scanning flag for continuous acquisition
Dim Background(1900)
Dim Spectra(1900, 7)
Dim SpectraNbr As Integer
Dim Intensity(1900)
Dim StartTime
Dim PreFix$
''''''''''''''''''''''''''''''''''''''''''/
'Additional declarations added here

Dim ServerName As String
Dim Directory
Dim HTMLRow$(500)
Dim HTMLRowNumber As Integer
''''''''''''''''''''''''''''''''''''''''''/
'This call gives us the hWnd (window handle) of the screen
Private Declare Function GetDesktopWindow Lib "user32" () As Long

'This call assigns an hDC (handle of device context) from an hWnd
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

'BitBlt lets us draw an image from a hDC to another hDC (in our case, from an hDC of the screen capture to the hDC of a VB picture box)
Private Declare Function BitBlt Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal opCode As Long) As Long

'ReleaseDC will be used to clear out the hDC we generate for the screen capture.
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Dim ScanBlankFlag As Integer
Dim First As Integer, Last As Integer, WL1 As Integer, WL2 As Integer, MinY, MaxY
'FTP variables:
Dim hOpen As Long, hConnection As Long, hFile As Long
Dim dwType As Long
Dim dwSeman As Long

Private Sub ClearGraph_Click()
Dim x, y
  Graph.Cls
  List1.Clear
  DirectoryBox.Text = ""
  For y = 25 To 100 Step 25: Graph.Line (240, y)-(850, y), QBColor(7): Next y
  For x = 250 To 850 Step 50: Graph.Line (x, -1)-(x, 110), QBColor(7): Next x
  SpectraNbr = 0
  HelpLine.Caption = "Enter your lab name in the box at the top right of this page."
  DateLabel.Caption = Date$
End Sub

Private Sub Form_Load()
  Me.Top = 0
  Me.Left = 0
  Me.Width = 1366 * Screen.TwipsPerPixelX
  Me.Height = 768 * Screen.TwipsPerPixelY
'Set up FTP
  hOpen = InternetOpen("My VB Test", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
  If hOpen = 0 Then
    ErrorOut Err.LastDllError, "InternetOpen"
    Unload Form1
  End If
  dwType = FTP_TRANSFER_TYPE_BINARY
  'dwType = FTP_TRANSFER_TYPE_ASCII
  dwSeman = 0 'Active symantic ftp, not spelling error: semantic? and 0 is active.
  'dwSeman = INTERNET_FLAG_PASSIVE
  hConnection = 0
  
Dim i, s$
'Set up Ocean Optics Spectrometer
'ServerName = "130.111.192.243"
  ServerName = "interchemnet.um.maine.edu"
  
'Open json file template and store in HTMLRow$(I) array
  Open App.Path + "\ICNhtml.txt" For Input As 1
  i = 0
  While Not EOF(1)
    i = i + 1
    Line Input #1, HTMLRow$(i)
  Wend
  HTMLRowNumber = i
  Close 1
  Open App.Path + "\CalNbrs.txt" For Input As 1
    Input #1, WL1
    Input #1, WL2
    Input #1, First
    Input #1, Last
    Input #1, MaxY
    Input #1, PreFix$
  Close 1
  SpectraNbr = 0
  Graph.ScaleLeft = 240
  Graph.ScaleWidth = 610
  
  s$ = "            "
  Label1.Caption = "   250" & s$ & "300" & s$ & "350" & s$ & "400" & s$ & "450" & s$ & " 500" & s$ & "550" & s$ & "600" & s$ & "650" & s$ & "700" & s$ & "750" & s$ & "800"
  s$ = "This program must have the Vernier LoggerLite Program running in the background." + Chr$(13)
  s$ = s$ + "Close all other programs and double click Default.gmbl" + Chr$(13)
  s$ = s$ + "On the Logger program menu, click Experiment, Change Units and then %Transmittance" + Chr$(13)
  s$ = s$ + "Click Experiment again, Calibrate, Spectrometer 1. Wait, then click Disable Calibration." + Chr$(13)
  s$ = s$ + "Then click the Collect icon. Select Erase and Continue if needed." + Chr$(13)
  s$ = s$ + "Click on this program to bring it to the front. Click Next User."
  HelpLine.Caption = s$
  StartTime = Timer
End Sub
Private Sub Form_Unload(Cancel As Integer)
  If hConnection <> 0 Then InternetCloseHandle hConnection
  hConnection = 0
  HelpLine.Caption = "Disconnected."
  End
End Sub

Private Sub Blank_Click()
  'Clear background array
  Erase Background
  'Graph.Cls
  Scan 1  '1 is for Blank
  
End Sub
Private Sub Exit_Click()
  Dim w$
  w$ = InputBox$("To calibrate, block beam path and enter password, or click cancel.")
  If w$ = "dark" Then
    'Clear background array
    Graph.Cls
    w = MsgBox("Block light path completely and click OK")
    Scan 0 '0 is for Dark Background
  ElseIf w$ = "exit" Then
    Open App.Path + "\CalNbrs.txt" For Output As 1
      Print #1, WL1
      Print #1, WL2
      Print #1, First
      Print #1, Last
      Print #1, MaxY
      Print #1, PreFix$
      Print #1, "First 2 are Wavelength Range, next 2 are first and last is MaxY Dark Value."
    Close 1
    End
  End If
End Sub

Private Sub ScanSample_Click()
  If ScanBlankFlag = 0 Then MsgBox ("A Blank is required before a %T or A scan."): Exit Sub
  Scan 3  '2 is for %T scan, Nbr=3 is for A scan.
End Sub
Private Sub DirectoryBox_KeyUp(KeyCode As Integer, Shift As Integer)
 Dim i1 As Integer, i2 As Integer, w$, ww$
 Dim ftpcheck As Boolean
 
 If KeyCode = 13 Then
  'Open connection to FTP server
    'Make sure all connections are closed.
    If hConnection <> 0 Then
        InternetCloseHandle hConnection
    End If
    'Now open the specified connection
    hConnection = InternetConnect(hOpen, "ftp.umeche.maine.edu", INTERNET_INVALID_PORT_NUMBER, "DebugUser", "Test2015", INTERNET_SERVICE_FTP, dwSeman, 0)
    If hConnection = 0 Then
        ErrorOut Err.LastDllError, "InternetConnect"
        Exit Sub
    Else
        HelpLine.Caption = "Connected to ftp.umeche.maine.edu"
    End If
    
    'Now connect to specified directory
    
    If (FtpSetCurrentDirectory(hConnection, DirectoryBox.Text) = False) Then
       ErrorOut Err.LastDllError, "FtpSetCurrentDirectory"
       Exit Sub
    Else
       HelpLine.Caption = "Directory is changed to " & DirectoryBox.Text
    End If
  
  'Clear listbox and add current datafile names to List1
  List1.Clear
  Dim szDir As String
  Dim hFind As Long
  Dim nLastError As Long
  Dim dError As Long
  Dim ptr As Long
  Dim pData As WIN32_FIND_DATA

  hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
  nLastError = Err.LastDllError
  If hFind = 0 Then
        If (nLastError = ERROR_NO_MORE_FILES) Then
            MsgBox "This directory is empty!"
        Else
            ErrorOut Err.LastDllError, "FtpFindFirstFile"
        End If
        Exit Sub
  End If

  dError = NO_ERROR
  Dim bRet As Boolean
  szDir = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
  List1.AddItem (szDir)
  Do
        pData.cFileName = String(MAX_PATH, 0)
        bRet = InternetFindNextFile(hFind, pData)
        If Not bRet Then
            dError = Err.LastDllError
            If dError = ERROR_NO_MORE_FILES Then
                Exit Do
            Else
                ErrorOut Err.LastDllError, "InternetFindNextFile"
                InternetCloseHandle (hFind)
                Exit Sub
            End If
        Else
            szDir = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
            List1.AddItem (szDir)
        End If
  Loop
   
  Dim szTemp As String
  szTemp = String(1024, Chr$(0))
  If (FtpGetCurrentDirectory(hConnection, szTemp, 1024) = False) Then
    ErrorOut Err.LastDllError, "FtpGetCurrentDirectory"
    Exit Sub
  End If
  'MsgBox szDir, , "Directory Listing of: " & szTemp
  InternetCloseHandle (hFind)
  'Make sure all connections are closed.
  If hConnection <> 0 Then
        InternetCloseHandle hConnection
  End If
  w$ = "Your data will automatically be stored on the ICN server. To access it from your computer, tablet or smart phone, "
  w$ = w$ & "write down this address in your notebook: http://icn2.umeche.maine.edu/DataFiles/" & DirectoryBox.Text & "/index.html" & Chr$(13)
  w$ = w$ & " Enter the address in the address bar of a browser like Internet Explorer, Chrome, Firefox..."
  HelpLine.Caption = w$
 End If
End Sub

Private Sub Scan(Nbr As Integer)
  Dim ScreenColor As Long
  Dim Counter As Integer
  Dim x As Long, y As Long, y0 As Long
  Dim i As Integer, s1, s2, w1, w2
  Dim Ix As Integer
  Dim WL, s, A
  Dim FileName As String
  
  Dim DC As Long
  Dim T0
  
 'First, shrink this window
    Me.Top = 0
    Me.Left = 0
    Me.Width = 1980
    Me.Height = 570
    T0 = Timer: While (Timer - T0) < 1: Wend 'Wait 1 seconds for spectrometer and screen
    'Get the hWnd of the screen
    Dim scrHwnd As Long
    scrHwnd = GetDesktopWindow
    'Now, assign an hDC to the hWnd we generated
    Dim shDC As Long
    shDC = GetDC(scrHwnd)
    'Determine the size of the screen
    Dim screenWidth As Long, screenHeight As Long
    screenWidth = Screen.Width \ Screen.TwipsPerPixelX
    screenHeight = Screen.Height \ Screen.TwipsPerPixelY
    'Copy the pixel data from the screen into our form
    BitBlt Me.hDC, 0, 0, screenWidth, screenHeight, shDC, 0, 0, vbSrcCopy
    'Release our hold on the screen DC
    ReleaseDC scrHwnd, shDC
    Me.Picture = Me.Image
   
   
    't0 = Timer
    'Analyze
    'Hide all boxes and controls
    Blank.Visible = False
    ClearGraph.Visible = False
    DateLabel.Visible = False
    DirectoryBox.Visible = False
    Form1.Exit.Visible = False
    Graph.Visible = False
    HelpLine.Visible = False
    List1.Visible = False
    ScanSample.Visible = False
    Label1.Visible = False
    Label2.Visible = False
    Label3.Visible = False
    Label4.Visible = False
    Label5.Visible = False
    Label6.Visible = False
    Label7.Visible = False
    Label8.Visible = False
    
  ScreenColor = 0
  Counter = 0
  'Screen size 1920 by 1080, x range max: 100 to 1525, y range max: 100 to 1000
  'Laptop Screen size 1366 by 768, x range max: 100 to 1350, y range max: 100 to 1000
  'erase Intensity
  'Expand Form for analysis
  Me.Width = 1366 * Screen.TwipsPerPixelX
  Me.Height = 768 * Screen.TwipsPerPixelY
  'MsgBox ("ok1?")
  'Find the first point on plotted data
  x = First
  For y = 125 To 665
    ScreenColor = Me.Point(x, y)
    If ScreenColor = 3342591 Then Intensity(x) = y: y0 = y: y = 750: Counter = 1
  Next y
  If Counter = 0 Then MsgBox ("Couldn't find data"): Exit Sub
  'To save time, utilize fact that line is continuous and search there and step outward
  For x = First + 3 To Last Step 3
    For y = 1 To 100
      ScreenColor = Me.Point(x, y0 + y)
      If ScreenColor = 3342591 And (y0 + y) < 666 Then
        Intensity(x) = y0 + y:      y0 = y0 + y: y = 999: Counter = Counter + 1
      End If
      ScreenColor = Me.Point(x, y0 - y)
      If ScreenColor = 3342591 And (y0 - y) > 124 Then
        Intensity(x) = y0 - y:      y0 = y0 - y: y = 999: Counter = Counter + 1
      End If
    Next y
    If y = 101 Then MsgBox ("Couldn't extract all data"): Exit Sub
  Next x
  
  Me.Picture = Nothing
  Blank.Visible = True
  ClearGraph.Visible = True
  DateLabel.Visible = True
  DirectoryBox.Visible = True
  Form1.Exit.Visible = True
  Graph.Visible = True
  HelpLine.Visible = True
  List1.Visible = True
  ScanSample.Visible = True
  Label1.Visible = True
  Label2.Visible = True
  Label3.Visible = True
  Label4.Visible = True
  Label5.Visible = True
  Label6.Visible = True
  Label7.Visible = True
  Label8.Visible = True
 
  Graph.Cls
  For y = 25 To 100 Step 25: Graph.Line (240, y)-(850, y), QBColor(7): Next y
  For x = 250 To 850 Step 50: Graph.Line (x, -1)-(x, 110), QBColor(7): Next x
  DoEvents
  'Find first data point, minimum, maximum and last data point for %Signal calculation.
  
'Now plot %Signal versus wavelength
  If Nbr = 0 Then 'Find first x, last x and MaxY (Max is actually min value since y plots down
    'If this is not done, program uses last good values stored in calnbrs.txt
    MaxY = 0: y = 0 'First = 0: Last = 0
    For x = First To Last Step 3
      MaxY = MaxY + Intensity(x): y = y + 1
      'If First = 0 And Ix > 0 Then First = X
      'If First > 0 Then MaxY = MaxY + Ix
      'If First > 0 And Ix = 0 Then Last = X: X = 1900
    Next x
    MaxY = MaxY / y
  ElseIf Nbr = 1 Then 'Scan blank
    For x = First To Last Step 3
      WL = Int((WL2 - WL1) * (x - First) / (Last - First) + WL1 + 0.5)
      Background(x) = MaxY - Intensity(x)
      Graph.PSet (WL, 100), QBColor(7)
    Next x
    SpectraNbr = 0
    ScanBlankFlag = 1
  ElseIf Nbr = 2 Then 'Plot Transmittance. Don't Scan unless a blank has been done.
    For x = First To Last Step 3
      If Background(x) > 0 Then
        Spectra(x, SpectraNbr) = 100 * (MaxY - Intensity(x)) / Background(x)
      End If
    Next x
    For i = 0 To SpectraNbr
      For x = First To Last Step 3
        If Background(x) > 0 And Background(x + 3) > 0 Then
          w1 = Int((WL2 - WL1) * (x - First) / (Last - First) + WL1 + 0.5)
          w2 = Int((WL2 - WL1) * ((x + 3) - First) / (Last - First) + WL1 + 0.5)
          Graph.Line (w1, Spectra(x, i))-(w2, Spectra(x + 3, i)), QBColor(i)
        End If
      Next x
    Next i
    SpectraNbr = SpectraNbr + 1
    
  ElseIf Nbr = 3 Then 'Plot Absorbance. Don't Scan unless a blank has been done.
    For x = First To Last Step 3
      WL = Int((WL2 - WL1) * (x - First) / (Last - First) + WL1 + 0.5)
      If Background(x) > 0 Then
        Spectra(x, SpectraNbr) = 100 * (MaxY - Intensity(x)) / Background(x)
        'If s > 0 Then A = -Log(s) / Log(10) Else A = 5
        'Graph.PSet (WL, 25 * A)
      End If
    Next x
    For i = 0 To SpectraNbr
      For x = First To Last Step 3
        If Background(x) > 0 And Background(x + 3) > 0 Then
          s1 = Spectra(x, i) / 100
          s2 = Spectra(x + 3, i) / 100
          If s1 > 0 And s2 > 0 Then
            w1 = Int((WL2 - WL1) * (x - First) / (Last - First) + WL1 + 0.5)
            w2 = Int((WL2 - WL1) * ((x + 3) - First) / (Last - First) + WL1 + 0.5)
            Graph.Line (w1, 25 * (-Log(s1) / Log(10)))-(w2, 25 * (-Log(s2) / Log(10))), QBColor(i)
          End If
        End If
      Next x
    Next i
    SpectraNbr = SpectraNbr + 1
  End If
  
  If Nbr > 1 Then
     'Create HTML file and save on server
    If DirectoryBox.Text <> "" Then 'assume an IP and save it on server
      HelpLine.Caption = "Scan Complete. Now writing file to server."
      icnmake ("temp.json")
      HelpLine.Caption = "Temp.json Data File Saved"
''''''SaveToDisk
      SaveToServer
      'HelpLine.Caption = "File saved on server and web page updated."
    Else 'Save it locally as a text file.
      'FileName = Right$(Date$, 2) + Left$(Date$, 2) + Mid$(Date$, 4, 2)
      'FileName = FileName + "-" + Left$(Time$, 2) + Mid$(Time$, 4, 2) + Right$(Time$, 2)
      'FileName = FileName + ".TXT"
      'Open App.Path + "\" + FileName For Output As 1
      'For j = 300 To 700
      '  'Graph.PSet (x, yy(j, 1)), QBColor(14)
      '  x = 10000000# / j  'All files saved as wavenumber and %Transmission like FTIR
      '  If jCount(j - 300) > 0 Then Print #1, Str$(Int(x + 0.5)) + "," + Str$(Int(100 * Spectra(j - 300) + 0.5) / 100)
      'Next j
      'Close 1
      'HelpLine.Caption = "Scan Complete. Text file saved on hard drive in: " & Chr$(13) & App.Path & "\" & FileName & Chr$(13) & "Note your data has not been saved on the ICN server! Enter your lab name and recollect data."
    End If
  End If
  
  'DarkBack.Enabled = True
  Blank.Enabled = True ' re-enable buttons
  ScanSample.Enabled = True
End Sub


Sub icnmake(fname2$)
Dim Count As Integer
Dim WorkString As String * 12
Dim Record As String * 36
Dim RecordLength As Integer
Dim i, L, j, kk, k1, k2, Sign, Sign0, Exponent, Exponent0 As Integer
Dim ICNPath As String, FileName As String
Dim d, d2, iflag
Dim lf$, Cr$, s$, s2$, d3$, xs$, ys$
Dim work, x As Long, y, WL

lf$ = Chr$(10)   'W* variables w are always temp. & local. DL
Cr$ = Chr$(13)   'i,(j,k,l) variables are always temp. & local  DL

ICNPath = CurDir

Open App.Path + "\" + fname2$ For Output As 1
'Header is single string.
    FileName = PreFix$ + "-" + Right$(Date$, 2) + Left$(Date$, 2) + Mid$(Date$, 4, 2)
    FileName = FileName + "-" + Left$(Time$, 2) + Mid$(Time$, 4, 2) + Right$(Time$, 2)
    s$ = FileName  'ICN ID Header
    Print #1, "{"
    Print #1, "label: " + "'" + s$ + "',"
    Print #1, "data: [";
    
    For x = First To Last Step 3 'First point will be at 240 nm, last at 850 nm.
      If Background(x) > 0 Then
        WL = Int((WL2 - WL1) * (x - First) / (Last - First) + WL1 + 0.5)
        y = 100 * (MaxY - Intensity(x)) / Background(x)
        xs$ = Str$(10000000# / WL): ys$ = Str$(y) 'All files saved as wavenumber rather than wavelength
        Print #1, "[" + xs$ + "," + ys$ + "], ";
      End If
    Next x
    Print #1, "[" + xs$ + "," + ys$ + "]]"  'duplicate last point to close out string
    Print #1, "}"
Close 1 'Close File

End Sub


Private Sub SaveToServer()
  Dim T0, fp$, fname2$, i, FileName As String
  FileName = PreFix$ + "-" + Right$(Date$, 2) + Left$(Date$, 2) + Mid$(Date$, 4, 2)
  FileName = FileName + "-" + Left$(Time$, 2) + Mid$(Time$, 4, 2) + Right$(Time$, 2)
  FileName = FileName + ".JSON"
  Dim ftpcheck As Boolean
 'Open connection and change directory
  If hConnection <> 0 Then
        InternetCloseHandle hConnection
  End If
  'Now open the specified connection
  hConnection = InternetConnect(hOpen, "interchemnet.um.maine.edu", INTERNET_INVALID_PORT_NUMBER, "icninstrument", "5ka#ixo9", INTERNET_SERVICE_FTP, dwSeman, 0)
  If hConnection = 0 Then
        ErrorOut Err.LastDllError, "InternetConnect"
        Exit Sub
  Else
        HelpLine.Caption = "Connected to interchemnet.um.maine.edu"
  End If
  'Now connect to specified directory
  If (FtpSetCurrentDirectory(hConnection, DirectoryBox.Text) = False) Then
       ErrorOut Err.LastDllError, "FtpSetCurrentDirectory"
       Exit Sub
  Else
       HelpLine.Caption = "Directory is changed to " & DirectoryBox.Text
  End If
  
  'Place data file in student folder
  If (FtpPutFile(hConnection, CurDir$ + "\" + "Temp.json", FileName, dwType, 0) = False) Then
    'Wait a second and try one more time
    T0 = Timer: While Timer - T0 < 1: Wend
    If (FtpPutFile(hConnection, CurDir$ + "\" + "Temp.json", FileName, dwType, 0) = False) Then
      ErrorOut Err.LastDllError, "FtpPutFile"
      Exit Sub
    End If
  End If
  HelpLine.Caption = FileName & " has been saved on server!"
  

  'Add filename to list box
  Form1.List1.AddItem FileName
  Form1.List1.ListIndex = Form1.List1.ListCount - 1
  'Create HTML file: index.html
  CreateHTML
  'Copy updated student index.html to student folder
  fp$ = App.Path + "\index.html"
  fname2$ = "index.html"
  If (FtpPutFile(hConnection, fp$, fname2$, dwType, 0) = False) Then
      ErrorOut Err.LastDllError, "FtpPutFile"
      Exit Sub
  Else
      HelpLine.Caption = FileName & " saved on server!"
  End If
  
  'Close connection
  If hConnection <> 0 Then
        InternetCloseHandle hConnection
  End If

'erase temp.json
'skip next line for testing
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Kill fp$
'Find position of new file for LoadFiles_Click and select it
For i = 0 To Form1.List1.ListCount - 1
  If Form1.List1.List(i) = FileName + ".json" Then Form1.List1.Selected(i) = True
Next i
FileName = ""
'''FirstTime = "YES" 'Force load defaults for new sample scans
T0 = Timer: While Timer - T0 < 1: Wend

End Sub
Private Sub SaveToDisk()
  Dim T0, fp$, fname2$, i, FileName
  'Rename temp.json file to filename.json
  FileName = PreFix$ + "-" + Right$(Date$, 2) + Left$(Date$, 2) + Mid$(Date$, 4, 2)
  FileName = FileName + "-" + Left$(Time$, 2) + Mid$(Time$, 4, 2) + Right$(Time$, 2)
  FileName = FileName + ".JSON"
  FileCopy "temp.json", FileName
  'Add filename to list box
  Form1.List1.AddItem FileName
  Form1.List1.ListIndex = Form1.List1.ListCount - 1
  CreateHTML
  For i = 0 To Form1.List1.ListCount - 1
    If Form1.List1.List(i) = FileName + ".json" Then Form1.List1.Selected(i) = True
  Next i
  FileName = ""
End Sub

Private Sub CreateHTML()
'Updates student index.html file
Dim i, j, k, Q$, fp$
Q$ = Chr$(34)
Open "index.html" For Output As 1
For i = 1 To HTMLRowNumber
  If HTMLRow$(i) <> "<!--icnstart-->" Then
    Print #1, HTMLRow$(i)
  Else 'write button for filename
    Print #1, "<!--icnstart-->"
    Print #1, "<b>" + DirectoryBox.Text + "</b>"
    Print #1, "  </br>"
    Print #1, "  <table border=" + Q$ + "0" + Q$ + ">"
    Print #1, "  <tr>"
    k = 0
    For j = Form1.List1.ListCount - 1 To 0 Step -1
      fp$ = Form1.List1.List(j)
      Print #1, "    <td>"
      Print #1, "      <input class=" + Q$ + "fetchSeries" + Q$ + " type=" + Q$ + "button" + Q$ + " value=" + Q$ + Left$(fp$, 16) + Q$ + ">"
      Print #1, "      <a href=" + Q$ + fp$ + Q$ + ">*</a>"
      Print #1, "      <span></span>"
      Print #1, "    </td>"
      k = k + 1: If k Mod 4 = 0 Then Print #1, "  <tr>" 'start a new row
    Next j
    Print #1, "  </tr>"
    Print #1, "  </table>"
  End If
Next i
Close 1
End Sub

Private Sub ErrorOut(ByVal dwError As Long, ByRef szFunc As String)
Dim dwRet As Long
Dim dwTemp As Long
Dim szString As String * 2048
Dim szErrorMessage As String

dwRet = FormatMessage(FORMAT_MESSAGE_FROM_HMODULE, GetModuleHandle("wininet.dll"), dwError, 0, szString, 256, 0)
szErrorMessage = szFunc & " error code: " & dwError & " Message: " & szString
Debug.Print szErrorMessage
MsgBox szErrorMessage
If (dwError = 12003) Then
    ' Extended error information was returned
    dwRet = InternetGetLastResponseInfo(dwTemp, szString, 2048)
    MsgBox szString
End If
End Sub

Private Sub Timer1_Timer()
  If (Timer - StartTime > 7200) Then
    MsgBox$ ("If you are done with this spectrometer, turn off the switch on the back of the spectrometer. Don't unplug anything. Don't exit the software. Just close the laptop cover. If you have more to do click OK")
    StartTime = Timer
  End If
End Sub