module1.bas

适合乡镇供电所使用电费处理系统v3 软件

End Function

'////////////处理sql中的查询/////////////////
'以后在动态生成 Select 语句， 使用：
'  SqlString = "Select * from myBas where Name  = " & CheckString(Text1)
'///////////////////////////////////////////
Public Function CheckSQL(s) As String
    pos = InStr(s, "'")
    While pos > 0
    s = Mid(s, 1, pos) & "'" & Mid(s, pos + 1)
    pos = InStr(pos + 2, s, "'")
    Wend
    
    CheckSQL = "'" & s & "'"
End Function

'/////////////渐变颜色///////////////////////

Sub Gradient(TheObject As Object, Redval&, Greenval&, Blueval&, TopToBottom As Boolean)
    Dim Step%, Reps%, FillTop%, FillLeft%, FillRight%, FillBottom%, HColor$
    Step = (TheObject.Height / 63)
    If TopToBottom = True Then FillTop = 0 Else FillTop = TheObject.Height - Step
    FillLeft = 0
    FillRight = TheObject.Width
    FillBottom = FillTop + Step
    For Reps = 1 To 63
        TheObject.Line (FillLeft, FillTop)-(FillRight, FillBottom), RGB(Redval, Greenval, Blueval), BF
        Redval = Redval - 4
        Greenval = Greenval - 4
        Blueval = Blueval - 4
        If Redval <= 0 Then Redval = 0
        If Greenval <= 0 Then Greenval = 0
        If Blueval <= 0 Then Blueval = 0
        If TopToBottom = True Then FillTop = FillBottom Else FillTop = FillTop - Step
        FillBottom = FillTop + Step
    Next
End Sub


'//////////渐变色彩函数///////////////////
Sub FormPaintColor(objName As Object, sigRedUp As Single, sigGreenUp As Single, sigBlueUp As Single, _
               sigRedDn As Single, sigGreenDn As Single, sigBlueDn As Single)
On Error Resume Next
Dim objHeight As Single
Dim RedInfo As Single, GreenInfo As Single, BlueInfo As Single
Dim Red As Single, Green As Single, Blue As Single
objHeight = objName.ScaleHeight
RedInfo = (sigRedDn - sigRedUp) / objHeight
GreenInfo = (sigGreenDn - sigGreenUp) / objHeight
BlueInfo = (sigBlueDn - sigBlueUp) / objHeight
For i = 0 To objHeight - 1
    Red = sigRedUp + i * RedInfo
    Green = sigGreenUp + i * GreenInfo
    Blue = sigBlueUp + i * BlueInfo
    objName.ForeColor = RGB(Red, Green, Blue)
    objName.Line (0, i)-(objName.ScaleWidth - 1, i)
Next i
End Sub

'///////////////////获取计算机用户名/////////////
Public Function sUserName() As String

Dim Bufstr As String
Bufstr = Space$(50)

If GetUserName(Bufstr, 50) > 0 Then
    sUserName = Bufstr
    sUserName = RTrim(sUserName)
    'UserName = StripTerminator(UserName)
Else
    sUserName = ""
End If
        
End Function

'////////////获取计算机名//////////////////

Function sGetComputerName() As String
  Dim sBuff As String
  Dim sBufSize As Long
  Dim sStatus As Long
  
  sBufSize = 255
  sBuff = String$(sBufSize, " ")
  sStatus = GetComputerName(sBuff, sBufSize)
  sGetComputerName = ""
  If sStatus <> 0 Then
     sGetComputerName = Left(sBuff, sBufSize)
  End If
  
End Function


'///////////////得知SHELL程序结束时间//////////////////////
Public Function StillRun(ByVal ProgramID) As Boolean
Dim lHProgram As Long
Dim lReturn As Long
hProgram = OpenProcess(0, False, ProgramID)
If Not hProgram = 0 Then
    StillRun = True
Else
    StillRun = False
End If
CloseHandle hProgram
End Function

