想用就用,VB基础代码

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

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

'========================================================

'十九、注册表的操作

'========================================================

Option Explicit

Const HKEY_CLASSES_ROOT = &H80000000

Const HKEY_CURRENT_USER = &H80000001

Const HKEY_LOCAL_MACHINE = &H80000002

Const HKEY_USERS = &H80000003

Const HKEY_PERFORMANCE_DATA = &H80000004

Const HKEY_CURRENT_CONFIG = &H80000005

Const HKEY_DYN_DATA = &H80000006

Const REG_NONE = 0

Const REG_SZ = 1

Const REG_EXPAND_SZ = 2

Const REG_BINARY = 3

Const REG_DWORD = 4

Const REG_DWORD_BIG_ENDIAN = 5

Const 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 Long

Private 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 Long

Dim 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", hKey

RegSetValueEx hKey, DSNName, 0, REG_SZ, ByVal strDBType, Len(strDBType) + 1

RegCreateKey HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & DSNName, hKey

RegSetValueEx hKey, "Driver", 0, REG_EXPAND_SZ, ByVal CStr(strDriver), Len(strDriver) + 1

RegSetValueEx hKey, "Server", 0, REG_SZ, ByVal CStr(strServer), Len(strServer) + 1

RegSetValueEx hKey, "Database", 0, REG_SZ, ByVal CStr(strDatabase), Len(strDatabase) + 1

RegSetValueEx hKey, "LastUser", 0, REG_SZ, ByVal CStr(strLastUser), Len(strLastUser) + 1

End Sub

'========================================================

'二十、TreeView的使用,及选中其中指定的节点

'========================================================

Private Sub Command1_Click()

Dim nodeY As Node

For Each nodeY In TreeView1.Nodes

If CStr(Trim(nodeY.Text)) = "ff" Then

nodeY.Selected = True

TreeView1.SetFocus

Exit For

End If

Next

End Sub

Private Sub Form_Load()

Rs1.CommandType = adCmdText

Rs1.RecordSource = "select distinct biao,zu from test order by zu"

Rs1.Refresh

Dim Rs As ADODB.Recordset

Set 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

Loop

End Sub

'========================================================

'二十一、Word对象的使用(查找Word文档中是否包含指定关键字,

'以及在指定位置插入字符串)

'========================================================

Private Sub Command1_Click()

Dim wrdApp As Object

Dim f, fso As Object

Dim filepath As String

Dim Keywords As String

filepath = "c:\words"

Keywords = "abc"

Set fso = CreateObject("Scripting.FileSystemObject")

Set folders = fso.GetFolder(filepath)

I = 0

For 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 If

Next

Set wrdApp = Nothing

End Sub

Private Sub Command2_Click()

Dim wrdApp As Object

Dim wrdRows, wrdCols, I As Long

Dim insText As String

wrdRows = 10: wrdCols = 10

insText = "TEST"

Set wrdApp = CreateObject("Word.Application")

wrdApp.Visible = False

wrdApp.Documents.Open FileName:="C:\words\1.doc"

For I = 1 To wrdRows

wrdApp.ActiveDocument.Content.insertAfter vbCrLf

Next

wrdApp.ActiveDocument.Content.GoTo What:=3, Which:=2, Count:=wrdRows

wrdApp.ActiveDocument.Content.insertAfter Space(wrdCols) & "PPPPPPPPPPPPP"

wrdApp.ActiveDocument.Save

wrdApp.Quit

Set wrdApp = Nothing

End Sub

更多请看原贴:http://expert.csdn.net/Expert/topic/1555/1555609.xml?temp=.3376276

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航