Attribute VB_Name = "Module1"
'参数说明

' 按键: [F1] [F2] [OK] [ESC] [SCAN] [NET] [TAB] [LEFT] [RIGHT]


'Split(s1, vbCrLf, -1, vbTextCompare)(0)   ==> 按键名称
'Split(s1, vbCrLf, -1, vbTextCompare)(1)   ==> 设备序号
'Split(s1, vbCrLf, -1, vbTextCompare)(2)   ==> 用户代号
'Split(s1, vbCrLf, -1, vbTextCompare)(3)   ==> 窗体编号
'Split(s1, vbCrLf, -1, vbTextCompare)(4)   ==> 目前位置
'Split(s1, vbCrLf, -1, vbTextCompare)(5)   ==> 数值变量1 此变量具特殊用途, 字段移动时会自动清零.
'Split(s1, vbCrLf, -1, vbTextCompare)(6)   ==> 数值变量2
'Split(s1, vbCrLf, -1, vbTextCompare)(7)   ==> 数值变量3
'Split(s1, vbCrLf, -1, vbTextCompare)(8)   ==> 文字变量
'Split(s1, vbCrLf, -1, vbTextCompare)(9)   ==> 第一栏输入内容
'Split(s1, vbCrLf, -1, vbTextCompare)(10)   ==> 第二栏输入内容
'Split(s1, vbCrLf, -1, vbTextCompare)(11)   ==> 第三栏输入内容
'.........
'.........
'.........
'Split(s1, vbCrLf, -1, vbTextCompare)(N)   ==> 第N栏输入内容


'程序执行时没有参数, 将读取call.txt  完成后写入 ret.txt
'程序执行时有参数, 将读取参数名称的文字文件, 完成后写入同一文字文件


Public s1 As String, s2 As String, getname As String, putname As String

Sub Main()
On Error Resume Next
If Command$ = "" Then
    getname = "call.txt"
    putname = "ret.txt"
Else
    getname = Command$
    putname = Command$
End If

s1 = FileGet(getname)

Select Case Split(s1, vbCrLf, -1, vbTextCompare)(0)
    Case "F1"
        f1_rtn
    Case "F2"
        f2_rtn
    Case "OK"
        ok_rtn
    Case "ESC"
        esc_rtn
    Case "SCAN"
        scan_rtn
    Case "NET"
        net_rtn
    Case "TAB"
        tab_rtn
    Case "LEFT"
        left_rtn
    Case "RIGHT"
        right_rtn
    Case Else
        ot_rtn
End Select
Kill putname
FilePut putname, s2
'MsgBox "?????"
End
End Sub

Function ot_rtn()

End Function

Function f1_rtn()
On Error Resume Next
s2 = "[Form]" & vbCrLf
s2 = s2 & "TXT01=" & Split(s1, vbCrLf, -1, vbTextCompare)(0) & "陈陈陈" & vbCrLf
s2 = s2 & "TXT02=." & vbCrLf
s2 = s2 & "TXT04=" & "奥硕普电脑科技" & vbCrLf

End Function

Function f2_rtn()
On Error Resume Next
s2 = "[Form]" & vbCrLf
s2 = s2 & "MSG=" & "你按了[" & Split(s1, vbCrLf, -1, vbTextCompare)(0) & "]按键!" & vbCrLf

s2 = s2 & "FN=" & "2" & vbCrLf

s2 = s2 & "BEEP=" & "-...-" & vbCrLf


End Function

Function ok_rtn()
Dim TM_NO As String, QTY As String, CK_NO As String
On Error Resume Next
s2 = "[Form]" & vbCrLf

TM_NO = Split(s1, vbCrLf, -1, vbTextCompare)(9)
CK_NO = Split(s1, vbCrLf, -1, vbTextCompare)(10)

Call CK_RTN(TM_NO, CK_NO)

End Function

Function esc_rtn()
On Error Resume Next
s2 = "[Form]" & vbCrLf
s2 = s2 & "MSG=" & "你按了[" & Split(s1, vbCrLf, -1, vbTextCompare)(0) & "]按键!" & vbCrLf

s2 = s2 & "BEEP=" & ".-" & vbCrLf

