Graphics Compression/Encryption

[funkynut]

Originally posted by FunkyNut

[glow=red,2,300]----====This is not a copy and paste Tut====----This is more of a guide[/glow]

Difficulty: 3/5 (Easier then it really looks)

Part 1

Ok, this tutorial will guide you through creating a new project that will compress and at the same time, make it unreadable by most things. This is only the basics so i'm not providing 100% protection and I cant be sure it will work on any version except vinilla Ms . Ok, lets begin...

Right, lets start off with the app that will compress the graphics for us. Open up Visual Basic and create a standard Exe and name the first form 'frmMain'
Now to make the form look more professional, set BorderStyle to '1-Fixed Single' and Enable the Min button

Now, to browse through the files to locate the file we wanna compress we have to add a CommonDialog control, if you know how to add one to the project, skip this section, else, read on
1) Press ctrl + T so we can access the controls dialog
2) Scroll down until we find 'Microsoft Common Dialog control 6.0'


Now add the control to the form. Incase you didnt know, the commondialog control allows us to use common windows such as browse, print and select color.


Now, onto the rest of the controls, you will need to add:
TextBox ; - Called txtPath
Command Button - cmdBrowse
6 x Option Button - optCompression (This is an array, take a look at the pic, 0 is the top button, 5 is the bottom)
TextBox ; - txtFileName
TextBox ; - txtExtension
2 x Command Button - cmdGo and cmdExit
A bit of decoration (Great tip, for any labels you dont use, name them lblDuff(or something) and make it and array so you dont have a list full of label1, label2, etc and only have one name for all the rubbish labels)

Hopefully it should have the same controls as this:


Time to add some code, this is only simple stuff, no complex stuff yet
This is pretty self explained, allows the user to exit when they press quit, double click 'cmdExit' and add

Code:

Unload Me

Now to add the browse feature, double click 'cmdBrowse' and add

Code:

With CommonDialog1
        .DialogTitle = "Please select the file you wish to use"
        ' Now select which files we can browse( Format is "Filter 1 description|filter 1 FileName|Filter 2 Descrip|Filter 2 Filename"
        .Filter = "Bitmaps (*.bmp)|*.bmp|Jpegs (*.jpg)|*.jpg|Gifs (*.gif)|*.gif|All Picture Files(*.bmp;*.jpg;*.gif)|*.bmp;*.gif;*.jpg|All Files (*.*)|*.* "
        .FilterIndex = 1 ' Set to bitmaps only
      
        ' Finally show the browse dialog
        .ShowOpen
      
        ' Set the text box to the path
        txtPath.Text = .FileName
    End With

The explanation,
Lets start with the With...End with thing, using this thing we can use this to change the propertys of something without having to type it in eg:

Code:

With MadeUpControl
        .MadeUpProperty1 = MadeUpValue1
        .MadeUpProperty2 = MadeUpValue2
        .MadeUpProperty3 = MadeUpValue3
    End With

'Is easier then

    MadeUpControl.MadeUpProperty1 = MadeUpValue1
    MadeUpControl.MadeUpProperty2 = MadeUpValue2
    MadeUpControl.MadeUpProperty3 = MadeUpValue3

Although we dont need to, it looks best if we change the CommonDialog default controls, the only bit that I would assume needs explaning is the Filters. For the filters we usually first specifie a Filter description, then seperate it using a pipe symbol "|" and we then specifie the files we want to include ( FileName.FileType) and we place all this within quotations E.g

Code:

CommonDialog1.Filter = " This is the Filter description | *.*" ' Specifie a wildcard if you dont know it

If we want multiple filters, just add another pipe symbol and repeat

Code:

CommonDialog1.Filter = " This is the Filter description | *.*|This is Filter2 description | Map001.Dat"

If we want to search for multiple different files in a filter just add ; after the FileType

Code:

This is the Filter description | *.*; *.bmp

