Page 2 of 2 FirstFirst 12
Results 11 to 13 of 13

Thread: Craft The World - what a game!

  1. #11
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,544
    Rep Power
    172
    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
    Last edited by ReneMiner; 28-02-2015 at 20:36.
    I think there are missing some Forum-sections as beta-testing and support

  2. #12
    Super Moderator Petr Schreiber's Avatar
    Join Date
    Aug 2005
    Location
    Brno - Czech Republic
    Posts
    7,129
    Rep Power
    732
    Hell yeah, I am happy you feel the power
    Learn 3D graphics with ThinBASIC, learn TBGL!
    Windows 10 64bit - Intel Core i5-3350P @ 3.1GHz - 16 GB RAM - NVIDIA GeForce GTX 1050 Ti 4GB

  3. #13
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,544
    Rep Power
    172
    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
    
    Last edited by ReneMiner; 01-03-2015 at 14:10.
    I think there are missing some Forum-sections as beta-testing and support

Page 2 of 2 FirstFirst 12

Similar Threads

  1. Sysadmins of the world, unite!
    By Charles Pegge in forum Shout Box Area
    Replies: 1
    Last Post: 04-01-2014, 06:22
  2. End of the World [Again]
    By JosephE in forum General
    Replies: 17
    Last Post: 26-05-2011, 07:58
  3. Most typical face in the world
    By Charles Pegge in forum Shout Box Area
    Replies: 0
    Last Post: 05-03-2011, 07:35
  4. Windows API `Hello World!`
    By Charles Pegge in forum Programs
    Replies: 26
    Last Post: 24-03-2009, 17:14
  5. Game: Game modes
    By Michael Hartlef in forum CM contest 2009
    Replies: 16
    Last Post: 05-10-2008, 04:58

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •