modbasecode.bas

WinBig. A file archive utility written in VB. Compression and decompression routines are LZSS. Full

Attribute VB_Name = "ModBasecode"
Option Explicit

Public Function cdDate(arg1 As Long) As Date
    cdDate = DateAdd("s", arg1, "1/1/70")
End Function

Public Function hex(arg1 As Variant, arg2 As Byte) As String
    hex = String(arg2 - Len(VBA.hex$(arg1)), "0") + VBA.hex$(arg1)
End Function

Public Function Dot(arg1 As String, Optional arg2 As Boolean = True, Optional arg3 As String = ".") As String
    Dim spot1 As Integer, spot2 As Integer
    
    spot2 = 1
    Do
        spot1 = InStr(spot2, arg1, arg3)
        If spot1 > 0 Then spot2 = spot1 + 1
    Loop While spot1 > 0
    
    If spot2 > 1 Then
        If arg2 = True Then
            Dot = Mid(arg1, spot2)
        Else
            Dot = Left(arg1, spot2 - 2)
        End If
    Else
        If arg2 = True Then
            Dot = arg1
        Else
            Dot = ""
        End If
    End If
End Function

Public Sub ValidateDir(arg1 As String)
    On Error Resume Next
    
    If Dir(arg1, vbDirectory) = "" Then
        If Dot(arg1, False, "\") = arg1 Then
            MkDir arg1
        Else
            ValidateDir Dot(arg1, False, "\")
            MkDir arg1
        End If
    End If
End Sub

Public Function Key(strText As String, Optional aKeySize As Integer = 16) As String
    Dim i As Integer, c As Integer, x As Integer
    Dim strBuff As String

    strBuff = String(aKeySize, 32)
    
    If Len(strText) Then
        For i = 1 To Len(strText)
            c = Asc(Mid$(strText, i, 1))
            c = c + Asc(Mid$(strBuff, (i Mod aKeySize) + 1, 1))
            If c > &HFF Then
                x = i
                Do
                    Mid$(strBuff, (x Mod aKeySize) + 1, 1) = Chr$(c And &HFF)
                    x = x + 1
                    c = (c - &HFF) + Asc(Mid$(strBuff, (x Mod aKeySize) + 1, 1))
                Loop Until c <= &HFF
                Mid$(strBuff, (x Mod aKeySize) + 1, 1) = Chr$(c And &HFF)
            Else
                Mid$(strBuff, (i Mod aKeySize) + 1, 1) = Chr$(c And &HFF)
            End If
        Next i
    Else
        strBuff = strText
    End If
    Key = strBuff
End Function

Public Function Str2Hex(strText As String) As String
    Dim i As Integer, c As Integer
    Dim strBuff As String, strList As String
    
    strList = "0123456789ABCDEF"
    
    If Len(strText) Then
        For i = 1 To Len(strText)
            c = HiNibb(Asc(Mid$(strText, i, 1)))
            strBuff = strBuff & Mid$(strList, c + 1, 1)
            c = LoNibb(Asc(Mid$(strText, i, 1)))
            strBuff = strBuff & Mid$(strList, c + 1, 1)
        Next i
    Else
        strBuff = strText
    End If
    Str2Hex = strBuff
End Function

Public Function Hex2Str(strText As String) As String
    Dim i As Integer, c As Integer
    Dim strBuff As String, strList As String
    
    strList = "123456789ABCDEF"
    
    If Len(strText) Then
        For i = 1 To Len(strText) Step 2
            c = InStr(1, strList, Mid$(strText, i, 1)) * 16
            c = c + InStr(1, strList, Mid$(strText, i + 1, 1))
            strBuff = strBuff & Chr$(c)
        Next i
    Else
        strBuff = strText
    End If
    Hex2Str = strBuff
End Function

Public Function LoNibb(ByVal w As Byte) As Byte
    LoNibb = w And &HF
End Function

Public Function HiNibb(ByVal w As Byte) As Byte
    HiNibb = (w And &HF0&) \ 16
End Function

Public Function EncryptText(strText As String, Optional ByVal strPwd As String = "