Friday, July 17, 2009

VB 6.0 code fro HID Communication and create Excel using data from Hid Device

Option Explicit



Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_MAXIMIZE = 3
Private Const SW_MINIMIZE = 6
Private Const SW_RESTORE = 9
Private Const SW_SHOW = 5
Private Const SW_SHOWDEFAULT = 10
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOWNORMAL = 1

Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Private Const SE_ERR_ACCESSDENIED = 5 ' access denied
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const SE_ERR_DDETIMEOUT = 28
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_OOM = 8 ' out of memory
Private Const SE_ERR_SHARE = 26

Private Const STYLE_NORMAL = 11



Dim bAlertable As Long
Dim Capabilities As HIDP_CAPS
Dim DataString As String
Dim DetailData As Long
Dim DetailDataBuffer() As Byte
Dim DeviceAttributes As HIDD_ATTRIBUTES
Dim DevicePathName As String
Dim DeviceInfoSet As Long
Dim ErrorString As String
Dim EventObject As Long
Dim HIDHandle As Long
Dim HIDOverlapped As OVERLAPPED
Dim LastDevice As Boolean
Dim MyDeviceDetected As Boolean
Dim MyDeviceInfoData As SP_DEVINFO_DATA
Dim MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA
Dim Needed As Long
Dim OutputReportData(7) As Byte
Dim PreparsedData As Long
Dim ReadHandle As Long
Dim Result As Long
Dim Security As SECURITY_ATTRIBUTES
Dim Timeout As Boolean
Dim my_data As Byte
Dim qty As Integer


Dim txtline, h As String
Dim i, j, k As Integer
Dim objExcel As New Excel.Application
Dim data() As String
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet
Dim dtlog() As String
Dim log, time, time1, date2, date1 As String
Dim datalg() As String
Dim filename, interval, timediff As String
Dim volt1, volt2, cur1, cur2, bcur, freq1, freq2 As String
Dim vlt1value, vlt2value, cr1value, cr2value, bcrvalue, fr1value, fr2value As String
Dim datear() As String
Dim dtr As String
Dim sFile, sfile1 As String
Dim cell As Integer
Dim chrcur, dishrcur, gntime, nongntime, fault, file3, fault1 As String

Dim exdate, extime As String

Dim edate() As String
Dim etime() As String

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String

Dim bname, bname1, wkflname, sfile2 As String
'Set these to match the values in the device's firmware and INF file.
'0925h is Lakeview Research's vendor ID.

Const MyVendorID = &H1234
Const MyProductID = &H2

Function FindTheHid() As Boolean

'Makes a series of API calls to locate the desired HID-class device.
'Returns True if the device is detected, False if not detected.

Dim Count As Integer
Dim GUIDString As String
Dim HidGuid As GUID
Dim MemberIndex As Long

LastDevice = False
MyDeviceDetected = False

'Values for SECURITY_ATTRIBUTES structure:

Security.lpSecurityDescriptor = 0
Security.bInheritHandle = True
Security.nLength = Len(Security)

'******************************************************************************
'HidD_GetHidGuid
'Get the GUID for all system HIDs.
'Returns: the GUID in HidGuid.
'The routine doesn't return a value in Result
'but the routine is declared as a function for consistency with the other API calls.
'******************************************************************************

Result = HidD_GetHidGuid(HidGuid)
Call DisplayResultOfAPICall("GetHidGuid")

'Display the GUID.

GUIDString = _
Hex$(HidGuid.Data1) & "-" & _
Hex$(HidGuid.Data2) & "-" & _
Hex$(HidGuid.Data3) & "-"

For Count = 0 To 7

'Ensure that each of the 8 bytes in the GUID displays two characters.

If HidGuid.Data4(Count) >= &H10 Then
GUIDString = GUIDString & Hex$(HidGuid.Data4(Count)) & " "
Else
GUIDString = GUIDString & "0" & Hex$(HidGuid.Data4(Count)) & " "
End If
Next Count

'lstResults.AddItem " GUID for system HIDs: " & GUIDString

'******************************************************************************
'SetupDiGetClassDevs
'Returns: a handle to a device information set for all installed devices.
'Requires: the HidGuid returned in GetHidGuid.
'******************************************************************************

DeviceInfoSet = SetupDiGetClassDevs _
(HidGuid, _
vbNullString, _
0, _
(DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))

Call DisplayResultOfAPICall("SetupDiClassDevs")
DataString = GetDataString(DeviceInfoSet, 32)

'******************************************************************************
'SetupDiEnumDeviceInterfaces
'On return, MyDeviceInterfaceData contains the handle to a
'SP_DEVICE_INTERFACE_DATA structure for a detected device.
'Requires:
'the DeviceInfoSet returned in SetupDiGetClassDevs.
'the HidGuid returned in GetHidGuid.
'An index to specify a device.
'******************************************************************************

'Begin with 0 and increment until no more devices are detected.

MemberIndex = 0

Do
'The cbSize element of the MyDeviceInterfaceData structure must be set to
'the structure's size in bytes. The size is 28 bytes.

MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
Result = SetupDiEnumDeviceInterfaces _
(DeviceInfoSet, _
0, _
HidGuid, _
MemberIndex, _
MyDeviceInterfaceData)

Call DisplayResultOfAPICall("SetupDiEnumDeviceInterfaces")
If Result = 0 Then LastDevice = True

'If a device exists, display the information returned.

If Result <> 0 Then



'******************************************************************************
'SetupDiGetDeviceInterfaceDetail
'Returns: an SP_DEVICE_INTERFACE_DETAIL_DATA structure
'containing information about a device.
'To retrieve the information, call this function twice.
'The first time returns the size of the structure in Needed.
'The second time returns a pointer to the data in DeviceInfoSet.
'Requires:
'A DeviceInfoSet returned by SetupDiGetClassDevs and
'an SP_DEVICE_INTERFACE_DATA structure returned by SetupDiEnumDeviceInterfaces.
'*******************************************************************************

MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
Result = SetupDiGetDeviceInterfaceDetail _
(DeviceInfoSet, _
MyDeviceInterfaceData, _
0, _
0, _
Needed, _
0)

DetailData = Needed

Call DisplayResultOfAPICall("SetupDiGetDeviceInterfaceDetail")


'Store the structure's size.

MyDeviceInterfaceDetailData.cbSize = _
Len(MyDeviceInterfaceDetailData)

'Use a byte array to allocate memory for
'the MyDeviceInterfaceDetailData structure

ReDim DetailDataBuffer(Needed)

'Store cbSize in the first four bytes of the array.

Call RtlMoveMemory _
(DetailDataBuffer(0), _
MyDeviceInterfaceDetailData, _
4)

'Call SetupDiGetDeviceInterfaceDetail again.
'This time, pass the address of the first element of DetailDataBuffer
'and the returned required buffer size in DetailData.

