copyübersetz 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
juergenkulow
Beiträge: 188
Registriert: 22.12.2016 12:49
Wohnort: :D_üsseldorf-Wersten

copyübersetz mit DeepL API

Beitrag von juergenkulow »

Programm überwacht den Inhalt der Zwischenablage und übersetzt den Inhalt wenn er sich ändert.
Das Ergebnis wird in der Zwischenablage gespeichert, außerdem in einer Datei im Dokumentenverzeichnis.
Ein MessageRequester zeigt den Anfang der Antwort an.
Für den Betrieb ist ein kostenpflichtiger Schlüssel von DeepL erforderlich.
Für Übertragungen von Englisch nach Deutsch gilt DeepL zur Zeit als beste Maschine.

Code: Alles auswählen

; DeepL ansprechen in der Programmiersprache PureBasic als Thread - experimental Linux
; Story: Teile von meherere Nanowerk Emerging Newsletter Mails sollen vom Englischen ins Deutsche
; übertragen werden und auf einmal in die Zwischenablage und eine Datei kopiert werden.
; "Ende" ins Clipboard kopiert oder Alt-F4 beendet Überwachung der Zwischenablage und Speichert das 
; Gesamtergebnis in der Zwischenablage und in einer Dokumentendatei des Benutzers. (Bitte auf Schreibrechte achten.)
; Link: https://www.purebasic.fr/german/viewtopic.php?f=8&t=32299
Define DeepLKey.s="abcdef01-2345-6789-abcd-ef0123456789" ; Bitte tragen Sie hier Ihren auth_key ein.

; Thread-Version
; 0. Das Programm kann per Terminal gesteuert werden, default-Werte überschreiben.
; 1. Text in die Ablage kopieren
; 2. Programm copyübersetz.out aufrufen.
; 3. wiederhole Text in die Ablage kopieren bis kein Text mehr verfügbar
; 4. Ende in die Ablage kopieren oder ALT-F4 im Programmfenster auslösen.
 
; Zu beachten:
; Die Anzahl der Zeichen pro Monat ist auf etwas mehr als 1/4 Mio gesetzt.
; offen: Meldung wenn "Konto" leer ist.
; Klassifizierte Texte dürfen nicht übers Internet übertragen werden.
; Für systemkritische Anwendungen wie Kraftwerke, Krankenhäuser ist DeepL nicht zugelassen.
; Was passiert wenn ein Thread vom Server nicht mehr beantworted wird?
; Was passiert wenn ein Thread auf dem Client abstürzt ? OnErrorCall(@ErrorHandlerThread())

; To-Do
; User auth_key muss sicher gespeichert sein. Offen im Programmcode ist zu schwach.
; Welche Reaktion soll auf Serverantwort "d" erfolgen? 
; offen: Test der 15 s Warteschleife bei offenen Serverantworten. 
; offen: F1 Hilfe im Fenster, Terminal: --help und ? 

CompilerIf  #PB_Compiler_Thread=0
  CompilerError " Thread sicheres Executable einschalten."
CompilerEndIf
EnableExplicit
Define Browser$="firefox" ; Bitte anpassen.
Macro NeueZeile
  #LF$ ; Linux
EndMacro

Structure curlTyp
  Kennzeichen.s
  Aufruf.s
  Antwort.s
  Dauer.i
  Exitcode.i
  Startzeit.i
  Stopzeit.i
EndStructure

CompilerIf 8=SizeOf(Integer)
  #MagischeZahl=$4711471247134714
CompilerElse
  #MagischeZahl=$47114712
CompilerEndIf

NewList curl.curlTyp()
NewList  Befehle.s()

Define Event
Define Textnummer=1
Define Quellsprache.s=""
Define Zielsprache.s="&target_lang=de"
Define Formality.s="&formality=less"
Define Quelledef=#False

