一佳一

记录像1+1一样简洁的代码

导航

VB6学习笔记

Posted on 2017-04-06 17:14  一佳一  阅读(721)  评论(0编辑  收藏  举报

1.数据库读取

【工程】菜单的【引用】菜单项,打开引用对话框,选中【Microsoft ActiveX Data Objects 6.1 Library】

【工程】菜单的【引用】菜单项,打开引用对话框,选中【Microsoft ActiveX Data Object Recordset 6.0 Library】

 

'定义连接对象和记录集
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Public pid As Integer  '把a定义在通用区

Private Sub btn_Add_Click(Index As Integer)
Form2.Show vbModal
End Sub

Private Sub DataGrid1_Click()
 pid = DataGrid1.Columns(0).Value
 Form2.Show vbModal
End Sub

Private Sub Form_Load()
pid = 0
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
'建立无源数据库连接
conn.ConnectionString = "driver={sql server};server=.;UID=sa;pwd=123;Database=testvb"
conn.ConnectionTimeout = 50
conn.Open
Dim str As String
'连接连接对象
Set rs.ActiveConnection = conn
'设置游标类型
rs.CursorType = adOpenDynamic
'设置查询字符串
str = "select * from T_Product "
rs.Open str, conn, adOpenStatic, adLockOptimistic

If rs.EOF = True Then
MsgBox "没有任何数据", vbOKOnly + vbExclamation, "警告"
Else


 Set DataGrid1.DataSource = rs
 MsgBox rs.RecordCount, vbOKOnly + vbExclamation, "提示"
 
 
End If

End Sub

2.提交

Private Sub Command1_Click()
Dim conn As New ADODB.Connection
  Dim rs As New ADODB.Recordset
      conn.Open "driver={sql server};server=.;UID=sa;pwd=123;Database=testvb"
      rs.CursorType = adOpenStatic
      rs.CursorLocation = adUseClient
      'conn.Execute "insert,delete,update的语句"
      conn.Execute "insert into  T_Product values(" + Me.Text1.Text + ", " + Me.Text2.Text + ")"

      '关闭连接  释放内存
      conn.Close
      Set rs = Nothing
      Set conn = Nothing
      MsgBox "插入成功"
      Unload Me
End Sub

Private Sub Form_Load()
If Form1.pid <> 0 Then '判断修改还是删除
MsgBox "修改"
Else
MsgBox "添加"
End If
End Sub

3.访问网络

Dim postData As String
Dim url As String


Private Sub Command1_Click()
    postFun
End Sub
Private Function postFun()
   
url = "http://127.0.0.1/api/car/***.ashx"
postData = ""

Dim HttpClient As Object
  
  Set HttpClient = CreateObject("Microsoft.XMLHTTP")
  HttpClient.Open "POST", url, False
  HttpClient.setRequestHeader "Content-Type", "text/xml; charset=UTF-8"
  HttpClient.Send pvToByteArray(postData)
        
  Do While HttpClient.readyState <> 4
    DoEvents
  Loop
    
  MsgBox HttpClient.responseText
End Function


Private Function pvToByteArray(sText As String) As Byte()
   pvToByteArray = GB2312ToUTF8(sText)
       
End Function
  
Public Function GB2312ToUTF8(strIn As String, Optional ByVal ReturnValueType As VbVarType = vbString) As Variant
    Dim adoStream As Object
    
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = "utf-8"
    adoStream.Type = 2 'adTypeText
    adoStream.Open
    adoStream.WriteText strIn
    adoStream.Position = 0
    adoStream.Type = 1 'adTypeBinary
    GB2312ToUTF8 = adoStream.Read()
    adoStream.Close
    
    If ReturnValueType = vbString Then GB2312ToUTF8 = Mid(GB2312ToUTF8, 1)
         
End Function

Private Sub Form_Load()
Me.Timer1.Interval = 1000

End Sub

Private Sub Timer1_Timer()
postFun
End Sub

 4.条形码

http://blog.csdn.net/easyboot/article/details/50808498