想用就用，VB基础代码

作者：Cooly
出处：http://search.csdn.net/expert/topic/51/5101/2003/3/20/1555609.htm

''''=======================================================
''''一、如何使用ADODC控件绑定数据到DataGrid和DataList
''''=======================================================

Public isDB As Boolean

Private Sub Form_Load()
Dim connStr, AccessLocation As String
AccessLocation = "C:\db1.mdb"
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessLocation & ";Persist Security Info=False"
Adodc1.ConnectionString = connStr
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from tableabc"
Adodc1.Refresh
For i = 0 To Adodc1.Recordset.Fields.Count - 1
    List1.AddItem Adodc1.Recordset.Fields(i).Name
Next
Set DataList1.DataSource = Adodc1
DataList1.DataField = "Col1"
DataList1.BoundColumn = "Col1"
Set DataList1.RowSource = Adodc1
DataList1.ListField = "Col1"

Adodc1.Recordset.MoveFirst
End Sub

Private Sub List1_Click() ''''选择DataGrid中显示的字段
Dim sql, sql1 As String

sql = "select "
For i = 0 To List1.ListCount - 1
 If List1.Selected(i) Then
    If Trim(sql1) = "" Then
       sql1 = List1.List(i)
    Else
       sql1 = sql1 & ", " & List1.List(i)
    End If
 End If
Next

If Trim(sql1) = "" Then
   sql1 = "*"
End If

sql = sql & sql1 & " from tableabc"

Adodc1.RecordSource = sql
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub

''''========================================================
''''二、如何对文件进行二进制读写
''''========================================================
Dim getValue() As Byte

Private Sub Command1_Click()
Open "C:\1.cmd" For Binary Access Write As #2
     Put #2, , getValue()
Close #2

End Sub

Private Sub Form_Load()

Open "C:\command.com" For Binary Access Read As #1
      ReDim getValue(FileLen("C:\command.com"))
      Get #1, , getValue
Close #1
End Sub

''''========================================================
''''三、字符串处理算法(1)
'''' 求出已知字符串中出现频率最高的字串内容及出现次数
''''========================================================
Private Sub Command1_Click()
Dim a, b As String
Dim i As Long
Dim c, t As Long

c = 0
a = "abcdefcdedgcdeethcdenbicde"
For i = 1 To Len(a)
    t = 0
    b = a
    If i = Len(a) - 2 Then Exit For
    Do Until InStr(b, Mid(a, i, 3)) = 0
       b = Right(b, Len(b) - InStr(b, Mid(a, i, 3)))
       t = t + 1
    Loop
    If t > c Then
       c = t
    End If
Next
MsgBox c
End Sub

''''========================================================
''''四、DriveListBox,DirListBox,FileListBox三个控件的使用
''''========================================================

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
Text1.Text = File1.Path & "\" & File1.FileName
End Sub

''''========================================================
''''五、如何对目录进行操作 (使用FSO)
''''========================================================

Private Sub Command1_Click()
Dim fso As Object
Dim SourcePath, TargetPath As String
SourcePath = Text1.Text
TargetPath = Text2.Text
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(TargetPath) Then
   fso.CopyFolder SourcePath & "*.*", TargetPath
   fso.CopyFile SourcePath & "*.*", TargetPath
Else
   fso.CreateFolder (TargetPath)
   fso.CopyFolder SourcePath & "*.*", TargetPath
   fso.CopyFile SourcePath & "*.*", TargetPath
End If
Set fso = Nothing
MsgBox "复制完成"
End Sub

Private Sub Command2_Click()
Dim fso As Object
Dim TargetPath As String
TargetPath = "D:\Test"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder TargetPath, True
Set fso = Nothing
MsgBox "删除成功"
End Sub

''''========================================================
''''六、如何取出DataGrid控件选定行的内容
''''========================================================

Private Sub DataGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DataGrid1.Row = DataGrid1.RowContaining(Y)
MsgBox DataGrid1.Columns(0).Text
End Sub

Private Sub Form_Load()
Adodc1.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=test;Data Source=SERVER"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from test"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.AllowUpdate = False
End Sub

''''========================================================
''''七、如何ADODB对象绑定DataGrid控件
''''========================================================

Private Sub Form_Load()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset

Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset
conn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=test;Data Source=SERVER"
conn.Open , "sa"

rst.CursorLocation = adUseClient

rst.Open "select * from table1", conn, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = rst

End Sub

''''========================================================
''''八、日期函数的使用以及使用FileExists判断文件是否存在
''''========================================================
Private Sub Command1_Click()
If IsNumeric(Text1.Text) And InStr(Text1.Text, ".") = 0 And InStr(Text1.Text, "-") = 0 Then
   If CLng(Text1.Text) > 0 And CLng(Text1.Text) <= 12 Then
      MsgBox DateDiff("d", DateSerial(Year(Now()), Text1.Text, 1), DateAdd("m", 1, DateSerial(Year(Now()), Text1.Text, 1)))
   Else
      MsgBox "Error"
   End If
Else
   MsgBox "Error, Wrong Value"
End If
End Sub

Private Sub Command2_Click()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists("C:\command.com") = True Then
       MsgBox "C:\Command.com 文件已存在"
    Else
       MsgBox "C:\Command.com 文件不存在"
    End If

Set fso = Nothing
End Sub

''''========================================================
''''九、十进制与二进制的简单算法。
''''========================================================

Private Sub Command1_Click()
Dim a, b As Long
Dim c As String
a = Text1.Text
Do
   If a = 0 Then Exit Do
   If a > 1 Then
      b = a Mod 2
   Else
      b = a
   End If
   c = CStr(b) & CStr(c)
   a = a \ 2
Loop
Text2.Text = c
End Sub

Private Sub Command2_Click()
Dim a, b As String
Dim i, c, d As Long
a = Text2.Text

For i = 1 To Len(a)
    c = CLng(Mid(a, i, 1))
    If c = 1 Then
       d = d + 2 ^ (Len(a) - i)
    End If
Next
Text3.Text = d
End Sub

''''========================================================
''''十七、在容器中移动控件
''''========================================================
Public isMove As Boolean
Public bX, bY As Long

Private Sub Form_Load()
isMove = False
End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   isMove = True
   bX = X
   bY = Y
End If
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 And isMove Then
   Label1.Move X + Label1.Left - bX, Y + Label1.Top - bY
End If
End Sub

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
isMove = False
End Sub

''''========================================================
''''十八、如何在运行程序的时候获得外部参数
''''========================================================
Private Sub Form_Load()
Dim ParaArray() As String
Dim GetString As String
Dim I As Long
GetString = Trim(Command())
If InStr(GetString, "/") = 1 Then
   If Len(GetString) > 1 Then
      GetString = Right(GetString, Len(GetString) - 1)
      ParaArray = Split(GetString, "/", -1, vbTextCompare)
      For I = 0 To UBound(ParaArray())
          MsgBox "Parameter " & I + 1 & ": = " & Trim(ParaArray(I))
      Next
   Else
      MsgBox "Empty Parameter!"
   End If
Else
   If InStr(GetString, "/") = 0 Then
      MsgBox "No Parameter! "
   Else
      MsgBox "Wrong Format"
   End If
End If
End Sub

''''========================================================
''''十九、注册表的操作
''''==============================================

[1] [2]  下一页

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18