End Function


Function scan_rtn()
On Error Resume Next
s2 = "[Form]" & vbCrLf
s2 = s2 & "MSG=" & "你按了[" & Split(s1, vbCrLf, -1, vbTextCompare)(0) & "]按键!" & vbCrLf

s2 = s2 & "BEEP=" & ".-" & vbCrLf

End Function

Function net_rtn()
On Error Resume Next
s2 = "[Form]" & vbCrLf
s2 = s2 & "MSG=" & "你按了[" & Split(s1, vbCrLf, -1, vbTextCompare)(0) & "]按键!" & vbCrLf

s2 = s2 & "BEEP=" & ".-" & vbCrLf

End Function


Function tab_rtn()
On Error Resume Next
s2 = "[Form]" & vbCrLf
's2 = s2 & "FRM=" & Split(s1, vbCrLf, -1, vbTextCompare)(9) & vbCrLf

s2 = s2 & "SCR01=6,2,陈正成,WHITE,RED" & vbCrLf

s2 = s2 & "SCR02=8,6,奥硕普电脑科技,GREEN,BLUE" & vbCrLf
s2 = s2 & "SCR03=10,6,FORTH,WHITE,BLACK" & vbCrLf
s2 = s2 & "SCR04=12,6,FORTH,RED" & vbCrLf

End Function

Function left_rtn()
On Error Resume Next
s2 = "[Form]" & vbCrLf

End Function

Function right_rtn()
On Error Resume Next
s2 = "[Form]" & vbCrLf

End Function

'======================以上为公用程序,以下为自写程序
Function CK_RTN(TM_NO As String, CK_NO As String)      'TM_NO--条形码,CK_NO--出库单号
Dim cn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim SQL As String, TM As String

On Error Resume Next
If TM_NO & "" = "" Then
    s2 = s2 & "MSG= 条形码,数量必须输入!" & vbCrLf
    s2 = s2 & "BEEP=" & "-...-" & vbCrLf
    Exit Function
End If

'打开数据库
lj = App.Path
lj = Left(lj, Len(lj) - 4)
cnstr = FileGet(lj & "\ini\database.ini") & vbCrLf & vbCrLf
'cnstr = FileGet(App.Path & "\ini\database.ini") & vbCrLf & vbCrLf   '测试时使用
SS = Split(cnstr, vbCrLf, -1, vbTextCompare)(dbn(index)) & ",,"
TT = "Data Source=" & Split(SS, ",", -1, vbTextCompare)(0) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(1)) <> "" Then TT = TT & "UID=" & Split(SS, ",", -1, vbTextCompare)(1) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(2)) <> "" Then TT = TT & "PWD=" & Split(SS, ",", -1, vbTextCompare)(2) & ";"
cn.Open TT

'FilePut App.Path & "\new_data.txt", cnstr & SS & TT & vbCrLf
 
Rs.Open "SELECT t_pur_record.* FROM t_pur_record ", cn, adOpenDynamic, adLockPessimistic

TM = "FWWWWWWNNNNNC"          '条码格式
len_f1 = InStr(1, TM, "F")
len_w1 = InStr(1, TM, "W")
len_n1 = InStr(1, TM, "N")
len_e1 = InStr(1, TM, "E")
len_c1 = InStr(1, TM, "C")
len_o1 = InStr(1, TM, "O")
len_f = len_w1 - len_f1
len_w = len_n1 - len_w1
len_n = IIf(len_c1 > 0, len_c1, len_o1) - len_n1

str_f = 10
For i = 1 To len_f
    str_f = str_f * 10
Next i

str_w = 10   '料号
For i = 1 To len_w
    str_w = str_w * 10
Next i

str_n = 10      '重量
For i = 1 To len_n
    str_n = str_n * 10
Next i

str_e = 10
For i = 1 To len_e
    str_e = str_e * 10
Next i

len_xs = 10    '小数位=2
For i = 1 To 2 - 1         'Text3 - 1
    len_xs = len_xs * 10
Next i