Result = SetupDiGetDeviceInterfaceDetail _
(DeviceInfoSet, _
MyDeviceInterfaceData, _
VarPtr(DetailDataBuffer(0)), _
DetailData, _
Needed, _
0)

Call DisplayResultOfAPICall(" Result of second call: ")


'Convert the byte array to a string.

DevicePathName = CStr(DetailDataBuffer())

'Convert to Unicode.

DevicePathName = StrConv(DevicePathName, vbUnicode)

'Strip cbSize (4 bytes) from the beginning.

DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)

'******************************************************************************
'CreateFile
'Returns: a handle that enables reading and writing to the device.
'Requires:
'The DevicePathName returned by SetupDiGetDeviceInterfaceDetail.
'******************************************************************************

HIDHandle = CreateFile _
(DevicePathName, _
GENERIC_READ Or GENERIC_WRITE, _
(FILE_SHARE_READ Or FILE_SHARE_WRITE), _
Security, _
OPEN_EXISTING, _
0&, _
0)

Call DisplayResultOfAPICall("CreateFile")

'Now we can find out if it's the device we're looking for.

'******************************************************************************
'HidD_GetAttributes
'Requests information from the device.
'Requires: The handle returned by CreateFile.
'Returns: an HIDD_ATTRIBUTES structure containing
'the Vendor ID, Product ID, and Product Version Number.
'Use this information to determine if the detected device
'is the one we're looking for.
'******************************************************************************

'Set the Size property to the number of bytes in the structure.

DeviceAttributes.Size = LenB(DeviceAttributes)
Result = HidD_GetAttributes _
(HIDHandle, _
DeviceAttributes)

Call DisplayResultOfAPICall("HidD_GetAttributes")
If Result <> 0 Then
Else
End If


'Find out if the device matches the one we're looking for.

If (DeviceAttributes.VendorID = MyVendorID) And _
(DeviceAttributes.ProductID = MyProductID) Then

'It's the desired device.

MyDeviceDetected = True
Else
MyDeviceDetected = False

'If it's not the one we want, close its handle.

Result = CloseHandle _
(HIDHandle)
DisplayResultOfAPICall ("CloseHandle")
End If
End If

'Keep looking until we find the device or there are no more left to examine.

MemberIndex = MemberIndex + 1
Loop Until (LastDevice = True) Or (MyDeviceDetected = True)

'Free the memory reserved for the DeviceInfoSet returned by SetupDiGetClassDevs.

Result = SetupDiDestroyDeviceInfoList _
(DeviceInfoSet)
Call DisplayResultOfAPICall("DestroyDeviceInfoList")

If MyDeviceDetected = True Then
FindTheHid = True

'Learn the capabilities of the device

Call GetDeviceCapabilities

'Get another handle for the overlapped ReadFiles.

ReadHandle = CreateFile _
(DevicePathName, _
(GENERIC_READ Or GENERIC_WRITE), _
(FILE_SHARE_READ Or FILE_SHARE_WRITE), _
Security, _
OPEN_EXISTING, _
FILE_FLAG_OVERLAPPED, _
0)

Call DisplayResultOfAPICall("CreateFile, ReadHandle")
Call PrepareForOverlappedTransfer
Else
End If

End Function

Private Function GetDataString _
(Address As Long, _
Bytes As Long) _
As String

'Retrieves a string of length Bytes from memory, beginning at Address.
'Adapted from Dan Appleman's "Win32 API Puzzle Book"

Dim Offset As Integer
Dim Result$
Dim ThisByte As Byte

For Offset = 0 To Bytes - 1
Call RtlMoveMemory(ByVal VarPtr(ThisByte), ByVal Address + Offset, 1)
If (ThisByte And &HF0) = 0 Then
Result$ = Result$ & "0"
End If
Result$ = Result$ & Hex$(ThisByte) & " "
Next Offset

GetDataString = Result$
End Function

Private Function GetErrorString _
(ByVal LastError As Long) _
As String

'Returns the error message for the last error.
'Adapted from Dan Appleman's "Win32 API Puzzle Book"

Dim Bytes As Long
Dim ErrorString As String
ErrorString = String$(129, 0)
Bytes = FormatMessage _
(FORMAT_MESSAGE_FROM_SYSTEM, _
0&, _
LastError, _
0, _
ErrorString$, _
128, _
0)

'Subtract two characters from the message to strip the CR and LF.

If Bytes > 2 Then
GetErrorString = Left$(ErrorString, Bytes - 2)
End If

End Function

Private Sub close_Click()
DataGrid1.Visible = False
DataGrid2.Visible = False
DataGrid3.Visible = False
fraSendAndReceive.Visible = False
Frame1.Visible = False

End Sub

Private Sub cmdContinuous_Click()

'Enables the user to select 1-time or continuous data transfers.

If cmdContinuous.Caption = "Start" Then
qty = 0
Text1.Text = ""
my_data = 0
Text2.Enabled = False
Command1.Enabled = False
Command2.Enabled = False
Label3.Caption = "0% completed"




'Change the command button to Cancel Continuous

cmdContinuous.Caption = "Stop"

'Enable the timer to read and write to the device once/second.

tmrContinuousDataCollect.Enabled = True
Call ReadAndWriteToDevice
Else

'Change the command button to Continuous

cmdContinuous.Caption = "Start"
Text2.Enabled = True
Command1.Enabled = True
Command2.Enabled = True


'Disable the timer that reads and writes to the device once/second.

tmrContinuousDataCollect.Enabled = False
End If

End Sub

Private Sub cmddata_Click()

filename = App.Path & "\Log Files\" & Text4.Text & ".log"


date1 = ""
date2 = ""
time = ""
time1 = ""

Text1.Enabled = True
Command3.Enabled = True

Dim fso As New FileSystemObject

