Private Declare Function SetForegroundWindow Lib "user32" ( _
    ByVal hWnd As Long) As Long
    
    'Globals:
    Dim i As Long
    'The number of floor tools to search
    Dim probedir As String
    'Temp storage for contents of WW
    Dim temp As String
    Dim appToRun As String
    Dim paramForApp As String
    Dim cmdline As String
    Dim Last_ToolId As String

    
    


Option Explicit

Private Type ToolInfo
    ToolId As String
    probe_card As New Collection
End Type

Private Probes(0 To 100) As ToolInfo
Private MaxProbe As Integer

Private Sub Command1_Click()
    
    Dim appToRun As String
    Dim paramForApp As String
    Dim cmdline As String
    Dim lines1 As String



Open App.Path & "\probecards.txt" For Input As #1
Open App.Path & "\probetemp.txt" For Output As #2
    
     Do While Not EOF(1)
        Line Input #1, lines1
            If InStr(lines1, "/OUTPUT=") Then
                Print #2, "/OUTPUT='" & App.Path & "\probecards.csv'"
            ElseIf InStr(lines1, "SITE=") Then
                Print #2, "  SITE=" & fab.List(fab.ListIndex)
                Else
                          Print #2, lines1
        End If
    Loop
            
    'Close acs scripts
    Close (1)
    Close (2)
        

    Dim oFile As New Scripting.FileSystemObject
    'Delete the old temp.bat and create a new version (this one will run the scr.acs script)
    del App.Path & "\temp.bat"
    Open App.Path & "\temp.bat" For Output As #1
    Print #1, "chdir """ & App.Path & "\"""
    If oFile.FolderExists("C:\users\" & getEnviron("USERNAME") & "\CrystalBall\Production") Then
        Print #1, "C:\users\" & getEnviron("USERNAME") & "\CrystalBall\Production\cbcli tool=runscript script=""" & App.Path & "\probetemp.txt"""
    ElseIf oFile.FolderExists("C:\Documents and Settings\" & getEnviron("USERNAME") & "\CrystalBall\Production") Then
        Print #1, """" & "C:\Documents and Settings\" & getEnviron("USERNAME") & "\CrystalBall\Production\CBCLI" & """" & " tool=runscript script=""" & App.Path & "\probetemp.txt"""
    Else
        MsgBox ("ERROR: No Path to Crystal Ball found!")
    End If
    
    Close (1)

    'execute the batch script that has the command to run scr.acs
    appToRun = getEnviron("comspec")
    paramForApp = " /C """ & App.Path & "\temp.bat"""
    cmdline = appToRun & paramForApp
    ExecCmd cmdline
    
    'Create and execute batch script
    Call go(App.Path & "")
End Sub


Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim sp() As String
Dim lines As String
Dim file As Integer
Dim Last_ToolId As String
Dim i As Integer

    If FileOrDir(App.Path & "\temp\config.txt") = 1 Then
    Open App.Path & "\temp\config.txt" For Input As #1
    Do While Not EOF(1)
        Line Input #1, lines
        If InStr(lines, "number") = 0 And Len(lines) > 1 Then
            fab.AddItem (lines)
        ElseIf InStr(lines, "number") Then
            sp = Split(lines, "=")
            probedir = sp(1)
        End If
        fab.ListIndex = 0
    Loop
    Close (1)
    End If

    'position of the program
    i = 0
    Me.Left = Screen.Width / 2 - Me.Width / 2  'align form to centre of screen
    Me.Top = Screen.Height / 2 - Me.Height / 2




End Sub

Private Sub fabtool_Click()
Dim i As Integer
Dim y As Integer
Dim num_probe_card As Integer
probe_card.clear
i = 0
num_probe_card = 0

    
    With Probes(fabtool.ListIndex)
        num_probe_card = .probe_card.Count
        For i = 1 To num_probe_card
            probe_card.AddItem .probe_card(i)
            
        Next i
    End With


End Sub

'Run the perl script to fill the txt files with new data
Private Sub go(filename As String)
    'retest_data.txt is default 'filename'
    'delete current temp.txt and temp.bat files (would have been the batch file to run src.acs)
    del App.Path & "\temp\temp.bat"
    del App.Path & "\temp\temp.txt"
    Dim fso As New FileSystemObject
    Dim cmdline As String
    Dim file As Integer
    
    'Create new temp.bat
    Open App.Path & "\temp\temp.bat" For Output As #1
            Print #1, "ChDir; """ & App.Path & " \ """
            Print #1, "perl """ & App.Path & "\probecards.pl"""
    Close (1)
    
    appToRun = getEnviron("comspec")
    paramForApp = " /C """ & App.Path & "\temp\temp.bat"""
    cmdline = appToRun & paramForApp
    'run the batch script (will run the perl script in the process)
    'the perl(calc.pl) script needs the scr.acs script as input
    'the output of the perl script will be saved in retest_data.txt
    ExecCmd cmdline

    'del App.Path & "\temp\temp.bat"
    'del app.path & "\temp\temp.txt"
    SetForegroundWindow (Me.hWnd)
    
probe_card.clear
Call Loadlist


End Sub

'Run the 'cmdline' as a process in a shell
Public Sub ExecCmd(cmdline As String)
    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim ReturnValue As Integer
      
    '//Initialize The STARTUPINFO Structure
    start.cb = Len(start)
      
    '//Start The Shelled Application
    ReturnValue = CreateProcessA(0&, cmdline, 0&, 0&, 1&, _
       NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
      
    '//Wait for The Shelled Application to Finish
    Do
       ReturnValue = WaitForSingleObject(proc.hProcess, 0)
       DoEvents
    Loop Until ReturnValue <> 258
    '//Close Handle to Shelled Application
    ReturnValue = CloseHandle(proc.hProcess)
End Sub

'used for getting the logged in user and the location of the command prompt
Private Function getEnviron(var As String) As String
     Dim i As Integer
     i = 1
     Dim sp() As String
     getEnviron = ""
     Do While Len(Environ$(i)) > 0
          If InStr(StrConv(Environ(i), vbLowerCase), StrConv(var, vbLowerCase)) Then
            sp = Split(Environ(i), "=")
            getEnviron = sp(1)
          End If
          i = i + 1
     Loop
End Function

'returns 1 for a file, 2 for a folder and 0 if nothing found. needs the microsoft scripting runtime referenced
Public Function FileOrDir(sFullPath As String) As Integer
    Dim bool As Boolean
    Dim oFile As New FileSystemObject
    
    FileOrDir = 0
    bool = oFile.FileExists(sFullPath)
    If bool = True Then
        FileOrDir = 1
    Else
        bool = oFile.FolderExists(sFullPath)
        If bool = True Then
            FileOrDir = 2
        End If
    End If
End Function

'Delete a file from the client OS
Private Function del(file As String)
    Dim fso As New FileSystemObject
    If fso.FileExists(file) Then
        Call fso.DeleteFile(file, True)
        del = 1
    Else
        del = 0
    End If
End Function

Private Function Loadlist()
Dim new_tool As String
Dim new_probe As String

Dim file As Integer
fabtool.clear
probe_card.clear
    file = FreeFile
    


    
    Open App.Path & "\new.csv" For Input As #file

    MaxProbe = -1
    Do Until EOF(file)
        Input #file, new_tool, new_probe
        If new_tool <> Last_ToolId Then
            Last_ToolId = new_tool
            MaxProbe = MaxProbe + 1
            Probes(MaxProbe).ToolId = new_tool
            fabtool.AddItem new_tool
        End If
            Probes(MaxProbe).probe_card.Add new_probe
    Loop

    Close #file
    
    fabtool.ListIndex = 0
End Function