Tags：vb代码 - 阡陌暮的部落格 - A tall tree catches the wind. 树大招风。

VB两种操作Access数据库方法的比较

[

2007年10月13日星期六 10:29 | by 九天狼 | 出处：本站原创 ]

↓看看这下面↓

↑有你需要的↑

在VB编程中通常要与数据库打交道，对于数据量较小的应用，一般选用Access作为数据库，因为Access数据库比较简单，功能也比较齐全，数据的备份、拷贝都很方便，且程序发布时不需要额外单独安装其它的数据库管理软件。因此，在功能能够满足要求的条件下，Access数据库往往成为一些小型数据库软件的首选。

　　关于用VB操作Access库表的方法有多种，一般初学者往往会使用数据控件，许多资料上也大都以此作为操作Access数据库的起点来介绍，因为这个方法使用起来非常简单，但使用数据控件的方法在程序编码上往往不够灵活。现在介绍一下其它两种操作Access数据库的方法。

　　第一种：使用数据库对象

　　首先，要进行有关数据对象的声明，代码如下。

Dim MyWs As Workspace
Dim MyDB As Database
Dim WordTab As Recordset

生成工作区，打开数据库，然后再根据需要打开相应的库表。

Set MyWs = DBEngine.CreateWorkspace″″ ″Admin″ ″″ dbUseJet
Set MyDB = MyWs.OpenDatabase数据库名称 False False
Set WordTab = MyDB.OpenRecordset″表名″ dbOpenDynaset



　　这种方法的优点是代码比较简单，要求的环境为DAO 2.5/3.51，其中表名可以换成SELECT语句，即根据条件打开所需要的记录集，这种方法可脱离数据控件，可以比较方便灵活地操作数据库表，增加了程序的灵活性。

　　提示：经过测试发现，这种方法只能打开Access97库表，对于Access2000库表却无能为力，会弹出库表格式不对的出错提示。另外，对数据环境的要求仍比较多。

　　第二种：使用ADODB

　　首先，声明一个链接变量，并根据需要声明记录集变量。

Dim LocCnn1 As ADODB.Connection
Dim LocRst1 As ADODB.Recordset

　　建立与数据库的链接，如果数据库没有口令，最后一行可以不写（写上也不会错）。

Set LocCnn1 = New ADODB.Connection
LocCnn1.Open ″Provider=Microsoft.Jet.OLEDB.4.0User ID=Admin″ & _
″Data Source=″ & App.Path & ″\数据库名称.mdb″& _
″Mode=Share Deny NoneExtended Properties=''Persist Security Info=False″ & _
″Jet OLEDBDatabase Password='asp561rbc'″

　　这种方法虽然代码长一些，但对数据环境要求低，且结构清晰，所编写的发布程序也大为减小。由于与链接SQL Server等数据库的方法一样，因而大量的操作数据库的代码相同，当数据库需要由Access扩充到一些大型数据库，或由一些大型数据库裁剪出一个简单数据库时，程序的移植会比较方便。

　　另外，这种方法对于Access97及Access2000均能很好地支持，兼容性好。对于大量插入、删除、修改等操作，只在Connection层进行即可，既可提高速度又可减少代码。

　　如果还要获取具体的记录集内容，则须再根据条件打开具体的库表，代码如下：

Set LocRst1 = New ADODB.Recordset　
LocRst1.CursorType = adOpenKeyset
LocRst1.LockType = adLockOptimistic
LocRst1.Open ″SELECT  FROM 表名″ LocCnn1adCmdText

　　提示：一般情况下，建议使用第二种方法。

Tags: vb代码

VB代码 | 评论(0) | 引用(0) | 阅读(3174)

VB字符串取反代码

[

2007年1月28日星期一 19:43 | by 九天狼 | 出处：本站原创 ]

字符串取反

Function RStr(Str As String) As String
For i = Len(Str) To 1 Step -1
RStr = RStr & Mid(Str, i, 1)
Next
End Function

Tags: vb代码 , 取反字符串

VB代码 | 评论(0) | 引用(0) | 阅读(5986)

密码生成器

