[Modul]Übersetzen mit Deepl API

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
HeX0R
Beiträge: 2954
Registriert: 10.09.2004 09:59
Computerausstattung: AMD Ryzen 7 5800X
96Gig Ram
NVIDIA GEFORCE RTX 3060TI/8Gig
Win10 64Bit
G19 Tastatur
2x 24" + 1x27" Monitore
Glorious O Wireless Maus
PB 3.x-PB 6.x
Oculus Quest 2
Kontaktdaten:

[Modul]Übersetzen mit Deepl API

Beitrag von HeX0R »

Ich hab mich mal mit der deepl.com API beschäftigt und nen kleines Modul zusammengenagelt.
Ihr braucht nen API Key von deepl.com, den gibt's zwar kostenlos, allerdings wollen die trotzdem Kreditkartendaten haben.
Also nix für alle Aluhüte hier, für alle anderen:

Code: Alles auswählen

;/---------------
;| Deepl.pbi
;|
;| Module that makes use of the Deepl free API
;| https://www.deepl.com/docs-api
;|
;| Deepl translates usually MUCH MUCH better than google!
;|
;| You need to register to deepl.com to receive your free API Key
;| https://www.deepl.com/pro-api?cta=header-pro-api
;| With the deepl free API, you are allowed to translate 500000 characters / month
;|
;| (c)HeX0R 2022
;|
;| V1.00 (09.04.2022)
;|
;|
;/---------------
; ----------------------------------------------------------------------------
; "THE BEER-WARE LICENSE":
; <HeX0R@coderbu.de> wrote this file. as long as you retain this notice you
; can do whatever you want with this stuff. If we meet some day, and you think
; this stuff is worth it, you can buy me a beer in return
; (see address on https://hex0rs.coderbu.de/).
; Or just go out and drink a few on your own/with your friends ;)
;=============================================================================


CompilerIf #PB_Compiler_Thread = 0
	CompilerWarning "Please enable threadsafe compiler options, or asynchronous HTTPRequests might fail sometimes!"
CompilerEndIf