'///////////////32字节校验函数/////////////////
Function A32(ByVal virString As String)
    Dim SLen As Long, i As Long
    Dim returnNum
    Static STP As Long
    STP = 0
    SLen = Len(virString)
    If SLen <> 64 Then
       MsgBox "数据错误！", vbCritical
    End If
    For i = 1 To SLen - 32
        If i = 1 Then
           returnNum = Mid(virString, i, 2)
        End If
        If i = 2 Then
           returnNum = "&H" & returnNum Xor "&H" & Trim(Mid(virString, i + 1, 2))
        End If
        If i = 3 Then
           returnNum = returnNum Xor "&H" & Trim(Mid(virString, i + 2, 2))
        End If
        If i > 3 Then
           STP = STP + 1
           returnNum = returnNum Xor "&H" & Trim(Mid(virString, i + STP + 2, 2))
        End If
    Next
    A32 = returnNum
End Function

Public Function Crypt(texti, salasana) As String
       '加密
       On Error Resume Next

              For T = 1 To Len(salasana)
                     sana = Asc(Mid(salasana, T))
                     X1 = X1 + sana
              Next

       X1 = Int((X1 * 0.1) / 6)
       salasana = X1
       G = 0
        For TT = 1 To Len(texti)
           sana = Asc(Mid(texti, TT))
             G = G + 1
             If G = 6 Then G = 0
               X1 = 0
                If G = 0 Then X1 = sana - (salasana - 2)
                  If G = 1 Then X1 = sana + (salasana - 5)
                    If G = 2 Then X1 = sana - (salasana - 4)
                      If G = 3 Then X1 = sana + (salasana - 2)
                        If G = 4 Then X1 = sana - (salasana - 3)
                          If G = 5 Then X1 = sana + (salasana - 5)
                            X1 = X1 + G
                              Crypted = Crypted & Chr(X1)
        Next
        Crypt = Crypted
End Function

Public Function DeCrypt(texti, salasana) As String
 '解密
       On Error Resume Next

              For T = 1 To Len(salasana)
                     sana = Asc(Mid(salasana, T))
                     X1 = X1 + sana
              Next

       X1 = Int((X1 * 0.1) / 6)
       salasana = X1
       G = 0
       For TT = 1 To Len(texti)
         sana = Asc(Mid(texti, TT))
           G = G + 1
            If G = 6 Then G = 0
             X1 = 0
             If G = 0 Then X1 = sana + (salasana - 2)
              If G = 1 Then X1 = sana - (salasana - 5)
               If G = 2 Then X1 = sana + (salasana - 4)
                If G = 3 Then X1 = sana - (salasana - 2)
                 If G = 4 Then X1 = sana + (salasana - 3)
                  If G = 5 Then X1 = sana - (salasana - 5)
                   X1 = X1 - G
                   DeCrypted = DeCrypted & Chr(X1)
       Next
       DeCrypt = DeCrypted
End Function

Sub sTruInfo()
    Select Case Val(GzYue)
           Case 1
              BenY = "A"
              ShangY = "L"
           Case 2
              BenY = "B"
              ShangY = "A"
           Case 3
              BenY = "C"
              ShangY = "B"
           Case 4
              BenY = "D"
              ShangY = "C"
           Case 5
              BenY = "E"
              ShangY = "D"
           Case 6
              BenY = "F"
              ShangY = "E"
           Case 7
              BenY = "G"
              ShangY = "F"
           Case 8
              BenY = "H"
              ShangY = "G"
           Case 9
              BenY = "I"
              ShangY = "H"
           Case 10
              BenY = "J"
              ShangY = "I"
           Case 11
              BenY = "K"
              ShangY = "J"
           Case 12
              BenY = "L"
              ShangY = "K"
           Case Else
              BenY = "A"
              ShangY = "L"
    End Select
    AA = BenY & "月示数"
    BB = BenY & "月调整电量"
    CC = BenY & "月电量"
    DD = BenY & "月合计电量"
    EE = BenY & "月调整金额"
    FF = BenY & "月滞纳金"
    GG = BenY & "月电费"
    HH = BenY & "月合计电费"
    II = BenY & "月代扣"
    JJ = BenY & "发票打印"
    KK = BenY & "交费情况"
    LL = BenY & "计算"
    VV = BenY & "月时间"
    AAA = ShangY & "月示数"
    BBB = ShangY & "月电量"
    CCC = ShangY & "月电费"
    
End Sub