Craft The World - what a game!

**ReneMiner** · 28-02-2015, 20:12

thinBasic is so cool, it can unpack the game data, exchange values, repack the game data to a package (129MB) that is compressed 10% smaller than the original (142MB) and the game still runs! And all that without the need of any additional software nor libraries. UNBELIEVEABLE

**Petr Schreiber** · 01-03-2015, 00:39

Hell yeah, I am happy you feel the power

**ReneMiner** · 01-03-2015, 09:17

For the nosy audience: this is the script.
It won't work if you don't have the game, but it contains 3 useful functions (2 to call) as

Dir_Kill()
which will actually kill a directory with all it's content
(Dir_Remove only removes completely empty directories)

ZLib_PackFolder()
which will create a zip-file from a folder and all its content in one call

ZLib_AddSubdir()
gets called initially by ZLib_PackFolder on the parenting folder and
will add a specified folder and it's content to a zip-archive
(usually user does not call this)

Uses "Console", "FILE", "ZLib","UI"

' ---------------------------------------------------------------------

Function ZLib_PackFolder(ByVal sFolder      As String, _
                Optional ByVal sZipfilename As String, _
                         ByVal lFileTypes    As Long = %FILE_NORMAL
                         ) As Boolean
' ---------------------------------------------------------------------
                                                                 
' this function to make a zip from a complete folder
' sFolder: full path to the folder to pack as zip

' sZipfilename: full path & filename 
'               if omitted the folders name
'               will be taken and ".zip" gets appended   

' lFileTypes: combination of one or more FILE-module-equates
' only these are accepted/make sense:
'   %FILE_NORMAL
'   %FILE_READONLY
'   %FILE_HIDDEN
'   %FILE_SYSTEM
'   %FILE_ARCHIVE
 
