module1.bas

来自「齐鲁石化某分公司的数据采集管理系统」· BAS 代码 · 共 177 行

Attribute VB_Name = "Module1"
Global supername As String      '超级用户名
Global superpwd As String       '超级密码
Global unitname As String
Global temperature As String
Global humidity As String
Global weather As String
Global SuperAdmin As Boolean  '超级权限
Global Usering_Name As String   '登录用户
Global AdminIF As Boolean

Global dfrwUser As Boolean

Global g_VarDriver As String '数据库驱动
Global g_VarServer As String '服务名称
Global g_VarDbase As String '数据库名称
Global g_VarUser As String '用户名称
Global g_VarPassword As String '用户口令
Global g_VarDbaseTable As String '数据库表名

Public watchDate As String
Public watchTime As String
Public Guo_Che_FangXiang As String

Global gdh_DB_Path As String
Global gdh_Edit_Formats As String

Public objFileSystem As Object
Public WeightOpenYN As Boolean

Public Type PageAttrib
    PNumber As Integer  '计算机纸型索引号
    PName As String     '纸型
    PSize As String     '纸型大小(高x宽)
    PCount As Integer   '合适记录数
End Type

Global PageType(0 To 13) As PageAttrib

Sub Main()
    If App.PrevInstance = False Then
        gdhLogin.Show vbModal
        If Not gdhLogin.LoginSucceeded Then
        '登录失败，退出应用程序
            End
        End If
        Unload gdhLogin
        gdhMain.Show
    Else
        MsgBox "程序已经运行，请不要重复启用"
    End If
End Sub

Function prnt11(x As Long, y As Long, Font As Single, Txt As String, Val As Integer)
    Dim str As String, str1 As String, str2 As String, i As Integer
    
    Printer.CurrentX = x
    Printer.CurrentY = y
    Printer.FontBold = False
    Printer.FontSize = Font
    str = Txt
    str2 = str
    i = 0
    rowlab = 0
    If Len(Trim(str)) = 0 Then
        rowlab = 1   '待打印字符串为空的标志
    Else
        Do While Len(str) > 0
            Printer.CurrentX = x
            Printer.CurrentY = y + rowlab * 240
            rowlab = rowlab + 1
            If Len(str) >= Val Then
                str1 = Mid(str, 1, Val)
                Printer.Print str1
                i = i + 1
                str = Mid(str2, i * Val + 1)
            Else
                Printer.Print str
                Exit Do
            End If
        Loop
    End If
End Function

Function StringFormat(strSource As String, setLenth As Integer, LorR As String, ifFix As Boolean, setChar As String) As String

    Dim iSpaceNo As Integer
    Dim istrLen As Integer
    Dim i As Integer
    Dim Schar(1 To 255) As String
    Dim HanZiCount As Integer
    Dim ZiFuCount As Integer
    Dim Extanded As Boolean
    
    iSpaceNo = setLenth
    istrLen = Len(strSource)
    
    For i = 1 To istrLen
        Schar(i) = Mid(strSource, i, 1)
        If Asc(Schar(i)) < 0 Or Asc(Schar(i)) > 255 Then
            HanZiCount = HanZiCount + 1
            iSpaceNo = iSpaceNo - 2
        Else
            ZiFuCount = ZiFuCount + 1
            iSpaceNo = iSpaceNo - 1
        End If
        If iSpaceNo < 0 Then Exit For
    Next i
    
    If iSpaceNo < 0 Then
        iSpaceNo = iSpaceNo + 2
        HanZiCount = HanZiCount - 1
        Extanded = True
    End If
    
    
    If ifFix = True Then
        StringFormat = Mid(strSource, 1, HanZiCount + ZiFuCount)
        If Extanded = False Then
            
            If LorR = "L" Then
                For i = 1 To iSpaceNo
                    StringFormat = StringFormat + setChar
                Next i
            ElseIf LorR = "R" Then
                For i = 1 To iSpaceNo
                    StringFormat = setChar + StringFormat
                Next i
            ElseIf LorR = "I" Then
                For i = 1 To iSpaceNo \ 2
                    StringFormat = setChar + StringFormat
                Next i
                For i = 1 To (iSpaceNo - iSpaceNo \ 2)
                    StringFormat = StringFormat + setChar
                Next i
            End If
            
        End If
    ElseIf ifFix = False Then
        StringFormat = strSource
        
        If Extanded = False Then
            
            If LorR = "L" Then
                For i = 1 To iSpaceNo
                StringFormat = StringFormat + setChar
                Next i
            ElseIf LorR = "R" Then
                For i = 1 To iSpaceNo
                StringFormat = setChar + StringFormat
                Next i
            ElseIf LorR = "I" Then
                For i = 1 To iSpaceNo \ 2
                    StringFormat = setChar + StringFormat
                Next i
                For i = 1 To (iSpaceNo - iSpaceNo \ 2)
                    StringFormat = StringFormat + setChar
                Next i
            End If
            
        End If
        
    End If
    
End Function

Function Drop_table(ByVal tableName As String, ByVal dbPath As String)
    Dim db As ADODB.Connection
    On Error Resume Next
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";Jet OLEDB:Database Password=1;"
    db.Execute "drop table " & tableName & ""
    db.Close
    Exit Function
ok:
End Function