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
Reply With Quote
I think there are missing some Forum-sections as beta-testing and support
Members who have read this thread: 0
Bookmarks