' it will pack a complete folder in one go 
' -existing old zip-file will be deleted- 
' this is NOT to ADD anything
  
  Local lCheck As Long 
  
  If Not DIR_Exists(sFolder) Then Return FALSE
  
  If Len(sZipFilename) = 0 Then
    sZipFilename = Trim$(sFolder, "\") & ".zip"
  EndIf
  If RIGHT$(sFolder, 1) <> "\" Then 
    sFolder &= "\"
  EndIf
     
  If FILE_Exists(sZipFilename) Then
    FILE_Kill(sZipfilename)
  EndIf
  
  ' local check for valid flagged filetypes:
  If (lFileTypes And %FILE_NORMAL)   Then lCheck = %FILE_NORMAL
  If (lFileTypes And %FILE_READONLY) Then lCheck = lCheck Or %FILE_READONLY
  If (lFileTypes And %FILE_HIDDEN)   Then lCheck = lCheck Or %FILE_HIDDEN
  If (lFileTypes And %FILE_SYSTEM)   Then lCheck = lCheck Or %FILE_SYSTEM
  If (lFileTypes And %FILE_ARCHIVE)  Then lCheck = lCheck Or %FILE_ARCHIVE
  
  
  ' start with the initial directory:
  ZLib_AddSubDir(sZipfilename, sFolder, lCheck)
  
  ' close the zip finally 
  ZLib_AddEx(sZipfilename, "", %ZLIB_CLOSE)     
  ' (ZLib_AddEx: helpfile is wrong here, it must be %ZLIB_, not %ZIP_)
  
  ' do we have data?
  Function = (FILE_Size(sZipFilename) > 0)
  
End Function

' ---------------------------------------------------------------------
Function ZLib_AddSubDir(ByVal sZipfilename As String, _
                        ByVal sDir         As String, _
                        ByVal lFileTypes    As Long    )
' ---------------------------------------------------------------------

' this function will add a subdir and all of its content 
' it gets called ' from the function above if all is ok and then
' calls itself until all data is added to the zip

' it will not copy empty directories into a zip !

  Local sFile() As String
  Local sPath() As String
  Local nFiles  As Long  = DIR_ListArray(sFile, sDir, "*.*", lFileTypes )
  Local nDirs   As Long  = DIR_ListArray(sPath, sDir, "*", %FILE_SUBDIR )
  Local i       As Long
  
  If nFiles Then
    For i = 1 To nFiles
      ZLib_AddEx(sZIPFileName, sDir & sFile(i), %ZLIB_REL_PATH )  
    Next
  EndIf
  
  ' calls itself:
  If nDirs Then
    For i = 1 To nDirs
      ZLib_AddSubDir(sZipFilename, sDir & sPath(i) & "\", lFileTypes )
    Next
  EndIf
      
                        
End Function

'-----------------------------------------------------------------
Function DIR_Kill(ByVal sPath As String)
  
  If RIGHT$(sPath, 1 ) <> "\" Then sPath &= "\"
    
  Local sSubdir() As String
  Local sFiles()  As String
  Local Index As Long      
  
  Local lDirs As Long  = DIR_ListArray(sSubDir, sPath, "*", %FILE_SUBDIR)
  
  Local lFiles As Long = DIR_ListArray(sFiles, sPath, "*", %FILE_NORMAL   _
                                                         | %FILE_READONLY _                                      | 
                                                         | %FILE_HIDDEN   _
                                                         | %FILE_SYSTEM   _
                                                         | %FILE_ARCHIVE  )
  
  If lFiles Then
    For Index = 1 To lFiles
      FILE_Kill( sPath & sFiles(Index) )
    Next
  EndIf
  
  If lDirs Then
    For Index = 1 To lDirs
      Dir_Kill(sPath & sSubdir(Index))
    Next
  EndIf
  
  DIR_Remove(sPath)
  
End Function

                                         
String sWorkingpath = APP_ScriptPath & "main\"
String sGamepath    = "C:\Program Files (x86)\Steam\SteamApps\common\CraftTheWorld"
String sWorld, sLine(), sCheck, sValue
Long   nLines, lLine, lPos
Byte   bChar 
  
While Not DIR_Exists(sGamepath)
  ' uses UI-module only for this one request- and only in certain cases...

  sGamepath = Dialog_BrowseForFolder(0, "Please select your CraftTheWorld-folder", "C:\", TRUE)
  
  If Not DIR_Exists(sGamepath) Then 
    Select Case MsgBox(0, "Invalid path specified. Retry to select another path, Cancel to quit",%MB_RETRYCANCEL, "ctw-modmana30")
      Case %IDCANCEL
        Stop
        
    End Select
  EndIf
Wend

If RIGHT$(sGamepath,1) <> "\" Then sGamepath += "\"

If Not DIR_Exists(sWorkingpath) Then DIR_Make(sWorkingpath)


If FILE_Exists(sGamepath & "main.pak") Then  
 
  If FILE_Exists(sGamepath & "original_Main.pak") Then
    FILE_Kill(sGamePath & "Main.pak") 
    FILE_Rename(sGamepath & "original_Main.pak", sGamepath & "Main.Pak")
    PrintL "original Gamedata restored."
    PrintL "Press any key to end"
    WaitKey
    Stop
  Else  
    FILE_Rename(sGamepath & "Main.pak", sGamepath & "original_Main.Pak")
    PrintL "Main.Pak renamed to original_Main.Pak"
    PrintL
  EndIf
Else
  PrintL "archive not found. Will abort. Press any key"
  WaitKey
  Stop
EndIf

If FILE_Exists(sGamepath & "original_Main.pak") Then
    
  PrintL "extracting the package..."
  Print "please wait"
  PrintL
  ZLib_Extract(sGamepath & "original_Main.Pak", sWorkingpath)

  
  sWorld = FILE_Load(sWorkingpath & "data\world.xml")
  If StrPtrLen(StrPtr(sWorld)) < 1000 Then
    PrintL "!!! unexpected Error !!! Restoring original data..."
    PrintL "Have To quit :("
    FILE_Rename(sGamepath & "original_Main.pak", sGamepath & "Main.Pak")
    WaitKey
    Stop
  EndIf
  
  nLines = Parse sWorld, sLine, $CRLF
  PrintL Str$(nLines) & " lines of code parsed" 
  For lLine = 1 To nLines
    
    If StrPtrLen(StrPtr(sLine(lLine))) > 40 Then
      sCheck = TrimFull$(sLine(lLine))
      If StrPtrLen(StrPtr(sCheck)) > 38 Then
        If Peek(StrPtr(sCheck) + 1) <> 33 Then  
          If InStr(sCheck, "ManaRestoreTime") Then
            PrintL "ManaRestoreTime found at line" & Str$(lLine)
            lPos = InStr(sCheck, "value=" )
            If lPos Then
              lPos += 6   
              bChar = Peek(StrPtr(sCheck) + lPos)
              While bChar  <> 34
                sValue &= Chr$(bChar)
                lPos += 1
                bChar = Peek(StrPtr(sCheck)+lPos)
              Wend
              sCheck = Replace$(sLine(lLine), sValue, With "30" )   
              sWorld = Replace$(sWorld, sLine(lLine), With sCheck )
              PrintL "implemented new ManaRestoreTime of 30 seconds"
              FILE_Save(sWorkingpath & "data\world.xml", sWorld )
              PrintL "creating new package- please wait..."
              If ZLib_PackFolder(sWorkingPath, APP_ScriptPath & "Main.pak") Then
                PrintL "copy the package to the gamefolder"
                FILE_Copy(APP_ScriptPath & "Main.pak", sGamepath & "Main.pak")
              Else
                PrintL "!!! unexpected Error while creating the package !!!"
                PrintL "Will abort now. Press any key"
                WaitKey
                Stop
              EndIf
              If DIR_Exists(sWorkingPath) Then
                Dir_Kill(sWorkingpath)
                PrintL "removing temporary data" 
              EndIf
              
              PrintL "all done, have fun playing now..."
              Exit For  
            EndIf  
          EndIf
        EndIf
      EndIf      
    EndIf
  Next
  
EndIf
  
PrintL  
PrintL "press any key to end"
 
WaitKey