📄 modsfis.bas
字号:
If Dir(strLocalFile) = "" Then
Wait 100
End If
If gstrDebugMode <> "1" Then
FileCopy strLocalFile, App.Path + "\BackUp\Request\" + strSN + ".txt"
End If
DeleteFileEx strLocalFile
Exit Sub
Errhandle:
Select Case Err.Number
Case 73, 48, 75, 76, 46, 53, 56, 52
Wait 50
Resume
Case Else
MsgBox Err.Description + CStr(Err.Number)
Stop
End Select
End Sub
Public Sub SendResultFile(strTypeDrive As String)
Dim strSN As String
Dim strDrive As String
Dim strResponseFile As String
Dim strRemoteFile As String
Dim strLocalFile As String
Select Case strTypeDrive
Case "Normal"
strDrive = gstrResultLogDrive
Case "RePrint"
strDrive = gstrRePrintResultLogDrive
Case Else
Stop
End Select
strSN = UCase(Trim(frmMain.txtSN))
On Error GoTo Errhandle
'If old response file exists,Delete it
strResponseFile = gstrResponseLogDrive + "\" + strSN + ".sf"
If Dir(strResponseFile) <> "" Then DeleteFileEx strResponseFile
strRemoteFile = strDrive + "\" + strSN + ".txt"
strLocalFile = App.Path + "\Sfis\" + strSN + ".txt" '03-07-16 20:24 at home/Gao
'Save a txt File
Open strLocalFile For Output As #1
'03-07-17-14:10 Delete gstrModel,gstrIMEI,gstrVendorSN
' Print #1, gstrLineNo + ";" + gstrStation + ";" + gstrEmployee + ";" + strSN + ";" + "PASS;" + gstrModel + ";" + gstrLocation + ";" + gstrIMEI + ";" + gstrVendorSN + ";" + gstrBattery1_Model + ";" + gstrBattery1 + ";" + gstrBattery2_Model + ";" + gstrBattery2 + ";" + gstrBatteryLocation + ";" + gstrTripChargerModel + ";" + gstrTripChargerLocation + ";" + gstrTripChargerSN + ";"
Print #1, gstrLineNo + ";" + gstrStation + ";" + gstrEmployee + ";" + strSN + ";" + "PASS;" + ";" + gstrModel + ";" + gstrLocation + ";" + gstrBattery1_Model + ";" + gstrBattery1 + ";" + gstrBattery2_Model + ";" + gstrBattery2 + ";" + gstrBatteryLocation + ";" + gstrTripChargerModel + ";" + gstrTripChargerLocation + ";" + gstrTripChargerSN + ";"
Close #1
Wait 50
If gstrDebugMode = "1" Or gstrDebugMode = "2" Then
CopyFileEx strLocalFile, strRemoteFile
End If
If Dir(strLocalFile) = "" Then
Wait 100
End If
If gstrDebugMode <> "1" Then
FileCopy strLocalFile, App.Path + "\BackUp\Result\" + strSN + ".txt"
End If
DeleteFileEx strLocalFile
Exit Sub
Errhandle:
Select Case Err.Number
Case 73, 48, 75, 76, 46, 53, 56, 52
Wait 50
Resume
Case Else
MsgBox Err.Description + CStr(Err.Number)
Stop
End Select
End Sub
Public Function ReadResponseFile(strType As String, strFlow As String) As Boolean
Dim i As Integer
Dim strSfFile1 As String
Dim strSfFile2 As String
Dim strBuffer As String
Dim BsArray() As String
Dim blnResponse As Boolean
Dim strSN As String
Dim strDrive As String
strSN = Trim(frmMain.txtSN)
On Error GoTo Errhandle
blnResponse = False
Select Case UCase(strFlow)
Case "NORMAL"
strDrive = gstrResponseLogDrive
Case "REPRINT"
strDrive = gstrRePrintResponseLogDrive
Case Else
Stop
End Select
strSfFile1 = strDrive + "\" + strSN + ".sf"
strSfFile2 = App.Path + "\Sfis\" + strSN + ".sf"
i = 0
If Dir(strSfFile2) <> "" Then
DeleteFileEx strSfFile2
End If
Do Until i > 5
DoEvents
If Dir(strSfFile1) <> "" Then
blnResponse = True
CopyFileEx strSfFile1, strSfFile2
If Dir(strSfFile2) = "" Then
Wait 100
End If
Open strSfFile2 For Input As #1
Line Input #1, strBuffer
Close #1
BsArray = Split(strBuffer, ";")
Select Case UCase(BsArray(1))
Case "PASS"
ReadResponseFile = True
If UCase(strType) = "REQUEST" And UCase(strFlow) = "NORMAL" Then
frmMain.lblCECTSN = "CECTSN:" + BsArray(4)
frmMain.lblIMEI = "IMEI :" + BsArray(4)
End If
If UCase(strType) = "REQUEST" And UCase(strFlow) = "REPRINT" Then
'Give Value and PrintOut
With frmMain
.txtModel = BsArray(3)
gstrModel = BsArray(3)
.txtLocation = BsArray(4)
gstrLocation = BsArray(4)
.lblIMEI = "IMEI :" + BsArray(5)
gstrIMEI = BsArray(5)
.lblCECTSN = "CECTSN:" + BsArray(6)
gstrVendorSN = BsArray(6)
.txtBattModel = BsArray(7)
gstrBattery1_Model = BsArray(7)
.txtBattery1 = BsArray(8)
gstrBattery1 = BsArray(8)
gstrBattery2_Model = BsArray(9)
.txtBattery2 = BsArray(10)
gstrBattery2 = BsArray(10)
.txtBattLocation = BsArray(11)
gstrBatteryLocation = BsArray(11)
.txtTripChargerModel = BsArray(12)
gstrTripChargerModel = BsArray(12)
.txtTripChargerLocation = BsArray(13)
gstrTripChargerLocation = BsArray(13)
.txtTripChargerSN = BsArray(14)
gstrTripChargerSN = BsArray(14)
End With
PrintOut
End If
Case "FAIL"
ReadResponseFile = False
Select Case UCase(strType)
Case "REQUEST"
frmMain.lblResult = "FAIL" + BsArray(3)
frmMain.BackColor = vbRed
Case "RESULT"
frmMain.lblResult = "FAIL" + BsArray(4)
frmMain.BackColor = vbRed
Case Else
MsgBox "Program Error!!!"
Stop
End Select
Case Else
frmMain.lblResult = "TMO Server Error Response!!!"
frmMain.BackColor = vbRed
ReadResponseFile = False
End Select
Exit Do
End If
Wait 100
i = i + 1
Loop
If blnResponse = False Then
ReadResponseFile = False
frmMain.lblResult = "TMO No Response,Please Contact MIS!!"
frmMain.BackColor = vbRed
Else
If gstrDebugMode = "2" Then
CopyFileEx strSfFile2, App.Path + "\Backup\" + strType + "\" + strSN + ".sf"
End If
DeleteFileEx strSfFile1
DeleteFileEx strSfFile2
End If
frmMain.txtSN.SelStart = 0
frmMain.txtSN.SelLength = Len(frmMain.txtSN)
frmMain.txtSN.SetFocus
Exit Function
Errhandle:
Select Case Err.Number
Case 73, 48, 75, 76, 46, 53, 56, 52
Wait 50
Resume
Case Else
MsgBox Err.Description + CStr(Err.Number)
Stop
End Select
End Function
Public Sub DeleteFileEx(strFilename As String)
Dim lngHandle As Long
Dim intI As Integer
intI = 0
Do
lngHandle = DeleteFile(strFilename)
intI = intI + 1
Loop Until lngHandle <> 0& Or intI = 5
End Sub
Public Sub CopyFileEx(strSourceFile As String, strDesFile As String)
Dim lngHandle As Long
Dim intI As Integer
intI = 0
Do
lngHandle = CopyFile(strSourceFile, strDesFile, False)
intI = intI + 1
Loop Until lngHandle <> 0& Or intI = 5
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -