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