If fso.FileExists(App.Path & "\Excel Files\" & Text5.Text & ".xls") = False Then

Workbooks.open filename:=sfile2
Set oWB = objExcel.Application.ActiveWorkbook
oWB.SaveAs (App.Path & "\Excel Files\" & Text5.Text & ".xls")
objExcel.Visible = True
Else


If MsgBox("Filename already exists.Do you want to repalce it?", vbYesNo + vbCritical, "Deletion") = vbYes Then

Workbooks.open filename:=sfile2
Set oWB = objExcel.Application.ActiveWorkbook
oWB.Save
objExcel.Visible = True
Else
MsgBox "Please Enter Another File Name"
objExcel.Visible = False

End If
End If

End Sub

Private Sub cmdOnce_Click()
Call ReadAndWriteToDevice
End Sub

Private Sub DisplayResultOfAPICall(FunctionName As String)

'Display the results of an API call.

Dim ErrorString As String
ErrorString = GetErrorString(Err.LastDllError)
'Scroll to the bottom of the list box.
lstResults.ListIndex = lstResults.ListCount - 1

End Sub

Private Sub Combo1_Click()

date1 = ""
date2 = ""
time = ""
time1 = ""
interval = Trim(Combo1.Text)

If interval = "All" Then

convertexcel
convertexcelcumdata
convertexcelfaultdata

End If

If interval = "5min" Then

convertexcel5min
convertexcelcumdata
convertexcelfaultdata

End If

If interval = "10 min" Then

convertexcel10min
convertexcelcumdata
convertexcelfaultdata

End If

Text1.Enabled = True
Command3.Enabled = True



Adodc1.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sfile2
Adodc1.RecordSource = "SELECT * FROM [Sheet1$]"
Adodc1.Refresh

Adodc2.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sfile1
Adodc2.RecordSource = "SELECT * FROM [Sheet1$]"
Adodc2.Refresh

Adodc3.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & file3
Adodc3.RecordSource = "SELECT * FROM [Sheet1$]"
Adodc3.Refresh

Set DataGrid1.DataSource = Adodc1
DataGrid1.Refresh

Set DataGrid2.DataSource = Adodc2
DataGrid2.Refresh

Set DataGrid3.DataSource = Adodc3
DataGrid3.Refresh



DataGrid1.Columns("Date").Width = 1000 'test here
DataGrid1.Columns("Time").Width = 1000
DataGrid1.Columns("Voltage(ERRU1)").Width = 1500
DataGrid1.Columns("Voltage(ERRU2)").Width = 1500
DataGrid1.Columns("Current(ERRU1)").Width = 1500
DataGrid1.Columns("Current(ERRU2)").Width = 1500
DataGrid1.Columns("Charging Current").Width = 1500
DataGrid1.Columns("Discharging Current").Width = 1700
DataGrid1.Columns("Alternator RPM").Width = 1500

DataGrid2.Columns("Date").Width = 800 'test here
DataGrid2.Columns("Time").Width = 800
DataGrid2.Columns("Charging Current").Width = 1400
DataGrid2.Columns("Discharging Current").Width = 1700
DataGrid2.Columns("Generation Time").Width = 1400

DataGrid3.Columns("Date").Width = 800 'test here
DataGrid3.Columns("Time").Width = 800
DataGrid3.Columns("Fault").Width = 3100

DataGrid1.Visible = True

End Sub

Private Sub Command1_Click()

Dim fso As New FileSystemObject

If fso.FileExists(App.Path & "\Log Files\" & Text2.Text & ".log") = False Then

Open App.Path & "\Log Files\" & Text2.Text & ".log" For Output As #1
Print #1, Text1.Text
Close #1
MsgBox "File saved successfully!"

Else

If MsgBox("Filename already exists.Do you want to repalce it?", vbYesNo + vbCritical, "Deletion") = vbYes Then
Open App.Path & "\Log Files\" & Text2.Text & ".log" For Output As #1
Print #1, Text1.Text
Close #1
MsgBox "File saved successfully!"
Else

MsgBox "Please Enter Another File Name"
End If
End If
End Sub

Private Sub Command2_Click()
Call Startup
Call FindTheHid
If MyDeviceDetected = True Then
Label4.ForeColor = &HFF00&
Label4.Caption = " Device is connected on port"
cmdContinuous.Enabled = True

Else
Label4.ForeColor = &HFF

Label4.Caption = " Device is not connected on port"
cmdContinuous.Enabled = False

End If
End Sub

Private Sub Command3_Click()

Dim fso As New FileSystemObject

If fso.FileExists(App.Path & "\Log Files\" & Text4.Text & ".log") = False Then

Open App.Path & "\Log Files\" & Text4.Text & ".log" For Output As #1
Print #1, Text1.Text
Close #1
MsgBox "File saved successfully!"

Else

If MsgBox("Filename already exists.Do you want to repalce it?", vbYesNo + vbCritical, "Deletion") = vbYes Then

Open App.Path & "\Log Files\" & Text4.Text & ".log" For Output As #1
Print #1, Text1.Text
Close #1
MsgBox "File saved successfully!"

Else

MsgBox "Please Enter Another File Name"

End If
End If
filename = App.Path & "\Log Files\" & Text4.Text & ".log"
convertexcel
convertexcelcumdata

Adodc1.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sfile2
Adodc1.RecordSource = "SELECT * FROM [Sheet1$]"
Adodc1.Refresh

Adodc2.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sfile1
Adodc2.RecordSource = "SELECT * FROM [Sheet2$]"
Adodc2.Refresh

DataGrid1.Visible = True
DataGrid2.Visible = True
DataGrid3.Visible = True

Frame1.Visible = True
Label6.Visible = True
Combo1.Visible = True
Label1.Visible = True
Label8.Visible = True
Text5.Visible = True
Label9.Visible = True
cmddata.Visible = True
fraSendAndReceive.Visible = False
Label3.Visible = False
objExcel.Application.Quit
Text5.Text = "Default"
Label8.Caption = "Your Current FileName:"
End Sub

Private Sub Command4_Click()

Set oWB = objExcel.Workbooks.open(App.Path & "\Excel Files\" & Text5.Text & ".xls")
objExcel.Visible = True

End Sub

Private Sub download_Click()

fraSendAndReceive.Visible = True
Label3.Visible = True
DataGrid1.Visible = False
Frame1.Visible = False
DataGrid2.Visible = False
DataGrid3.Visible = False
DataGrid4.Visible = False
Command3.Enabled = False

End Sub

Private Sub exit_Click()
End

End Sub

Private Sub export_Click()

filename = App.Path & "\Log Files\" & Text4.Text & ".log"
convertexcel
convertexcelcumdata

Adodc1.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sfile2
Adodc1.RecordSource = "SELECT * FROM [Sheet1$]"
Adodc1.Refresh

Adodc2.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sfile1
Adodc2.RecordSource = "SELECT * FROM [Sheet2$]"
Adodc2.Refresh


DataGrid1.Visible = True
DataGrid2.Visible = True
DataGrid3.Visible = True

Frame1.Visible = True
Label6.Visible = True
Combo1.Visible = True
Label1.Visible = True
Label8.Visible = True
Text5.Visible = True
Label9.Visible = True
cmddata.Visible = True
fraSendAndReceive.Visible = False
Label3.Visible = False
objExcel.Application.Quit
Text5.Text = "Default"
Label8.Caption = "Your Current FileName:"
End Sub

Private Sub Form_Load()
frmMain.Show
my_data = 0
tmrDelay.Enabled = False
Call Startup
Call FindTheHid
If MyDeviceDetected = True Then
Label4.ForeColor = &HFF00&
Label4.Caption = " Device is connected on port"
cmdContinuous.Enabled = True

Else
Label4.ForeColor = &HFF
Label4.Caption = " Device is not connected on port"
cmdContinuous.Enabled = False

End If

On Error Resume Next
MkDir App.Path & "\Log Files"

On Error Resume Next
MkDir App.Path & "\Excel Files"

On Error Resume Next
MkDir App.Path & "\Temp"



objExcel.DisplayAlerts = False

Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As file

DeleteAllFiles App.Path & "\Temp"

End Sub

Public Function DeleteAllFiles(ByVal FolderSpec As String) As Boolean

Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As file


If oFs.FolderExists(FolderSpec) Then
Set oFolder = oFs.GetFolder(FolderSpec)
On Error Resume Next
For Each oFile In oFolder.Files
oFile.Delete True 'setting force to true
'deletes read-only file
Next
DeleteAllFiles = oFolder.Files.Count = 0
End If

End Function
Private Sub Form_Unload(Cancel As Integer)
Call Shutdown
End Sub

Private Sub GetDeviceCapabilities()

'******************************************************************************
'HidD_GetPreparsedData
'Returns: a pointer to a buffer containing information about the device's capabilities.
'Requires: A handle returned by CreateFile.
'There's no need to access the buffer directly,
'but HidP_GetCaps and other API functions require a pointer to the buffer.
'******************************************************************************

Dim ppData(29) As Byte
Dim ppDataString As Variant

'Preparsed Data is a pointer to a routine-allocated buffer.

Result = HidD_GetPreparsedData _
(HIDHandle, _
PreparsedData)
Call DisplayResultOfAPICall("HidD_GetPreparsedData")

'Copy the data at PreparsedData into a byte array.

Result = RtlMoveMemory _
(ppData(0), _
PreparsedData, _
30)
Call DisplayResultOfAPICall("RtlMoveMemory")

ppDataString = ppData()

'Convert the data to Unicode.

ppDataString = StrConv(ppDataString, vbUnicode)

'******************************************************************************
'HidP_GetCaps
'Find out the device's capabilities.
'For standard devices such as joysticks, you can find out the specific
'capabilities of the device.
'For a custom device, the software will probably know what the device is capable of,
'so this call only verifies the information.
'Requires: The pointer to a buffer containing the information.
'The pointer is returned by HidD_GetPreparsedData.
'Returns: a Capabilites structure containing the information.
'******************************************************************************
Result = HidP_GetCaps _
(PreparsedData, _
Capabilities)

Call DisplayResultOfAPICall("HidP_GetCaps")

'******************************************************************************
'HidP_GetValueCaps
'Returns a buffer containing an array of HidP_ValueCaps structures.
'Each structure defines the capabilities of one value.
'This application doesn't use this data.
'******************************************************************************

'This is a guess. The byte array holds the structures.

Dim ValueCaps(1023) As Byte

Result = HidP_GetValueCaps _
(HidP_Input, _
ValueCaps(0), _
Capabilities.NumberInputValueCaps, _
PreparsedData)

Call DisplayResultOfAPICall("HidP_GetValueCaps")

'lstResults.AddItem "ValueCaps= " & GetDataString((VarPtr(ValueCaps(0))), 180)
'To use this data, copy the byte array into an array of structures.

'Free the buffer reserved by HidD_GetPreparsedData

Result = HidD_FreePreparsedData _
(PreparsedData)
Call DisplayResultOfAPICall("HidD_FreePreparsedData")

End Sub

Private Sub InitializeDisplay()
Dim Count As Integer
Dim ByteValue As String

'Create a dropdown list box for each byte to send.

For Count = 0 To 255
If Len(Hex$(Count)) < 2 Then
ByteValue = "0" & Hex$(Count)
Else
ByteValue = Hex$(Count)
End If
frmMain.cboByte0.AddItem ByteValue, Count
Next Count

For Count = 0 To 255
If Len(Hex$(Count)) < 2 Then
ByteValue = "0" & Hex$(Count)
Else
ByteValue = Hex$(Count)
End If
frmMain.cboByte1.AddItem ByteValue, Count
Next Count

'Select a default item for each box

frmMain.cboByte0.ListIndex = 0
frmMain.cboByte1.ListIndex = 128

'Check the autoincrement box to increment the values each time a report is sent.

chkAutoincrement.Value = 1
End Sub

Private Sub PrepareForOverlappedTransfer()

'******************************************************************************
'CreateEvent
'Creates an event object for the overlapped structure used with ReadFile.
'Requires a security attributes structure or null,
'Manual Reset = True (ResetEvent resets the manual reset object to nonsignaled),
'Initial state = True (signaled),
'and event object name (optional)
'Returns a handle to the event object.
'******************************************************************************

If EventObject = 0 Then
EventObject = CreateEvent _
(Security, _
True, _
True, _
"")
End If

Call DisplayResultOfAPICall("CreateEvent")

'Set the members of the overlapped structure.

HIDOverlapped.Offset = 0
HIDOverlapped.OffsetHigh = 0
HIDOverlapped.hEvent = EventObject
End Sub

Private Sub ReadAndWriteToDevice()

'Sends two bytes to the device and reads two bytes back.

Dim Count As Integer

'Report Header



'Some data to send
'(if not using the combo boxes):
'OutputReportData(0) = &H12
'OutputReportData(1) = &H34
'OutputReportData(2) = &HF0
'OutputReportData(3) = &HF1
'OutputReportData(4) = &HF2
'OutputReportData(5) = &HF3
'OutputReportData(6) = &HF4
'OutputReportData(7) = &HF5

'If the device hasn't been detected or it timed out on a previous attempt
'to access it, look for the device.

If MyDeviceDetected = False Then
MyDeviceDetected = FindTheHid

End If

If MyDeviceDetected = True Then

'Get the bytes to send from the combo boxes.
'Increment the values if the autoincrement check box is selected.

If chkAutoincrement.Value = 1 Then
If cboByte0.ListIndex < 255 Then
cboByte0.ListIndex = cboByte0.ListIndex + 1
Else
cboByte0.ListIndex = 0
End If
If cboByte1.ListIndex < 255 Then
cboByte1.ListIndex = cboByte1.ListIndex + 1
Else
cboByte1.ListIndex = 0
End If
End If

OutputReportData(0) = cboByte0.ListIndex
'OutputReportData(1) = cboByte1.ListIndex

'Write a report to the device

Call WriteReport

'Read a report from the device.

Call ReadReport
Else
End If

'Scroll to the bottom of the list box.

lstResults.ListIndex = lstResults.ListCount - 1

'If the list box has more than 300 items, trim the contents.

If lstResults.ListCount > 300 Then
For Count = 1 To 100
lstResults.RemoveItem (Count)
Next Count
End If

End Sub

Private Sub ReadReport()

'Read data from the device.

Dim Count
Dim data_count

Dim NumberOfBytesRead As Long

'Allocate a buffer for the report.
'Byte 0 is the report ID.

Dim ReadBuffer() As Byte
Dim UBoundReadBuffer As Integer

'******************************************************************************
'ReadFile
'Returns: the report in ReadBuffer.
'Requires: a device handle returned by CreateFile
'(for overlapped I/O, CreateFile must be called with FILE_FLAG_OVERLAPPED),
'the Input report length in bytes returned by HidP_GetCaps,
'and an overlapped structure whose hEvent member is set to an event object.
'******************************************************************************

Dim ByteValue As String

'The ReadBuffer array begins at 0, so subtract 1 from the number of bytes.

ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)

'Scroll to the bottom of the list box.

lstResults.ListIndex = lstResults.ListCount - 1

'Do an overlapped ReadFile.
'The function returns immediately, even if the data hasn't been received yet.
data_count = 0
Top:

Result = ReadFile _
(ReadHandle, _
ReadBuffer(0), _
CLng(Capabilities.InputReportByteLength), _
NumberOfBytesRead, _
HIDOverlapped)
Call DisplayResultOfAPICall("ReadFile")

'lstResults.AddItem "waiting for ReadFile"

'Scroll to the bottom of the list box.

lstResults.ListIndex = lstResults.ListCount - 1
bAlertable = True

'******************************************************************************
'WaitForSingleObject
'Used with overlapped ReadFile.
'Returns when ReadFile has received the requested amount of data or on timeout.
'Requires an event object created with CreateEvent
'and a timeout value in milliseconds.
'******************************************************************************
Result = WaitForSingleObject _
(EventObject, _
6000)
Call DisplayResultOfAPICall("WaitForSingleObject")

'Find out if ReadFile completed or timeout.

Select Case Result
Case WAIT_OBJECT_0

'ReadFile has completed

Case WAIT_TIMEOUT

'Timeout


'Cancel the operation

'*************************************************************
'CancelIo
'Cancels the ReadFile
'Requires the device handle.
'Returns non-zero on success.
'*************************************************************
Result = CancelIo _
(ReadHandle)

Call DisplayResultOfAPICall("CancelIo")

'The timeout may have been because the device was removed,
'so close any open handles and
'set MyDeviceDetected=False to cause the application to
'look for the device on the next attempt.

CloseHandle (HIDHandle)
Call DisplayResultOfAPICall("CloseHandle (HIDHandle)")
CloseHandle (ReadHandle)
Call DisplayResultOfAPICall("CloseHandle (ReadHandle)")
MyDeviceDetected = False
Case Else
MyDeviceDetected = False
End Select


If data_count < 511 Then


txtBytesReceived.Text = ""
For Count = 1 To UBound(ReadBuffer)

'Add a leading 0 to values 0 - Fh.

If Len(Hex$(ReadBuffer(Count))) < 2 Then
ByteValue = "0" & Hex$(ReadBuffer(Count))
Else
ByteValue = Hex$(ReadBuffer(Count))
End If



Text1.Text = Text1.Text & ByteValue & " "
data_count = data_count + 1



'Display the received bytes in the text box.

txtBytesReceived.SelStart = Len(txtBytesReceived.Text)
txtBytesReceived.SelText = ByteValue & vbCrLf

Next Count
GoTo Top

End If

'******************************************************************************
'ResetEvent
'Sets the event object in the overlapped structure to non-signaled.
'Requires a handle to the event object.
'Returns non-zero on success.
'******************************************************************************

Call ResetEvent(EventObject)
Call DisplayResultOfAPICall("ResetEvent")

End Sub

Private Sub Shutdown()

'Actions that must execute when the program ends.

'Close the open handles to the device.

Result = CloseHandle _
(HIDHandle)
Call DisplayResultOfAPICall("CloseHandle (HIDHandle)")

Result = CloseHandle _
(ReadHandle)
Call DisplayResultOfAPICall("CloseHandle (ReadHandle)")

End Sub

Private Sub Startup()

Call InitializeDisplay
tmrContinuousDataCollect.Enabled = False
tmrContinuousDataCollect.interval = 1000

End Sub

Private Sub new_Click()
fraSendAndReceive.Visible = True
Label3.Visible = True
'Text1.Visible = True

End Sub

Private Sub open_Click()

CommonDialog1.DialogTitle = "Open File"
CommonDialog1.Filter = "Log Documents (*.log)|*.log|Text Documents (*.txt)|*.txt|Excel Spreadsheets (*.xls)|*.xls"
CommonDialog1.FilterIndex = 1
CommonDialog1.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
CommonDialog1.ShowOpen
filename = CommonDialog1.filename

Dim fl As String
fl = CommonDialog1.FileTitle
If filename = "" Then

Else

convertexcel
convertexcelcumdata
convertexcelfaultdata

sFile = App.Path & "\Excel Files\Default.xls"

Adodc1.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sfile2
Adodc1.RecordSource = "SELECT * FROM [Sheet1$]"
Adodc1.Refresh

Adodc2.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sfile1
Adodc2.RecordSource = "SELECT * FROM [Sheet1$]"
Adodc2.Refresh

Adodc3.ConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & file3
Adodc3.RecordSource = "SELECT * FROM [Sheet1$]"
Adodc3.Refresh

Set DataGrid1.DataSource = Adodc1
DataGrid1.Refresh

Set DataGrid2.DataSource = Adodc2
DataGrid2.Refresh

Set DataGrid3.DataSource = Adodc3
DataGrid3.Refresh

DataGrid1.Columns("Date").Width = 1000 'test here
DataGrid1.Columns("Time").Width = 1000
DataGrid1.Columns("Voltage(ERRU1)").Width = 1500
DataGrid1.Columns("Voltage(ERRU2)").Width = 1500
DataGrid1.Columns("Current(ERRU1)").Width = 1500
DataGrid1.Columns("Current(ERRU2)").Width = 1500
DataGrid1.Columns("Charging Current").Width = 1500
DataGrid1.Columns("Discharging Current").Width = 1700
DataGrid1.Columns("Alternator RPM").Width = 1500


DataGrid2.Columns("Date").Width = 800 'test here
DataGrid2.Columns("Time").Width = 800
DataGrid2.Columns("Charging Current").Width = 1400
DataGrid2.Columns("Discharging Current").Width = 1700
DataGrid2.Columns("Generation Time").Width = 1400


DataGrid3.Columns("Date").Width = 800 'test here
DataGrid3.Columns("Time").Width = 800
DataGrid3.Columns("Fault").Width = 3100

If interval = "5min" Then

DataGrid4.Visible = True
DataGrid1.Visible = False

End If

DataGrid1.Visible = True
DataGrid2.Visible = True
DataGrid3.Visible = True

Frame1.Visible = True
Label6.Visible = True
Combo1.Visible = True
Label1.Visible = True
Label8.Visible = True
Text5.Visible = True
Label9.Visible = True
cmddata.Visible = True

fraSendAndReceive.Visible = False
Label3.Visible = False
objExcel.Application.Quit
Text5.Text = "Default"
Label8.Caption = "Your Current FileName:"
End If
End Sub

Private Sub tmrContinuousDataCollect_Timer()


If my_data < Val(Text3.Text) * 2.54 Then
Call ReadAndWriteToDevice
Else
tmrContinuousDataCollect.Enabled = False


End If
qty = Round((my_data / 2.54) * (100 / Val(Text3.Text)), 0)
If qty > 98 Then
cmdContinuous.Caption = "Start"
Command1.Enabled = True
Command2.Enabled = True

Text2.Enabled = True

End If
If qty > 100 Then
qty = 100
End If



Label3.Caption = qty & "% Completed"

If Label3.Caption = "100% Completed" Then

Label6.Visible = True
Combo1.Visible = True
Label1.Visible = True
cmddata.Visible = True
Command3.Enabled = True
Text4.Enabled = True



End If



End Sub

Private Sub tmrDelay_Timer()

Timeout = True
tmrDelay.Enabled = False

End Sub

Private Sub WriteReport()

'Send data to the device.

Dim Count As Integer
Dim NumberOfBytesRead As Long
Dim NumberOfBytesToSend As Long
Dim NumberOfBytesWritten As Long
Dim ReadBuffer() As Byte
Dim SendBuffer() As Byte

'The SendBuffer array begins at 0, so subtract 1 from the number of bytes.

ReDim SendBuffer(Capabilities.OutputReportByteLength - 1)

'******************************************************************************
'WriteFile
'Sends a report to the device.
'Returns: success or failure.
'Requires: the handle returned by CreateFile and
'The output report byte length returned by HidP_GetCaps
'******************************************************************************

'The first byte is the Report ID

SendBuffer(0) = 0


SendBuffer(1) = my_data

NumberOfBytesWritten = 0

Result = WriteFile _
(HIDHandle, _
SendBuffer(0), _
CLng(Capabilities.OutputReportByteLength), _
NumberOfBytesWritten, _
0)
Call DisplayResultOfAPICall("WriteFile")
my_data = my_data + 1

For Count = 1 To UBound(SendBuffer)
lstResults.AddItem " " & Hex$(SendBuffer(Count))
Next Count

End Sub

Function convertexcel()

Dim line As String
Dim Count As String
h = 2
Dim TextLine As String

Open filename For Input Shared As #1
Do While Not EOF(1) '// Loop until end of file.
Line Input #1, TextLine '// Read line into variable.
' use the TextLine herer...
line = TextLine

Loop
Close #1

'create excel file


Set oWB = objExcel.Workbooks.Add
Set oWS = oWB.Worksheets("Sheet1")

bname = oWB.Name
oWS.Cells.Columns.AutoFit
oWS.Cells.WrapText = False

oWS.Range("A1").Value = "Date"
oWS.Range("B1").Value = "Time"
oWS.Range("C1").Value = "Voltage(ERRU1)"
oWS.Range("D1").Value = "Current(ERRU1)"
oWS.Range("E1").Value = "Voltage(ERRU2)"
oWS.Range("F1").Value = "Current(ERRU2)"
oWS.Range("G1").Value = "Charging Current"
oWS.Range("H1").Value = "Discharging Current"
oWS.Range("I1").Value = "Alternator RPM"


dtlog = Split(line, "FE FF")
For k = 0 To UBound(dtlog) - 1
log = dtlog(k)

If k = 0 Then

Dim dlog() As String
dlog = Split(log, "FF")
log = dlog(1)

End If

datalg = Split(log, " ")
Count = UBound(datalg)

If Count <= 21 Then
If Count >= 18 Then

time = datalg(3) & ":" & datalg(2)
date1 = datalg(4) & "/" & datalg(5) & "/" & datalg(6)

If exdate = "" Then

exdate = date1

Else

exdate = exdate & "," & date1

End If

If extime = "" Then

extime = time

Else

extime = extime & "," & time

End If


If dtr = "" Then

dtr = date1

Else

dtr = dtr + "," + date1

End If

oWS.Range("A" & h).Value = " " & Trim$(Trim$(datalg(4)) & "/" & Trim$(datalg(5)) & "/" & Trim$(datalg(6)))
oWS.Range("B" & h).Value = datalg(3) & ":" & datalg(2)

volt1 = HextoDec(datalg(7) & datalg(8))
vlt1value = Round((volt1 - 511) * 0.495, 2)

If vlt1value < 0 Then

vlt1value = 0

End If

cur1 = HextoDec(datalg(11) & datalg(12))
cr1value = Round((cur1 - 511) * 2.44, 2)

If cr1value < 0 Then

cr1value = 0

End If

volt2 = HextoDec(datalg(9) & datalg(10))
vlt2value = Round((volt2 - 511) * 0.495, 2)

If vlt2value < 0 Then

vlt2value = 0

End If

cur2 = HextoDec(datalg(13) & datalg(14))
cr2value = Round((cur2 - 511) * 2.44, 2)


If cr2value < 0 Then

cr2value = 0

End If

bcur = HextoDec(datalg(15) & datalg(16))
bcrvalue = Round((bcur - 511) * 2.44, 2)
freq1 = HextoDec(datalg(17) & datalg(18))
fr1value = Round((freq1 * 0.79) * 7.5)

If bcrvalue < 0 Then

bcrvalue = 0

End If

If fr1value < 0 Then

fr1value = 0

End If

oWS.Range("C" & h).Value = vlt1value
oWS.Range("D" & h).Value = cr1value
oWS.Range("E" & h).Value = vlt1value
oWS.Range("F" & h).Value = cr2value
oWS.Range("G" & h).Value = bcrvalue
oWS.Range("I" & h).Value = fr1value

h = h + 1

End If
End If
Count = ""

Next k

If Val(Application.Version) < 12 Then
'You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143

Else
'You use Excel 2007

FileExtStr = ".xls": FileFormatNum = 56

End If

TempFilePath = App.Path
TempFileName = "\Temp\All" & Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)
oWB.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
oWB.close SaveChanges:=True
sfile2 = TempFilePath & TempFileName & FileExtStr
objExcel.Application.Quit

End Function

Function convertexcel5min()

DataGrid1.Visible = False
Dim line As String
Dim Count As String
h = 2
Dim TextLine As String
Open filename For Input Shared As #1
Do While Not EOF(1) '// Loop until end of file.
Line Input #1, TextLine '// Read line into variable.
' use the TextLine herer...
line = TextLine

Loop
Close #1

'create excel file

Dim fso As New FileSystemObject
Set oWB = objExcel.Workbooks.Add
Set oWS = oWB.Worksheets("Sheet1")
bname = oWB.Name
oWS.Cells.Columns.AutoFit
oWS.Cells.WrapText = False
bname = oWB.Name

oWS.Range("A1").Value = "Date"
oWS.Range("B1").Value = "Time"
oWS.Range("C1").Value = "Voltage(ERRU1)"
oWS.Range("D1").Value = "Current(ERRU1)"
oWS.Range("E1").Value = "Voltage(ERRU2)"
oWS.Range("F1").Value = "Current(ERRU2)"
oWS.Range("G1").Value = "Charging Current"
oWS.Range("H1").Value = "Discharging Current"
oWS.Range("I1").Value = "Alternator RPM"

dtlog = Split(line, "FE FF")

For k = 0 To UBound(dtlog) - 1

log = dtlog(k)

If k = 0 Then

Dim dlog() As String
dlog = Split(log, "FF")
log = dlog(1)


End If

datalg = Split(log, " ")
Count = UBound(datalg)

If Count <= 21 Then

If Count >= 18 Then

time = datalg(4) & "/" & datalg(5) & "/" & datalg(6) & " " & datalg(3) & ":" & datalg(2)
date1 = datalg(4) & "/" & datalg(5) & "/" & datalg(6)

If date1 >= date2 Then

date2 = date1

If time >= time1 Then
time1 = Format(DateAdd("n", 5, time), "dd/MM/yy hh:mm")
time = ""
date1 = ""

oWS.Range("A" & h).Value = " " & datalg(4) & "/" & datalg(5) & "/" & datalg(6)
oWS.Range("B" & h).Value = datalg(3) & ":" & datalg(2)

volt1 = HextoDec(datalg(7) & datalg(8))
vlt1value = Round((volt1 - 511) * 0.495, 2)

If vlt1value < 0 Then

vlt1value = 0

End If


cur1 = HextoDec(datalg(11) & datalg(12))

cr1value = (cur1 - 511) * 2.44


If cr1value < 0 Then

cr1value = 0

End If

volt2 = HextoDec(datalg(9) & datalg(10))

vlt2value = Round((volt2 - 511) * 0.495, 2)

If vlt2value < 0 Then

vlt2value = 0

End If


cur2 = HextoDec(datalg(13) & datalg(14))
cr2value = (cur2 - 511) * 2.44


If cr2value < 0 Then

cr2value = 0

End If


bcur = HextoDec(datalg(15) & datalg(16))
bcrvalue = Round((bcur - 511) * 2.44, 2)

freq1 = HextoDec(datalg(17) & datalg(18))
fr1value = Round((freq1 * 0.79) * 7.5)

If bcrvalue < 0 Then

bcrvalue = 0

End If

If fr1value < 0 Then

fr1value = 0

End If

oWS.Range("C" & h).Value = vlt1value
oWS.Range("D" & h).Value = cr1value
oWS.Range("E" & h).Value = vlt2value
oWS.Range("F" & h).Value = cr2value
oWS.Range("G" & h).Value = bcrvalue
oWS.Range("I" & h).Value = fr1value

h = h + 1
End If
End If
End If
End If
Count = ""
Next k


If Val(Application.Version) < 12 Then
'You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143
Else

'You use Excel 2007

FileExtStr = ".xls": FileFormatNum = 56

End If
TempFilePath = App.Path
TempFileName = "\Temp\5min" & Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)
oWB.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
oWB.close SaveChanges:=True
sfile2 = TempFilePath & TempFileName & FileExtStr
objExcel.Application.Quit

End Function

Function convertexcel10min()

Dim line As String
Dim Count As String
h = 2
Dim TextLine As String

'Open App.Path & "\download.log" For Input Access Read As #nHandle

Open filename For Input Shared As #1


Do While Not EOF(1) '// Loop until end of file.
Line Input #1, TextLine '// Read line into variable.
' use the TextLine herer...

line = TextLine

Loop
Close #1




'create excel file

Dim fso As New FileSystemObject

If fso.FileExists(App.Path & "\Excel Files\Default.xls") = False Then
Set oWB = objExcel.Workbooks.Add
Set oWS = oWB.Worksheets("Sheet1")
bname = oWB.Name
Else

Workbooks.open filename:=sfile2
Set oWB = objExcel.Application.ActiveWorkbook
Set oWS = oWB.Worksheets("Sheet1")
bname = oWB.Name


End If
bname = oWB.Name
oWS.Cells.Columns.AutoFit
oWS.Cells.WrapText = False

oWS.Range("A1").Value = "Date"
oWS.Range("B1").Value = "Time"
oWS.Range("C1").Value = "Voltage(ERRU1)"
oWS.Range("D1").Value = "Current(ERRU1)"
oWS.Range("E1").Value = "Voltage(ERRU2)"
oWS.Range("F1").Value = "Current(ERRU2)"
oWS.Range("G1").Value = "Charging Current"
oWS.Range("H1").Value = "Discharging Current"
oWS.Range("I1").Value = "Alternator RPM"

dtlog = Split(line, "FE FF")

For k = 0 To UBound(dtlog) - 1

log = dtlog(k)

If k = 0 Then

Dim dlog() As String

dlog = Split(log, "FF")
log = dlog(1)

End If

datalg = Split(log, " ")

Count = UBound(datalg)

If Count <= 21 Then

If Count >= 18 Then

time = datalg(4) & "/" & datalg(5) & "/" & datalg(6) & " " & datalg(3) & ":" & datalg(2)
date1 = datalg(4) & "/" & datalg(5) & "/" & datalg(6)


If date1 >= date2 Then

date2 = date1

If time >= time1 Then

time1 = Format(DateAdd("n", 10, time), "dd/MM/yy hh:mm")
time = ""
date1 = ""

oWS.Range("A" & h).Value = " " & datalg(4) & "/" & datalg(5) & "/" & datalg(6)
oWS.Range("B" & h).Value = datalg(3) & ":" & datalg(2)

volt1 = HextoDec(datalg(7) & datalg(8))
vlt1value = Round((volt1 - 511) * 0.495, 2)

If vlt1value < 0 Then

vlt1value = 0

End If


cur1 = HextoDec(datalg(11) & datalg(12))

cr1value = (cur1 - 511) * 2.44


If cr1value < 0 Then

cr1value = 0

End If

volt2 = HextoDec(datalg(9) & datalg(10))

vlt2value = Round((volt2 - 511) * 0.495, 2)
If vlt2value < 0 Then

vlt2value = 0

End If


cur2 = HextoDec(datalg(13) & datalg(14))
cr2value = (cur2 - 511) * 2.44


If cr2value < 0 Then

cr2value = 0

End If


bcur = HextoDec(datalg(15) & datalg(16))
bcrvalue = Round((bcur - 511) * 2.44, 2)

freq1 = HextoDec(datalg(17) & datalg(18))
fr1value = Round((freq1 * 0.79) * 7.5)

If bcrvalue < 0 Then

bcrvalue = 0

End If

If fr1value < 0 Then

fr1value = 0

End If


oWS.Range("C" & h).Value = vlt1value
oWS.Range("D" & h).Value = cr1value
oWS.Range("E" & h).Value = vlt2value
oWS.Range("F" & h).Value = cr2value
oWS.Range("G" & h).Value = bcrvalue
oWS.Range("I" & h).Value = fr1value

h = h + 1
End If
End If
End If
End If
Count = ""

Next k


If Val(Application.Version) < 12 Then
'You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143
Else

'You use Excel 2007

FileExtStr = ".xls": FileFormatNum = 56
End If

TempFilePath = App.Path
TempFileName = "\Temp\10min" & Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)


oWB.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
oWB.close SaveChanges:=True
sfile2 = TempFilePath & TempFileName & FileExtStr
objExcel.Application.Quit
End Function
Public Function HextoDec(HexNum As String) As Long
Dim lngOut As Long
Dim i As Integer
Dim c As Integer

For i = 1 To Len(HexNum)
c = Asc(UCase(Mid(HexNum, i, 1)))
Select Case c

Case 65 To 70
lngOut = lngOut + ((c - 55) * 16 ^ (Len(HexNum) - i))

Case 48 To 57
lngOut = lngOut + ((c - 48) * 16 ^ (Len(HexNum) - i))

Case Else


End Select
Next i
HextoDec = lngOut
End Function
Function convertexcelcumdata()

'nHandle = FreeFile

Dim line As String
Dim Count As String
h = 2
Dim TextLine As String

'Open App.Path & "\download.log" For Input Access Read As #nHandle

'Open filename For Input Access Read As #1
Open filename For Input Shared As #1


Do While Not EOF(1) '// Loop until end of file.
Line Input #1, TextLine '// Read line into variable.
' use the TextLine herer...

line = TextLine

Loop
Close #1

Set oWB = objExcel.Workbooks.Add
Set oWS = oWB.Worksheets("Sheet1")
bname1 = oWB.Name
oWS.Cells.Columns.AutoFit
oWS.Cells.WrapText = False
oWS.Range("A1").Value = "Date"
oWS.Range("B1").Value = "Time"
oWS.Range("C1").Value = "Charging Current"
oWS.Range("D1").Value = "Discharging Current"
oWS.Range("E1").Value = "Generation Time"
oWS.Range("F1").Value = "Non Generation Time"
dtlog = Split(line, "FE FF")
For k = 0 To UBound(dtlog) - 1
log = dtlog(k)

If k = 0 Then

Dim dlog() As String
dlog = Split(log, "FF")
log = dlog(1)

End If
Dim vl As String
vl = Mid(log, 2, 2)
If vl = "02" Then
datalg = Split(log, " ")

Dim dt As String
Count = UBound(datalg)

If Count <= 21 Then
If Count >= 11 Then

Dim dt1 As String
edate = Split(exdate, ",")
dt1 = edate(1)
Dim tm As String
etime = Split(extime, ",")
tm = etime(1)

chrcur = HextoDec(datalg(2) & datalg(3) & datalg(4))
dishrcur = HextoDec(datalg(5) & datalg(6) & datalg(7))
gntime = HextoDec(datalg(8) & datalg(9))
nongntime = HextoDec(datalg(10) & datalg(11))

oWS.Range("A" & h).Value = dt1
oWS.Range("B" & h).Value = tm
oWS.Range("C" & h).Value = chrcur
oWS.Range("D" & h).Value = dishrcur
oWS.Range("E" & h).Value = gntime
oWS.Range("F" & h).Value = nongntime

h = h + 1
End If
End If
End If
Count = ""

Next k
oWB.Save
If Val(Application.Version) < 12 Then
'You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143
Else

'You use Excel 2007

FileExtStr = ".xls": FileFormatNum = 56

End If

TempFilePath = App.Path
TempFileName = "\Temp\cum" & Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)