[

2007年1月27日星期日 20:12 | by 九天狼 | 出处：本站原创 ]

对功能进行了升级和大量修改.
最新版源码下载:

下载文件

这个文件只能在登入之后下载。请先注册或登入

下面是旧版的
新建一个窗体,放入以下控件:()内为控件的Caption属性.
list1放在窗体最上边,label1(长度:)和text1为一组,label2(数量:)和text2为一组,lable3(位置:)和text3为一组,最后再放置一个Command1(生成)按钮.
自行将控件放置在适当的位置.
将以下代码复制到窗体代码中:

Dim TempPsdString As String
Dim tem(3) As String
Private Sub Command1_Click()
Dim i As Integer
Dim TmpStr As String
List1.Clear
Open Text3 & "pwd.txt" For Output As #1
Print ""
Close #1
For i = 0 To Text2 - 1
TmpStr = GetStr(Text1)
List1.AddItem TmpStr
Open Text3 & "pwd.txt" For Append As #1
Print #1, TmpStr
Close #1
Form1.Caption = "密码生成器" & "--已完成" & Int(i / (Text2 - 1) * 100) & "%"
Next
If MsgBox("已生成" & Text2 & "个" & Text1 & "字符的密码" & vbCr & "是否打开密码文件查看?", vbYesNo + vbInformation, "任务完成") = vbYes Then Shell "notepad.exe " & Text3 & "pwd.txt"
Form1.Caption = "密码生成器"
End Sub

Function GetStr(Index As Integer) As String
If Index < 1 Then Exit Function
Dim i As Integer
Dim TmpStr As String
For i = 1 To Index
Randomize
TmpStr = Mid(TempPsdString, Int(Len(TempPsdString) * Rnd) + 1, 1)
GetStr = GetStr + CStr(TmpStr)
Next
End Function

Private Sub Form_Load()
Text3 = App.Path
If Right(Text3, 1) <> "\" Then Text3 = Text3 & "\"
Text3 = App.Path
If Right(Text3, 1) <> "\" Then Text3 = Text3 & "\"
tem(0) = "0123456789"
tem(1) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
tem(2) = "abcdefghijklmnopqrstuvwxyz"
tem(3) = "~!@#$%^&*()_+[]:,.<>?/*-"
TempPsdString = tem(0) + tem(1) + tem(2) + tem(3)
End Sub

高级功能:自主选择密码字符:
按上边的方法添加完控件后.再添加一个控件组:Check1,复制Check,并粘贴3次.得到一个Check1的控件数组.从Check1(0)-Check(3)
并添加以下代码到窗体代码中:

Private Sub Check1_Click(Index As Integer)
TempPsdString = ""
For i = 0 To 3
If Check1(i).Value = 1 Then TempPsdString = TempPsdString & tem(i)
Next
If TempPsdString = "" Then MsgBox "必须选择一项！": Check1(Index).Value = 1
End Sub

Tags: vb代码 , 密码生成

VB代码 | 评论(0) | 引用(0) | 阅读(7733)

VB连接数据库的方法1

[

2007年1月27日星期日 20:11 | by 九天狼 | 出处：本站原创 ]

Public connSTR As String '定义一个公用变量

Public Function CData() '连接数据库,
On Error GoTo errEnd
dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "Data.mdb"
connSTR = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbName & ";Persist Security Info=False"
Exit Sub
errEnd:
MsgBox err.Description, vbOKOnly + vbExclamation, "打开数据库出错"
End Function

阅读全文

Tags: vb代码 , 数据库连接

VB代码 | 评论(0) | 引用(0) | 阅读(7925)

汉字转拼音源码

[

2007年1月25日星期四 15:34 | by 九天狼 | 出处：本站原创 ]

下面是模块代码,请将其复制到模块中.

