modcode.bas

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

Attribute VB_Name = "ModCode"
Option Explicit

Public oError As New cError

Public CRC32_Table() As Long

Public Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(0 To 63) As Byte
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(0 To 63) As Byte
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type

Public Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Public Sub Build_CRC32_Table()
    Dim lix As Integer
    ReDim CRC32_Table(0 To 255)
    For lix = 0 To 255
        CRC32_Table(lix) = CLng(LoadResString(lix))
    Next lix
End Sub

Public Function CRC32(buffer() As Byte, Start As Integer, Lenth As Integer) As Long
    Dim ulCRC As Long, index As Integer
    ulCRC = &HFFFFFFFF
    For index = Start To Start + Lenth - 1
        ulCRC = (((ulCRC And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor CRC32_Table((ulCRC And &HFF) Xor buffer(index))
    Next index
    CRC32 = ulCRC Xor &HFFFFFFFF
End Function

Public Function CrcString(Text As String) As Currency
    Dim lx As Integer, Bytes() As Byte, CrcMsb As Long, CrcLsb As Long
    
    lx = Len(Text) \ 2
    Bytes = StrConv(LCase(Text), vbFromUnicode)
    CrcMsb = CRC32(Bytes, 0, lx)
    CrcLsb = CRC32(Bytes, lx, lx)

    CopyMemory ByVal VarPtr(CrcString) + 4, CrcLsb, 4
    CopyMemory ByVal VarPtr(CrcString), CrcMsb, 4
End Function

Public Function CrcStringAll(Text As String) As Currency
    Dim lx As Integer, Bytes() As Byte, CrcMsb As Long, CrcLsb As Long
    
    lx = Len(Text) \ 2
    Bytes = StrConv(LCase(Text), vbFromUnicode)
    CrcMsb = CRC32(Bytes, 0, lx)
    CrcLsb = CRC32(Bytes, lx, Len(Text) - lx)

    CopyMemory ByVal VarPtr(CrcStringAll) + 4, CrcLsb, 4
    CopyMemory ByVal VarPtr(CrcStringAll), CrcMsb, 4
End Function

Public Sub xor_run(buffer() As Byte, buffer_size As Long)
    Dim last_char As Byte, i As Long
    last_char = &HD5
    For i = 0 To buffer_size
        last_char = buffer(i) Xor last_char
        buffer(i) = last_char
    Next i
End Sub

Public Sub xor_make(buffer() As Byte, buffer_size As Long)
    Dim last_char As Byte, i As Long
    last_char = &HD5
    For i = 0 To buffer_size
        buffer(i) = buffer(i) Xor last_char
        last_char = buffer(i) Xor last_char
    Next i
End Sub

Public Sub SwapString(String1 As String, String2 As String)
    Dim lltemp As Long
    CopyMemory lltemp, ByVal VarPtr(String1), 4
    CopyMemory ByVal VarPtr(String1), ByVal VarPtr(String2), 4
    CopyMemory ByVal VarPtr(String2), lltemp, 4
End Sub

Public Sub SwapValues(FirstValue As Variant, SecondValue As Variant)
    Dim TmpValue As Variant
    TmpValue = FirstValue
    FirstValue = SecondValue
    SecondValue = TmpValue
End Sub

Public Function SetTime(filename As String, Time As Date) As Boolean
    Dim rtn As Long, hFil As Long
    Dim fnd As WIN32_FIND_DATA, systim As SYSTEMTIME, zone As TIME_ZONE_INFORMATION
    
    rtn = GetTimeZoneInformation(zone)
    If rtn <= 0 Then Exit Function

    Time = DateAdd("n", zone.Bias, Time)
    
    systim.wMonth = DatePart("m", Time)
    systim.wDay = DatePart("d", Time)
    systim.wYear = DatePart("yyyy", Time)
    systim.wMinute = DatePart("n", Time)
    systim.wSecond = DatePart("s", Time)
    systim.wHour = DatePart("h", Time)
    
    FindFirstFile filename, fnd

    rtn = SystemTimeToFileTime(systim, fnd.ftLastWriteTime)
    If rtn = 0 Then Exit Function
    
    hFil = lopen(filename, OF_WRITE Or OF_SHARE_DENY_WRITE)
    If hFil = hInvalid Then Exit Function
    
    SetFileTime hFil, fnd.ftCreationTime, fnd.ftLastAccessTime, fnd.ftLastWriteTime
    
    lclose hFil
    SetTime = True
End Function