Now, I think we had better add a busy/Loading form to the project, so go and add a new form called frmBusy and put on it a label called lblStatus and a progress bar called prbProgress(If you dont know how to get one, follow the same steps as you did to add the CommonDialog object but look for 'Microsoft Windows Common Controls 6.0'
This is what mine looks like:



Part 2

Ok, now we need to add the compression Mod, which is based on Zlib.dll
(Btw, I cant take much credit for this mod, most of it was from PlanetSourceCode.Com)

Make a new mod called modCompress and add this code

Code:

' /////////////////////// \\\\\\\\\\\\\\\\\\\\\\\\
'/////// I cant take credit for much of this\\\\\\\
'\\\\\\\ only a few odd things,Most is from ///////
' \\\\\\\\\\\\\PlanetSourceCode.Com///////////////

Option Explicit

'the following are for compression/decompression
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function compress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function compress2 Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long, ByVal level As Long) As Long
Private Declare Function uncompress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long

'the following are for compression/decompression
Dim lngCompressedSize As Long
Dim lngDecompressedSize As Long

Public Enum CZErrors 'for compression/decompression
    Z_OK = 0
    Z_STREAM_END = 1
    Z_NEED_DICT = 2
    Z_ERRNO = -1
    Z_STREAM_ERROR = -2
    Z_DATA_ERROR = -3
    Z_MEM_ERROR = -4
    Z_BUF_ERROR = -5
    Z_VERSION_ERROR = -6
End Enum

Public Enum CompressionLevels 'for compression/decompression
    Z_NO_COMPRESSION = 0
    Z_BEST_SPEED = 1
    'note that levels 2-8 exist, too
    Z_BEST_COMPRESSION = 9
    Z_DEFAULT_COMPRESSION = -1
End Enum

Public Property Get ValueCompressedSize() As Long
    'size of an object after compression
    ValueCompressedSize = lngCompressedSize
End Property

Private Property Let ValueCompressedSize(ByVal New_ValueCompressedSize As Long)
    lngCompressedSize = New_ValueCompressedSize
End Property

Public Property Get ValueDecompressedSize() As Long
    'size of an object after decompression
    ValueDecompressedSize = lngDecompressedSize
End Property

Private Property Let ValueDecompressedSize(ByVal New_ValueDecompressedSize As Long)
    lngDecompressedSize = New_ValueDecompressedSize
End Property

Public Function CompressByteArray(TheData() As Byte, CompressionLevel As Integer) As Long
'compress a byte array
Dim lngResult As Long
Dim lngBufferSize As Long
Dim arrByteArray() As Byte
  
    lngDecompressedSize = UBound(TheData) + 1
  
    'Allocate memory for byte array
    lngBufferSize = UBound(TheData) + 1
    lngBufferSize = lngBufferSize + (lngBufferSize * 0.01) + 12
    ReDim arrByteArray(lngBufferSize)
  
    Call SetStatus("Compressing ByteArray", 5)
    'Compress byte array (data)
    lngResult = compress2(arrByteArray(0), lngBufferSize, TheData(0), UBound(TheData) + 1, CompressionLevel)
  
    'Truncate to compressed size
    ReDim Preserve TheData(lngBufferSize - 1)
    CopyMemory TheData(0), arrByteArray(0), lngBufferSize
  
    Call SetStatus("Compressing ByteArray", 6)
    'Set property
    lngCompressedSize = UBound(TheData) + 1
  
    'return error code (if any)
    CompressByteArray = lngResult
  
End Function

Public Function CompressString(Text As String, CompressionLevel As Integer) As Long
'compress a string
Dim lngOrgSize As Long
Dim lngReturnValue As Long
Dim lngCmpSize As Long
Dim strTBuff As String
  
    ValueDecompressedSize = Len(Text)
  
    'Allocate string space for the buffers
    lngOrgSize = Len(Text)
    strTBuff = String(lngOrgSize + (lngOrgSize * 0.01) + 12, 0)
    lngCmpSize = Len(strTBuff)
  
    'Compress string (temporary string buffer) data
    lngReturnValue = compress2(ByVal strTBuff, lngCmpSize, ByVal Text, Len(Text), CompressionLevel)
  
    'Crop the string and set it to the actual string.
    Text = Left$(strTBuff, lngCmpSize)
  
    'Set compressed size of string.
    ValueCompressedSize = lngCmpSize
  
    'Cleanup
    strTBuff = ""
  
    'return error code (if any)
    CompressString = lngReturnValue

End Function

