作者：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 StringAccessLocation = "C:\db1.mdb"connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessLocation & ";Persist Security Info=False"Adodc1.ConnectionString = connStrAdodc1.CommandType = adCmdTextAdodc1.RecordSource = "select * from tableabc"Adodc1.RefreshFor i = 0 To Adodc1.Recordset.Fields.Count - 1    List1.AddItem Adodc1.Recordset.Fields(i).NameNextSet DataList1.DataSource = Adodc1DataList1.DataField = "Col1"DataList1.BoundColumn = "Col1"Set DataList1.RowSource = Adodc1DataList1.ListField = "Col1" Adodc1.Recordset.MoveFirstEnd 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 IfNext If Trim(sql1) = "" Then   sql1 = "*"End If sql = sql & sql1 & " from tableabc" Adodc1.RecordSource = sqlAdodc1.RefreshSet DataGrid1.DataSource = Adodc1End 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, , getValueClose #1End Sub '========================================================'三、字符串处理算法(1)' 求出已知字符串中出现频率最高的字串内容及出现次数'========================================================Private Sub Command1_Click()Dim a, b As StringDim i As LongDim c, t As Long c = 0a = "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 IfNextMsgBox cEnd Sub '========================================================'四、DriveListBox,DirListBox,FileListBox三个控件的使用'======================================================== Private Sub Dir1_Change()File1.Path = Dir1.PathEnd Sub Private Sub Drive1_Change()Dir1.Path = Drive1.DriveEnd Sub Private Sub File1_Click()Text1.Text = File1.Path & "\" & File1.FileNameEnd Sub '========================================================'五、如何对目录进行操作 (使用FSO)'======================================================== Private Sub Command1_Click()Dim fso As ObjectDim SourcePath, TargetPath As StringSourcePath = Text1.TextTargetPath = Text2.TextSet fso = CreateObject("Scripting.FileSystemObject")If fso.FolderExists(TargetPath) Then   fso.CopyFolder SourcePath & "*.*", TargetPath   fso.CopyFile SourcePath & "*.*", TargetPathElse   fso.CreateFolder (TargetPath)   fso.CopyFolder SourcePath & "*.*", TargetPath   fso.CopyFile SourcePath & "*.*", TargetPathEnd IfSet fso = NothingMsgBox "复制完成"End Sub Private Sub Command2_Click()Dim fso As ObjectDim TargetPath As StringTargetPath = "D:\Test"Set fso = CreateObject("Scripting.FileSystemObject")fso.DeleteFolder TargetPath, TrueSet fso = NothingMsgBox "删除成功"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).TextEnd 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 = adCmdTextAdodc1.RecordSource = "select * from test"Adodc1.RefreshSet DataGrid1.DataSource = Adodc1DataGrid1.AllowUpdate = FalseEnd Sub '========================================================'七、如何ADODB对象绑定DataGrid控件'======================================================== Private Sub Form_Load()Dim conn As ADODB.ConnectionDim rst As ADODB.Recordset Set conn = New ADODB.ConnectionSet rst = New ADODB.Recordsetconn.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, adLockOptimisticSet 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 IfElse   MsgBox "Error, Wrong Value"End IfEnd Sub Private Sub Command2_Click()Dim fso As ObjectSet 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 = NothingEnd Sub '========================================================'九、十进制与二进制的简单算法。'======================================================== Private Sub Command1_Click()Dim a, b As LongDim c As Stringa = Text1.TextDo   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 \ 2LoopText2.Text = cEnd Sub Private Sub Command2_Click()Dim a, b As StringDim i, c, d As Longa = 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 IfNextText3.Text = dEnd Sub '========================================================'十七、在容器中移动控件'========================================================Public isMove As BooleanPublic bX, bY As Long Private Sub Form_Load()isMove = FalseEnd 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 = YEnd IfEnd 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 - bYEnd IfEnd Sub Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)isMove = FalseEnd Sub '========================================================'十八、如何在运行程序的时候获得外部参数'========================================================Private Sub Form_Load()Dim ParaArray() As StringDim GetString As StringDim I As LongGetString = 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 IfElse   If InStr(GetString, "/") = 0 Then      MsgBox "No Parameter! "   Else      MsgBox "Wrong Format"   End IfEnd IfEnd Sub '========================================================'十九、注册表的操作'======================================================== Option ExplicitConst HKEY_CLASSES_ROOT = &H80000000Const HKEY_CURRENT_USER = &H80000001Const HKEY_LOCAL_MACHINE = &H80000002Const HKEY_USERS = &H80000003Const HKEY_PERFORMANCE_DATA = &H80000004Const HKEY_CURRENT_CONFIG = &H80000005Const HKEY_DYN_DATA = &H80000006Const REG_NONE = 0Const REG_SZ = 1Const REG_EXPAND_SZ = 2Const REG_BINARY = 3Const REG_DWORD = 4Const REG_DWORD_BIG_ENDIAN = 5Const REG_MULTI_SZ = 7 Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As LongPrivate Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Sub Command1_Click()Dim hKey As LongDim DSNName, strDriver, strServer, strDatabase, strLastUser, strDBType As String DSNName = "myodbc" strDriver = "C:\\WINNT\\System32\\sqlsrv32.dll" 'SQL Server的驱动,如果用VFP可以改成相应的文件strServer = "SERVER"strDatabase = "test"strLastUser = "sa"strDBType = "SQL Server" RegCreateKey HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKeyRegSetValueEx hKey, DSNName, 0, REG_SZ, ByVal strDBType, Len(strDBType) + 1 RegCreateKey HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & DSNName, hKeyRegSetValueEx hKey, "Driver", 0, REG_EXPAND_SZ, ByVal CStr(strDriver), Len(strDriver) + 1RegSetValueEx hKey, "Server", 0, REG_SZ, ByVal CStr(strServer), Len(strServer) + 1RegSetValueEx hKey, "Database", 0, REG_SZ, ByVal CStr(strDatabase), Len(strDatabase) + 1RegSetValueEx hKey, "LastUser", 0, REG_SZ, ByVal CStr(strLastUser), Len(strLastUser) + 1End Sub '========================================================'二十、TreeView的使用，及选中其中指定的节点'========================================================Private Sub Command1_Click()Dim nodeY As NodeFor Each nodeY In TreeView1.Nodes    If CStr(Trim(nodeY.Text)) = "ff" Then       nodeY.Selected = True       TreeView1.SetFocus       Exit For    End IfNextEnd Sub Private Sub Form_Load()Rs1.CommandType = adCmdTextRs1.RecordSource = "select distinct biao,zu from test order by zu"Rs1.RefreshDim Rs As ADODB.RecordsetSet Rs = Rs1.Recordset     Set nodX = TreeView1.Nodes.Add(, , "r", "报表组  ")        i = 0    Dim TempString As String    Dim TempKey As Long    Do Until Rs.EOF Or Rs.BOF     If TempString = Rs!zu Then        Set nodeX = TreeView1.Nodes.Add("Z" & TempKey, tvwChild, "B" & i, Rs!biao)     Else        Set nodX = TreeView1.Nodes.Add("r", tvwChild, "Z" & i, Rs!zu)        Set nodeX = TreeView1.Nodes.Add("Z" & i, tvwChild, "B" & i, Rs!biao)        TempString = Rs!zu        TempKey = i     End If        Rs.MoveNext        i = i + 1    LoopEnd Sub '========================================================'二十一、Word对象的使用(查找Word文档中是否包含指定关键字，'以及在指定位置插入字符串)'========================================================Private Sub Command1_Click()Dim wrdApp As ObjectDim f, fso As ObjectDim filepath As StringDim Keywords As String filepath = "c:\words"Keywords = "abc" Set fso = CreateObject("Scripting.FileSystemObject") Set folders = fso.GetFolder(filepath) I = 0For Each f In folders.Files    If LCase(Right(f.Name, Len(f.Name) - InStrRev(f.Name, "."))) = "doc" Then       Set wrdApp = CreateObject("Word.Application")       wrdApp.Visible = False       wrdApp.Documents.Open FileName:=filepath & "\" & f.Name        If InStr(wrdApp.ActiveDocument.Content.Text, Keywords) <> 0 Then          MsgBox f.Name       End If              wrdApp.Quit           End IfNext Set wrdApp = Nothing End Sub Private Sub Command2_Click()Dim wrdApp As ObjectDim wrdRows, wrdCols, I As LongDim insText As String wrdRows = 10: wrdCols = 10insText = "TEST" Set wrdApp = CreateObject("Word.Application")wrdApp.Visible = FalsewrdApp.Documents.Open FileName:="C:\words\1.doc" For I = 1 To wrdRows    wrdApp.ActiveDocument.Content.insertAfter vbCrLfNext wrdApp.ActiveDocument.Content.GoTo What:=3, Which:=2, Count:=wrdRowswrdApp.ActiveDocument.Content.insertAfter Space(wrdCols) & "PPPPPPPPPPPPP" wrdApp.ActiveDocument.SavewrdApp.Quit Set wrdApp = Nothing End Sub更多请看原贴：http://expert.csdn.net/Expert/topic/1555/1555609.xml?temp=.3376276

评论