oWB.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
oWB.close SaveChanges:=True
sfile1 = TempFilePath & TempFileName & FileExtStr
objExcel.Application.Quit
End Function

Function convertexcelfaultdata()

Dim line As String
Dim Count As String
h = 2
Dim TextLine As String


Open filename For Input Shared As #1
Do While Not EOF(1) '// Loop until end of file.
Line Input #1, TextLine '// Read line into variable.
' use the TextLine herer...
line = TextLine

Loop
Close #1

'create excel file

Set oWB = objExcel.Workbooks.Add
Set oWS = oWB.Worksheets("Sheet1")
bname1 = oWB.Name
oWS.Cells.Columns.AutoFit
oWS.Cells.WrapText = False
oWS.Range("A1").Value = "Date"
oWS.Range("B1").Value = "Time"
oWS.Range("C1").Value = "Fault"
dtlog = Split(line, "FE FF")

For k = 0 To UBound(dtlog) - 1

log = dtlog(k)
If k = 0 Then
Dim dlog() As String
dlog = Split(log, "FF")
log = dlog(1)

End If

Dim vl As String
vl = Mid(log, 2, 2)
If vl = "04" Then

datalg = Split(log, " ")
Count = UBound(datalg)

If Count <= 21 Then
If Count >= 8 Then
fault = datalg(7)

