mymodule.bas

用VB写的和数据库联合编程的电子图档管理系统

Attribute VB_Name = "MyModule"
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long

Public UserName As String '用户
Public UserPas As String '用户密码
Public Purview As String '操作权限
Public fMainForm As frmMain


Sub Main()

    '初始化帮助文件
    Dim name As String
    name = App.Path + "\" + App.EXEName + ".chm"
    App.HelpFile = name
    
    Dim fLogin As New frmLogin
    fLogin.Show vbModal
    If Not fLogin.OK Then
        '登录失败，退出应用程序
        End
    End If
    Unload fLogin


    Set fMainForm = New frmMain
    fMainForm.Width = 9090
    fMainForm.Height = 5970
    fMainForm.Show
    
End Sub

'将表单的字段(ole)保存到文件
Function FieldToFileStream(filename As String, fdObject As Field) As Integer
    
    Dim count As Long
    Dim data() As Byte
    Dim left As Long
    Dim i As Long
    Dim size As Long
    Dim iFileNumber As Integer
    
    iFileNumber = FreeFile
    DeleteFile filename
    Open filename For Binary Access Write As iFileNumber
    size = 4096

    ReDim data(size)
    count = fdObject.FieldSize() \ size
    
    ' 获得文件的块数
    left = fdObject.FieldSize() Mod size
    '整块后余下的数据
    For i = 0 To count - 1
        data() = fdObject.GetChunk(i * size, size)
        ' 取一块
        Put iFileNumber, , data()
        '将块写入临时文件
    Next
    If left > 0 Then
        data() = fdObject.GetChunk(count * size, left)
        '取余下的数据
        Put iFileNumber, , data()
        '将其写入临时文件
    End If
    
    Close iFileNumber
    FieldToFileStream = 0
    '返回
    
End Function

'将文件保存至表单字段(ole)
Function FileStreamToField(Fld As Field, DiskFile 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 '定义循环变量
    Dim BLOCKSIZE As Long
    
    BLOCKSIZE = 4096
    
    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() '写入FLD
    Next i
    ReDim byteData(LeftOver) '重新定义数据块的大小
    Get SourceFile, , byteData() '读到内存块中
    Fld.AppendChunk byteData() '写入FLD
    Close SourceFile '关闭源文件
    End If
    
End Function

'是否是数字
Function isnumber(d As String)
    
    isnumber = 1
    
    Dim i As Integer
    
    For i = 1 To Len(d)
      If Mid(d, i, 1) < "0" Or Mid(d, i, 1) > "9" Then
         isnumber = 0
         Exit Function
      End If
    Next
    
    If Len(d) <= 0 Then isnumber = 0
    
End Function

'是不是合法的日期
Function IsDate(d As String)
    
    IsDate = 1
    
    If Len(d) > 10 Then IsDate = 0
    
    Dim i, m, n As Integer
    m = -1: n = -1
    
    '获取两个'-'的位置分别保存至m,n
    For i = 1 To Len(d)
       If Mid(d, i, 1) = "-" Then
           If m = -1 Then
              m = i
           Else
              n = i
           End If
       End If
    Next
    '如果没有两个'-'
    If m = -1 Or n = -1 Then
        IsDate = 0
        Exit Function
    End If
    '剩下年是否都是数字
    If m <> -1 Then
        For i = 1 To m - 1
           If Mid(d, i, 1) < "0" Or Mid(d, i, 1) > "9" Then
              IsDate = 0
              Exit Function
           End If
        Next
    End If
    '剩下月是否都是数字
    If m <> -1 And n <> -1 Then
        For i = m + 1 To n - 1
           If Mid(d, i, 1) < "0" Or Mid(d, i, 1) > "9" Then
              IsDate = 0
              Exit Function
           End If
        Next
    End If
    
    '月是否在1-12之间
    If m + 1 <> n - 1 Then
       Dim t As Integer
       t = (Asc(Mid(d, m + 1, 1)) - 48) * 10 + Asc(Mid(d, n - 1, 1)) - 48
       If t <= 0 Or t > 12 Then
          IsDate = 0
          Exit Function
       End If
    End If
    '剩下日是否都是数字
    If n <> -1 Then
        For i = n + 1 To Len(d)
           If Mid(d, i, 1) < "0" Or Mid(d, i, 1) > "9" Then
              IsDate = 0
              Exit Function
           End If
        Next
    End If
    '日是否在1-31之间
    If n + 1 <> Len(d) Then
       t = (Asc(Mid(d, n + 1, 1)) - 48) * 10 + Asc(Mid(d, Len(d), 1)) - 48
       If t <= 0 Or t > 31 Then
          IsDate = 0
          Exit Function
       End If
    End If
    
End Function