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