VB6学习笔记

'定义连接对象和记录集
Dim conn AsADODB.Connection
Dim rs AsADODB.Recordset
Public pid As Integer  '把a定义在通用区
Private Sub btn_Add_Click(Index As Integer)
Form2.Show vbModal
End Sub
Private SubDataGrid1_Click()
 pid = DataGrid1.Columns(0).Value
 Form2.Show vbModal
End Sub
Private SubForm_Load()
pid = 0
Set conn = NewADODB.Connection
Set rs = NewADODB.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

Private SubCommand1_Click()
Dim conn As NewADODB.Connection
  Dim rs As NewADODB.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 SubForm_Load()
If Form1.pid <> 0 Then '判断修改还是删除
MsgBox "修改"
Else
MsgBox "添加"
End If
End Sub

Dim postData As String
Dim url As String
Private SubCommand1_Click()
    postFun
End Sub
Private FunctionpostFun()
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
  MsgBoxHttpClient.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) AsVariant
    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 SubForm_Load()
Me.Timer1.Interval = 1000
End Sub
Private SubTimer1_Timer()
postFun
End Sub