'汉字转拼音
Public Function py(mystr As String) As String
If Asc(mystr) < 0 Then
If Asc(Left(mystr, 1)) < Asc("啊") Then
py = "0"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("啊") And Asc(Left(mystr, 1)) < Asc("芭") Then
py = "A"
Exit Function
End If
[separator]
If Asc(Left(mystr, 1)) >= Asc("芭") And Asc(Left(mystr, 1)) < Asc("擦") Then
py = "B"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("擦") And Asc(Left(mystr, 1)) < Asc("搭") Then
py = "C"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("搭") And Asc(Left(mystr, 1)) < Asc("蛾") Then
py = "D"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("蛾") And Asc(Left(mystr, 1)) < Asc("发") Then
py = "E"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("发") And Asc(Left(mystr, 1)) < Asc("噶") Then
py = "F"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("噶") And Asc(Left(mystr, 1)) < Asc("哈") Then
py = "G"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("哈") And Asc(Left(mystr, 1)) < Asc("击") Then
py = "H"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("击") And Asc(Left(mystr, 1)) < Asc("喀") Then
py = "J"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("喀") And Asc(Left(mystr, 1)) < Asc("垃") Then
py = "K"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("垃") And Asc(Left(mystr, 1)) < Asc("妈") Then
py = "L"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("妈") And Asc(Left(mystr, 1)) < Asc("拿") Then
py = "M"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("拿") And Asc(Left(mystr, 1)) < Asc("哦") Then
py = "N"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("哦") And Asc(Left(mystr, 1)) < Asc("啪") Then
py = "O"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("啪") And Asc(Left(mystr, 1)) < Asc("期") Then
py = "P"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("期") And Asc(Left(mystr, 1)) < Asc("然") Then
py = "Q"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("然") And Asc(Left(mystr, 1)) < Asc("撒") Then
py = "R"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("撒") And Asc(Left(mystr, 1)) < Asc("塌") Then
py = "S"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("塌") And Asc(Left(mystr, 1)) < Asc("挖") Then
py = "T"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("挖") And Asc(Left(mystr, 1)) < Asc("昔") Then
py = "W"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("昔") And Asc(Left(mystr, 1)) < Asc("压") Then
py = "X"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("压") And Asc(Left(mystr, 1)) < Asc("匝") Then
py = "Y"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("匝") Then
py = "Z"
Exit Function
End If
Else
If UCase(mystr) <= "Z" And UCase(mystr) >= "A" Then
py = UCase(Left(mystr, 1))
Else
py = mystr
End If
End If

End Function
'汉字转拼音完

下面是使用代码:

Private Sub Text1_Change()'text1l输入时在label1中即时显示拼音
If Option1.Value = True Then
Label1.Caption = ""
Dim a As Integer
a = Len(Text1.Text)
For i = 1 To a
Label1.Caption = Label1.Caption & py(Mid(Text1.Text, i, 1))
Next i
End If
End Sub

Private Sub Command1_Click()'按command1后在label1显示拼音
Dim a As Integer
Label1.Caption = ""
a = Len(Text1.Text)
For i = 1 To a
Label1.Caption = Label1.Caption & py(Mid(Text1.Text, i, 1))
Next i
End Sub

Tags: vb代码

VB代码 | 评论(1) | 引用(0) | 阅读(7892)

窗体透明源码

[

2007年1月25日星期四 14:38 | by 九天狼 | 出处：本站原创 ]

下面是模块代码

'窗体透明代码开始
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
Public Const LWA_COLORKEY = &H1
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
'窗体透明代码结束

下面是使用代码:最下边的一行中的255为透明度.值为0-255,0为完全透明,255为完全不透明

Dim rtn As Long
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, 255, LWA_ALPHA

Tags: vb代码

VB代码 | 评论(0) | 引用(0) | 阅读(7806)

vb窗体最上层源码

[

2007年1月25日星期四 14:34 | by 九天狼 | 出处：本站原创 ]

下面的是模块代码

'窗体位于最上层代码开始
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_SHOWWINDOW = &H40
Public Const FLAGS = &H2 Or &H1
'窗体位于最上层代码结束

下面是使用代码,可以放在任意地方,注意的两个retvalue=同时只能使用一个

Dim retvalue As Long
retvalue = SetWindowPos(Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)'取消最上层
retvalue = SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)'设置为最上层

Tags: vb代码

VB代码 | 评论(0) | 引用(0) | 阅读(6842)