; Erklärung der Funktionen
Declare.s curlCall(Aufruf.s) ; Ruft cURL auf. ( https://curl.se/ oder https://de.wikipedia.org/wiki/CURL )
Declare   InitCurlData(List curl.curlTyp(), iName.s, iAufruf.s)
Declare.s Q(Stunde.i, Minute.i, Sekunde.i, Zeitzone.s)
Declare.s sDateiname(sUTC.s)
Declare.s sUTC()
Declare   TheadcurlCall(*Wert)
Declare.q ZBefehl(ausClipboard.s,List Befehle.s())

; Hauptprogramm
Repeat
  AddElement(Befehle())
  Read.s Befehle()
Until Befehle()=""

CompilerIf Not Defined(DeepLKey,#PB_Variable)
  Define DeepLKey.s="abcdef01-2345-6789-abcd-ef0123456789"
CompilerEndIf
If DeepLKey="abcdef01-2345-6789-abcd-ef0123456789" Or DeepLKey=""
  MessageRequester("Fehler","Bitte besorgen Sie sich einen auth_key auf"+#LF$+
                            "https://www.deepl.com/pro#developer"+#LF$+
                            "In der Adresszeile des Ihres Browser Strg+v drücken." )
 
  SetClipboardText("https://www.deepl.com/pro#developer")
  RunProgram(Browser$,"https://www.deepl.com/pro#developer","")
  End
EndIf

If CountProgramParameters()>=1
  Define i
  For i=0 To CountProgramParameters()-1
    Debug ProgramParameter(i)
    Select ProgramParameter(i)
      Case "default" : Formality=""
      Case "less"    : Formality="&formality=less"
      Case "more"    : Formality="&formality=more"
      Case "DE","de" ; German
        If Quelledef : Zielsprache="&target_lang=de" : Else : Quellsprache="&source_lang=de" :Quelledef=#True :EndIf
      Case "EN","en" ; English
        If Quelledef : Zielsprache="&target_lang=en" : Else : Quellsprache="&source_lang=en" :Quelledef=#True :EndIf
      Case "FR","fr" ; French
        If Quelledef : Zielsprache="&target_lang=fr" : Else : Quellsprache="&source_lang=fr" :Quelledef=#True :EndIf
      Case "IT","it" ; Italian
        If Quelledef : Zielsprache="&target_lang=it" : Else : Quellsprache="&source_lang=it" :Quelledef=#True :EndIf
      Case "JA","ja" ; Japanese
        If Quelledef : Zielsprache="&target_lang=ja" : Else : Quellsprache="&source_lang=ja" :Quelledef=#True :EndIf
      Case "ES","es" ; Spanish
        If Quelledef : Zielsprache="&target_lang=es" : Else : Quellsprache="&source_lang=es" :Quelledef=#True :EndIf
      Case "NL","nl" ; Dutch
        If Quelledef : Zielsprache="&target_lang=nl" : Else : Quellsprache="&source_lang=nl" :Quelledef=#True :EndIf
      Case "PL","pl" ; Polish
        If Quelledef : Zielsprache="&target_lang=pl" : Else : Quellsprache="&source_lang=pl" :Quelledef=#True :EndIf
      Case "PT","pt" ; Portuguese (all Portuguese varieties mixed)
        If Quelledef : Zielsprache="&target_lang=pt" : Else : Quellsprache="&source_lang=pt" :Quelledef=#True :EndIf
      Case "RU","ru" ; Russian
        If Quelledef : Zielsprache="&target_lang=ru" : Else : Quellsprache="&source_lang=ru" :Quelledef=#True :EndIf
      Case "ZH","zh" ; Chinese
        If Quelledef : Zielsprache="&target_lang=zh" : Else : Quellsprache="&source_lang=zh" :Quelledef=#True :EndIf
        ; nur Zielsprachen
      Case "EN-GB","en-gb" :Zielsprache="&target_lang=en-GB" ; English (British)
      Case "EN-US","en-us" :Zielsprache="&target_lang=en-US" ; English (American)
      Case "PT-PT","pt-pt" :Zielsprache="&target_lang=pt-PT" ; Portuguese (all Portuguese varieties excluding Brazilian Portuguese)
      Case "PT-BR","pt-br" :Zielsprache="&target_lang=pt-BR" ; Portuguese (Brazilian)
      Default
    EndSelect
  Next
EndIf

Define Text.s=URLEncoder(GetClipboardText()) ; Besorge ersten Text aus der Zwischenablage.

If OpenWindow(0, 0, 0, 168, 42, "copyübersetz", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  AddWindowTimer(0, 123, 16)
  TextGadget(0, 10,  10, 250, 20, "ElapsedMilliseconds()")
  If Text<>""
    InitCurlData(curl(),"Text","https://api.deepl.com/v2/translate?auth_key="+DeepLKey+"&text="+Text+
                               Zielsprache+Quellsprache+"&tag_handling=xml&formality="+Formality)
    CreateThread(@TheadcurlCall(),@curl())
  EndIf
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_Timer And EventTimer() = 123
      SetGadgetText(0, Str(ElapsedMilliseconds()))
      ; Debug ElapsedMilliseconds()
    EndIf 
    If Text<>URLEncoder(GetClipboardText())
      Text=URLEncoder(GetClipboardText())
      Select ZBefehl(Text,Befehle())
        Case 0
          Textnummer+1
          InitCurlData(curl(),"Text"+Str(Textnummer),"https://api.deepl.com/v2/translate?auth_key="+
                                                     DeepLKey+"&text="+Text+
                                                     Zielsprache+Quellsprache+
                                                     "&tag_handling=xml&formality="+Formality)
          CreateThread(@TheadcurlCall(),@curl()) ; Erstelle eigenen Thread für Text in Clipboard.         
        Case 1
          Event=#PB_Event_CloseWindow
        Default
          MessageRequester("unbehandelter Befehl",Text)
          ; End
      EndSelect 
    EndIf
  Until Event = #PB_Event_CloseWindow
  CloseWindow(0)
EndIf

; Warte auf das Ende der Threads
; Wenn ein Serverthread nicht endet droht hier eine Endlosschleife.
; Auf welche Zeit ist ein Serverthread begrenzt?
; offen: Test in der Wildbahn.
Define wartenBis=ElapsedMilliseconds()+15000 ; 15 s
ForEach curl()
  While Curl()\Exitcode=#MagischeZahl
    Delay(1)
    If wartenBis<=ElapsedMilliseconds()
      If #PB_MessageRequester_Yes=MessageRequester("Zeit überschritten", "Programm abbrachen?",
                                                   #PB_MessageRequester_YesNo )
        Break 2 ; Springt ans Ende von ForEach crul() Next!
      Else
        wartenBis=ElapsedMilliseconds()+15000; 15 s warten
      EndIf
    EndIf
  Wend
Next
Define Gesamtantwort.s
If ListSize(curl())=1
  Gesamtantwort=curl()\Antwort
Else
  Define Start=curl()\Startzeit
  Define Stop=curl()\Stopzeit
  ForEach curl()
    Gesamtantwort+"<"+Curl()\Kennzeichen+NeueZeile+Curl()\Antwort+NeueZeile
    If curl()\Startzeit<Start
      Start=curl()\Startzeit
    EndIf
    If curl()\Startzeit>Stop
      Stop=curl()\Stopzeit
    EndIf 
    Gesamtantwort+"<Ende"+NeueZeile 
  Next   
EndIf
SetClipboardText(Gesamtantwort)
Define Dateiname.s=GetUserDirectory(#PB_Directory_Documents)+sDateiname(sUTC())+".txt"
Define Datei=OpenFile(#PB_Any,Dateiname)
WriteString(Datei,Gesamtantwort,#PB_UTF8 )
CloseFile(Datei)
If ListSize(curl())=1 
  MessageRequester(Str(curl()\Stopzeit-curl()\Startzeit)+" ms DeepL-Antwort:",Left(curl()\Antwort,2000)+Space(20))
Else
  MessageRequester("Zeit ms:"+Str(Stop-Start),Left(Gesamtantwort,2000)+Space(20))
EndIf

Procedure InitCurlData(List curl.curlTyp(), iName.s, iAufruf.s)
  AddElement(curl())
  curl()\Kennzeichen=iName
  curl()\Aufruf=iAufruf
  curl()\Exitcode=#MagischeZahl
  curl()\Startzeit=ElapsedMilliseconds()
EndProcedure

Procedure.s curlCall(Aufruf.s)
  Protected curl = RunProgram("curl",Aufruf,"", #PB_Program_Open | #PB_Program_Read)
  Protected Output$ = ""
  Protected *mem=AllocateMemory(1000000) ; Mehr ale 1. Mio Zeichen darf ein Text bei deepL nicht haben.
  If 0=*mem
    ProcedureReturn "Speicherfehler"
  EndIf
  If curl
    While ProgramRunning(curl)
      If AvailableProgramOutput(curl)
        ReadProgramData(curl,*mem,1000000)
        Output$+PeekS(*mem,-1,#PB_UTF8)+Chr(13)
      Else
        Delay(10) ; Warte 10 ms
                  ;Debug "Delay(10)"
      EndIf
    Wend
    If ProgramExitCode(curl)<>0
      Output$ + "Exitcode: " + Str(ProgramExitCode(curl))
    EndIf   
    CloseProgram(curl) ; Schließt die Verbindung zum Programm
    FreeMemory(*mem)
    ProcedureReturn Output$
  Else
    ProcedureReturn ""
  EndIf
EndProcedure 

Procedure TheadcurlCall(*Wert)
  Protected *curl.curlTyp=*Wert
  Protected Antwort.s
  Antwort=curlCall(*curl\Aufruf)
  Protected StartText=FindString(Antwort,"text")+7
  *curl\Antwort=ReplaceString(ReplaceString(Mid(Antwort,StartText,Len(Antwort)-4-StartText),
                                            "\n",NeueZeile),
                              "\"+Chr(34),Chr(34))
  *curl\Stopzeit=ElapsedMilliseconds()
  *curl\Exitcode=0 ; Alles in Ordnung.
EndProcedure

Procedure.s Q(Stunde.i, Minute.i, Sekunde.i, Zeitzone.s)
  ; siehe: https://www.zeitverschiebung.net/de/
  ; siehe: https://de.wikipedia.org/wiki/Zeitzone
  Protected Q=Stunde*4+Minute/15
  Protected Qsec=(Minute%15)*60+Sekunde
  Protected Qplus=0
  Select Zeitzone
    ;...
    Case "UTC"               : Qplus=22
    Case "MEZ"               : Qplus=18 ; UTC+1
    Case "MESZ"              : Qplus=14 ; UTC+2
    ;...     
    Case "IST", "SLST"       ; UTC+5:30
    Case "Nepal"             : Qplus=95 ; UTC+5:45 
    ;...
    Case "IDLE", "NZST"      : Qplus=70; UTC+12
    ;...
    Case "Tonga"             : Qplus=66; UTC+13
    Default                  : Qplus=22 ; UTC
  EndSelect
  ProcedureReturn RSet(Str((Q+Qplus)%96),2,"0")+RSet(Str(Qsec),3,"0")
  ; offen viele Zeitzonen.
EndProcedure

CompilerIf #PB_Compiler_OS=#PB_OS_Linux Or #PB_Compiler_OS=#PB_OS_MacOS
Procedure.s sUTC() ;Linux
  Protected ProgramID
  Protected Output$
  Protected Parameter$="-u "+Chr(34)+"+%H%M%S"+Chr(34)
  ProgramID = RunProgram("date", Parameter$, "", #PB_Program_Open | #PB_Program_Read)
  If ProgramID
    While ProgramRunning(ProgramID)
      Output$ + ReadProgramString(ProgramID)
    Wend
    CloseProgram(ProgramID)
  EndIf
  ProcedureReturn Output$
 
  ProcedureReturn
EndProcedure
CompilerElse ;Windows
  Procedure.s sUTC()
    Protected st.SYSTEMTIME
    GetSystemTime_(@st)
    ProcedureReturn RSet(Str(st\wHour),2,"0")+RSet(Str(st\wMinute),2,"0")+RSet(Str(st\wSecond),2,"0")
  EndProcedure
CompilerEndIf

Procedure.s sDateiname(sUTC.s)
  Protected Stunde=Val(Left(sUTC,2))
  Protected Minute=Val(Mid(sUTC,3,2))
  Protected Sekunde=Val(Mid(sUTC,5,2))
 
  ProcedureReturn "1"+FormatDate("%yyyy%mm%dd%hh%ii%ss",Date())+"Q"+Q(Stunde,Minute,Sekunde,"UTC")
EndProcedure

Procedure.q ZBefehl(ausClipboard.s,List Befehle.s())
  Protected retWert.q=0
  Protected gefunden, Stelle, Laenge, NaechstesLeerzeichen,von
  Protected Z.s
 
  If FindString(ausClipboard," ") ; Kein Befehl sondern Text.
    ProcedureReturn 0
  Else
    ResetList(Befehle())
    gefunden=#False
    While NextElement(Befehle()) And gefunden=#False
      Stelle=FindString(Befehle(),ausClipboard)
      If Stelle<>0
        ; Isoliere Z
        ; Znn Ende
        NaechstesLeerzeichen=FindString(Befehle()," ",Stelle+Len(ausClipboard))
        von=Stelle+Len(ausClipboard)+1
        ;Laenge=2
        Laenge=NaechstesLeerzeichen-(Stelle+Len(ausClipboard)-2)
        Z.s= Mid(Befehle(),von,Laenge) ; erkennen Nummern - Umsetzen
        If Left(Z,1)="Z"
          Z=Mid(z,2)
          retwert=10*retwert
          Select Left(z,1)
            Case "0","०","੦","೦": retWert=retWert
            Case "1","१","੧","೧" : retWert+1
            Case "2","२","੨","೨": retWert+2
            Case "3","३","੩","೩": retWert+3
            Case  "4","४","੪","೪" : retWert+4
            Case "5","५","੫","೫": retWert+5
            Case "6","६","੬","೬" : retWert+6
            Case "7","७","੭","೭" :retWert+7
            Case "8","८","੮","೮" :retWert+8
            Case "9","९","੯","೯" :retWert+9
          EndSelect ; offen weitere Unicode Nummbernsysteme
        EndIf
      EndIf
    Wend
    ProcedureReturn retWert
  EndIf
EndProcedure

DataSection
  Data.s "de ISO639 Ende Z1 " ; Hier kann auch ein IncludeBinary mit vielen KByte stehen.
  Data.s "kok ISO639 Kabar Z೧ "
  Data.s ""
EndDataSection
; 210313 1. 2x MessageRequester  +Space(20) 2. Rechtsschreibung & Kommentare 3. Zahlen kn 4. Del curlcallB 5. kok

; <Text
; Im Wesentlichen drückt eine winzige, spitze Sonde das Material ein, während es unter kontrollierten Bedingungen mit Licht beleuchtet wird, und die Tiefe und Geschwindigkeit, mit der die Sonde die Oberfläche eindrückt, kann gemessen werden. Die Sonde erzeugt Versetzungen - Verschiebungen von Kristallebenen - in der Nähe der Oberfläche, und mit einem Transmissionselektronenmikroskop beobachten die Forscher die Wirkung von Licht in einem Bereich von Wellenlängen auf die Versetzungskeimbildung (die Geburt neuer Versetzungen) und die Versetzungsmobilität (das Gleiten oder Gleiten der Versetzungen von dem Punkt, an dem sie erzeugt wurden).
; <Ende
; <Text2
; Die Beleuchtung durch Licht hat keinen Einfluss darauf: Die im Halbleiter durch das Licht angeregten Elektronen und Löcher (die "photoangeregten Ladungsträger") beeinflussen die Dehnungsenergie der Versetzung nicht, und es ist diese Energie, die die "Linienspannung" der Versetzung bestimmt, die den Keimbildungsprozess steuert.
; <Ende
edit: 3x / Zeile 341 Danke an kernadec
15. März 12021 2x MessageRequester +Space(20) 2. Rechtsschreibung & Kommentare 3. Zahlen kn 4. Del curlcallB 5. kok
Zuletzt geändert von juergenkulow am 15.03.2021 10:23, insgesamt 2-mal geändert.
Bitte stelle Deine Fragen, denn den Erkenntnisapparat einschalten entscheidet über das einzig bekannte Leben im Universum.

Jürgen Kulow Wersten :D_üsseldorf NRW D Europa Erde Sonnensystem Lokale_Flocke Lokale_Blase Orion-Arm
Milchstraße Lokale_Gruppe Virgo-Superhaufen Laniakea Sichtbares_Universum
Benutzeravatar
kernadec
Beiträge: 25
Registriert: 05.07.2009 17:51

Re: copyübersetz mit DeepL API

Beitrag von kernadec »

Hallo,
Danke für Aktie den Code
Fehler mit PB 573, 32 und 64 Bit
Zeile 341: Strukturfelder
wird vermisst.
herzlich

Strukturen verwenden nur ein "\"
Lösung
modifiziere Zeile 341:

Code: Alles auswählen

 ProcedureReturn RSet(Str(st\wHour),2,"0")+RSet(Str(st\wMinute),2,"0")+RSet(Str(st\wSecond),2,"0")
Antworten