EL_NO = Val(Mid(TM_NO, len_w1, len_w))
W_QTY = Mid(TM_NO, len_n1, len_n) / len_xs
If W_QTY & "" = "" Then W_QTY = 0 '防止空值出错
If EL_NO & "" = "" Then EL_NO = 0
sum_rk = GET_SUM("rdweight", "t_sl_record", "gpluno=" & EL_NO & " and rdweight=" & W_QTY)
sum_ck = GET_SUM("pur_weight", "t_pur_record", "gpluno=" & EL_NO & " and pur_weight=" & W_QTY)
If sum_rk <= sum_ck Or sum_rk = 0 Then '有库存的才写入
    s2 = s2 & "MSG= 出库数量超出库存!" & vbCrLf
    s2 = s2 & "BEEP=" & "-...-" & vbCrLf
    Exit Function
End If

If CK_NO & "" = "" Then
    BIG_NO = Right(GET_BIG("pur_no", "t_pur_record", "FORMAT(pur_man,'YYMM')='" & Format(Date, "YYMM") & "'"), 5) + 1
    BIG_NO = Format(Date, "YYMM") & Right(BIG_NO + 100000, 5)
Else
    BIG_NO = CK_NO
    FIRST_ELNO = GET_STR("gpluno", "t_pur_record", "pur_no=" & BIG_NO)
    If EL_NO <> FIRST_ELNO And FIRST_ELNO & "" <> "" Then
    s2 = s2 & "MSG= 物料与第一笔不同!" & vbCrLf
    s2 = s2 & "BEEP=" & ".-" & vbCrLf
    Exit Function
    End If
    
    old_tm = GET_STR("gpluno", "t_pur_record", "gpluno=" & EL_NO & " and pur_weight=" & W_QTY & " and pur_no=" & BIG_NO)
    If old_tm & "" <> "" Then
        s2 = s2 & "MSG= 此出库单已有该条码!" & vbCrLf
        s2 = s2 & "BEEP=" & ".-" & vbCrLf
    End If

End If
Rs.AddNew
Rs("grdtime") = Now()
Rs("pur_no") = BIG_NO
Rs("gpluno") = EL_NO
Rs("pur_mcode") = ""
Rs("gmmode") = 0
Rs("gstyle") = 0
Rs("pur_weight") = W_QTY
Rs("pur_price") = 1
Rs("pur_sum") = Rs("pur_price") * Rs("pur_weight") 'Split(s1, vbTab, -1, vbTextCompare)(1)
Rs("pur_man") = Date
If Rs("gpluno") & "" <> "" Then Rs.Update
Rs.Close
DoEvents
sleep 1800

s2 = s2 & "TXT02=" & BIG_NO & vbCrLf  '傳值到介面

sum_rkjs = GET_COUNT("gpluno", "t_sl_record", "gpluno=" & EL_NO & " and rdweight=" & W_QTY)
sum_ckjs = GET_COUNT("gpluno", "t_pur_record", "gpluno=" & EL_NO & " and pur_weight=" & W_QTY)

s2 = s2 & "SCR01=7,1, '累计件数: " & GET_COUNT("pur_no", "t_pur_record", "pur_no=" & BIG_NO) & "'" & vbCrLf
s2 = s2 & "SCR02=8,1, '累计重量: " & GET_SUM("pur_weight", "t_pur_record", "pur_no=" & BIG_NO) & "'" & vbCrLf
s2 = s2 & "SCR03=9,1, '剩余件数: " & sum_rkjs - sum_ckjs & "'" & vbCrLf       '总入库件数-总出库件数-本次出库件数
s2 = s2 & "SCR04=10,1, '剩余重量: " & sum_rk - sum_ck - W_QTY & "'" & vbCrLf   '总入库-总出库-本次出库
s2 = s2 & "SCR05=11,1, '" & GET_STR("mname1", "t_base_merchandise", "mplu_no=" & EL_NO) & "'" & vbCrLf
s2 = s2 & "SCR06=3,1, 'ＥＳＣ结束否则继续扫'" & vbCrLf
's2 = s2 & "SCR05=10,1, '库位: " & el_no & "'" & vbCrLf
's2 = s2 & "SCR06=11,1, '品名: " & el_no & "'" & vbCrLf

End Function



