Option Explicit
Private Declare Function LCMapstring Lib "kernel32" Alias "LCMapStringA" (ByVal locale As Long, ByVal dwpflags As Long, ByVal lpsrcstr As String, ByVal cchsrc As Long, ByVal lpdeststr As String, ByVal cchdest As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpstring As String) As Long
Dim stf As String
Dim stj As String
Dim stlen As String
Dim DataTemp() As VMCode
Private Sub Combo1_Click()
Text1.Text = DataTemp(Combo1.ListIndex).prd_no
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim VarString
Dim dbFilePath As String
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim SQL As String
Dim i As Integer
Dim vartest As String
dbFilePath = "FileDSN=db_tz13.dsn;UID=sa;PWD=sqlsa" 'server 192.168.1.12
If KeyCode = 13 Then
Text1.Text = ""
If Combo1.Text <> "" Then
VarString = Split(Combo1.Text, " ") 'split是一个切割函数
Combo1.Clear
SQL = "SELECT prd_no,spc FROM DBO.PRDT WHERE "
For i = 0 To UBound(VarString)
stj = VarString(i)
stlen = lstrlen(stj)
stf = Space(stlen)
LCMapstring &H804, &H4000000, stj, stlen, stf, stlen
VarString(i) = stf
If i <> 0 Then
SQL = SQL & " and "
End If
SQL = SQL & "CHARINDEX(N'" & Trim(VarString(i)) & "',spc)<>0"
Next i
SQL = SQL & " order by prd_no"
Else
Label3.Caption = ""
Exit Sub
End If
Else
Exit Sub
End If
On Error GoTo ExecuteSQL_Error
Set cnn = New ADODB.Connection
cnn.Open dbFilePath
cnn.Execute "use db_tz13"
Set rst = New ADODB.Recordset
rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic
If rst.RecordCount <> 0 Then
ReDim DataTemp(rst.RecordCount - 1)
Label3.Caption = "找到符合条件的 " & rst.RecordCount & "条记录!"
rst.MoveFirst
For i = 0 To rst.RecordCount - 1
stf = rst.Fields(1)
stlen = lstrlen(stf)
stj = Space(stlen)
LCMapstring &H804, &H2000000, stf, stlen, stj, stlen
DataTemp(i).prd_no = rst.Fields(0)
DataTemp(i).spc = stj
Combo1.AddItem DataTemp(i).prd_no & " | " & DataTemp(i).spc
rst.MoveNext
If i = 100 Then
i = rst.RecordCount
Label3.Caption = Label3.Caption & Chr(13) & "请注意仅仅列出前100个记录!"
End If
Next i
'Combo1.Drop
'SendKeys "{f4}"
Else
Label3.Caption = "找到符合条件的 0条记录!"
End If
Exit Sub
ExecuteSQL_Error:
MsgBox "连接服务器失败!", vbOKOnly + vbCritical, "错误!"
End Sub