elecfeemodulel.bas

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

        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

'//////////渐变色彩函数///////////////////
'示例:FormPaintColor()
'色值精细,速度慢
'////////////////////////////////////////
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
    Dim i As Integer
    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

'///////////////得知SHELL程序结束时间//////////////////////
Public Function StillRun(ByVal ProgramID) As Boolean
    Dim lHProgram As Long
    Dim lReturn As Long
    Dim hProgram 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
       '加密
       Dim t As Integer
       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"
              QianY = "J"
           Case 2
              BenY = "B"
              ShangY = "A"
              QianY = "L"
           Case 3
              BenY = "C"
              ShangY = "B"
              QianY = "A"
           Case 4
              BenY = "D"
              ShangY = "C"
              QianY = "B"
           Case 5
              BenY = "E"
              ShangY = "D"
              QianY = "C"
           Case 6
              BenY = "F"
              ShangY = "E"
              QianY = "D"
           Case 7
              BenY = "G"
              ShangY = "F"
              QianY = "E"
           Case 8
              BenY = "H"
              ShangY = "G"
              QianY = "F"
           Case 9
              BenY = "I"
              ShangY = "H"
              QianY = "G"
           Case 10
              BenY = "J"
              ShangY = "I"
              QianY = "H"
           Case 11
              BenY = "K"
              ShangY = "J"
              QianY = "I"
           Case 12
              BenY = "L"
              ShangY = "K"
              QianY = "J"
           Case Else
              BenY = "A"
              ShangY = "L"
              QianY = "K"
    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 & "月时间"
    WW = BenY & "月电建"
    yy = BenY & "月三峡"
    
    MM = BenY & "月线损"
    NN = BenY & "月损失"
    ZZ = BenY & "月维费"

    AAA = ShangY & "月示数"
    BBB = ShangY & "月电量"
    CCC = ShangY & "月电费"
    DDD = ShangY & "月调整金额"
    QQQ = QianY & "月示数"
    EEE = ShangY & "月调整电量"
End Sub

'设置listindex属性而不发生click事件函数:
Public Function SetListIndex(lst As Control, ByVal NewIndex As Long) As Long
    If TypeOf lst Is ListBox Then
       Call SendMessage(lst.hWnd, LB_SETCURSEL, NewIndex, 0&)
       SetListIndex = SendMessage(lst.hWnd, LB_GETCURSEL, NewIndex, 0&)
    ElseIf TypeOf lst Is ComboBox Then
       Call SendMessage(lst.hWnd, CB_SETCURSEL, NewIndex, 0&)
       SetListIndex = SendMessage(lst.hWnd, CB_GETCURSEL, NewIndex, 0&)
    End If
End Function

'数据库解密函数
Function DeCryptDataPass(dataPath As String) As String
    Dim Source(13), dest(13), result(13) As Byte
    Dim tt_byte  As Byte
    Dim i As Integer
    Dim StrTemp As String
    Source(0) = &H86
    Source(1) = &HFB
    Source(2) = &HEC
    Source(3) = &H37
    Source(4) = &H5D
    Source(5) = &H44
    Source(6) = &H9C
    Source(7) = &HFA
    Source(8) = &HC6
    Source(9) = &H5E
    Source(10) = &H28
    Source(11) = &HE6
    Source(12) = &H13
    If Trim(dataPath) = "" Then Exit Function
    Open dataPath For Binary Access Read As #1
    For i = 1 To 81
        Get #1, i, tt_byte
        If i > 66 And i < 80 Then dest(i - 67) = tt_byte
    Next
    StrTemp = ""
    For i = 0 To 12
        result(i) = Source(i) Xor dest(i)
        StrTemp = StrTemp + Chr(result(i))
    Next
    Close #1
    DeCryptDataPass = ";pwd=" & Trim(StrTemp)
End Function