XeNTaX

Code: Select all

' Rahly's cool effort resulted in a Delphi application
' Mr.Mouse converted Rahly's code to VB and adapted it to fit CFIL files. 

Public Function DecompressJAFile(source As String, dest As String) As Boolean

Dim MyFile
Dim Buffer1() As Byte, Buffer2() As Byte
Dim Count As Long, Count2 As Long
Dim Temp1(255) As Byte, Temp2(255) As Byte, Temp3(255) As Byte, Temp4(255) As Byte
Dim TempChar As Long, Counter As Long, Temp As Long, Temp2value As Long, TempIt As Long
Dim CFIL As Long, U1 As Long, UnCom As Long
Dim BlockSize As Integer

On Error GoTo Hell

MyFile = FreeFile
Open source For Binary Access Read As MyFile
Get MyFile, , CFIL
Get MyFile, , U1
Get MyFile, , UnCom
ReDim Buffer2(UnCom - 1)


 For Count = 0 To 255
 Temp3(Count) = Count
 Next Count
 
 Count2 = 0
 
Do

Get MyFile, , BlockSize

If BlockSize > 0 Then ' compression , max bock 7fff?

ReDim Buffer1(BlockSize - 1)

Get MyFile, , Buffer1
 
 Counter = 0
 
 Do
 
   For Count = 0 To 255
   Temp1(Count) = Temp3(Count)
   Next Count
   
   TempChar = Buffer1(Counter)
   Counter = Counter + 1
   Temp = 0

    Do
      If TempChar > &H7F Then
        Temp = TempChar + Temp - &H7F
      Else
        If TempChar >= 0 Then
          TempIt = TempChar + 1
           Do
            Temp1(Temp) = Buffer1(Counter)
            Counter = Counter + 1
            If Temp <> Temp1(Temp) Then
              Temp4(Temp) = Buffer1(Counter)
              Counter = Counter + 1
            End If
            Temp = Temp + 1
            TempIt = TempIt - 1
           Loop Until TempIt = 0
          End If ''tempchar >= 0
       End If '' else

      If Temp < &H100 Then
        TempChar = Buffer1(Counter)
        Counter = Counter + 1
      End If
        
    Loop Until Temp >= &H100
     
    TempIt = LShiftLong(Buffer1(Counter), 8) Or Buffer1(Counter + 1)

    Counter = Counter + 2
    Temp2value = 0
    Do
      
      If Temp2value <> 0 Then
        Temp2value = Temp2value - 1
        Temp = Temp2(Temp2value)
      Else
        Temp = TempIt
        TempIt = TempIt - 1
        If Temp = 0 Then Exit Do
  

        Temp = Buffer1(Counter)
        Counter = Counter + 1

      End If
      TempChar = Temp1(Temp)
      If Temp = (TempChar And &HFF) Then
        Buffer2(Count2) = Temp
        Count2 = Count2 + 1
      
      Else
        Temp = Temp4(Temp)
        Temp2(Temp2value) = Temp
        Temp2(Temp2value + 1) = TempChar
        Temp2value = Temp2value + 2
      End If
  Loop
  
  Loop Until Counter >= UBound(Buffer1) + 1
  
  Else ' maxblock
  ReDim Buffer1(32768 - Abs(BlockSize) - 1)
  Get MyFile, , Buffer1
  For t = 0 To (UBound(Buffer1))   Buffer2(Count2) = Buffer1(t)
  Count2 = Count2 + 1
  Next t
  End If
  
  'YES, I KNOW I SHOULD HAVE USED SOME 
  'COLONEL MEMCOPY BITCHING ROUTINE FOR THAT BUFFER1->2 BIT!!!!!!
  
  Loop Until Count2 >= UnCom
  
  Close MyFile
  ReDim Preserve Buffer2(Count2 - 1)
  
  On Error Resume Next
  Kill dest
  On Error GoTo Hell
  
  MyFile = FreeFile
  Open dest For Binary Access Write As MyFile
  Put MyFile, , Buffer2
  Close MyFile
  DecompressJAFile = True
  
  Exit Function

Hell:
 DecompressJAFile = False


End Function