Public Function DecompressByteArray(TheData() As Byte, OriginalSize As Long) As Long
'decompress a byte array
Dim lngResult As Long
Dim lngBufferSize As Long
Dim arrByteArray() As Byte
  
    lngDecompressedSize = OriginalSize
    lngCompressedSize = UBound(TheData) + 1
  
    'Allocate memory for byte array
    lngBufferSize = OriginalSize
    lngBufferSize = lngBufferSize + (lngBufferSize * 0.01) + 12
    ReDim arrByteArray(lngBufferSize)
    Call SetStatus("Decompressing ByteArray", 4)
  
    'Decompress data
    lngResult = uncompress(arrByteArray(0), lngBufferSize, TheData(0), UBound(TheData) + 1)
  
    'Truncate buffer to compressed size
    ReDim Preserve TheData(lngBufferSize - 1)
    CopyMemory TheData(0), arrByteArray(0), lngBufferSize
    Call SetStatus("Decompressing ByteArray", 5)
  
    'return error code (if any)
    DecompressByteArray = lngResult
  
End Function

Public Function DecompressString(Text As String, OriginalSize As Long) As Long
'decompress a string
Dim lngResult As Long
Dim lngCmpSize As Long
Dim strTBuff As String
  
    'Allocate string space
    strTBuff = String(ValueDecompressedSize + (ValueDecompressedSize * 0.01) + 12, 0)
    lngCmpSize = Len(strTBuff)
  
    ValueDecompressedSize = OriginalSize
  
    'Decompress
    lngResult = uncompress(ByVal strTBuff, lngCmpSize, ByVal Text, Len(Text))
  
    'Make string the size of the uncompressed string
    Text = Left$(strTBuff, lngCmpSize)
  
    ValueCompressedSize = lngCmpSize
  
    'return error code (if any)
    DecompressString = lngResult
  
End Function
Public Function CompressFile(FilePathIn As String, FilePathOut As String, CompressionLevel As Integer) As Long
'compress a file
Dim intNextFreeFile As Integer
Dim TheBytes() As Byte
Dim lngResult As Long
Dim lngFileLen As Long
  
    frmBusy.Show
    frmBusy.prbProgress.Max = 9
  
    ' Along the way, we are gonna make it look professional and infom the user
    ' Of the programs actions
    Call SetStatus("Checking File Size", 1)
    lngFileLen = FileLen(FilePathIn)
  
    Call SetStatus("Allocating Byte array", 2)
    'allocate byte array
    ReDim TheBytes(lngFileLen - 1)
  
    'read byte array from file
    Close #10
    intNextFreeFile = FreeFile '10 'FreeFile
    Call SetStatus("Reading Original File", 3)
    Open FilePathIn For Binary Access Read As #intNextFreeFile
        Get #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
  
    'compress byte array
    Call SetStatus("Compressing ByteArray", 4)
    lngResult = CompressByteArray(TheBytes(), CompressionLevel)
  
    'kill any file in place
    On Error Resume Next
    Call SetStatus("Clearing Old Files", 7)
    Kill FilePathOut
    On Error GoTo 0
  
    'Write it out
    Call SetStatus("Writing compressed file to disk", 8)
    intNextFreeFile = FreeFile
    Open FilePathOut For Binary Access Write As #intNextFreeFile
        Put #intNextFreeFile, , lngFileLen 'must store the length of the original file
        Put #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
  
    Call SetStatus("Clearing byte array from memory", 9)
    Erase TheBytes
    CompressFile = lngResult
  
    Unload frmBusy
    frmMain.Show
  
End Function

Public Function DecompressFile(FilePathIn As String, FilePathOut As String) As Long
'decompress a file
Dim intNextFreeFile As Integer
Dim TheBytes() As Byte
Dim lngResult As Long
Dim lngFileLen As Long
  
    frmBusy.Show
    frmBusy.prbProgress.Max = 8
  
    Call SetStatus("Allocating Byte array", 1)
    'allocate byte array
    ReDim TheBytes(FileLen(FilePathIn) - 1)
  
    Call SetStatus("Reading Compressed File", 2)
    'read byte array from file
    intNextFreeFile = FreeFile
    Open FilePathIn For Binary Access Read As #intNextFreeFile
        Get #intNextFreeFile, , lngFileLen 'the original (uncompressed) file's length
        Get #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
  
    Call SetStatus("Decompressing ByteArray", 3)
    'decompress
    lngResult = DecompressByteArray(TheBytes(), lngFileLen)
  
    'kill any file already there
    On Error Resume Next
    Call SetStatus("Clearing Old Files", 6)
    Kill FilePathOut
    On Error GoTo 0
  
    'Write it out
    Call SetStatus("Writing Decompressed file to disk", 7)
    intNextFreeFile = FreeFile
    Open FilePathOut For Binary Access Write As #intNextFreeFile
        Put #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
  
    Call SetStatus("Clearing byte array from memory", 8)
    Erase TheBytes
    DecompressFile = lngResult
  
    Unload frmBusy
    frmMain.Show

