modencrypt.bas

1、以DLL形式提供医生工作站 2、 根据【检查项目】

Attribute VB_Name = "modEncrypt"
Option Explicit

'对字符串进行加密，返回加密后的字符串
Public Function PacsEncrypt(ByVal strToEncrypt As String) As String
    On Error GoTo ErrHandler
    Dim il_bit, il_x, il_y, il_z, il_len, i As Long
    Dim is_out As String
    il_len = Len(strToEncrypt)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len
        il_bit = AscW(Mid(strToEncrypt, i, 1))    'W系列支持unicode
        
        il_y = (il_bit * 13 Mod 256) + il_x
        is_out = is_out & ChrW(Fix(il_y))  '取整 int和fix区别: fix修正负数
        il_x = il_bit * 13 / 256
    Next
    is_out = is_out & ChrW(Fix(il_x))
    
    strToEncrypt = is_out
    il_len = Len(strToEncrypt)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len
        il_bit = AscW(Mid(strToEncrypt, i, 1))
        '取前4位值
        il_y = il_bit / 16 + 64
        is_out = is_out & ChrW(Fix(il_y))
        '取后4位值
        il_y = (il_bit Mod 16) + 64
        is_out = is_out & ChrW(Fix(il_y))
    Next
    PacsEncrypt = is_out
    
    Exit Function
ErrHandler:
    PacsEncrypt = strToEncrypt
End Function


Function PacsDecrypt(ByVal strParaToDecrypt As String) As String
    On Error GoTo ErrHandler
    Dim is_out As String
    Dim il_x, il_y, il_len, i, il_bit As Long
    
    Dim strToDecrypt As String
    strToDecrypt = strParaToDecrypt

    il_len = Len(strToDecrypt)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len Step 2
        il_bit = AscW(Mid(strToDecrypt, i, 1))
        '取前4位值
        il_y = (il_bit - 64) * 16
        '取后4位值
        'dd = AscW(Mid(password, i + 1, 1)) - 64
        il_y = il_y + AscW(Mid(strToDecrypt, i + 1, 1)) - 64
        is_out = is_out & ChrW(il_y)
    Next

    il_x = 0
    il_y = 0
    strToDecrypt = is_out
    is_out = ""

    il_len = Len(strToDecrypt)
    il_x = AscW(Mid(strToDecrypt, il_len, 1))

    For i = (il_len - 1) To 1 Step -1
        il_y = il_x * 256 + AscW(Mid(strToDecrypt, i, 1))
        il_x = il_y Mod 13
        is_out = ChrW(Fix(il_y / 13)) & is_out
    Next
    PacsDecrypt = is_out
    
    Exit Function
ErrHandler:
    PacsDecrypt = strToDecrypt
End Function