If fault = "E1" Then
fault1 = "Alternator Failure"
End If

If fault = "E2" Then
fault1 = "Power Voltage"
End If

If fault = "E3" Then
fault1 = "UVC Failure"
End If

If fault = "E4" Then
fault1 = "Power Circuit Failure"
End If

If fault = "E5" Then
fault1 = "OVC Trip to OVC Reset"
End If

If fault = "E6" Then
fault1 = "Overload"
End If

If fault = "E7" Then
fault1 = "Short Circuit"
End If

If fault = "E8" Then
fault1 = "Battery Low Voltage"
End If

If fault = "E9" Then
fault1 = "Phase Failure"
End If

If fault = "EA" Then
fault1 = "Shaft Failure"
End If

oWS.Range("A" & h).Value = " " & datalg(4) & "/" & datalg(5) & "/" & datalg(6)
oWS.Range("B" & h).Value = datalg(3) & ":" & datalg(2)
oWS.Range("C" & h).Value = fault1

h = h + 1
End If
End If
End If
Count = ""
Next k
oWB.Save

If Val(Application.Version) < 12 Then
'You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143
Else

'You use Excel 2007

FileExtStr = ".xls": FileFormatNum = 56

End If

TempFilePath = App.Path
TempFileName = "\Temp\fault" & Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)
oWB.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
oWB.close SaveChanges:=True
file3 = TempFilePath & TempFileName & FileExtStr
objExcel.Application.Quit

End Function

No comments:

Using Authorization with Swagger in ASP.NET Core

 Create Solution like below LoginModel.cs using System.ComponentModel.DataAnnotations; namespace UsingAuthorizationWithSwagger.Models {     ...