End Function

Most of this you can really only pickup on by scanning through the code (Btw, if you compress a file to big you'll get an error [Above 250mb] but you can fix it by modding Verrigans 64k limit fix for this)



Time to finish the app,
Double click 'cmdGo' and add:

Code:

Dim ArrayScan As Byte
Dim CompressionLevel As Integer
Dim PathOut As String

    ' Ok, first check if we have any empty fields
    If Trim(txtPath.Text) = "" Or Trim(txtFileName.Text) = "" Or Trim(txtExtension.Text) = "" Then
        Call MsgBox("Sorry, you need to fill in all the fields!", vbOKOnly Or vbCritical)
        Exit Sub
    End If
  
    ' Now check all the option buttons for a selected one
    For ArrayScan = 0 To optCompression.Count - 1
        If optCompression(ArrayScan).Value = True Then
             Select Case ArrayScan
                 Case 0
                     CompressionLevel = CompressionLevels.Z_NO_COMPRESSION
                 Case 1
                     CompressionLevel = CompressionLevels.Z_BEST_SPEED
                 Case 2
                     CompressionLevel = 3
                 Case 3
                     CompressionLevel = CompressionLevels.Z_DEFAULT_COMPRESSION
                 Case 4
                     CompressionLevel = 7
                 Case 5
                     CompressionLevel = CompressionLevels.Z_BEST_COMPRESSION
             End Select
            
             ' No need to scan the rest
             Exit For
        End If

    Next ArrayScan
  
    ' Now get the folder from which the original file is located
    PathOut = Left(txtPath.Text, Len(txtPath.Text) - Len(FileName))
  
    ' Now we start the compression process
    Call CompressFile(txtPath.Text, PathOut & txtFileName.Text & "." & txtExtension.Text, CompressionLevel)

1)This is pretty simple, the first bit checks that the information we need is available and if it isnt, stop and make the user add it.
2)The next step is to check each and every option button in the optCompression Array until we find one thats been selected, once we have, use select case to determine which one is selected and act apon it.
3)The section before finally compressing the file is to find out the folder the original file is in so we can put the compressed file in it, It gets the length of the path when it doesnt have the filename on the end and then stores that.
4)To compress the file, we supplie the path to the file being compress, the path to the file compressing to and the compression level. The compression level was already determined before so we only need to work out the PathOut, which we do by adding Filename then the file extension wanted, Simply really...

Now the very final bits, this bit is to show the status (Altougth it wont be amazing accurate) In the CompressFile function i've added SetStatus commands which has two arguments, one is the stage and the other is stage description. This sub will change the label and progress bar on the frmBusy window, so create a new Mod called modGeneral(Unless you dont mind it being mixed up with modCompression) and add to it:

Code:

Public Sub SetStatus(ByVal Status As String, ByVal Progress As Byte)
    frmBusy.lblStatus.Caption = Status & " ..."
    frmBusy.prbProgress.Value = Progress
    ' Delay so we can see the effects
    Call Pause(100)
End Sub

But wait, whats this pause sub? Ok, unless you dont mind it zipping through just flashing the busy screen at you and looking ugly you can delete that, but if you want to actually see your hard work add a timer to frmBusy called 'tmrPause', just leave the propertys and double click it and add

Code:

tmrPause.Enabled = False

and add next to Sub SetStatus

Code:

Public Sub Pause(ByVal Interval As Long)
    With frmBusy.tmrPause
        .Interval = Interval
        .Enabled = True
      
        Do Until .Enabled = False
             DoEvents
        Loop
    End With

End Sub

What this basicly does is, when the pause sub is called, it sets the timer to an interval and enables it, and straight after that enters a loop. Were now stuck looping through that loop until the timer activates and turns itself off.


