作者：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