danke,
)
Haste etwas Zeit, dann werde ich es mal "Neu machen", wenn nicht kann ichFluid Byte hat geschrieben:Daunloht kapott, wo kann isch rundärladän?
Code: Alles auswählen
;/----------
;|
;| (c)HeX0R 2008
;|
;/----------
Global NewList Lines.s()
Global NewList NoConvert.s()
Procedure.l AddData(y.l, *C.LONG, Add.l)
Protected i.l, j.l, PackSize.l, Size.l, Long.l, Crunch.l, Result.l
Protected a$, Line.s, MyLSet.s, Label.s, BinaryFile.s
Protected *Buffer, *BufferPack
SelectElement(Lines(), y + Add - 1)
y = -1
Repeat
a$ = Lines()
Line = Trim(RemoveString(a$, #TAB$))
If Left(LCase(Line), 13) = "includebinary"
y = ListIndex(Lines())
If MyLSet = ""
For i = 1 To Len(a$)
If Mid(a$, i, 1) = " " Or Mid(a$, i, 1) = #TAB$
MyLSet + Mid(a$, i, 1)
Else
Break
EndIf
Next i
EndIf
ElseIf FindString(a$, Chr(34), 1) = 0 And FindString(a$, ":", 1)
Label = "?" + LCase(Trim(RemoveString(StringField(a$, 1, ":"), #TAB$)))
Break
EndIf
Until PreviousElement(Lines()) = 0
If y = -1
ProcedureReturn 0
EndIf
SelectElement(Lines(), y)
Line = Trim(RemoveString(Lines(), #TAB$))
If Left(LCase(Line), 13) <> "includebinary"
ProcedureReturn 0
EndIf
BinaryFile = StringField(Line, 2, Chr(34))
Size = FileSize(BinaryFile)
ForEach NoConvert()
If NoConvert() = BinaryFile
BinaryFile = ""
Break
EndIf
Next
If BinaryFile = "" Or ReadFile(0, BinaryFile) = 0
ProcedureReturn 0
EndIf
*Buffer = AllocateMemory(Size)
If *Buffer = 0
CloseFile(0)
ProcedureReturn 0
EndIf
ReadData(0, *Buffer, Size)
CloseFile(0)
*BufferPack = AllocateMemory(Size + 8)
If *BufferPack
PackSize = PackMemory(*Buffer, *BufferPack, Size, 9)
If PackSize
Crunch = #True
FreeMemory(*Buffer)
*Buffer = *BufferPack
Swap Size, PackSize
If *C\l = 0
*C\l = #True
EndIf
EndIf
EndIf
If Size / 32 > 1000 And MessageRequester("Sure ?", "The binary " + Chr(34) + BinaryFile + Chr(34) + " will produce " + Str(Size / 32) + " additional lines!" + #LF$ + "Proceed anyway ?", #PB_MessageRequester_YesNo) <> #PB_MessageRequester_Yes
AddElement(NoConvert())
NoConvert() = BinaryFile
FreeMemory(*Buffer)
ProcedureReturn 0
EndIf
Lines() = MyLSet + ";" + Lines()
AddElement(Lines())
Lines() = MyLSet + ";<<Changed through BinaryIncluder (c)HeX0R>>"
AddElement(Lines())
Result = 2
If Crunch
Lines() = MyLSet + ";The following binary is packed!"
AddElement(Lines())
Lines() = MyLSet + "Data.l $" + RSet(Hex(PackSize), 8, "0") + " ;<-Size of this unpacked Binary"
AddElement(Lines())
Result + 2
EndIf
For j = 0 To Size Step 32
Line = MyLSet + "Data.l "
For i = 0 To 7
If (j + i * 4) > Size
Break
EndIf
Long = PeekL(*Buffer + j + (i * 4))
Line + "$" + RSet(Hex(Long), 8, "0") + ", "
Next i
Line = Left(Line, Len(Line) - 2)
Lines() = Line
If j < Size
Result + 1
AddElement(Lines())
EndIf
Next j
FreeMemory(*Buffer)
ForEach Lines()
If Crunch And FindString(LCase(Lines()), "catchimage", 1) And FindString(LCase(Lines()), Label, 1) And FindString(LCase(Lines()), "catchimagepacked", 1) = 0
Lines() = ReplaceString(Lines(), "catchimage", "CatchImagePacked", #PB_String_NoCase)
EndIf
Next
ProcedureReturn Result
EndProcedure
Procedure.l Main()
Protected i.l, j.l, k.l, x.l = -1, y.l = -1, BOM.l, Crunch.l, Add.l, AddProc.l = #True
Protected a$, TempFile.s
If GetEnvironmentVariable("PB_TOOL_IDE") = ""
;-Install Me
If CountProgramParameters() = 0
a$ = PathRequester("Select Path to PureBasic:" + #LF$ + "(Press Cancel if you don't want me to install in the IDE)" , "")
If a$
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
If OpenPreferences(a$ + "tools.prefs") = 0
OpenPreferences(GetEnvironmentVariable("HOME") + ".purebasic/tools.prefs")
EndIf
CompilerElse
If OpenPreferences(a$ + "tools.prefs") = 0
OpenPreferences(GetEnvironmentVariable("APPDATA") + "\Purebasic\tools.prefs")
EndIf
CompilerEndIf
PreferenceGroup("ToolsInfo")
j = ReadPreferenceLong("ToolCount", 0)
k = #True
For i = 1 To j
PreferenceGroup("Tool_" + Str(i - 1))
If ReadPreferenceString("Command", "") = ProgramFilename()
k = #False
EndIf
Next i
If k
PreferenceGroup("Tool_" + Str(j))
WritePreferenceString("Command", ProgramFilename())
WritePreferenceString("Arguments", Chr(34) + "%TEMPFILE" + Chr(34) + " %SELECTION")
WritePreferenceString("WorkingDir", GetPathPart(ProgramFilename()))
WritePreferenceString("MenuItemName", "BinaryIncluder")
WritePreferenceLong("Shortcut", 262258) ;Default Alt+F3
WritePreferenceString("ConfigLine", "")
WritePreferenceLong("Trigger", 0)
WritePreferenceLong("Flags", 1)
WritePreferenceLong("ReloadSource", 2)
WritePreferenceLong("HideEditor", 0)
WritePreferenceLong("HideFromMenu", 0)
WritePreferenceLong("SourceSpecific", 0)
WritePreferenceLong("Deactivate", 0)
PreferenceGroup("ToolsInfo")
WritePreferenceLong("ToolCount", j + 1)
MessageRequester("OK", "BinaryIncluder Tool successfully installed in PB-IDE!" + #LF$ + "Please restart your IDE.")
EndIf
ClosePreferences()
EndIf
EndIf
ProcedureReturn #False
EndIf
TempFile = ProgramParameter()
a$ = ProgramParameter()
y = Val(StringField(a$, 1, "x"))
x = Val(StringField(a$, 3, "x"))
If y = 0 Or TempFile = ""
ProcedureReturn #False
EndIf
If OpenFile(0, TempFile) = 0
ProcedureReturn #False
EndIf
BOM = ReadStringFormat(0)
While Eof(0) = 0
AddElement(Lines())
Lines() = ReadString(0, BOM)
If Lines() = "Procedure.l CatchImagePacked(ImageID.l, *Address.LONG, Size.l = 0, Flags.l = 0)"
AddProc = #False
EndIf
Wend
CloseFile(0)
k = #False
For i = y To x
j = AddData(i, @Crunch, Add)
If j
k = #True
Add + j
EndIf
Next i
If k = #False Or CreateFile(0, TempFile) = 0
ProcedureReturn #False
EndIf
WriteStringFormat(0, BOM)
If Crunch And AddProc
WriteStringN(0, ";Following Procedure can be used for Catching Images, which are marked as packed!")
WriteStringN(0, "Procedure.l CatchImagePacked(ImageID.l, *Address.LONG, Size.l = 0, Flags.l = 0)")
WriteStringN(0, #TAB$ + "Protected Result.l, *Buffer")
WriteStringN(0, "")
WriteStringN(0, #TAB$ + "*Buffer = AllocateMemory(*Address\l)")
WriteStringN(0, #TAB$ + "If *Buffer")
WriteStringN(0, #TAB$ + #TAB$ + "If UnPackMemory(*Address + 4, *Buffer)")
WriteStringN(0, #TAB$ + #TAB$ + #TAB$ + "Result = CatchImage(ImageID, *Buffer, Size, Flags)")
WriteStringN(0, #TAB$ + #TAB$ + "EndIf")
WriteStringN(0, #TAB$ + #TAB$ + "FreeMemory(*Buffer)")
WriteStringN(0, #TAB$ + "EndIf")
WriteStringN(0, "")
WriteStringN(0, #TAB$ + "ProcedureReturn Result")
WriteStringN(0, "EndProcedure")
WriteStringN(0, "")
EndIf
ForEach Lines()
WriteStringN(0, Lines(), BOM)
Next
CloseFile(0)
ProcedureReturn #True
EndProcedure
Main()