Ok, thats it for the compressing application, heres a ScreenShot of my finished app (And one of the kittens and The mother Cat in the background )


Well, i'mma go to bed, as you can tell by that last ScreenShot, its dam early, I need sleep and I have to wake for 9 so i'll fix these posts up sometime since theres bound to be errors based on the time. I'll finish the other half of this (Decompressing for DirectDraw to use) soon aswell

Part 3 - Decompressing for use with directdraw

Since i'm writing the tutorial while i'm programming it, I have no idea how this'll turn out so Bare with me

Ok, I think the only way to do this is to create a decompressed file, load it and then kill it straight After. Although this could increase loading times, if anybody knows how to create surfaces using files stored on memory then be my guest

To begin with, Create a new mod called ModCompression and add this code (Its the same as above with Parts removed such as SetStatus)

Code:

' /////////////////////// \\\\\\\\\\\\\\\\\\\\\\\\
'/////// I can take credit for alot of this \\\\\\\
'\\\\\\\ only a few odd things,Most is from ///////
' \\\\\\\\\\\\\PlanetSourceCode.Com///////////////

Option Explicit

'the following are for compression/decompression
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function compress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function compress2 Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long, ByVal level As Long) As Long
Private Declare Function uncompress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long

'the following are for compression/decompression
Dim lngCompressedSize As Long
Dim lngDecompressedSize As Long

Public Enum CZErrors 'for compression/decompression
    Z_OK = 0
    Z_STREAM_END = 1
    Z_NEED_DICT = 2
    Z_ERRNO = -1
    Z_STREAM_ERROR = -2
    Z_DATA_ERROR = -3
    Z_MEM_ERROR = -4
    Z_BUF_ERROR = -5
    Z_VERSION_ERROR = -6
End Enum

Public Enum CompressionLevels 'for compression/decompression
    Z_NO_COMPRESSION = 0
    Z_BEST_SPEED = 1
    'note that levels 2-8 exist, too
    Z_BEST_COMPRESSION = 9
    Z_DEFAULT_COMPRESSION = -1
End Enum

Public Property Get ValueCompressedSize() As Long
    'size of an object after compression
    ValueCompressedSize = lngCompressedSize
End Property

Private Property Let ValueCompressedSize(ByVal New_ValueCompressedSize As Long)
    lngCompressedSize = New_ValueCompressedSize
End Property

Public Property Get ValueDecompressedSize() As Long
    'size of an object after decompression
    ValueDecompressedSize = lngDecompressedSize
End Property

Private Property Let ValueDecompressedSize(ByVal New_ValueDecompressedSize As Long)
    lngDecompressedSize = New_ValueDecompressedSize
End Property

Public Function CompressByteArray(TheData() As Byte, CompressionLevel As Integer) As Long
'compress a byte array
Dim lngResult As Long
Dim lngBufferSize As Long
Dim arrByteArray() As Byte
  
    lngDecompressedSize = UBound(TheData) + 1
  
    'Allocate memory for byte array
    lngBufferSize = UBound(TheData) + 1
    lngBufferSize = lngBufferSize + (lngBufferSize * 0.01) + 12
    ReDim arrByteArray(lngBufferSize)
  
    'Compress byte array (data)
    lngResult = compress2(arrByteArray(0), lngBufferSize, TheData(0), UBound(TheData) + 1, CompressionLevel)
  
    'Truncate to compressed size
    ReDim Preserve TheData(lngBufferSize - 1)
    CopyMemory TheData(0), arrByteArray(0), lngBufferSize
  
    'Set property
    lngCompressedSize = UBound(TheData) + 1
  
    'return error code (if any)
    CompressByteArray = lngResult
  
End Function

Public Function CompressString(Text As String, CompressionLevel As Integer) As Long
'compress a string
Dim lngOrgSize As Long
Dim lngReturnValue As Long
Dim lngCmpSize As Long
Dim strTBuff As String
  
    ValueDecompressedSize = Len(Text)
  
    'Allocate string space for the buffers
    lngOrgSize = Len(Text)
    strTBuff = String(lngOrgSize + (lngOrgSize * 0.01) + 12, 0)
    lngCmpSize = Len(strTBuff)
  
    'Compress string (temporary string buffer) data
    lngReturnValue = compress2(ByVal strTBuff, lngCmpSize, ByVal Text, Len(Text), CompressionLevel)
  
    'Crop the string and set it to the actual string.
    Text = Left$(strTBuff, lngCmpSize)
  
    'Set compressed size of string.
    ValueCompressedSize = lngCmpSize
  
    'Cleanup
    strTBuff = ""
  
    'return error code (if any)
    CompressString = lngReturnValue

