Meine kleine Abswechslungs Projektarbeit.
Den Source habe ich komplett übernommen von ParkL seinem Beitrag zu GETTEXT für PB und Multilange.
Ich habe begonnen den Source nach Möglichkeit auf PB 6.3 anzugleichen.
Komplett abgeschlossen ist das Projekt noch nicht, ich habe noch extrem viel alten Source Teil vorhanden
den ich nach und nach versuche auszuschließen.
Leider habe ich gerade das Original nicht zur Hand als den Link zum Beitrag.
https://www.purebasic.fr/german/viewto ... TE#p17247
Das als Vorstellung zur aktuellen Arbeit neben dem restlichen.
Dazu habe ich versucht extrem viel aus den vorangegangenen Post mit vielen Tipps anzuwenden.
Evtl. sind nicht alle so gut verarbeitet worden. mit einem entsprechenden UpDate versuche ich Euch die Arbeit zu verbessern.
Natürlich freue ich mich über Anregung und Kritik.
Unten also mein Source zzt. überarbeitet sowie Link zur Datei.
Habe bedauerlicherweise nicht gerade gesehen wie ich die Datei anhängen könnte.
Code: Alles auswählen
;- Top
;/ Gettext for PB by ParkL
;/
;/ USAGE:
;/ Whenever you use a string that's supposed to be internationalized use the GetText function.
;/
;/ Example:
;/ mytext.s = "Blah Blah Blah" --> mytext.s = GetText("Blah Blah Blah")
;/
;/ If the string you pass is in the translation list, the translated text will be returned.
;/ If it isn't in the list, the initial string you passed to GetText() will be returned.
;/
;/ To Load a language file use the GetText_LoadLanguage(file.s) function.
;/
;/ To create a language template file for your programm set the #GETTEXT_CREATE_TEMPLATE
;/ constant to 1. GetText() will now "collect" the strings you pass in a seperate list. Play around
;/ until you're sure gettext has collected all strings you want to be on your
;/ translation template (duplicates will be skipped). Then call GetText_WriteLanguage(file.s).
;/
;/ compilerif #GETTEXT_CREATE_TEMPLATE
;/ GetText_WriteLanguage("template.txt")
;/ compilerendif
;/ end
;/
;/ Note:
;/
;/ To create a template file #GETTEXT_CREATE_TEMPLATE must be true or the GetText_WriteLanguage()
;/ function simply won't exist because of the compiler directives.
; -----------------------------------------------------------------------------
; Name: *** GETTEXT Language Template***
; Description: *** siehe oben ***
; Author: John Doe
; Date: 2026-03-08
; Version: 2.0
; PB-Version: 6.3
; OS: Windows, Linux, macOS
; Credit: PureBasic Forum Englisch (pop3.pbi)
; Forum: https://www.purebasic.fr/english/
; : https://www.purebasic.fr/german/viewtopic.php?t=17225
; : https://www.purebasic.fr/german/viewtopic.php?t=29021
; : https://www.purebasic.fr/english/viewtopic.php?t=51959&hilit=MD5Fingerprint&start=30 (pop3.pbi)
; :
; Created by: DaMu
; -----------------------------------------------------------------------------
#GETTEXT_CREATE_TEMPLATE = 0 ;If you want to create a template file set this to 1
UseCRC32Fingerprint()
Structure _GetText_KeyValuePair
Key.l
Value.s
StructureUnion
language.s
languagecode.s
EndStructureUnion
EndStructure
CompilerIf #PB_Compiler_OS = #PB_OS_Windows ;OK, let's use CRLF as a Newline Symbol for Win
GetText_newline.s = Chr(13)+Chr(10)
CompilerElse ; LF for the other platforms
GetText_newline.s = Chr(10)
CompilerEndIf
Global NewList _GetText_ReadList._GetText_KeyValuePair() ;Temporary List for loading the language file.
Global Dim _GetText_List._GetText_KeyValuePair(0) ;The list we'll be sorting and searching
Global Dim CountList(0)
Global _GetText_ListCount.l ;Internal Var with the list-count
Global Dim _GetText_Quicksort(0)
CompilerIf #GETTEXT_CREATE_TEMPLATE ;OK, we need 2 more functions if we'd like to create a template
Global NewList GetText_Keys.s()
Procedure _GetText_InList(text.s) ; PRIVATE, don't worry about this one
ForEach GetText_Keys()
If GetText_Keys() = text
ProcedureReturn 1
EndIf
Next
ProcedureReturn 0
EndProcedure
Procedure GetText_WriteLanguage(file.s) ;file is the filename of the template file you want to write. Returns 0 on fail !
Protected fhnd.l
fhnd = CreateFile(#PB_Any, file)
If fhnd
WriteStringN(fhnd, "# Easy Gettext Language File. Please use '\n' to signal a line feed !" ,#PB_Ascii)
WriteStringN(fhnd, "GETTEXT",#PB_Ascii)
WriteStringN(fhnd, "Language",#PB_Ascii)
WriteStringN(fhnd, "Langcode",#PB_Ascii)
ForEach GetText_Keys()
WriteStringN(fhnd, GetText_Keys(),#PB_Ascii)
WriteStringN(fhnd, "*",#PB_Ascii)
Next
CloseFile(fhnd)
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
CompilerEndIf
Procedure _GetText_Search(search.s) ; PRIVATE, binary search for the text's CRC
Protected pivot, searchcrc.s, success.l, fe.l, le.l, Result.s, *Buffer
fe = 0
le = _GetText_ListCount-1
success = 0
CompilerIf #PB_Compiler_Unicode And #PB_Compiler_Version > 540
*Buffer = AllocateMemory(StringByteLength(search, #PB_Ascii) + 1)
PokeS(*Buffer, search, - 1, #PB_Ascii)
searchcrc = Fingerprint(*Buffer, Len(search),#PB_Cipher_MD5)
Debug searchcrc
FreeMemory(*Buffer)
CompilerEndIf
; Repeat
If IsFingerprint(Len(searchcrc)) <> 0
success = 0
ElseIf IsFingerprint(Len(searchcrc)) -1
success = 1
ElseIf IsFingerprint(Len(searchcrc)) +1
success = 1
; pivot = (fe+le)/2
; If _GetText_List(pivot)\Key = searchcrc
; success = 1
; Else
; If searchcrc < _GetText_List(pivot)\Key
; le = pivot -1
; Else
; fe = pivot +1
; EndIf
; EndIf
; Until success Or fe > le
; If success
; ProcedureReturn pivot
; Else
; ProcedureReturn 0
EndIf
EndProcedure
; Procedure _GetText_Quicksort_Divide(left, right) ; PRIVATE, little QS-Divide Function
; Protected pivot, Swap.l
; pivot = _GetText_List((left + right)/2)\Key
; While left<right
; While _GetText_List(left)\Key < pivot And left<right
; left+1
; Wend
; While _GetText_List(right)\Key > pivot And left < right
; right-1
; Wend
; Swap = AllocateMemory(SizeOf(_GetText_KeyValuePair))
; CopyMemory(@_GetText_List(left), Swap, SizeOf(_GetText_KeyValuePair))
; CopyMemory(@_GetText_List(right), @_GetText_List(left), SizeOf(_GetText_KeyValuePair))
; CopyMemory(Swap, @_GetText_List(right), SizeOf(_GetText_KeyValuePair))
; FreeMemory(Swap)
; Wend
; ProcedureReturn left
;EndProcedure
; rocedure _GetText_Quicksort(left, right) ; PRIVATE, little QS
; Protected division
; If right > left
; division = _GetText_Quicksort_Divide(left, right)
; _GetText_Quicksort(left, division)
; _GetText_Quicksort(division+1, right)
; EndIf
; EndProcedure
Procedure.s GetText_GetLanguage() ;Returns the Name of the Language else ""
If _GetText_ListCount
ProcedureReturn _GetText_List(0)\language
Else
ProcedureReturn ""
EndIf
EndProcedure
Procedure.s GetText_GetLanguageCode() ;Returns the Code of the Language else ""
If _GetText_ListCount
ProcedureReturn _GetText_List(0)\languagecode
Else
ProcedureReturn ""
EndIf
EndProcedure
Procedure GetText_LoadLanguage(file.s) ;Load a language file. Will return 0 on fail.
Protected fhnd.l, i.l, strin.s, lang.s, langcode.s, *Buffer2
fhnd = ReadFile(#PB_Any, file)
If fhnd
ClearList(_GetText_ReadList())
i=0
While Eof(fhnd) = 0
strin = ReadString(fhnd, #PB_Ascii)
If Mid(Trim(strin), 0, 1) <> "#"
Select i
Case 0
If strin<>"GETTEXT"
ProcedureReturn 0
EndIf
Case 1
lang = strin
Case 2
langcode = strin
Default
If (i%2)=1
AddElement(_GetText_ReadList())
CompilerIf #PB_Compiler_Unicode And #PB_Compiler_Version > 540
*Buffer2 = AllocateMemory(StringByteLength(strin, #PB_Ascii) + 1)
PokeS(*Buffer2, strin, - 1, #PB_Ascii)
_GetText_ReadList()\Key = Val(Fingerprint(*Buffer2, Len(strin),#PB_Cipher_CRC32))
Else
_GetText_ReadList()\Value = strin
EndIf
EndSelect
i+1
EndIf
Wend
CloseFile(fhnd)
_GetText_ListCount = CountList(_GetText_ReadList())
If _GetText_ListCount
_GetText_ReadList()\language = lang
_GetText_ReadList()\languagecode = langcode
Dim _GetText_List._GetText_KeyValuePair(_GetText_ListCount)
i=0
ForEach _GetText_ReadList()
CopyMemory(@_GetText_ReadList(), @_GetText_List(i), SizeOf(_GetText_KeyValuePair))
i+1
Next
EndIf
;Sort our List to CRC asc for Binary Search later
; _GetText_Quicksort(0, #PB_Sort_NoCase, _GetText_ListCount-1)
; ProcedureReturn _GetText_ListCount
EndIf
ProcedureReturn 0
EndProcedure
Procedure.s GetText(text.s) ; Returns text.s's translation, if text.s isn't found in the translation list it returns text.s
Shared GetText_newline.s
Protected i, searchtext.s
CompilerIf #GETTEXT_CREATE_TEMPLATE
If _GetText_InList(text) = 0
AddElement(GetText_Keys())
GetText_Keys() = text
EndIf
CompilerEndIf
searchtext = ReplaceString(text, GetText_newline, "\n")
i = _GetText_Search(searchtext)
If i
ProcedureReturn ReplaceString(_GetText_List(i)\Value, "\n", GetText_newline)
Else
ProcedureReturn text
EndIf
EndProcedure
;- Example
If OpenConsole()
If GetText_LoadLanguage("c:\langtest.txt")
PrintN("Lang-File found.")
Else
PrintN("Lang-File not found. Using standard texts.")
EndIf
PrintN(GetText("This is a test ! ;)"))
PrintN(GetText("Another test !"))
CompilerIf #GETTEXT_CREATE_TEMPLATE
GetText_WriteLanguage("langtemplate.txt")
CompilerEndIf
Input()
CloseConsole()
CompilerEndIf
EndIfHerzliche Grüsse
Chris
