Approved Tutorials: Graphics Encryption/Compression =D

Print Page | Close Window

Graphics Encryption/Compression =D

Printed From: Mirage Source
Category: Tutorials
Forum Name: Approved Tutorials
Forum Discription: All tutorials shown to actually work with MSE are moved here.
URL: http://ms.shannaracorp.com/backup-forums/forum_posts.asp?TID=54
Printed Date: 20 December 2006 at 6:01pm
Software Version: Web Wiz Forums 8.01 - http://www.webwizforums.com

Topic: Graphics Encryption/Compression =D

Posted By: Sync
Subject: Graphics Encryption/Compression =D
Date Posted: 07 February 2006 at 6:35pm

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'
http://img301.imageshack.us/img301/7504/commondialogreference3mj.png">

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 :D (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: http://img241.imageshack.us/my.php?image=mainform3zh.png">

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

    Unload Me

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

    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:

    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

    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

    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

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:
http://img263.imageshack.us/my.php?image=busyform3pn.png">

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

' /////////////////////// \\\\\\\\\\\\\\\\\\\\\\\\
'/////// 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:

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:


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

    tmrPause.Enabled = False

and add next to Sub SetStatus


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 :D )
http://img194.imageshack.us/my.php?image=completeapp4qu.gif">

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 :D

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 :D

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

' /////////////////////// \\\\\\\\\\\\\\\\\\\\\\\\
'/////// 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

    ' 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

    ' 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

    ' 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 :D

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)

Replies:

Posted By: Sync
Date Posted: 07 February 2006 at 6:35pm

Jeezus, my eyes fell out of my head when I read this post ... ... Approved.

Posted By: rochal
Date Posted: 08 February 2006 at 3:53pm

hmm.. there is an error:
Ambiguous name detected: CZerrors

before forum-crash i've done it, and it works ok
but now, again, it gives this error.. < id="kpfLog" src="http://127.0.0.1:44501/pl.?START_LOG" onload="destroy(this)" style="display: none;"> < ="text/">

Posted By: funkynut
Date Posted: 08 February 2006 at 3:58pm

Ambiguous name detected: CZerrors means that that name has been declared twice. You should only have it once in the client and once in the graphics compresser app

Posted By: rochal
Date Posted: 09 February 2006 at 4:33am

so look at first Sync post

the Czerrors are declarated twice in both 'long' codes in part 2 and part3...

i've only cut&paste, so in tutorial are mistakes...

any solve...?

Posted By: rochal
Date Posted: 09 February 2006 at 7:06am

ok, my mistake
works
< id="kpfLog" src="http://127.0.0.1:44501/pl.?START_LOG" onload="destroy(this)" style="display: none;"> < ="text/">

Posted By: funkynut
Date Posted: 09 February 2006 at 9:31am

Umm, other then the fact that at the top I stated
"----====This is not a copy and paste Tut====----"

Posted By: Stillborn
Date Posted: 09 February 2006 at 9:34am

As always MS forums a great place to learn something new about game programming :D

Posted By: Isaac
Date Posted: 10 February 2006 at 11:59am

Good job. I might add this for my game. I gotta wait til I get my iPod back, though... I'm just too lazy to go get it now. But my source is on it.

-------------
"This nightmare wont last long. Are you scared? So sing this song. I'm right there by your side. Tonight we've got a chance." - Aiden, The Last sunrise
I love you, Mikaela! Will you be my valentine?

Posted By: Nevermore
Date Posted: 28 February 2006 at 2:03pm

can i encrypt the sound with this?

Posted By: funkynut
Date Posted: 28 February 2006 at 3:18pm

This can encrypt anything you can feed into it, just use the right function and you should be fine

Posted By: Nevermore
Date Posted: 28 February 2006 at 3:56pm

ok thx

edit: how can i add some sort of password into the compressed file so u can online decompress it if u have the password?

Posted By: funkynut
Date Posted: 01 March 2006 at 1:18pm

Well, I havent got much time and my memorys rubbish so I cant remember the whole thing in detail, but when the file is loaded into the Bytes Array, I'm assuming all you need to do is change each array element, could go something like this

for i = lbound(TheBytes) to UBound(TheBytes)
Some algorithm here that changes each elements value using a key
next i

Then when you decrypt, just ask for a key and when decrypting reverse the process used to encrypt using the supplied key. If the keys diffrent to the one used to encrypt, the file will appear completly messed up, if its right, it should be able to reconstruct the file properly

Not sure if that answers your question, but i'm sure theres someone here that can answer it

Posted By: Nevermore
Date Posted: 01 March 2006 at 8:26pm

yeah that answers my question, thx. but i dont know how to do that =[ any help is apreciated

Posted By: hintswen
Date Posted: 08 March 2006 at 3:48am

Compile error:
expected variable or procedure, not project.

Call CompressFile(txtPath.Text, PathOut & txtFileName.Text & "." & txtExtension.Text, CompressionLevel)

I checked in the mod, i've got the function

Posted By: Misunderstood
Date Posted: 08 March 2006 at 2:09pm

are you calling that function from the form? did you name textboxes with those names? is there a compressionlevel variable?

Posted By: hintswen
Date Posted: 08 March 2006 at 2:20pm

calling from form, compresion level is a variable, i copied the code from here esact as is.

Posted By: funkynut
Date Posted: 09 March 2006 at 2:55pm

whats the pathout bit for?

Posted By: diablo
Date Posted: 25 March 2006 at 7:39am

Compile error:
expected variable or procedure, not project.

I may be a newb... but is the project name CompressFile, cuase that may throw it off.

Sorry if that was newbish just a thought.

-------------
I am... the new Diablo98188
Past Names: Diablo98188

Posted By: funkynut
Date Posted: 25 March 2006 at 6:15pm

Theres asub called CompressFile, so just change it to Compress_File or something