End Function

Public Function DecompressByteArray(TheData() As Byte, OriginalSize As Long) As Long
'decompress a byte array
Dim lngResult As Long
Dim lngBufferSize As Long
Dim arrByteArray() As Byte
  
    lngDecompressedSize = OriginalSize
    lngCompressedSize = UBound(TheData) + 1
  
    'Allocate memory for byte array
    lngBufferSize = OriginalSize
    lngBufferSize = lngBufferSize + (lngBufferSize * 0.01) + 12
    ReDim arrByteArray(lngBufferSize)
  
    'Decompress data
    lngResult = uncompress(arrByteArray(0), lngBufferSize, TheData(0), UBound(TheData) + 1)
  
    'Truncate buffer to compressed size
    ReDim Preserve TheData(lngBufferSize - 1)
    CopyMemory TheData(0), arrByteArray(0), lngBufferSize
  
    'return error code (if any)
    DecompressByteArray = lngResult
  
End Function

Public Function DecompressString(Text As String, OriginalSize As Long) As Long
'decompress a string
Dim lngResult As Long
Dim lngCmpSize As Long
Dim strTBuff As String
  
    'Allocate string space
    strTBuff = String(ValueDecompressedSize + (ValueDecompressedSize * 0.01) + 12, 0)
    lngCmpSize = Len(strTBuff)
  
    ValueDecompressedSize = OriginalSize
  
    'Decompress
    lngResult = uncompress(ByVal strTBuff, lngCmpSize, ByVal Text, Len(Text))
  
    'Make string the size of the uncompressed string
    Text = Left$(strTBuff, lngCmpSize)
  
    ValueCompressedSize = lngCmpSize
  
    'return error code (if any)
    DecompressString = lngResult
  
End Function
Public Function CompressFile(FilePathIn As String, FilePathOut As String, CompressionLevel As Integer) As Long
'compress a file
Dim intNextFreeFile As Integer
Dim TheBytes() As Byte
Dim lngResult As Long
Dim lngFileLen As Long
  
    ' Along the way, we are gonna make it look professional and infom the user
    ' Of the programs actions
    lngFileLen = FileLen(FilePathIn)
  
    'allocate byte array
    ReDim TheBytes(lngFileLen - 1)
  
    'read byte array from file
    Close #10
    intNextFreeFile = FreeFile '10 'FreeFile
    Open FilePathIn For Binary Access Read As #intNextFreeFile
        Get #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
  
    'compress byte array
    lngResult = CompressByteArray(TheBytes(), CompressionLevel)
  
    'kill any file in place
    On Error Resume Next
    Kill FilePathOut
    On Error GoTo 0
  
    'Write it out
    intNextFreeFile = FreeFile
    Open FilePathOut For Binary Access Write As #intNextFreeFile
        Put #intNextFreeFile, , lngFileLen 'must store the length of the original file
        Put #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
  
    Erase TheBytes
    CompressFile = lngResult
End Function

Public Function DecompressFile(FilePathIn As String, FilePathOut As String) As Long
'decompress a file
Dim intNextFreeFile As Integer
Dim TheBytes() As Byte
Dim lngResult As Long
Dim lngFileLen As Long
  
    'allocate byte array
    ReDim TheBytes(FileLen(FilePathIn) - 1)
  
    'read byte array from file
    intNextFreeFile = FreeFile
    Open FilePathIn For Binary Access Read As #intNextFreeFile
        Get #intNextFreeFile, , lngFileLen 'the original (uncompressed) file's length
        Get #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
  
    'decompress
    lngResult = DecompressByteArray(TheBytes(), lngFileLen)
  
    'kill any file already there
    On Error Resume Next
    Kill FilePathOut
    On Error GoTo 0
  
    'Write it out
    intNextFreeFile = FreeFile
    Open FilePathOut For Binary Access Write As #intNextFreeFile
        Put #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
  
    Erase TheBytes
    DecompressFile = lngResult
  