DeclareModule Deepl
	Structure _TRANSLATE_
		Text.s
		Translated.s
	EndStructure
	
	Declare Init(ApiKey.s, Asynchronous = #False, Window = -1, WinEvent = -1)
	
	;       Needs to be called first.
	;       ApiKey        => ApiKey you got from deepl.com
	;       Asynchronous  => When #False, the procedure Translate() will be finished, when it returns and you can immediately look at the translations
	;                        When #True, the procedure Translate() will immediate return while the loading is still ongoing.
	;                        Your window (var Window), will receive an event (var WinEvent), when retrieving is finnished.
	;                        You should then call GetLastResult() to get all the translations
	;       Window        => Only needed, when Asynchronous is #True
	;       WinEvent      => Only needed, when Asynchronous is #True
	
	Declare Translate(List TRN._TRANSLATE_(), target_lang.s = "en-GB", source_lang.s = "")
	
	;       List TRN()    => all Text elements you want to be translated
	;                        the module will fill all the Translated elements then
	;       target_lang   => language you want the texts to be translated to
	;       souce_lang    => language of your set phrases (can be left out, than it will be auto detected)
	
	Declare GetLastResult(List TRN._TRANSLATE_())
	
	;       Only needed in asynchronous mode
	;       The module will not remember the initially sent TRN list, but makes a copy of it.
	;       Therefore, you have to resend your initial TRN list, and the module will fill the translated elements.
	
EndDeclareModule


Module Deepl
	EnableExplicit
	InitNetwork()
	
	#MAX_TEXTS = 50    ;deepl.com accepts a maximum of 50 text arguments
	
	Structure Phrases
		detected_source_language.s
		text.s
	EndStructure
	
	Structure DEEPL_RESULT
		List translations.Phrases()
	EndStructure
	
	Structure _GLOBAL_
		APIKey.s
		Async.i
	EndStructure
	
	Structure _THREAD_
		ThreadID.i
		WinEvent.i
		Window.i
		Finished.i
		target_lang.s
		source_lang.s
		List Source._TRANSLATE_()
	EndStructure
	
	Global Thread._THREAD_
	Global GL._GLOBAL_
	Thread\Finished = #True
	
	Procedure Init(ApiKey.s, Asynchronous = #False, Window = -1, WinEvent = -1)
		
		GL\APIKey       = ApiKey
		GL\Async        = Asynchronous
		Thread\Window   = Window
		Thread\WinEvent = WinEvent
	EndProcedure
	
	Procedure MyThread(*T._THREAD_)
		Protected POST.s, Text.s, Count, R, Result.s, JSON, *Index, Stop, Flag, Progress
		Protected DeeplRes.DEEPL_RESULT, ok
		
		NewMap Header$()
		Header$("Host")         = "api-free.deepl.com"
		Header$("Accept")       = "*/*"
		Header$("User-Agent")   = "TextTranslater"
		Header$("Content-Type") = "application/x-www-form-urlencoded"
		
		POST = "auth_key=" + GL\APIKey + #LF$
		POST + "&target_lang=" + *T\target_lang + #LF$
		If *T\source_lang
			POST + "&source_lang=" + *T\source_lang + #LF$
		EndIf
		
		FirstElement(*T\Source())
		
		Repeat
			*Index = @*T\Source()
			Text   = ""
			Count  = 0
			Repeat
				Count + 1
				TEXT + "&text=" + URLEncoder(*T\Source()\Text) + #LF$
				If Count >= #MAX_TEXTS
					Break
				EndIf
			Until NextElement(*T\Source()) = 0
			
			If Text
				Text                      = POST + Text
				Stop                      = 0
				Header$("Content-Length") = Str(StringByteLength(Text, #PB_UTF8))
				If GL\Async
					Flag = #PB_HTTP_Asynchronous
				EndIf
				R = HTTPRequest(#PB_HTTP_Post, "https:/api-free.deepl.com/v2/translate", Text, Flag, Header$())
				If R
					ok = #PB_HTTP_Success
					If Flag = #PB_HTTP_Asynchronous
						Repeat
							Delay(100)
							Progress = HTTPProgress(R)
							Select Progress
								Case #PB_HTTP_Success, #PB_HTTP_Failed, #PB_HTTP_Aborted
									ok = Progress
									Break
								Default
									;doesn't work anyway, progress is alway 0
; 									If *T\Window <> -1 And *T\WinEvent <> -1
; 										PostEvent(*T\WinEvent, *T\Window, Progress)
; 									EndIf
							EndSelect
						ForEver
					EndIf
					If ok = #PB_HTTP_Success
						If HTTPInfo(R, #PB_HTTP_StatusCode) = "200"
							Result = HTTPInfo(R, #PB_HTTP_Response)
							ClearList(DeeplRes\translations())
							If ParseJSON(0, Result)
								ExtractJSONStructure(JSONValue(0), @DeeplRes, DEEPL_RESULT)
								If ListSize(DeeplRes\translations()) > 0
									ChangeCurrentElement(*T\Source(), *Index)
									ForEach DeeplRes\translations()
										*T\Source()\Translated = DeeplRes\translations()\text
										If NextElement(*T\Source()) = 0
											Stop = #True
											Break
										EndIf
									Next
								EndIf
								FreeJSON(0)
							EndIf
						Else
							ok = #PB_HTTP_Failed
							FinishHTTP(R)
							Break
						EndIf
					Else
						FinishHTTP(R)
						Break
					EndIf
					FinishHTTP(R)
				EndIf
			EndIf
		Until Text = "" Or Stop
		
		If GL\Async And *T\WinEvent <> -1 And *T\Window <> -1
			PostEvent(*T\WinEvent, *T\Window, ok)
		EndIf
		*T\Finished = #True
		*T\ThreadID = 0
		
		ProcedureReturn ok
	EndProcedure
	
	Procedure GetLastResult(List TRN._TRANSLATE_())
		Protected Result
		
		If Thread\Finished
			CopyList(Thread\Source(), TRN())
			Result = #True
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure Translate(List TRN._TRANSLATE_(), target_lang.s = "en-GB", source_lang.s = "")
		Protected Result
		
		If GL\APIKey = ""
			ProcedureReturn 0
		EndIf
		If Thread\Finished = 0 Or (Thread\ThreadID And IsThread(Thread\ThreadID))
			ProcedureReturn 0
		EndIf
		
		CopyList(TRN(), Thread\Source())
		
		Thread\source_lang = source_lang
		Thread\target_lang = target_lang
		If GL\Async
			Thread\Finished = 0
			Thread\ThreadID = CreateThread(@MyThread(), @Thread)
			Result          = Thread\ThreadID
		Else
			MyThread(@Thread)
			GetLastResult(TRN())
			Result = #True
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
EndModule


CompilerIf #PB_Compiler_IsMainFile
	
	Runtime Enumeration Windows
		#window_1
	EndEnumeration
	
	Runtime Enumeration Gadgets
		#text_from
		#combo_from
		#text_to
		#combo_to
		#editor_from
		#editor_to
		#button_go
	EndEnumeration
	
	Enumeration #PB_Event_FirstCustomValue
		#ThreadEvent
	EndEnumeration
	
	
	Global NewList TRN.Deepl::_TRANSLATE_()
	Global NewMap TargetLang$()
	Global NewMap SourceLang$()
	Global TranslationInProgress.i
	
	Runtime Procedure TranslateNow()
		Protected Count, i
		
		ClearList(TRN())
		Count = CountGadgetItems(#editor_from) - 1
		If Count < 0
			ProcedureReturn
		EndIf
		
		For i = 0 To Count
			AddElement(TRN())
			TRN()\Text = GetGadgetItemText(#editor_from, i)
		Next i
		
		DisableGadget(#editor_from, 1)
		DisableGadget(#editor_to, 1)
		DisableGadget(#button_go, 1)
		DisableGadget(#combo_from, 1)
		DisableGadget(#combo_to, 1)
		TranslationInProgress = #True
		
		Deepl::Translate(TRN(), TargetLang$(GetGadgetText(#combo_to)), SourceLang$(GetGadgetText(#combo_from)))
		
	EndProcedure
	
	Procedure.s GetXMLString()
		Protected XML$
		
		XML$ + "<?xml version='1.0' encoding='UTF-16'?>"
		XML$ + ""
		XML$ + "<dialogs>"
		XML$ + "  <window name='main' flags='#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_Invisible' minwidth='600' minheight='400' text='Deepl Translat0r' xpos='646' ypos='518' id='#window_1'>"
		XML$ + "    <vbox>"
		XML$ + "      <gridbox columns='2' rowexpand='item:2'>"
		XML$ + "        <hbox expand='item:2'>"
		XML$ + "          <text text='Translate from:' id='#text_from'/>"
		XML$ + "          <combobox id='#combo_from'/>"
		XML$ + "        </hbox>"
		XML$ + "        <hbox expand='item:2'>"
		XML$ + "          <text text='Translate to:' id='#text_to'/>"
		XML$ + "          <combobox id='#combo_to'/>"
		XML$ + "        </hbox>"
		XML$ + "        <editor id='#editor_from'/>"
		XML$ + "        <editor id='#editor_to'/>"
		XML$ + "        <hbox colspan='2' align='center' expand='no'>"
		XML$ + "          <button text='Translate Now' id='#button_go' onevent='TranslateNow()'/>"
		XML$ + "        </hbox>"
		XML$ + "      </gridbox>"
		XML$ + "    </vbox>"
		XML$ + "  </window>"
		XML$ + "</dialogs><!--DDesign0R Definition: PureBasic|1|1|1|P_|-|1-->"
		XML$ + ""
		
		ProcedureReturn XML$
	EndProcedure
	
	Procedure TranslatingFinished()
		If EventGadget() = #PB_HTTP_Success
			Deepl::GetLastResult(TRN())
			ClearGadgetItems(#editor_to)
			ForEach TRN()
				AddGadgetItem(#editor_to, -1, TRN()\Translated)
			Next
		EndIf
		DisableGadget(#editor_from, 0)
		DisableGadget(#editor_to, 0)
		DisableGadget(#button_go, 0)
		DisableGadget(#combo_from, 0)
		DisableGadget(#combo_to, 0)
		TranslationInProgress = #False
		
	EndProcedure
	
	Procedure main()
		Protected ApiKey$, a$, b$
		
		a$ = GetXMLString()
		If ParseXML(0, a$) And XMLStatus(0) = #PB_XML_Success
			CreateDialog(0)
			If OpenXMLDialog(0, 0, "main") = 0
				Debug DialogError(0)
				ProcedureReturn
			EndIf
		EndIf
		
		Restore Target_Languages
		Read.s a$
		Read.s b$
		While a$
			TargetLang$(a$) = b$
			AddGadgetItem(#combo_to, -1, a$)
			Read.s a$
			Read.s b$
		Wend
		
		Restore Source_Languages
		Read.s a$
		Read.s b$
		While a$
			SourceLang$(a$) = b$
			AddGadgetItem(#combo_from, -1, a$)
			Read.s a$
			Read.s b$
		Wend
		
		OpenPreferences(GetUserDirectory(#PB_Directory_ProgramData) + "hex0r" + #PS$ + "deeplapi" + #PS$ + "deepl.prefs")
		ApiKey$ = ReadPreferenceString("ApiKey", "")
		If ApiKey$
			a$ = ReadPreferenceString("target_lang", "EN-GB")
			If a$
				SetGadgetText(#combo_to, a$)
			EndIf
			a$ = ReadPreferenceString("source_lang", "Auto")
			If a$
				SetGadgetText(#combo_from, a$)
			EndIf
			ResizeWindow(DialogWindow(0), ReadPreferenceInteger("x", #PB_Ignore), ReadPreferenceInteger("y", #PB_Ignore), ReadPreferenceInteger("w", #PB_Ignore), ReadPreferenceInteger("h", #PB_Ignore))
			ClosePreferences()
		Else
			ClosePreferences()
			ApiKey$ = InputRequester("Deepl API Key", "please enter your API Key for Deepl", "")
			If ApiKey$ = ""
				ProcedureReturn
			EndIf
			If FileSize(GetUserDirectory(#PB_Directory_ProgramData) + "hex0r") <> -2
				CreateDirectory(GetUserDirectory(#PB_Directory_ProgramData) + "hex0r")
			EndIf
			If FileSize(GetUserDirectory(#PB_Directory_ProgramData) + "hex0r" + #PS$ + "deeplapi") <> -2
				CreateDirectory(GetUserDirectory(#PB_Directory_ProgramData) + "hex0r" + #PS$ + "deeplapi")
			EndIf
			CreatePreferences(GetUserDirectory(#PB_Directory_ProgramData) + "hex0r" + #PS$ + "deeplapi" + #PS$ + "deepl.prefs")
			WritePreferenceString("ApiKey", ApiKey$)
			ClosePreferences()
			SetGadgetState(#combo_from, 0)
			SetGadgetState(#combo_to, 0)
		EndIf
		
		Deepl::Init(ApiKey$, #True, DialogWindow(0), #ThreadEvent)
		
		BindEvent(#ThreadEvent, @TranslatingFinished())
		HideWindow(DialogWindow(0), 0)
		
		Repeat
			Select WaitWindowEvent()
				Case #PB_Event_CloseWindow
					If TranslationInProgress = #False
						Break
					EndIf
			EndSelect
		ForEver
		
		If OpenPreferences(GetUserDirectory(#PB_Directory_ProgramData) + "hex0r" + #PS$ + "deeplapi" + #PS$ + "deepl.prefs")
			WritePreferenceString("target_lang", GetGadgetText(#combo_to))
			WritePreferenceString("source_lang", GetGadgetText(#combo_from))
			WritePreferenceInteger("x", WindowX(DialogWindow(0)))
			WritePreferenceInteger("y", WindowY(DialogWindow(0)))
			WritePreferenceInteger("w", WindowWidth(DialogWindow(0)))
			WritePreferenceInteger("h", WindowHeight(DialogWindow(0)))
			ClosePreferences()
		EndIf
		
	EndProcedure
	
	main()
	End
	
	DataSection
		Target_Languages:
		Data.s "Bulgarian", "BG", "Czech", "CS", "Danish", "DA", "German", "DE", "Greek", "EL", "English (British)", "EN-GB"
		Data.s "English (American)", "EN-US", "English (unspecified)", "EN", "Spanish", "ES", "Estonian", "ET"
		Data.s "Finnish", "FI", "French", "FR", "Hungarian", "HU", "Italian", "IT", "Japanese", "JA", "Lithuanian", "LT"
		Data.s "Latvian", "LV", "Dutch", "NL", "Polish", "PL", "Portuguese (all Portuguese varieties excluding Brazilian Portuguese)", "PT-PT"
		Data.s "Portuguese (Brazilian)", "PT-BR", "Portuguese (unspecified variant For backward compatibility", "PT"
		Data.s "Romanian", "RO", "Russian", "RU", "Slovak", "SK", "Slovenian", "SL", "Swedish", "SV", "Chinese", "ZH"
		Data.s "", ""
		Source_Languages:
		Data.s "Auto", "", "Bulgarian", "BG", "Czech", "CS", "Danish", "DA", "German", "DE", "Greek", "EL"
		Data.s "English", "EN", "Spanish", "ES", "Estonian", "ET", "Finnish", "FI", "French", "FR", "Hungarian", "HU"
		Data.s "Italian", "IT", "Japanese", "JA", "Lithuanian", "LT", "Latvian", "LV", "Dutch", "NL", "Polish", "PL"
		Data.s "Portuguese (all Portuguese varieties mixed)", "PT", "Romanian", "RO", "Russian", "RU", "Slovak", "SK"
		Data.s "Slovenian", "SL", "Swedish", "SV", "Chinese", "ZH"
		Data.s "", ""
	EndDataSection
	
CompilerEndIf
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: [Modul]Übersetzen mit Deepl API

Beitrag von RSBasic »

Danke HeX0R für dein Modul. :allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Antworten