module1.bas

有读者和图书信息的添加查询,借还书等,先建立数据库和ODBC数据源

Attribute VB_Name = "Module1"
Public flag As Integer
Public bflagadd As Integer
Public flagadd As Integer
Public brflagadd As Integer
Public filename As String


Public Function ConnectString() As String
       ConnectString = "FileDSN=zhozhiyonxsbook.dsn;UID=sa;PWD="
End Function

Public Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset
       Dim cnn As ADODB.Connection
       Dim rst As ADODB.Recordset
       Set cnn = New ADODB.Connection
       cnn.Open ConnectString
       Set rst = New ADODB.Recordset
       rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic
       Set ExecuteSQL = rst
End Function

Public Sub SavetoDB(diskFile As String, jszh As String)
       Dim bytedata() As Byte
       Dim numblocks As Long
       Dim filelength As Long
       Dim leftover As Long
       Dim sourcefile As Long
       Dim i As Long
       Const BLOCKSIZE = 4096
       Dim cnn As ADODB.Connection
       Dim ADOrst As New ADODB.Recordset
       Dim fld As ADODB.Field
       Set cnn = New ADODB.Connection
       cnn.Open ConnectString
       ADOrst.Open "zzyxs", cnn, adOpenDynamic, adLockOptimistic
       Do While Trim(ADOrst("借书证号").Value) <> Trim(jszh) And Not ADOrst.EOF
                ADOrst.MoveNext
       Loop
       If Not ADOrst.EOF Then
           Set fld = ADOrst("照片")
       Else
           Exit Sub
       End If
       sourcefile = FreeFile
       Open diskFile For Binary Access Read As sourcefile
       filelength = LOF(sourcefile)
       If filelength = 0 Then
          Close sourcefile
          MsgBox diskFile & "无内容或内容不存在!"
       Else
          numblocks = filelength \ BLOCKSIZE
          leftover = filelength Mod BLOCKSIZE
          fld.Value = Null
          ReDim bytedata(BLOCKSIZE)
          For i = 1 To numblocks
              Get sourcefile, , bytedata()
              fld.AppendChunk bytedata()
          Next i
          ReDim bytedata(leftover)
          Get sourcefile, , bytedata()
          fld.AppendChunk bytedata()
          Close sourcefile
          ADOrst!FileLen = filelength
          ADOrst.Update
          ADOrst.Close
          cnn.Close
    End If
End Sub


Public Sub getfromDB(diskFile As String, jszh As String)
       Dim bytedata() As Byte
       Dim numblocks As Long
       Dim filelength As Long
       Dim leftover As Long
       Dim sourcefile As Long
       Dim i As Long
       Const BLOCKSIZE = 4096
       Dim cnn As ADODB.Connection
       Dim ADOrst As New ADODB.Recordset
       Dim fld As ADODB.Field
       Set cnn = New ADODB.Connection
       cnn.Open ConnectString
       ADOrst.Open "zzyxs", cnn, adOpenDynamic, adLockOptimistic
       Do While Trim(ADOrst("借书证号").Value) <> Trim(jszh) And Not ADOrst.EOF
                ADOrst.MoveNext
       Loop
       If Not ADOrst.EOF Then
          Set fld = ADOrst("照片")
       Else
          Exit Sub
       End If
       sourcefile = FreeFile
       Open diskFile For Binary As sourcefile
       filelength = ADOrst!FileLen
       If IsNull(filelength) Or filelength = 0 Then
          Close sourcefile
          MsgBox diskFile & "无内容或不存在!"
       Else
          numblocks = filelength \ BLOCKSIZE
          leftover = filelength Mod BLOCKSIZE
          For i = 1 To numblocks
              bytedata() = fld.GetChunk(BLOCKSIZE)
              Put sourcefile, , bytedata()
          Next i
          ReDim bytedata(leftover)
          bytedata() = fld.GetChunk(leftover)
          Put sourcefile, , bytedata()
          Close sourcefile
          ADOrst.Close
          cnn.Close
       End If
End Sub

Sub main()
    flag = 0
    frmmain.Show
End Sub