End Function

After doing that, we now have to edit a few things in modDirectX
First thing we have to change is the check for Items.Bmp etc

Code:

' Check for files existing
    If FileExist("sprites.bmp") = False Or FileExist("tiles.bmp") = False Or FileExist("items.bmp") = False Then
        Call MsgBox("You dont have the graphics files in the same directory as this executable!", vbOKOnly, GAME_NAME)
        Call GameDestroy
    End If

Once you have found that, Change Items.Bmp, Sprites.Bmp and Tiles.Bmp to whatever you have named the files e.g

Code:

' Check for files existing
    If FileExist("sprites.Tes") = False Or FileExist("tiles.Tes") = False Or FileExist("items.Tes") = False Then
        Call MsgBox("You dont have the graphics files in the same directory as this executable!", vbOKOnly, GAME_NAME)
        Call GameDestroy
    End If

Now we need to Decompress the files, since the whole point of this really is not to hand ready made graphics on a plate to the user, we need to allow the user as little time with the Decompressed file as possible, so, we need to Decompress the file just before we actually need it and as soon as were done, kill the file.

First find this code

Code:

' Init sprite ddsd type and load the bitmap
    DDSD_Sprite.lFlags = DDSD_CAPS
    DDSD_Sprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_SpriteSurf = DD.CreateSurfaceFromFile(App.Path & "\Sprites.bmp", DDSD_Sprite)
    DD_SpriteSurf.SetColorKey DDCKEY_SRCBLT, key

Now change that to (Remember to change the bolded parts to match your case)

' Init sprite ddsd type and load the bitmap
DDSD_Sprite.lFlags = DDSD_CAPS
DDSD_Sprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
Call DecompressFile(App.Path & "\Testing.tes", App.Path & "\Tester.Vms")
Set DD_SpriteSurf = DD.CreateSurfaceFromFile(App.Path & "\Tester.Vms", DDSD_Sprite)
Call Kill(App.Path & "\Tester.Vms")
DD_SpriteSurf.SetColorKey DDCKEY_SRCBLT, key

I've bolded the parts i've changed,

The first bold line pretty much Decompress a file (The first argument) and then creates a file that contains the data(The second argument). The reason i've decompressed it to a .Vms file and not a .bmp is because the extension really doesnt matter. The data held in the file will tell anything trying to open it that its a Bitmap, and the extension only say what program opens it, which means when DirectDraw attempts to open it, it scans the first section (The header) to check if its a Bitmap, if it is, continue to load it (Do a google on Bitmap structure to learn more). This extension change can help distract the average Joe and of course .Vms is interchangable with anything you feel like, as long as you Decompress to, Load and Kill the same file

The second Bold section has been changed to load up the file that has just been created

The third Bold line deletes the file


Now using the above code, change the Items.Bmp and Tiles.Bmp to the same format and that should be it


Just remember, this is only a guide on how to load Encrypted/Compressed files into DirectDraw and doesnt include other things such as the NpcEditor sprite preview etc, Although I might look into this, dont hold your hopes up. The only hints I can give is to either blt from DirectDraw surfaces instead of a second Pic, or just repeat what i've added to load to DirectDraw and change it for a picture box (The second option might be abit too slow though)

[/img]

[grimsk8ter11]

hehe i was about to post this one, ill post the alternate instead now so theres mroe then one way.

[funkynut]

Arnt you lucky, I decided to post my tus since most of them have a few images in them and they can be a pain to transfer XD

[grimsk8ter11]

ya, finding code segemnts from the old forum is ahrd ot, i used the old old forum ones first and jsut find/replaced code: with [code], I do like your encryption though, I jsut like how verrs loads.

[Aydan]

Hmm I've give nthis ago but for some reason i keep getting runtime error 424 "object Required"

This line in cmdGO is highlighted.

Code:

If Trim(txtpath.Text) = "" Or Trim(txtfilename.Text) = "" Or Trim(txtExtension.Text) = "" Then

Any ideas guys?

[Kraft]

Any ideas guys?

Try creating txtpath, txtfilename and txtExtension.

[Matt]

Agreed. My guess would be to create the physical controls. Which seem to be 3 text boxes.

[Aydan]

yeah i did haha. perhaps i typed the names wrong. il have a quick look lol.