
'***************** Teil von JR

VAR _clshownoerrors%=0
VAR _clshowerrors%=1

declare _clDLL%
declare _cl_errortext$[]
declare _cl_rndpool#,_cl_rndpoollen&,_cl_rndpos&
declare _cl_faddr_cryptInit%,_cl_faddr_cryptEnd%,_cl_faddr_cryptAddRandom%,_cl_faddr_cryptCreateEnvelope%,_cl_faddr_cryptSetAttribute%,_cl_faddr_cryptPushData%,_cl_faddr_cryptFlushData%
declare _cl_faddr_cryptPopData%,_cl_faddr_cryptDestroyEnvelope%,_cl_faddr_cryptSetAttributeString%,_cl_faddr_cryptGetAttribute%,_cl_faddr_cryptCreateContext%,_cl_faddr_cryptEncrypt%
declare _cl_faddr_cryptDestroyContext%,_cl_faddr_cryptCreateSession%,_cl_faddr_cryptDestroySession%,_cl_faddr_cryptGenerateKey%,_cl_faddr_cryptGetAttributeString%
declare _cl_OwnEMailAddress$
declare _cm_RawMail$
declare _cm_Sender$,_cm_Recipient$,_cm_Subject$,_cm_CC$,_cm_BCC$,_cm_Recipients$
declare _cm_AnzAttachments&,_cm_AnzBodies&,_cm_AnzNestedEmails&
declare _cm_AttachmentArt$[],_cm_AttachmentFn$[],_cm_BodyArt$[],_cm_BodyCharSet$[],_cm_Body$[],_cm_NestedEmailFn$[]
declare _ImapCapa1$,_ImapCapa2$,_ImapGBfolders%,_ImapGBEmails%,_UIDValidity&
VAR _CRLF$=@chr$(13)+@chr$(10)

PROC clInit
  parameters noslowpoll% 'kann auch weggelassen werden, dann =0; sollte nur in Ausnahmefällen =1 gesetzt und slowpoll dann später im Programm aufgerufen werden (s. S. 33 im CryptLib-Manual, das ist S. 47 des PDF-Dokuments)
  declare owpa$,a&
  if %pcount=0
    noslowpoll%=0
  endif
  if (@upper$(@cl_extractfilename(@par$(0)))<>"PROFAN.EXE") and (@upper$(@cl_extractfilename(@par$(0)))<>"PRFRUN32.EXE") 'EXE wurde gestartet, Pfad ist in @par$(0)
    owpa$=@cl_extractpath(@par$(0))
  else 'es wurde interpretiert oder über PRC-ausführen gestartet, Pfad ist in @par$(1) (über die .prf- bzw. .enh-Datei im Interpreter oder die .prc-Datei, wenn über PRC-ausführen getartet wurde)
    owpa$=@cl_extractpath(@par$(1))
  endif
  if @right$(owpa$,1)="\\" 'extractpath gibt immer einen rechten Backslash zurück, es sei denn, dessen Eingabe enthielt gar keinen Pfad
    owpa$=@left$(owpa$,@len(owpa$)-1)
  endif
  _clDLL%=0
  a&=1
  while (_clDLL%=0) and (a&<=5)
    _clDLL%=@usedll(owpa$+"\\"+"cl32.dll") '$currentdir+"\\cl32.dll")
    inc a&
  endwhile
  if _clDLL%
    _cl_faddr_cryptInit%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptInit")
    _cl_faddr_cryptEnd%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptEnd")
    _cl_faddr_cryptAddRandom%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptAddRandom")
    _cl_faddr_cryptCreateEnvelope%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptCreateEnvelope")
    _cl_faddr_cryptSetAttribute%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptSetAttribute")
    _cl_faddr_cryptPushData%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptPushData")
    _cl_faddr_cryptFlushData%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptFlushData")
    _cl_faddr_cryptPopData%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptPopData")
    _cl_faddr_cryptDestroyEnvelope%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptDestroyEnvelope")
    _cl_faddr_cryptSetAttributeString%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptSetAttributeString")
    _cl_faddr_cryptGetAttribute%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptGetAttribute")
    _cl_faddr_cryptCreateContext%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptCreateContext")
    _cl_faddr_cryptEncrypt%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptEncrypt")
    _cl_faddr_cryptDestroyContext%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptDestroyContext")
    _cl_faddr_cryptCreateSession%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptCreateSession")
    _cl_faddr_cryptDestroySession%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptDestroySession")
    _cl_faddr_cryptGenerateKey%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptGenerateKey")
    _cl_faddr_cryptGetAttributeString%=@external("kernel32.dll","GetProcAddress",_clDLL%,"cryptGetAttributeString")
    case @call(_cl_faddr_cryptInit%)<>~crypt_ok: cl_hinweisbox "PROC clInit: cryptlib initialisation failed",1
    ifnot noslowpoll%
      clSlowPoll
    endif
  else
    cl_hinweisbox "cryptlib.inc: "+"cl32.dll"+" couldn't be loaded\n\nIf "+"cl32.dll"+" itself is present: Probably vcruntime140.dll ist missing in C:\\Windows\\SysWOW64 (64bit Windows) or C:\\Windows\\System32 \
                   (32bit Windows).\n\nAll dependencies:\nkernel32.dll\nuser32.dll\nadvapi32.dll\nnetapi32.dll\ndnsapi.dll\nws2_32.dll\nvcruntime140.dll\nucrtbase.dll",1
  endif
  '{ 'clRnd vorbereiten
  if _clDLL%
    _cl_rndpoollen&=1000
    dim _cl_rndpool#,_cl_rndpoollen&
    _cl_rndpos&=_cl_rndpoollen& 'beim ersten Aufruf von clRnd wird auf diese Weise der RndPool gefüllt, da hierdurch alle Bytes als schon verbraucht markiert werden
  endif
  '}
  '{ '_cl_errortext$[] füllen
  _cl_errortext$[~CRYPT_OK+100]="Function successful (no error)."
  'Error in parameters passed to function.  The parentheses are to catch
  'potential erroneous use in an expression
  _cl_errortext$[~CRYPT_ERROR_PARAM1+100]="Bad argument, parameter 1."
  _cl_errortext$[~CRYPT_ERROR_PARAM2+100]="Bad argument, parameter 2."
  _cl_errortext$[~CRYPT_ERROR_PARAM3+100]="Bad argument, parameter 3."
  _cl_errortext$[~CRYPT_ERROR_PARAM4+100]="Bad argument, parameter 4."
  _cl_errortext$[~CRYPT_ERROR_PARAM5+100]="Bad argument, parameter 5."
  _cl_errortext$[~CRYPT_ERROR_PARAM6+100]="Bad argument, parameter 6."
  _cl_errortext$[~CRYPT_ERROR_PARAM7+100]="Bad argument, parameter 7."
  'Errors due to insufficient resources
  _cl_errortext$[~CRYPT_ERROR_MEMORY+100]="Out of memory."
  _cl_errortext$[~CRYPT_ERROR_NOTINITED+100]="Data has not been initialised."
  _cl_errortext$[~CRYPT_ERROR_INITED+100]="Data has already been initialised."
  _cl_errortext$[~CRYPT_ERROR_NOSECURE+100]="Operation not available at requested sec.level."
  _cl_errortext$[~CRYPT_ERROR_RANDOM+100]="No reliable random data available."
  _cl_errortext$[~CRYPT_ERROR_FAILED+100]="Operation failed."
  _cl_errortext$[~CRYPT_ERROR_INTERNAL+100]="Internal consistency check failed."
  'Security violations
  _cl_errortext$[~CRYPT_ERROR_NOTAVAIL+100]="This type of operation not available."
  _cl_errortext$[~CRYPT_ERROR_PERMISSION+100]="No permission to perform this operation."
  _cl_errortext$[~CRYPT_ERROR_WRONGKEY+100]="Incorrect key used to decrypt data."
  _cl_errortext$[~CRYPT_ERROR_INCOMPLETE+100]="Operation incomplete/still in progress."
  _cl_errortext$[~CRYPT_ERROR_COMPLETE+100]="Operation complete/can't continue."
  _cl_errortext$[~CRYPT_ERROR_TIMEOUT+100]="Operation timed out before completion."
  _cl_errortext$[~CRYPT_ERROR_INVALID+100]="Invalid/inconsistent information."
  _cl_errortext$[~CRYPT_ERROR_SIGNALLED+100]="Resource destroyed by external event."
  'High-level function errors
  _cl_errortext$[~CRYPT_ERROR_OVERFLOW+100]="Resources/space exhausted."
  _cl_errortext$[~CRYPT_ERROR_UNDERFLOW+100]="Not enough data available."
  _cl_errortext$[~CRYPT_ERROR_BADDATA+100]="Bad/unrecognised data format."
  _cl_errortext$[~CRYPT_ERROR_SIGNATURE+100]="Signature/integrity check failed."
  'Data access function errors
  _cl_errortext$[~CRYPT_ERROR_OPEN+100]="Cannot open object."
  _cl_errortext$[~CRYPT_ERROR_READ+100]="Cannot read item from object."
  _cl_errortext$[~CRYPT_ERROR_WRITE+100]="Cannot write item to object."
  _cl_errortext$[~CRYPT_ERROR_NOTFOUND+100]="Requested item not found in object."
  _cl_errortext$[~CRYPT_ERROR_DUPLICATE+100]="Item already present in object."
  'Data enveloping errors
  _cl_errortext$[~CRYPT_ENVELOPE_RESOURCE+100]="Envelope Resource needed (such as a password etc.)."
  '}
ENDPROC 'clInit

PROC clDeInit
  if _clDLL%
    case @call(_cl_faddr_cryptEnd%)<>~crypt_ok: cl_hinweisbox "PROC clDeInit: cryptlib shutdown reported a problem (but cleanup was performed)",1
    freedll _clDLL%
    dispose _cl_rndpool#
    case _ImapGBfolders%: @destroywindow(_ImapGBfolders%)
    case _ImapGBEmails%: @destroywindow(_ImapGBEmails%)
  endif
ENDPROC 'clDeInit

PROC clSlowPoll
  case @call(_cl_faddr_cryptAddRandom%,0,~crypt_random_slowpoll)<>~crypt_ok: cl_hinweisbox "cryptlib crypt_random_slowpoll failed",1
ENDPROC

'{ 'SSL/TLS-Email-Kommunikation
PROC clSSLConnect 'returndata# muss mit 10000 gedimt werden
  parameters server$,username$,password$,returndata#,warn%,SSL_Version% 'warn% & SSL_Version% können auch weggelassen werden (warn% dann =0); bei =1 werden Fehlermeldungen ausgegeben; SSL_Version% dann -1=automatisch höchste Version aushandeln
  declare erg%,weiter%,session&,s$,pc%
  declare datain#,bytesCopied&
  pc%=%pcount
  if pc%=5
    SSL_Version%=-1
  elseif pc%=4
    SSL_Version%=-1
    warn%=0
  endif
  session&=0
  weiter%=1
  '{ 'Crypt-Session erzeugen
  if weiter%
    erg%=@call(_cl_faddr_cryptCreateSession%,@addr(session&),~CRYPT_UNUSED,~CRYPT_SESSION_SSL)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLConnect: Crypt-Session konnte nicht erzeugt werden:\n\n"+@clgeterrortext(erg%),1
    else
      erg%=@call(_cl_faddr_cryptSetAttribute%,session&,~CRYPT_ATTRIBUTE_BUFFERSIZE,220000)
      if erg%<>~CRYPT_OK
        weiter%=0
        case warn%: cl_hinweisbox "PROC clSSLConnect: Puffergröße könnte nicht gesetzt werden:\n\n"+@clgeterrortext(erg%),1
      endif
    endif
  endif
  '}
  '{ 'Timeouts einstellen
  if weiter%
    erg%=@call(_cl_faddr_cryptSetAttribute%,session&,~CRYPT_OPTION_NET_READTIMEOUT,5)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLConnect: Read-Timeout konnte nicht gesetzt werden:\n\n"+@clgeterrortext(erg%),1
    else
      erg%=@call(_cl_faddr_cryptSetAttribute%,session&,~CRYPT_OPTION_NET_WRITETIMEOUT,5)
      if erg%<>~CRYPT_OK
        weiter%=0
        case warn%: cl_hinweisbox "PROC clSSLConnect: Write-Timeout konnte nicht gesetzt werden:\n\n"+@clgeterrortext(erg%),1
      endif
    endif
  endif
  '}
  '{ 'Server-Name, User-Name, Passwort setzen
  if weiter%
    s$=server$ '"pop.ionos.com:995"
    's$="pop.ionos.com:587"
    erg%=@call(_cl_faddr_cryptSetAttributeString%,session&,~CRYPT_SESSINFO_SERVER_NAME,@addr(s$),@len(s$))
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLConnect: Server-Daten konnten nicht gesetzt werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  if weiter%
    s$=username$
    erg%=@call(_cl_faddr_cryptSetAttributeString%,session&,~CRYPT_SESSINFO_USERNAME,@addr(s$),@len(s$))
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLConnect: Username konnte nicht gesetzt werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  if weiter%
    s$=password$
    erg%=@call(_cl_faddr_cryptSetAttributeString%,session&,~CRYPT_SESSINFO_PASSWORD,@addr(s$),@len(s$))
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLConnect: Passwort konnte nicht gesetzt werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  '}
  '{ 'ggf. SSL-/TLS-Version hart vorgeben (normalerweise nicht nötig und empfohlen)
  if (weiter%=1) and (SSL_Version%<>-1)
    erg%=@call(_cl_faddr_cryptSetAttribute%,session&,~CRYPT_SESSINFO_VERSION,SSL_Version%) 'bestimmte SSL/TLS-Version erzwingen: 0=SSL, 1=TLS 1.0, 2=TLS 1.1, 3=TLS 1.2
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLConnect: erzwungene SSL-/TLS-Version konnte nicht eingestellt werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  '}
  '{ 'Crypt-Session aktivieren
  if weiter%
    erg%=@call(_cl_faddr_cryptSetAttribute%,session&,~CRYPT_SESSINFO_ACTIVE,1)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLConnect: Crypt-Session konnten nicht aktiviert werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  '}
  '{ 'Server-Antwort abholen
  if weiter%
    dim datain#,10000
    erg%=@call(_cl_faddr_cryptPopData%,session&,datain#,@sizeof(datain#)-1,@addr(bytesCopied&))
    if erg%=~CRYPT_OK
      ~RtlMoveMemory(returndata#,datain#,bytesCopied&)
      byte returndata#,bytesCopied&=0
    else
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLConnect: Server-Antwort konnte nicht gepoppt werden:\n\n"+@clgeterrortext(erg%),1
    endif
    dispose datain#
  endif
  '}
  return session&
ENDPROC 'clSSLConnect

PROC clSSLDisconnect 'returndata# muss mit 10000 gedimt werden
  parameters session&,returndata#,warn% 'warn kann auch weggelassen werden, dann 0=keine Warnungen
  declare pc%,erg%,vssl&,weiter%,dataout#,datain#,s$,bytesCopied&,command$
  pc%=%pcount
  if pc%=3
    warn%=0
  endif
  command$="QUIT"
  weiter%=1
  '{ 'Anfrage in die Session pushen
  s$=command$+@chr$(13)+@chr$(10)
  'dim dataout#,@len(s$)+1
  'string dataout#,0=s$
  dim dataout#,@len(s$)
  char dataout#,0=s$
  erg%=@call(_cl_faddr_cryptPushData%,session&,dataout#,@sizeof(dataout#),@addr(bytesCopied&))
  if erg%<>~CRYPT_OK
    weiter%=0
    case warn%: cl_hinweisbox "PROC clSSLDisconnect: Daten konnten nicht in die Session gepusht werden:\n\n"+@clgeterrortext(erg%),1
  endif
  dispose dataout#
  '}
  '{ 'Anfrage absenden (flushen)
  if weiter%
    erg%=@call(_cl_faddr_cryptFlushData%,session&)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLDisconnect: Daten konnten nicht zum Server geflusht werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  '}
  '{ 'Server-Antwort abholen
  if weiter%
    dim datain#,10000
    erg%=@call(_cl_faddr_cryptPopData%,session&,datain#,@sizeof(datain#)-1,@addr(bytesCopied&))
    if erg%=~CRYPT_OK
      ~RtlMoveMemory(returndata#,datain#,bytesCopied&)
      byte returndata#,bytesCopied&=0
    else
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLDisconnect: Server-Antwort konnte nicht gepoppt werden:\n\n"+@clgeterrortext(erg%),1
    endif
    dispose datain#
  endif
  '}
  return erg%
ENDPROC 'clSSLDisconnect

PROC clSSLImapDisconnect 'returndata# muss mit 10000 gedimt werden
  parameters session&,returndata#,warn% 'warn kann auch weggelassen werden, dann 0=keine Warnungen
  declare pc%,erg%,vssl&,weiter%,dataout#,datain#,s$,bytesCopied&,command$
  pc%=%pcount
  if pc%=3
    warn%=0
  endif
  command$="CLMtag776 logout"
  weiter%=1
  '{ 'Anfrage in die Session pushen
  s$=command$+@chr$(13)+@chr$(10)
  'dim dataout#,@len(s$)+1
  'string dataout#,0=s$
  dim dataout#,@len(s$)
  char dataout#,0=s$
  erg%=@call(_cl_faddr_cryptPushData%,session&,dataout#,@sizeof(dataout#),@addr(bytesCopied&))
  if erg%<>~CRYPT_OK
    weiter%=0
    case warn%: cl_hinweisbox "PROC clSSLImapDisconnect: Daten konnten nicht in die Session gepusht werden:\n\n"+@clgeterrortext(erg%),1
  endif
  dispose dataout#
  '}
  '{ 'Anfrage absenden (flushen)
  if weiter%
    erg%=@call(_cl_faddr_cryptFlushData%,session&)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLImapDisconnect: Daten konnten nicht zum Server geflusht werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  '}
  '{ 'Server-Antwort abholen
  if weiter%
    dim datain#,10000
    erg%=@call(_cl_faddr_cryptPopData%,session&,datain#,@sizeof(datain#)-1,@addr(bytesCopied&))
    if erg%=~CRYPT_OK
      ~RtlMoveMemory(returndata#,datain#,bytesCopied&)
      byte returndata#,bytesCopied&=0
    else
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLImapDisconnect: Server-Antwort konnte nicht gepoppt werden:\n\n"+@clgeterrortext(erg%),1
    endif
    dispose datain#
  endif
  '}
  return erg%
ENDPROC 'clSSLDisconnect

PROC clSSLDestroySession
  parameters session&,warn% 'warn kann auch weggelassen werden, dann 0=keine Warnungen
  declare pc%,weiter%,erg%
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  erg%=0
  weiter%=1
  '{ 'Crypt-Session beenden
  if 0 'weiter% 'SSL-Sessions können offenbar nicht deaktiviert werden
    erg%=@call(_cl_faddr_cryptSetAttribute%,session&,~CRYPT_SESSINFO_ACTIVE,0)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLDestroySession: Crypt-Session konnten nicht deaktiviert werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  if session&
    erg%=@call(_cl_faddr_cryptDestroySession%,session&)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLDestroySession: Crypt-Session konnten nicht beendet werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  '}
  return erg%
ENDPROC 'clSSLDestroySession

PROC clSSLGetSSLVersion
  parameters session&,warn% 'warn kann auch weggelassen werden, dann 0=keine Warnungen
  declare pc%,erg%,vssl&,weiter%
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  weiter%=1
  erg%=@call(_cl_faddr_cryptGetAttribute%,session&,~CRYPT_SESSINFO_VERSION,@addr(vssl&))
  if erg%<>~CRYPT_OK
    weiter%=0
    vssl&=-1
    case warn%: cl_hinweisbox "PROC clSSLGetSSLVersion: Versionsinfo konnte nicht gelesen werden:\n\n"+@clgeterrortext(erg%),1
  endif
  return vssl&
ENDPROC 'clSSLGetSSLVersion

PROC clSSLSendAnyCommandAndRetrieveAnswer 'returndata# muss mit 100000 gedimt werden
  parameters command$,session&,returndata#,warn% 'warn kann auch weggelassen werden, dann 0=keine Warnungen
  declare pc%,erg%,vssl&,weiter%,dataout#,datain#,s$,bytesCopied&,bigmem%,nochmal%,ofs%
  pc%=%pcount
  if pc%=3
    warn%=0
  endif
  bigmem%=0
  if @string$(returndata#,0)="BIGMEM"
    bigmem%=1
  endif
  weiter%=1
  '{ 'Anfrage in die Session pushen
  s$=command$+@chr$(13)+@chr$(10)
  'dim dataout#,@len(s$)+1
  'string dataout#,0=s$
  dim dataout#,@len(s$)
  char dataout#,0=s$
  erg%=@call(_cl_faddr_cryptPushData%,session&,dataout#,@sizeof(dataout#),@addr(bytesCopied&))
  if erg%<>~CRYPT_OK
    weiter%=0
    case warn%: cl_hinweisbox "PROC clSSLSendAnyCommandAndRetrieveAnswer: Daten konnten nicht in die Session gepusht werden:\n\n"+@clgeterrortext(erg%),1
  endif
  dispose dataout#
  '}
  '{ 'Anfrage absenden (flushen)
  if weiter%
    erg%=@call(_cl_faddr_cryptFlushData%,session&)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLSendAnyCommandAndRetrieveAnswer: Daten konnten nicht zum Server geflusht werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  '}
  '{ 'Server-Antwort abholen
  if weiter%
    if bigmem%=0
      dim datain#,100000
    else
      dim datain#,1024*1024*30
    endif
    ofs%=0
    nochmal%=1
    while nochmal%
      nochmal%=0
      erg%=@call(_cl_faddr_cryptPopData%,session&,datain#,@sizeof(datain#)-1,@addr(bytesCopied&))
      if erg%=~CRYPT_OK
        ~RtlMoveMemory(returndata#+ofs%,datain#,bytesCopied&)
        byte returndata#,bytesCopied&+ofs%=0
        if @char$(datain#,bytesCopied&-1,1)="."
          nochmal%=1
          ofs%=ofs%+bytesCopied&
        endif
      else
        weiter%=0
        case warn%: cl_hinweisbox "PROC clSSLSendAnyCommandAndRetrieveAnswer: Server-Antwort konnte nicht gepoppt werden:\n\n"+@clgeterrortext(erg%),1
      endif
    endwhile
    dispose datain#
  endif
  '}
  return erg%
ENDPROC 'clSSLSendAnyCommandAndRetrieveAnswer

PROC clSSLRetrieveAnotherAnswer 'returndata# muss mit 100000 gedimt werden
  parameters session&,returndata#,warn% 'warn kann auch weggelassen werden, dann 0=keine Warnungen
  declare pc%,erg%,vssl&,weiter%,dataout#,datain#,s$,bytesCopied&,bigmem%,ofs%,nochmal%
  pc%=%pcount
  if pc%=3
    warn%=0
  endif
  bigmem%=0
  if @string$(returndata#,0)="BIGMEM"
    bigmem%=1
  endif
  '{ 'Server-Antwort abholen
  if bigmem%=0
    dim datain#,100000
  else
    dim datain#,1024*1024*30
  endif
  ofs%=0
  nochmal%=1
  while nochmal%
    nochmal%=0
    erg%=@call(_cl_faddr_cryptPopData%,session&,datain#,@sizeof(datain#)-1,@addr(bytesCopied&))
    if erg%=~CRYPT_OK
      ~RtlMoveMemory(returndata#+ofs%,datain#,bytesCopied&)
      byte returndata#,bytesCopied&+ofs%=0
      if @char$(datain#,bytesCopied&-1,1)="."
        nochmal%=1
        ofs%=ofs%+bytesCopied&
      endif
    else
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLRetrieveAnotherAnswer: Server-Antwort konnte nicht gepoppt werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endwhile
  dispose datain#
  '}
  return erg%
ENDPROC 'clSSLRetrieveAnotherAnswer

PROC clSSLSendAnyCommandNoAnswer
  parameters command$,session&,warn% 'warn kann auch weggelassen werden, dann 0=keine Warnungen
  declare pc%,erg%,vssl&,weiter%,dataout#,datain#,s$,bytesCopied&
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  weiter%=1
  '{ 'Anfrage in die Session pushen
  s$=command$+@chr$(13)+@chr$(10)
  'dim dataout#,@len(s$)+1
  'string dataout#,0=s$
  dim dataout#,@len(s$)
  char dataout#,0=s$
  erg%=@call(_cl_faddr_cryptPushData%,session&,dataout#,@sizeof(dataout#),@addr(bytesCopied&))
  if erg%<>~CRYPT_OK
    weiter%=0
    case warn%: cl_hinweisbox "PROC clSSLSendAnyCommandNoAnswer: Daten konnten nicht in die Session gepusht werden:\n\n"+@clgeterrortext(erg%),1
  endif
  dispose dataout#
  '}
  '{ 'Anfrage absenden (flushen)
  if weiter%
    erg%=@call(_cl_faddr_cryptFlushData%,session&)
    if erg%<>~CRYPT_OK
      weiter%=0
      case warn%: cl_hinweisbox "PROC clSSLSendAnyCommandNoAnswer: Daten konnten nicht zum Server geflusht werden:\n\n"+@clgeterrortext(erg%),1
    endif
  endif
  '}
  return erg%
ENDPROC 'clSSLSendAnyCommandNoAnswer

PROC clSSLConvert2ASCII
  parameters ret$,art% 'art%=1: "_" in " " verwandeln, sonst nicht (kann weggelassen werden, dann =1)
  declare pc%,i%,s$
  pc%=%PCount
  if pc%=1
    art%=1
  endif
  if @upper$(@left$(ret$,8))="=?UTF-8?"
    ret$=@right$(ret$,@len(ret$)-8)
    if @upper$(@left$(ret$,2))="Q?" 'lesbar
      ret$=@right$(ret$,@len(ret$)-2) 'links "Q?" weg
      ret$=@left$(ret$,@len(ret$)-2) 'rechts "?=" weg
      s$=""
      for i%,1,len(ret$,"=?="+@chr$(13)+@chr$(10)+" =?utf-8?Q?")
        s$=s$+@UTF8Decode(@substr$(ret$,i%,"=?="+@chr$(13)+@chr$(10)+" =?utf-8?Q?"))
      endfor 'i
      ret$=s$
    else '"B"=BASE64
      ret$=@right$(ret$,@len(ret$)-2) 'links "Q?" weg
      ret$=@left$(ret$,@len(ret$)-2) 'rechts "?=" weg
      s$=""
      for i%,1,len(ret$,"=?="+@chr$(13)+@chr$(10)+" =?utf-8?B?")
        s$=s$+@UTF8Decode(@substr$(ret$,i%,"=?="+@chr$(13)+@chr$(10)+" =?utf-8?B?"))
      endfor 'i
      ret$=s$
    endif
    if art%=1
      ret$=@translate$(ret$,"_"," ")
    endif
  elseif @upper$(@left$(ret$,13))="=?ISO-8859-1?"
    ret$=@right$(ret$,@len(ret$)-13)
    if @upper$(@left$(ret$,2))="Q?" 'lesbar
      ret$=@right$(ret$,@len(ret$)-2) 'links "Q?" weg
      ret$=@left$(ret$,@len(ret$)-2) 'rechts "?=" weg
      ret$=translate$(ret$,"=?="+@chr$(13)+@chr$(10)+" =?iso-8859-1?Q?","")
    else '"B"=BASE64
      ret$=@right$(ret$,@len(ret$)-2) 'links "Q?" weg
      ret$=@left$(ret$,@len(ret$)-2) 'rechts "?=" weg
      s$=""
      for i%,1,len(ret$,"=?="+@chr$(13)+@chr$(10)+" =?iso-8859-1?B?")
        s$=s$+@UTF8Decode(@substr$(ret$,i%,"=?="+@chr$(13)+@chr$(10)+" =?iso-8859-1?B?"))
      endfor 'i
      ret$=s$
    endif
    if art%=1
      ret$=@translate$(ret$,"_"," ")
    endif
    'das ist nur sein Subset der Möglichkeiten in ISO-8859-1! siehe https://de.wikipedia.org/wiki/ISO_8859-1
    ret$=@translate$(ret$,"=C4","Ä")
    ret$=@translate$(ret$,"=D6","Ö")
    ret$=@translate$(ret$,"=DC","Ü")
    ret$=@translate$(ret$,"=E4","ä")
    ret$=@translate$(ret$,"=F6","ö")
    ret$=@translate$(ret$,"=FC","ü")
    ret$=@translate$(ret$,"=DF","ß")
    'ret$=@translate$(ret$,"=??","€") '€ gab es bei Erstellung der Norm wohl noch nicht
    ret$=@translate$(ret$,"=24","$")
    ret$=@translate$(ret$,"=A3","£")
    ret$=@translate$(ret$,"=A5","¥")
    ret$=@translate$(ret$,"=A7","§")
    ret$=@translate$(ret$,"=23","#")
    ret$=@translate$(ret$,"=25","%")
    ret$=@translate$(ret$,"=26","&")
    ret$=@translate$(ret$,"=21","!")
    ret$=@translate$(ret$,"=22",@chr$(34))
    ret$=@translate$(ret$,"=27","'")
    ret$=@translate$(ret$,"=28","(")
    ret$=@translate$(ret$,"=29",")")
    ret$=@translate$(ret$,"=3F","?")
    ret$=@translate$(ret$,"=5F","_")
  endif
  return ret$
ENDPROC 'clSSLConvert2ASCII

'{ 'POP3
PROC clSSLPOP3ServerAndMailboxLogin 'Rückgabewert: -1: Server-Login failed, -2: Mailbox-Login failed (Server-Session wird automatisch beendet), >0: Session-Handle
  'mögliche ErrCodes in dieser PROC zur erweiterten Analyse des Verbindungsfehlers neben dem Rückgabewert der PROC:
  '0=kein ErrCode
  '1=Server unterstützt USER/PASS-Login nicht
  '2=USER/PASS fehlgeschlagen
  parameters Server$,Port$,Email$,PW$,aErrCode&,warn% 'aErrCode& und warn% können auch weggelassen werden (keine ErroCode-Rückgabe, keine Warnungen)
  declare pc%,erg%,ret%,session&,b#,s$
  pc%=%pcount
  if pc%=5
    warn%=0
  elseif pc%=4
    warn%=0
    aErrCode&=0
  endif
  case aErrCode&<>0: long aErrCode&,0=0
  dim b#,10000
  session&=@clSSLConnect(Server$+":"+Port$,Email$,PW$,b#,warn%)
  if session&<=0
    case warn%: cl_hinweisbox "clSSLPOP3ServerMailboxLogin: POP3-Server-Session konnte nicht aufgebaut werden",1
    dispose b#
    ret%=-1
  else
    s$=@string$(b#,0)
    dispose b#
    if @upper$(@left$(s$,3))<>"+OK"
      case warn%: cl_hinweisbox "clSSLPOP3ServerMailboxLogin: POP3-Server-Session konnte nicht aufgebaut werden:\n\n"+s$,1
      @clSSLDestroySession(session&,warn%)
      ret%=-1
    else
      dim b#,100000
      @clSSLSendAnyCommandAndRetrieveAnswer("CAPA",session&,b#,warn%)
      s$=@string$(b#,0)
      dispose b#
      if @instr(@chr$(13)+@chr$(10)+"USER"+@chr$(13)+@chr$(10),@upper$(s$))=0
        case warn%: cl_hinweisbox "clSSLPOP3ServerMailboxLogin: POP3-Server unterstützt kein USER/PASS-Login. CAPAs:\n\n"+s$,1
        case aErrCode&<>0: long aErrCode&,0=1
        ret%=-2
      else
        dim b#,100000
        @clSSLSendAnyCommandAndRetrieveAnswer("AUTH PLAIN "+@Encode64(@UTF8Encode(Email$)+@chr$(0)+@UTF8Encode(Email$)+@chr$(0)+@UTF8Encode(PW$)),session&,b#,warn%)
        s$=@string$(b#,0)
        dispose b#
        if @upper$(@left$(s$,3))<>"+OK"
          case warn%: cl_hinweisbox "clSSLPOP3ServerMailboxLogin: POP3-Postfach-Login fehlgeschlagen:\n\n"+s$,1
          case aErrCode&<>0: long aErrCode&,0=2
          dim b#,10000
          @clSSLDisconnect(session&,b#,warn%)
          dispose b#
          @clSSLDestroySession(session&,warn%)
          ret%=-2
        else
          ret%=session&
        endif
      endif
    endif
  endif
  return ret%
ENDPROC 'clSSLPOP3ServerMailboxLogin

PROC clSSLPOP3LogoutAndDisconnect 'Rückgabewert: 1: ok, 2: Mailbox-Logout failed, 4: Server-Disconnect failed (bitweise)
  parameters session&,warn%
  declare pc%,ret%,b#,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret%=1
  dim b#,10000
  @clSSLDisconnect(session&,b#,warn%)
  s$=@string$(b#,0)
  dispose b#
  if @upper$(@left$(s$,3))<>"+OK"
    case warn%: cl_hinweisbox "clSSLPOP3LogoutAndDisconnect: POP3-Postfach-Logout fehlgeschlagen:\n\n"+s$,1
    ret%=2
  endif
  if @clSSLDestroySession(session&,warn%)<>~crypt_ok
    case warn%: cl_hinweisbox "clSSLPOP3LogoutAndDisconnect: POP3-Server-Disconnect fehlgeschlagen.",1
    ret%=(ret% | 4)
  endif
  return ret%
ENDPROC 'clSSLPOP3LogoutAndDisconnect

PROC clSSLGetMailCount 'Rückgabewert: -1: Fehler, >=0: Anzahl Emails auf dem Server
  parameters session&,warn%
  declare pc%,erg%,b#,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  dim b#,100000
  erg%=-1
  erg%=@clSSLSendAnyCommandAndRetrieveAnswer("STAT",session&,b#,1)
  if erg%<>~CRYPT_OK
    if erg%<>-1
      case warn%: cl_hinweisbox "clSSLGetMailCount: Server-Abruffehler:\n\n"+@clgeterrortext(erg%),1
      erg%=-1
    else
      case warn%: cl_hinweisbox "clSSLGetMailCount: Server-Abruffehler",1
    endif
  else
    s$=@string$(b#,0)
    if @upper$(@left$(s$,3))<>"+OK"
      case warn%: cl_hinweisbox "clSSLGetMailCount: Server-Abruffehler:\n\n"+s$,1
      erg%=-1
    else
      erg%=@val(@substr$(s$,2," "))
    endif
  endif
  dispose b#
  return erg%
ENDPROC 'clSSLGetMailCount

PROC clSSLGetMailRawHeader 'Rückgabewert (String!): "-1": Fehler, sonst: Header$
  parameters session&,mailnum&,warn%
  declare pc%,erg%,ret$,b#,datain#,bytesCopied&
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  dim b#,100000
  erg%=@clSSLSendAnyCommandAndRetrieveAnswer("TOP "+@str$(mailnum&)+" 0",session&,b#,warn%)
  if erg%<>~CRYPT_OK
    case warn%: cl_hinweisbox "clSSLGetMailRawHeader: Email-Header konnte nicht abgerufen werden:\n\n"+@clgeterrortext(erg%),1
    ret$="-1"
  else
    ret$=@string$(b#,0)
    if @upper$(@trim$(ret$))="+OK" 'es muss zweimal gepoppt werden (da müsste mehr drinstehen)
      dispose b#
      dim b#,1024*1024*30
      dim datain#,1024*1024*30
      erg%=@call(_cl_faddr_cryptPopData%,session&,datain#,@sizeof(datain#),@addr(bytesCopied&))
      if erg%<>~CRYPT_OK
        case warn%: cl_hinweisbox "clSSLGetMailRawHeader: Email-Header konnte nicht abgerufen werden (beim 2. Pop):\n\n"+@clgeterrortext(erg%),1
        ret$="-1"
      else
        ~RtlMoveMemory(b#,datain#,bytesCopied&)
        byte b#,bytesCopied&=0
        ret$=@string$(b#,0)
      endif
    endif
  endif
  dispose b#
  return ret$
ENDPROC 'clSSLGetMailRawHeader

PROC clSSLGetRawMail 'Rückgabewert (String!): "-1": Fehler, sonst: Header$
  parameters session&,mailnum&,warn%
  declare pc%,erg%,ret$,b#,datain#,bytesCopied&,ofs%,nochmal%
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  dim b#,1024*1024*30
  string b#,0="BIGMEM" 'damit ein genügend großer Speicherbereich in clSSLSendAnyCommandAndRetrieveAnswer angefordert wird
  erg%=@clSSLSendAnyCommandAndRetrieveAnswer("RETR "+@str$(mailnum&),session&,b#,warn%)
  if erg%<>~CRYPT_OK
    case warn%: cl_hinweisbox "clSSLGetRawMail: Email konnte nicht abgerufen werden:\n\n"+@clgeterrortext(erg%),1
    ret$="-1"
  else
    if @upper$(@trim$(ret$))="+OK" 'es muss zweimal gepoppt werden (da müsste mehr drinstehen)
      dim datain#,1024*1024*30
      ofs%=0
      nochmal%=1
      while nochmal%
        nochmal%=0
        erg%=@call(_cl_faddr_cryptPopData%,session&,b#,@sizeof(datain#)-1,@addr(bytesCopied&))
        if erg%<>~CRYPT_OK
          case warn%: cl_hinweisbox "clSSLGetRawMail: Email-Header konnte nicht abgerufen werden (beim 2. Pop):\n\n"+@clgeterrortext(erg%),1
          ret$="-1"
        else
          ~RtlMoveMemory(b#+ofs%,datain#,bytesCopied&)
          byte b#,bytesCopied&+ofs%=0
          if @char$(datain#,bytesCopied&-1,1)="."
            nochmal%=1
            ofs%=ofs%+bytesCopied&
          endif
        endif
      endwhile
      dispose datain#
    endif
    if @upper$(@char$(b#,0,3))="+OK"
      ret$=@left$(@string$(b#,5),@len(@string$(b#,5))-3)
    else
      ret$=@left$(@string$(b#,0),@len(@string$(b#,0))-3)
    endif
  endif
  dispose b#
  return ret$
ENDPROC 'clSSLGetRawMail

PROC clSSLGetSenderFromRaw 'Rückgabewert (String!): "-1"=Sender not found, sonst: Sender$
  parameters rawheader$,warn%
  declare pc%,ret$,i%,s$,pos%
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret$="-1"
  for i%,1,@len(rawheader$,@chr$(13)+@chr$(10))
    s$=@trim$(@substr$(rawheader$,i%,@chr$(13)+@chr$(10)))
    if @upper$(@left$(s$,5))="FROM:"
      ret$=@trim$(right$(s$,@len(s$)-5))
      if @right$(ret$,1)=">"
        s$=""
        for pos%,@len(ret$)-1,1,-1
          if @mid$(ret$,pos%,1)<>"<"
            s$=@mid$(ret$,pos%,1)+s$
          else
            ret$=s$
            break
          endif
        endfor 'pos%
      endif
      break
    endif
  endfor 'i%
  if ret$="-1"
    case warn%: cl_hinweisbox "clSSLGetSenderFromRawHeader: Sender konnte nicht in Raw gefunden werden.",1
  endif
  return ret$
ENDPROC 'clSSLGetSenderFromRaw

PROC clSSLGetRecipientFromRaw 'Rückgabewert (String!): "-1"=Recipient not found, sonst: Recipient$
  parameters rawheader$,warn%
  declare pc%,ret$,i%,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret$="-1"
  for i%,1,@len(rawheader$,@chr$(13)+@chr$(10))
    s$=@trim$(@substr$(rawheader$,i%,@chr$(13)+@chr$(10)))
    if @upper$(@left$(s$,3))="TO:" 'SUBJECT
      ret$=@trim$(right$(s$,@len(s$)-3))
      break
    endif
  endfor 'i%
  if ret$="-1"
    case warn%: cl_hinweisbox "clSSLGetRecipientromRawHeader: Recipient konnte nicht in Raw gefunden werden.",1
  endif
  return ret$
ENDPROC 'clSSLGetRecipientFromRaw

PROC clSSLGetCCFromRaw 'Rückgabewert (String!): "-1"=CC not found, sonst: CC$
  parameters rawheader$,warn%
  declare pc%,ret$,i%,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret$="-1"
  for i%,1,@len(rawheader$,@chr$(13)+@chr$(10))
    s$=@trim$(@substr$(rawheader$,i%,@chr$(13)+@chr$(10)))
    if @upper$(@left$(s$,3))="CC:"
      ret$=@trim$(right$(s$,@len(s$)-3))
      break
    endif
  endfor 'i%
  if ret$="-1"
    case warn%: cl_hinweisbox "clSSLGetCCromRawHeader: CC konnte nicht in Raw gefunden werden.",1
  endif
  return ret$
ENDPROC 'clSSLGetCCFromRaw

PROC clSSLGetBCCFromRaw 'Rückgabewert (String!): "-1"=BCC not found, sonst: BCC$
  parameters rawheader$,warn%
  declare pc%,ret$,i%,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret$="-1"
  for i%,1,@len(rawheader$,@chr$(13)+@chr$(10))
    s$=@trim$(@substr$(rawheader$,i%,@chr$(13)+@chr$(10)))
    if @upper$(@left$(s$,4))="BCC:"
      ret$=@trim$(right$(s$,@len(s$)-3))
      break
    endif
  endfor 'i%
  if ret$="-1"
    case warn%: cl_hinweisbox "clSSLGetBCCromRawHeader: BCC konnte nicht in Raw gefunden werden.",1
  endif
  return ret$
ENDPROC 'clSSLGetBCCFromRaw

PROC clSSLGetSubjectFromRaw 'Rückgabewert (String!): "-1"=Subject not found, sonst: Subject$
  parameters rawheader$,warn%
  declare pc%,ret$,i%,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret$="-1"
  for i%,1,@len(rawheader$,@chr$(13)+@chr$(10))
    s$=@trim$(@substr$(rawheader$,i%,@chr$(13)+@chr$(10)))
    if @upper$(@left$(s$,8))="SUBJECT:"
      ret$=@trim$(right$(s$,@len(s$)-8))
      '"=?utf-8?Q?250.000_=E2=82=AC_+_5.000_=E2=82=AC_Sofortrente_Gewinnen!?="
      'nicht-ASCII-Zeichen im Subject: siehe https://ncona.com/2011/06/using-utf-8-characters-on-an-e-mail-subject/
      ret$=clSSLConvert2ASCII(ret$)
      break
    endif
  endfor 'i%
  if ret$="-1"
    case warn%: cl_hinweisbox "clSSLGetSubjectFromRawHeader: Subject konnte nicht in Raw gefunden werden.",1
  endif
  return ret$
ENDPROC 'clSSLGetSubjectFromRaw

PROC clSSLGetDateTimeFromRaw 'Rückgabewert (String!): "-1"=DateTime not found, sonst: DateTime$; Format: "Wed, 19 Jul 2023 22:40:31 +0200"
  parameters rawheader$,warn%
  declare pc%,ret$,i%,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret$="-1"
  for i%,1,@len(rawheader$,@chr$(13)+@chr$(10))
    s$=@trim$(@substr$(rawheader$,i%,@chr$(13)+@chr$(10)))
    if @upper$(@left$(s$,5))="DATE:"
      ret$=@trim$(right$(s$,@len(s$)-5))
      break
    endif
  endfor 'i%
  if ret$="-1"
    case warn%: cl_hinweisbox "clSSLGetDateTimeFromRawHeader: DateTime konnte nicht in Raw gefunden werden.",1
  endif
  return ret$
ENDPROC 'clSSLGetDateTimeFromRaw

PROC clSSLGetBoundaryFromRaw 'Rückgabewert (String!): "-1"=Boundary not found, sonst: Boundary
  parameters rawheader$,warn%
  declare pc%,ret$,a%,i%,o%,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret$="-1"
  for i%,1,@len(rawheader$,@chr$(13)+@chr$(10))
    s$=@trim$(@substr$(rawheader$,i%,@chr$(13)+@chr$(10)))
    if @instr("BOUNDARY=",@upper$(s$))
      ret$=""
      a%=@instr("BOUNDARY=",@upper$(s$))+10
      for o%,a%,@len(s$)
        if @mid$(s$,o%,1)<>@chr$(34)
          ret$=ret$+@mid$(s$,o%,1)
        else
          break
        endif
      endfor 'o%
      ret$="--"+ret$
      break
    endif
  endfor 'i%
  if ret$="-1"
    case warn%: cl_hinweisbox "clSSLGetBoundaryFromRawHeader: Boundary konnte nicht in Raw gefunden werden.",1
  endif
  return ret$
ENDPROC 'clSSLGetBoundaryFromRaw

PROC clSSLDeleteMail 'Rückgabewert: 1=ok, -1=Fehler
  parameters session&,mailnum&,warn%
  declare pc%,erg%,ret%,b#,datain#,bytesCopied&
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  dim b#,100000
  'string b#,0="BIGMEM" 'damit ein genügend großer Speicherbereich in clSSLSendAnyCommandAndRetrieveAnswer angefordert wird
  erg%=@clSSLSendAnyCommandAndRetrieveAnswer("DELE "+@str$(mailnum&),session&,b#,warn%)
  if erg%<>~CRYPT_OK
    case warn%: cl_hinweisbox "clSSLDeleteMail: Email konnte nicht gelöscht werden:\n\n"+@clgeterrortext(erg%),1
    ret%=-1
  else
    if @upper$(@left$(@string$(b#,0),3))<>"+OK"
      case warn%: cl_hinweisbox "clSSLDeleteMail: Email konnte nicht gelöscht werden.",1
      ret%=-1
    else
      ret%=1
    endif
  endif
  dispose b#
  return ret%
ENDPROC 'clSSLDeleteMail
'}

'{ 'SMTP
PROC clSSLSMTPServerAndMailboxLogin 'Rückgabewert: -1: Server-Login failed, -2: Mailbox-Login failed (Server-Session wird automatisch beendet), >0: Session-Handle
  'mögliche ErrCodes in dieser PROC zur erweiterten Analyse des Verbindungsfehlers neben dem Rückgabewert der PROC:
  '0=kein ErrCode
  '1=EHLO fehlgeschlagen
  '2=Server unterstützt AUTH PLAIN-Login nicht
  '3=AUTH PLAIN fehlgeschlagen
  parameters Server$,Port$,Email$,PW$,aErrCode&,warn% 'aErrCode& und warn% können auch weggelassen werden (keine ErroCode-Rückgabe, keine Warnungen)
  declare pc%,erg%,ret%,session&,b#,s$
  pc%=%pcount
  if pc%=5
    warn%=0
  elseif pc%=4
    warn%=0
    aErrCode&=0
  endif
  _cl_OwnEMailAddress$=Email$
  case aErrCode&<>0: long aErrCode&,0=0
  dim b#,10000
  session&=@clSSLConnect(Server$+":"+Port$,Email$,PW$,b#,warn%)
  if session&<=0
    case warn%: cl_hinweisbox "clSSLSMTPServerMailboxLogin: SMTP-Server-Session konnte nicht aufgebaut werden",1
    dispose b#
    ret%=-1
  else
    s$=@string$(b#,0)
    dispose b#
    if @left$(s$,3)<>"220"
      case warn%: cl_hinweisbox "clSSLSMTPServerMailboxLogin: SMTP-Server-Session konnte nicht aufgebaut werden (part 2):\n\n"+s$,1
      @clSSLDestroySession(session&,warn%)
      ret%=-1
    else
      dim b#,100000
      @clSSLSendAnyCommandAndRetrieveAnswer("EHLO "+@substr$(Email$,2,"@"),session&,b#,warn%)
      s$=@string$(b#,0)
      dispose b#
      if @left$(s$,3)<>"250"
        case warn%: cl_hinweisbox "clSSLSMTPServerMailboxLogin: EHLO-Kommando fehlgeschlagen:\n\n"+s$,1
        case aErrCode&<>0: long aErrCode&,0=1
        @clSSLDestroySession(session&,warn%)
        ret%=-2
      else
        if (@instr("AUTH",@upper$(s$))=0) or (@instr("PLAIN",@upper$(s$))=0)
          case warn%: cl_hinweisbox "clSSLSMTPServerMailboxLogin: SMTP-Server unterstützt kein AUTH PLAIN-Login:\n\n"+s$,1
          case aErrCode&<>0: long aErrCode&,0=2
          dim b#,10000
          @clSSLDisconnect(session&,b#,warn%)
          dispose b#
          @clSSLDestroySession(session&,warn%)
          ret%=-2
        else
          dim b#,100000
          @clSSLSendAnyCommandAndRetrieveAnswer("AUTH PLAIN "+@Encode64(@UTF8Encode(Email$)+@chr$(0)+@UTF8Encode(Email$)+@chr$(0)+@UTF8Encode(PW$)),session&,b#,warn%)
          s$=@string$(b#,0)
          dispose b#
          if @left$(s$,3)<>"235"
            case warn%: cl_hinweisbox "clSSLSMTPServerMailboxLogin: SMTP-Postfach-Login fehlgeschlagen:\n\n"+s$,1
            case aErrCode&<>0: long aErrCode&,0=3
            dim b#,10000
            @clSSLDisconnect(session&,b#,warn%)
            dispose b#
            @clSSLDestroySession(session&,warn%)
            ret%=-2
          else
            ret%=session&
          endif
        endif
      endif
    endif
  endif
  return ret%
ENDPROC 'clSSLSMTPServerAndMailboxLogin

PROC clSSLSMTPPrepareUtf8Subject 'wird zumindest von IONOS im Webmailer nicht korrekt angezeigt (von Pegasus Mail schon) - vermutlich ein temporärer Fehler bei IONOS [24.07.2023]
  parameters in$
  declare out$
  out$="=?utf-8?Q?"+@UTF8Encode(in$)+"?="
  return out$
ENDPROC 'clSSLSMTPPrepareUtf8Subject

PROC clSSLSMTPPrepareISO_8859_1_Subject 'das bekommt auch IONOS korrekt hin
  parameters in$
  declare out$
  out$="=?iso-8859-1?B?"+@Encode64(in$)+"?="
  return out$
ENDPROC 'clSSLSMTPPrepareUtf8Subject

PROC clSSLSMTSendRawMail 'Rückgabewert: 1: ok, -1=MAIL FROM fehlgeschlagen, -2=RCPT TO fehlgeschlagen, -3=DATA-Anfrage fehlgeschlagen, -4=Transfer-Phase fehlgeschlagen
  parameters session&,recipients$,rawmail$,warn%
  declare pc%,ret%,a%,b%,i%,b#,s$,erg%,pos%,posalt%
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  ret%=1
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("MAIL FROM: "+_cl_OwnEMailAddress$,session&,b#,warn%)
  s$=@string$(b#,0)
  if @left$(s$,3)<>"250"
    case warn%: cl_hinweisbox "clSSLSMTSendRawMail: MAIL FROM fehlgeschlagen:\n\n"+s$,1
    ret%=-1
  else
    for i%,1,@len(recipients$,",")
      @clSSLSendAnyCommandAndRetrieveAnswer("RCPT TO: "+@trim$(@substr$(recipients$,i%,",")),session&,b#,warn%)
      s$=@string$(b#,0)
      if @left$(s$,3)<>"250"
        case warn%: cl_hinweisbox "clSSLSMTSendRawMail: \qRCPT TO: "+@trim$(@substr$(recipients$,i%,","))+"\q fehlgeschlagen:\n\n"+s$,1
        ret%=-2
        break
      endif
    endfor 'i%
    if ret%=1
      @clSSLSendAnyCommandAndRetrieveAnswer("DATA",session&,b#,warn%)
      s$=@string$(b#,0)
      if @left$(s$,3)<>"354"
        case warn%: cl_hinweisbox "clSSLSMTSendRawMail: DATA-Anfrage fehlgeschlagen:\n\n"+s$,1
        ret%=-3
      else
        erg%=@clSSLSendAnyCommandNoAnswer(rawmail$,session&,warn%) 'ganze Email in einem Rutsch senden
        @clSSLSendAnyCommandAndRetrieveAnswer(@chr$(13)+@chr$(10)+".",session&,b#,warn%) 'auch hier ist kein schließendes CRLF nötig, im Gegenteil, das würde als neuer Befehl interpretiert, der ein "500 unrecognized command" zur Folge hätte
        s$=@string$(b#,0)
        if @left$(s$,3)<>"250"
          case warn%: cl_hinweisbox "clSSLSMTSendRawMail: Terminierung der Datenübertragung (\q.\q) fehlgeschlagen:\n\n"+s$,1
          ret%=-4
        endif
      endif
    endif
  endif
  dispose b#
  return ret%
ENDPROC 'clSSLSMTSendRawMail

PROC clSSLSMTPLogoutAndDisconnect 'Rückgabewert: 1: ok, 2: Mailbox-Logout failed, 4: Server-Disconnect failed (bitweise)
  parameters session&,warn%
  declare pc%,ret%,b#,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret%=1
  dim b#,10000
  @clSSLDisconnect(session&,b#,warn%)
  s$=@string$(b#,0)
  dispose b#
  if @left$(s$,3)<>"221"
    case warn%: cl_hinweisbox "clSSLSMTPLogoutAndDisconnect: SMTP-Postfach-Logout fehlgeschlagen:\n\n"+s$,1
    ret%=2
  endif
  if @clSSLDestroySession(session&,warn%)<>~crypt_ok
    case warn%: cl_hinweisbox "clSSLSMTPLogoutAndDisconnect: SMTP-Server-Disconnect fehlgeschlagen.",1
    ret%=(ret% | 4)
  endif
  return ret%
ENDPROC 'clSSLSMTPLogoutAndDisconnect
'}

'{ 'IMAP
PROC clSSLIMAPServerAndMailboxLogin 'Rückgabewert: -1: Server-Login failed, -2: Mailbox-Login failed (Server-Session wird automatisch beendet), >0: Session-Handle
  'mögliche ErrCodes in dieser PROC zur erweiterten Analyse des Verbindungsfehlers neben dem Rückgabewert der PROC:
  '0=kein ErrCode
  '1=Server unterstützt AUTH/PLAIN-Login nicht
  '2="authenticate plain"-Kommando fehlgeschlagen
  '3=AUTH/PLAIN-Benutzerdaten fehlgeschlagen (falsche credentials)
  parameters Server$,Port$,Email$,PW$,aErrCode&,warn% 'aErrCode& und warn% können auch weggelassen werden (keine ErroCode-Rückgabe, keine Warnungen)
  declare pc%,erg%,ret%,session&,b#,s$
  pc%=%pcount
  if pc%=5
    warn%=0
  elseif pc%=4
    warn%=0
    aErrCode&=0
  endif
  case aErrCode&<>0: long aErrCode&,0=0
  dim b#,10000
  session&=@clSSLConnect(Server$+":"+Port$,Email$,PW$,b#,warn%)
  if session&<=0
    case warn%: cl_hinweisbox "clSSLIMAPServerMailboxLogin: IMAP-Server-Session konnte nicht aufgebaut werden",1
    dispose b#
    ret%=-1
  else
    s$=@string$(b#,0)
    dispose b#
    if @upper$(@left$(s$,4))<>"* OK"
      case warn%: cl_hinweisbox "clSSLIMAPServerMailboxLogin: IMAP-Server-Session konnte nicht aufgebaut werden:\n\n"+s$,1
      @clSSLDestroySession(session&,warn%)
      ret%=-1
    else
      _ImapCapa1$=s$
      if @instr("AUTH=PLAIN",@upper$(_ImapCapa1$))=0
        case warn%: cl_hinweisbox "clSSLIMAPServerMailboxLogin: IMAP-Server unterstützt kein AUTH/PLAIN-Login. CAPAs:\n\n"+@right$(_ImapCapa1$,@len(_ImapCapa1$)-5),1
        case aErrCode&<>0: long aErrCode&,0=1
        ret%=-2
      else
        dim b#,100000
        @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 authenticate plain",session&,b#,warn%) 'einfach nur "CLM login "+Email$+" "+PW$ ginge auch (USER/PASS), dann bräuchte man das nächste Kommando nicht
        s$=@string$(b#,0)
'hinweisbox "authenticate plain request: |"+s$+"|",1
        if @left$(s$,2)<>"+ "
          case warn%: cl_hinweisbox "clSSLIMAPServerMailboxLogin: IMAP-Server-Login fehlgeschlagen:\n\n"+s$,1
          case aErrCode&<>0: long aErrCode&,0=2
          ret%=-2
        else
          @clSSLSendAnyCommandAndRetrieveAnswer(@Encode64(Email$+@chr$(0)+Email$+@chr$(0)+PW$),session&,b#,warn%)
          s$=@string$(b#,0)
'hinweisbox "authentication result: |"+s$+"|",1
          if @left$(s$,12)<>"CLMtag776 OK"
            case warn%: cl_hinweisbox "clSSLIMAPServerMailboxLogin: IMAP-Server-Login fehlgeschlagen:\n\n"+s$,1
            case aErrCode&<>0: long aErrCode&,0=3
            @clSSLDestroySession(session&,warn%)
            ret%=-2
          else
            @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 capability",session&,b#,warn%)
            _ImapCapa2$=@right$(@string$(b#,0),@len(@string$(b#,0))-5)
'hinweisbox "CAPA 2: |"+@string$(b#,0)+"|",1
            ret%=session&
          endif
        endif
        dispose b#
      endif
    endif
  endif
  return ret%
ENDPROC 'clSSLIMAPServerAndMailboxLogin

PROC clSSLIMAPLogoutAndDisconnect 'Rückgabewert: 1: ok, 2: Mailbox-Logout failed, 4: Server-Disconnect failed (bitweise)
  parameters session&,warn%
  declare pc%,ret%,b#,s$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  ret%=1
  dim b#,10000
  @clSSLImapDisconnect(session&,b#,warn%)
  s$=@string$(b#,0)
  dispose b#
  if @upper$(@left$(s$,5))<>"* BYE"
    case warn%: cl_hinweisbox "clSSLIMAPLogoutAndDisconnect: IMAP-Postfach-Logout fehlgeschlagen:\n\n"+s$,1
    ret%=2
  endif
  if @clSSLDestroySession(session&,warn%)<>~crypt_ok
    case warn%: cl_hinweisbox "clSSLIMAPLogoutAndDisconnect: IMAP-Server-Disconnect fehlgeschlagen.",1
    ret%=(ret% | 4)
  endif
  return ret%
ENDPROC 'clSSLIMAPLogoutAndDisconnect

PROC clSSLIMAPListFolders 'Rückgabewert: 1=ok, 0=Fehler; "Folder1?ParentFolders?Flag1°Flag2°...*Folder2?ParentFolders?Flag1°Flag2°...*..." (""=keine Ordner vorhanden), "-1"=Fehler; untersucht *nicht* den aktuell mit SELECT ausgewählten Folder, sondern immer jenen, der in path$ angegeben ist (path$="": Root-Folder)
  '{ 'Hinweise
  /*
  ParentFolders:
  "/"=Root-Ebene

  Tags:
  \HasNoChildren
    does not contain subfolders
  \HasChildren
    does contain subfolders
  \Drafts
    contains draft messages
  \Junk
    contains messages considered as junk/spam by the server
  \Noinferiors
    It is not possible for any child levels of hierarchy to exist under this name; no child levels exist now and none can be created in the future.
  \Noselect
    It is not possible to use this name as a selectable mailbox.
  \Marked
    The mailbox has been marked "interesting" by the server; the mailbox probably contains messages that have been added since the last time the mailbox was selected.
  \Unmarked
    The mailbox does not contain any additional messages since the last time the mailbox was selected.
  \Sent
    sent emails go here
  */
  '}
  parameters session&,path$,warn%
  declare ret%,b#,s$,s2$,s3$,a%,o%,pos%,i%,erg$,pc%,flags$,name$,servername$,parentfolders$,serverparentfolders$,ld$,instring%
  pc%=%pcount
  if pc%=2
    warn%=0
  elseif pc%=1
    path$=""
    warn%=0
  endif
  if path$<>""
    case @right$(path$,1)<>"/": path$=path$+"/"
  endif
  '{ 'Umlaute kodieren
  path$=@translate$(path$,"Ä","&AMQ-")
  path$=@translate$(path$,"Ö","&ARN-")
  path$=@translate$(path$,"Ü","&ANw-")
  path$=@translate$(path$,"ä","&AOQ-")
  path$=@translate$(path$,"ö","&APY-")
  path$=@translate$(path$,"ü","&APw-")
  path$=@translate$(path$,"ß","&AN8-")
  '}
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 list \q"+path$+"\q \q*\q",session&,b#,warn%) '"*": list subfolders recursively, "%" list subfolders non-recursively
  erg$=@string$(b#,0)
'hinweisbox erg$,1
  if @instr("CLMTAG776 BAD",@upper$(erg$))<>0
    case warn%: cl_hinweisbox "clSSLIMAPListFolders: Folder-Liste konnte nicht abgerufen werden: "+erg$
    ret%=0
  else
    while @instr("CLMTAG776 OK",@upper$(erg$))=0
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      erg$=erg$+@string$(b#,0)
    endwhile
    '{ 'Folder extrahieren und in _ImapGBfolders% schreiben
    ret%=1
    if _ImapGBfolders%=0
      _ImapGBfolders%=@create("GRIDBOX",%HWnd,"Name;0;200;ParentFolders;0;200;Flags;0;100;ServerName;0;200;ServerParentFolders;0;200",1,0,0,0,0)
      @sendmessage(_ImapGBfolders%,11,0,0) '11=WM_SETREDRAW
    endif
    clearlist _ImapGBfolders%
    a%=@len(erg$,_CRLF$)
    for i%,1,a%
      flags$=""
      name$=""
      servername$=""
      parentfolders$=""
      serverparentfolders$=""
      s$=@trim$(@substr$(erg$,i%,_CRLF$))
      if @upper$(@left$(s$,6))="* LIST"
        servername$=""
        instring%=0
        for o%,@len(s$),1,-1
          if (instring%=0) and (@mid$(s$,o%,1)=" ")
            break
          elseif (@mid$(s$,o%,1)=@chr$(34))
            inc instring%
            if instring%=2
              break
            endif
          else
            servername$=@mid$(s$,o%,1)+servername$
          endif
        endfor 'o%
        serverparentfolders$=@substr$(@substr$(s$,2,")"),2,@chr$(34)) 'parent folders
        '{ 'Umlaute dekodieren
        name$=servername$
        name$=@translate$(name$,"&AMQ-","Ä")
        name$=@translate$(name$,"&ARN-","Ö")
        name$=@translate$(name$,"&ANw-","Ü")
        name$=@translate$(name$,"&AOQ-","ä")
        name$=@translate$(name$,"&APY-","ö")
        name$=@translate$(name$,"&APw-","ü")
        name$=@translate$(name$,"&AN8-","ß")
        parentfolders$=serverparentfolders$
        parentfolders$=@translate$(parentfolders$,"&AMQ-","Ä")
        parentfolders$=@translate$(parentfolders$,"&ARN-","Ö")
        parentfolders$=@translate$(parentfolders$,"&ANw-","Ü")
        parentfolders$=@translate$(parentfolders$,"&AOQ-","ä")
        parentfolders$=@translate$(parentfolders$,"&APY-","ö")
        parentfolders$=@translate$(parentfolders$,"&APw-","ü")
        parentfolders$=@translate$(parentfolders$,"&AN8-","ß")
        '}
        s2$=@upper$(@translate$(@translate$(@substr$(@substr$(s$,2,"("),1,")"),"\\","")," ","°")) 'original flags (ucase)
'hinweisbox name$+"\n"+s2$
        '{ 'Flags schreiben
        if @instr("HASCHILDREN",s2$)<>0
          flags$=flags$+"C"
        else
          flags$=flags$+"-"
        endif
        if @instr("NOINFERIORS",s2$)<>0
          flags$=flags$+"I"
        else
          flags$=flags$+"-"
        endif
        if @instr("NOSELECT",s2$)<>0
          flags$=flags$+"N"
        else
          flags$=flags$+"-"
        endif
        if (@instr("MARKED",s2$)<>0) and (@instr("UNMARKED",s2$)=0)
          flags$=flags$+"M"
        else
          flags$=flags$+"-"
        endif
        if @instr("SENT",s2$)<>0
          flags$=flags$+"S"
        else
          flags$=flags$+"-"
        endif
        if @instr("DRAFTS",s2$)<>0
          flags$=flags$+"D"
        else
          flags$=flags$+"-"
        endif
        if @instr("JUNK",s2$)<>0
          flags$=flags$+"J"
        else
          flags$=flags$+"-"
        endif
        '}
        ld$=@Get("ListDel")
        @addstring(_ImapGBfolders%,name$+ld$+parentfolders$+ld$+flags$+ld$+servername$+ld$+serverparentfolders$)
      endif
    endfor 'i%
    '}
  endif
  'ret$=erg$
  dispose b#
  return ret%
ENDPROC 'clSSLIMAPListFolders

PROC clSSLIMAPSelectFolder 'Rückgabewert: 1=ok, 0=Fehler; setzt auch _UIDValidity&
  parameters session&,folder$,warn%
  declare erg%,b#,pc%,s$,s2$
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  erg%=1
  '{ 'Umlaute kodieren
  folder$=@translate$(folder$,"Ä","&AMQ-")
  folder$=@translate$(folder$,"Ö","&ARN-")
  folder$=@translate$(folder$,"Ü","&ANw-")
  folder$=@translate$(folder$,"ä","&AOQ-")
  folder$=@translate$(folder$,"ö","&APY-")
  folder$=@translate$(folder$,"ü","&APw-")
  folder$=@translate$(folder$,"ß","&AN8-")
  '}
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 select \q"+folder$+"\q",session&,b#,warn%)
  s$=@string$(b#,0)
  if (@instr("CLMTAG776 BAD",@upper$(s$))<>0) or (@instr("CLMTAG776 NO",@upper$(s$))<>0)
    case warn%: cl_hinweisbox "clSSLIMAPChangeFolder: Folder konnte nicht gewechselt werden: "+s$
    erg%=0
  else
    while @instr("CLMTAG776 OK",@upper$(s$))=0
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      s$=s$+@string$(b#,0)
    endwhile
    _UIDValidity&=0
    if @instr("[UIDVALIDITY",s$)<>0
      s2$=@right$(s$,@len(s$)-(@instr("[UIDVALIDITY",s$)-1))
      s2$=@substr$(s2$,2," ")
      s2$=@substr$(s2$,1,"]")
      _UIDValidity&=@val(s2$)
    endif
  endif
  dispose b#
  return erg%
ENDPROC 'clSSLIMAPSelectFolder

PROC clSSLIMAPCreateFolder 'Rückgabewert: 1=ok, 0=Fehler - Folder werden immer in Root angelegt. Unterfolder werden so definiert: <RootFolder>/<Child1>/<Child2>/[...]. Es können auch alle Folder in einem Pfad auf einmal angelegt werden. Der Foldername darf Leerzeichen enthalten.
  parameters session&,folder$,warn%
  declare erg%,b#,pc%,s$,s2$
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  erg%=1
  '{ 'Umlaute kodieren
  folder$=@translate$(folder$,"Ä","&AMQ-")
  folder$=@translate$(folder$,"Ö","&ARN-")
  folder$=@translate$(folder$,"Ü","&ANw-")
  folder$=@translate$(folder$,"ä","&AOQ-")
  folder$=@translate$(folder$,"ö","&APY-")
  folder$=@translate$(folder$,"ü","&APw-")
  folder$=@translate$(folder$,"ß","&AN8-")
  '}
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 CREATE \q"+folder$+"\q",session&,b#,warn%)
  s$=@string$(b#,0)
  if (@instr("CLMTAG776 BAD",@upper$(s$))<>0) or (@instr("CLMTAG776 NO",@upper$(s$))<>0)
    case warn%: cl_hinweisbox "clSSLIMAPCreateFolder: Folder konnte nicht angelegt werden: "+s$
    erg%=0
  else
    while @instr("CLMTAG776 OK",@upper$(s$))=0
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      s$=s$+@string$(b#,0)
    endwhile
  endif
  dispose b#
  return erg%
ENDPROC 'clSSLIMAPCreateFolder

PROC clSSLIMAPDeleteFolder 'Rückgabewert: 1=ok, 0=Fehler - Folder werden immer in Root gelöscht. Unterfolder werden so definiert: <RootFolder>/<Child1>/<Child2>/[...]. Achtung: Wenn man <RootFolder> löscht, bleibt <RootFolder>/<Child1> etc. bestehen. Also immer den untersten Pfad zuerst löschen und sich dann nach oben arbeiten.
  parameters session&,folder$,warn%
  declare erg%,b#,pc%,s$,s2$
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  erg%=1
  '{ 'Umlaute kodieren
  folder$=@translate$(folder$,"Ä","&AMQ-")
  folder$=@translate$(folder$,"Ö","&ARN-")
  folder$=@translate$(folder$,"Ü","&ANw-")
  folder$=@translate$(folder$,"ä","&AOQ-")
  folder$=@translate$(folder$,"ö","&APY-")
  folder$=@translate$(folder$,"ü","&APw-")
  folder$=@translate$(folder$,"ß","&AN8-")
  '}
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 DELETE \q"+folder$+"\q",session&,b#,warn%)
  s$=@string$(b#,0)
'hinweisbox s$,1
  if (@instr("CLMTAG776 BAD",@upper$(s$))<>0) or (@instr("CLMTAG776 NO",@upper$(s$))<>0)
    case warn%: cl_hinweisbox "clSSLIMAPDeleteFolder: Folder konnte nicht gelöscht werden: "+s$
    erg%=0
  else
    while @instr("CLMTAG776 OK",@upper$(s$))=0
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      s$=s$+@string$(b#,0)
    endwhile
  endif
  dispose b#
  return erg%
ENDPROC 'clSSLIMAPDeleteFolder

PROC clSSLIMAPListEmailUIDs 'holt die UIDs aller Emails im aktuellen Folder
  parameters session&,warn%
  declare ret%,pc%,b#,i%,s$,s2$,erg$,ld$
  pc%=%pcount
  if pc%=1
    warn%=0
  endif
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 uid search all",session&,b#,warn%)
  erg$=@string$(b#,0)
'hinweisbox erg$
  if (@instr("CLMTAG776 BAD",@upper$(erg$))<>0) or (@instr("CLMTAG776 NO",@upper$(erg$))<>0)
    case warn%: cl_hinweisbox "clSSLIMAPListEmailUIDs: Liste mit Email-UIDs konnte nicht abgerufen werden: "+erg$
    ret%=0
  else
    while @instr("CLMTAG776 OK",@upper$(erg$))=0
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      erg$=erg$+@string$(b#,0)
    endwhile
'hinweisbox erg$,1
    ret%=1
    if _ImapGBEmails%=0
      _ImapGBEmails%=@create("GRIDBOX",%HWnd,"UID;0;200",1,0,0,0,0)
      @sendmessage(_ImapGBEmails%,11,0,0) '11=WM_SETREDRAW
    endif
    clearlist _ImapGBEmails%
    ld$=@Get("ListDel")
    s$=@right$(erg$,@len(erg$)-@len("* SEARCH "))
    s$=@translate$(s$,_CRLF$," "+_CRLF$)
    for i%,1,@len(s$," ")
      s2$=@substr$(s$,i%," ")
      if @instr("CLMTAG776",@upper$(s2$))<>0
        break
      else
        @addstring(_ImapGBEmails%,s2$)
      endif
    endfor 'i%
  endif
  dispose b#
  return ret%
ENDPROC 'clSSLIMAPListEmailUIDs

PROC clSSLIMAPGetMailRawHeader 'Rückgabe (String!): "-1"=Fehler, sonst Header der Email
  'The FETCH command takes a list of sequence numbers or UIDs (as with SEARCH there are two variants, FETCH and UID FETCH) and a list of the information we are interested in. The most commonly used parts are:
  '|_. Part name |_. Part description | | BODY[TEXT] | Just the mail body, without the headers | | BODY[HEADER] | The mail headers | | BODY[HEADER.FIELDS ()] | Just the header fields indicated in list | | BODY[] | The entire mail text, header and body | | BODY.PEEK | Works as BODY does, but does not mark the mail as seen | | FLAGS | Flags set for the message | | UID | The UID of the message |
  parameters session&,UID&,warn%
  declare ret$,erg$,b#,pc%,i%,a%
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 uid fetch "+@str$(UID&)+" BODY.PEEK[HEADER]",session&,b#,warn%) '.PEEK markiert die Email nicht als gelesen
  '@clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 uid fetch "+@str$(UID&)+" BODY.PEEK[HEADER.FIELDS (TO)]",session&,b#,warn%) '.PEEK markiert die Email nicht als gelesen
  erg$=@string$(b#,0)
'hinweisbox erg$
  if (@instr("CLMTAG776 BAD",@upper$(erg$))<>0) or (@instr("CLMTAG776 NO",@upper$(erg$))<>0)
    case warn%: cl_hinweisbox "clSSLIMAPGetMailRawHeader: Email-Header konnte nicht abgerufen werden: "+erg$
    ret$="-1"
  else
    while @instr("CLMTAG776 OK",@upper$(erg$))=0
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      erg$=erg$+@string$(b#,0)
    endwhile
    ret$=@right$(erg$,@len(erg$)-(@instr(_CRLF$,erg$)+1))
    for i%,@len(erg$),1,-1
      if @char$(b#,i%,1)=")"
        a%=@len(erg$)-i%
        break
      endif
    endfor 'i%
'hinweisbox "len="+@str$(@len(erg$))+"\na%="+@str$(a%),1
    ret$=@left$(ret$,@len(ret$)-a%-2)
  endif
  dispose b#
  return ret$
ENDPROC 'clSSLIMAPGetMailRawHeader

PROC clSSLIMAPGetRawMail 'Rückgabe (String!): "-1"=Fehler, sonst Email
  'The FETCH command takes a list of sequence numbers or UIDs (as with SEARCH there are two variants, FETCH and UID FETCH) and a list of the information we are interested in. The most commonly used parts are:
  '|_. Part name |_. Part description | | BODY[TEXT] | Just the mail body, without the headers | | BODY[HEADER] | The mail headers | | BODY[HEADER.FIELDS ()] | Just the header fields indicated in list | | BODY[] | The entire mail text, header and body | | BODY.PEEK | Works as BODY does, but does not mark the mail as seen | | FLAGS | Flags set for the message | | UID | The UID of the message |
  parameters session&,UID&,SetSeen&,warn% 'SetSeen%=1: Email wird als gelesen markiert (default), =0: wird nicht als gelesen markiert (aber die Markierung wird auch nicht gelöscht, wenn sie schon gesetzt ist)
  declare ret$,erg$,b#,pc%,i%,a%
  pc%=%pcount
  if pc%=3
    warn%=0
  elseif pc%=2
    SetSeen&=1
    warn%=0
  endif
  dim b#,1024*1024*30
  string b#,0="BIGMEM" 'damit ein genügend großer Speicherbereich in clSSLSendAnyCommandAndRetrieveAnswer angefordert wird
  if SetSeen&=0
    @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 uid fetch "+@str$(UID&)+" BODY.PEEK[]",session&,b#,warn%) '.PEEK markiert die Email nicht als gelesen
  else
    @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 uid fetch "+@str$(UID&)+" BODY[]",session&,b#,warn%) '.PEEK markiert die Email nicht als gelesen
  endif
  erg$=@string$(b#,0)
'hinweisbox erg$
  if (@instr("CLMTAG776 BAD",@upper$(erg$))<>0) or (@instr("CLMTAG776 NO",@upper$(erg$))<>0)
    case warn%: cl_hinweisbox "clSSLIMAPGetRawMail: Email konnte nicht abgerufen werden: "+erg$
    ret$="-1"
  else
    while @instr("CLMTAG776 OK",@upper$(erg$))=0
      string b#,0="BIGMEM"
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      erg$=erg$+@string$(b#,0)
    endwhile
    ret$=@right$(erg$,@len(erg$)-(@instr(_CRLF$,erg$)+1))
    for i%,@len(erg$),1,-1
      if @char$(b#,i%,1)=")"
        a%=@len(erg$)-i%
        break
      endif
    endfor 'i%
'hinweisbox "len="+@str$(@len(erg$))+"\na%="+@str$(a%),1
    ret$=@left$(ret$,@len(ret$)-a%-2)
  endif
  dispose b#
  return ret$
ENDPROC 'clSSLIMAPGetMailRawHeader

PROC clSSLIMAPDeleteMail 'Rückgabewert: 1=ok, 0=Fehler
  parameters session&,UID&,warn%
  declare ret%,erg$,b#,pc%,i%,a%
  pc%=%pcount
  if pc%=2
    warn%=0
  endif
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 uid store "+@str$(UID&)+" +FLAGS (\Deleted)",session&,b#,warn%)
  erg$=@string$(b#,0)
'hinweisbox erg$
  if (@instr("CLMTAG776 BAD",@upper$(erg$))<>0) or (@instr("CLMTAG776 NO",@upper$(erg$))<>0)
    case warn%: cl_hinweisbox "clSSLIMAPDeleteMail: Email konnte nicht zum Löschen markiert werden: "+erg$
    ret%=0
  else
    while @instr("CLMTAG776 OK",@upper$(erg$))=0
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      erg$=erg$+@string$(b#,0)
    endwhile
    @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 expunge",session&,b#,warn%)
    erg$=@string$(b#,0)
    if (@instr("CLMTAG776 BAD",@upper$(erg$))<>0) or (@instr("CLMTAG776 NO",@upper$(erg$))<>0)
      case warn%: cl_hinweisbox "clSSLIMAPDeleteMail: Email konnte nicht gelöscht werden: "+erg$
      ret%=0
    else
      while @instr("CLMTAG776 OK",@upper$(erg$))=0
        @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
        erg$=erg$+@string$(b#,0)
      endwhile
      ret%=1
    endif
  endif
  dispose b#
  return ret%
ENDPROC 'clSSLIMAPDeleteMail

PROC clSSLIMAPCopyMail 'Rückgabewert: 1=ok, 0=Fehler - kopiert eine Email mit der angegebenen UID in den angegebenen Folder
  parameters session&,UID&,folder$,warn%
  declare erg%,b#,pc%,s$,s2$
  pc%=%pcount
  if pc%=3
    warn%=0
  endif
  erg%=1
  '{ 'Umlaute kodieren
  folder$=@translate$(folder$,"Ä","&AMQ-")
  folder$=@translate$(folder$,"Ö","&ARN-")
  folder$=@translate$(folder$,"Ü","&ANw-")
  folder$=@translate$(folder$,"ä","&AOQ-")
  folder$=@translate$(folder$,"ö","&APY-")
  folder$=@translate$(folder$,"ü","&APw-")
  folder$=@translate$(folder$,"ß","&AN8-")
  '}
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 COPY "+@str$(UID&)+" "+"\q"+folder$+"\q",session&,b#,warn%)
  s$=@string$(b#,0)
'hinweisbox s$,1
  if (@instr("CLMTAG776 BAD",@upper$(s$))<>0) or (@instr("CLMTAG776 NO",@upper$(s$))<>0)
    case warn%: cl_hinweisbox "clSSLIMAPCopyMail: Email konnte nicht kopiert werden: "+s$
    erg%=0
  else
    while @instr("CLMTAG776 OK",@upper$(s$))=0
      @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
      s$=s$+@string$(b#,0)
    endwhile
  endif
  dispose b#
  return erg%
ENDPROC 'clSSLIMAPCopyMail

PROC clSSLIMAPUploadMail 'Rückgabewert: 0=Fehler, >0=UID - lädt eine Email in den angegebenen Folder hoch
  parameters session&,rawmail$,folder$,warn%
  declare erg%,b#,pc%,s$,s2$
  pc%=%pcount
  if pc%=3
    warn%=0
  endif
  erg%=1
  '{ 'Umlaute kodieren
  folder$=@translate$(folder$,"Ä","&AMQ-")
  folder$=@translate$(folder$,"Ö","&ARN-")
  folder$=@translate$(folder$,"Ü","&ANw-")
  folder$=@translate$(folder$,"ä","&AOQ-")
  folder$=@translate$(folder$,"ö","&APY-")
  folder$=@translate$(folder$,"ü","&APw-")
  folder$=@translate$(folder$,"ß","&AN8-")
  '}
  dim b#,100000
  @clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 APPEND "+"\q"+folder$+"\q {"+@str$(@len(rawmail$))+"}",session&,b#,warn%)
  s$=@string$(b#,0)
'hinweisbox s$,1
  if @upper$(@left$(s$,2))<>"+ "
    case warn%: cl_hinweisbox "clSSLIMAPUploadMail: Email konnte nicht hochgeladen werden: "+s$
    erg%=0
  else
    @clSSLSendAnyCommandAndRetrieveAnswer(rawmail$,session&,b#,warn%)
    s$=@string$(b#,0)
'hinweisbox s$,1
    if (@instr("CLMTAG776 BAD",@upper$(s$))<>0) or (@instr("CLMTAG776 NO",@upper$(s$))<>0)
      case warn%: cl_hinweisbox "clSSLIMAPUploadMail: Email konnte nicht hochgeladen werden: "+s$
      erg%=0
    else
      while @instr("CLMTAG776 OK",@upper$(s$))=0
        @clSSLRetrieveAnotherAnswer(session&,b#,warn%)
        s$=s$+@string$(b#,0)
      endwhile
'hinweisbox @string$(b#,0)
      s2$=@substr$(@substr$(s$,2,"APPENDUID "),2," ")
      s2$=@substr$(s2$,1,"]")
      erg%=@val(s2$)
      '@clSSLIMAPSelectFolder(session&,"OUTBOX",1)
      '@clSSLSendAnyCommandAndRetrieveAnswer("CLMtag776 uid store "+s2$+" +FLAGS (\SendNow)",session&,b#,warn%)
'hinweisbox @string$(b#,0)
    endif
  endif
  dispose b#
  return erg%
ENDPROC 'clSSLIMAPUploadMail
'}

'{ 'Compose Mail
PROC clSSLNewMail
  _cm_RawMail$=""
  _cm_Sender$=""
  _cm_Recipient$=""
  _cm_CC$=""
  _cm_BCC$=""
  _cm_Recipients$="" 'enthält alle Empfänger
  _cm_Subject$=""
  _cm_AnzBodies&=0
  _cm_AnzAttachments&=0
  _cm_AnzNestedEmails&=0
ENDPROC 'clSSLNewMail

PROC clSSLAddSender
  parameters sender$
  _cm_Sender$=sender$
ENDPROC 'clSSLAddSender

PROC clSSLAddRecipient
  parameters recipients$
  declare i%
  '_cm_Recipient$=recipient$
  for i%,1,@len(recipients$,",")
    if _cm_Recipient$<>""
      _cm_Recipient$=_cm_Recipient$+","
    endif
    _cm_Recipient$=_cm_Recipient$+@trim$(@substr$(recipients$,i%,","))
    if _cm_Recipients$<>""
      _cm_Recipients$=_cm_Recipients$+","
    endif
    _cm_Recipients$=_cm_Recipients$+@trim$(@substr$(recipients$,i%,","))
  endfor 'i%
ENDPROC 'clSSLAddRecipient

PROC clSSLAddCC
  parameters recipients$
  declare i%
  '_cm_Recipient$=recipient$
  for i%,1,@len(recipients$,",")
    if _cm_CC$<>""
      _cm_CC$=_cm_CC$+","
    endif
    _cm_CC$=_cm_CC$+@trim$(@substr$(recipients$,i%,","))
    if _cm_Recipients$<>""
      _cm_Recipients$=_cm_Recipients$+","
    endif
    _cm_Recipients$=_cm_Recipients$+@trim$(@substr$(recipients$,i%,","))
  endfor 'i%
ENDPROC 'clSSLAddRecipient

PROC clSSLAddBCC
  parameters recipients$
  declare i%
  _cm_BCC$="others"
  for i%,1,@len(recipients$,",")
    'if _cm_BCC$<>"" 'nein, das zeigen manche Email-Programme an, und es stünde auch im Klartext in der Rohmail
    '  _cm_BCC$=_cm_BCC$+","
    'endif
    '_cm_BCC$=_cm_BCC$+@trim$(@substr$(recipients$,i%,","))
    if _cm_Recipients$<>""
      _cm_Recipients$=_cm_Recipients$+","
    endif
    _cm_Recipients$=_cm_Recipients$+@trim$(@substr$(recipients$,i%,","))
  endfor 'i%
ENDPROC 'clSSLAddRecipient

PROC clSSLAddSubject
  parameters subject$
  _cm_Subject$=subject$
ENDPROC 'clSSLAddSubject

PROC clSSLAddBody
  parameters art&,body$,charset$ 'body$ muss _CRLF$ als Zeilentrenner enthalten
  declare erg%,i%
  if %pcount=2
    charset$="ISO-8859-1"
  endif
  erg%=1
  inc _cm_AnzBodies&
  if art&=~MAIL_BODY_TYPE_TEXT
    _cm_BodyArt$[_cm_AnzBodies&]="text/plain"
  elseif art&=~MAIL_BODY_TYPE_HTML
    _cm_BodyArt$[_cm_AnzBodies&]="text/html"
  else
    erg%=0
  endif
  if erg%=1
    _cm_BodyCharSet$[_cm_AnzBodies&]=charset$
    body$=@translate$(body$,_CRLF$+".",_CRLF$+"..") 'der erste Punkt einer Zeile wird vom Server bzw. Email-Client weggeschnitten, um das Body-Ende-Zeichen zu schützen
    if @right$(body$,2)<>_CRLF$
      body$=body$+_CRLF$
    endif
    _cm_Body$[_cm_AnzBodies&]=body$
  else
    dec _cm_AnzBodies&
  endif
  return erg%
ENDPROC 'clSSLAddBody

PROC clSSLAddAttachment
  parameters attachmentfn$
  declare uextension$
  if @fileexists(attachmentfn$)=0
    return 0
  else
    inc _cm_AnzAttachments&
    uextension$=@upper$(@getfileextensiononly(attachmentfn$))
    if uextension$="TIFF"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="image/tiff"
    elseif uextension$="TIF"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="image/tif"
    elseif uextension$="BMP"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="image/bmp"
    elseif uextension$="JPG"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="image/jpg"
    elseif uextension$="JPEG"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="image/jpeg"
    elseif uextension$="PNG"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="image/png"
    elseif uextension$="GIF"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="image/gif"
    elseif uextension$="TXT"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="text/plain"
    elseif uextension$="HTM"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="text/htm"
    elseif uextension$="HTML"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="text/html"
    elseif (uextension$="DOC") or (uextension$="DOCX") or (uextension$="DOT") or (uextension$="DOTX")
      _cm_AttachmentArt$[_cm_AnzAttachments&]="application/msword"
    elseif (uextension$="XLS") or (uextension$="XLSX")
      _cm_AttachmentArt$[_cm_AnzAttachments&]="application/msexcel"
    elseif uextension$="PDF"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="text/pdf"
    elseif uextension$="MP3"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="audio/mpeg"
    elseif uextension$="WAV"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="audio/x-wav"
    elseif uextension$="OGG"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="audio/ogg"
    elseif uextension$="MP4"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="video/mp4"
    elseif uextension$="MOV"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="video/mov"
    elseif uextension$="AVI"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="video/x-msvideo"
    elseif uextension$="VCF"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="text/vcard"
    elseif uextension$="JSON"
      _cm_AttachmentArt$[_cm_AnzAttachments&]="application/json"
    else
      _cm_AttachmentArt$[_cm_AnzAttachments&]="file/unknown"
    endif
    _cm_AttachmentFn$[_cm_AnzAttachments&]=attachmentfn$
    return _cm_AnzAttachments&
  endif
ENDPROC 'clSSLAddAttachment

PROC clSSLAddEmailDigest
  parameters emailfn$
  if @fileexists(emailfn$)=0
    return 0
  else
    inc _cm_AnzNestedEmails&
    _cm_NestedEmailFn$[_cm_AnzNestedEmails&]=emailfn$
    return _cm_AnzNestedEmails&
  endif
ENDPROC 'clSSLAddEmailDigest

PROC clSSLComposeMail 'Return: -1=keine Absender-Email angegeben, -2=keine Empfänger-Email angegeben, -3=mindestens eine Attachment-Datei kann nicht eingelesen werden, -4=mindestens eine Email-Digest-Datei kann nicht eingelesen werden
  parameters warn%
  declare i%,erg%,weiter%,boundary$,altboundary$,digestboundary$,attachment#,rawattachment#
  if %pcount=0
    warn%=0
  endif
  '{ 'Boundaries erstellen
  boundary$=""
  altboundary$=""
  digestboundary$=""
  @set("RandSeed",@loword(&gettickcount))
  for i%,1,5
    boundary$=boundary$+@chr$(97+@rnd(26))
    altboundary$=altboundary$+@chr$(97+@rnd(26))
    digestboundary$=digestboundary$+@chr$(97+@rnd(26))
  endfor 'i%
  boundary$=boundary$+"----------SectionBoundary-"
  altboundary$=altboundary$+"----------AlternativeBoundary-"
  digestboundary$=digestboundary$+"----------DigestBoundary-"
  for i%,1,5
    boundary$=boundary$+@chr$(97+@rnd(26))
    altboundary$=altboundary$+@chr$(97+@rnd(26))
    digestboundary$=digestboundary$+@chr$(97+@rnd(26))
  endfor 'i%
  '}
  erg%=1
  weiter%=1
  if _cm_Sender$=""
    erg%=-1
    weiter%=0
  endif
  if weiter%
    if _cm_Recipient$=""
      erg%=-2
      weiter%=0
    endif
  endif
  if _cm_AnzBodies&=0
    _cm_AnzBodies&=1
    _cm_BodyArt$[1]=~MAIL_BODY_TYPE_TEXT
    _cm_BodyCharSet$[1]="ISO-8859-1"
    _cm_Body$[1]=""
  endif
  if weiter%
    '{ 'Header erstellen
    '_cm_RawMail$="From: "+"=?iso-8859-1?B?"+@Encode64(_cm_Sender$)+"?="+_CRLF$
    _cm_RawMail$="From: "+_cm_Sender$+_CRLF$
    '_cm_RawMail$=_cm_RawMail$+"Sender: "+"=?iso-8859-1?B?"+@Encode64(_cm_Sender$)+"?="+_CRLF$
    _cm_RawMail$=_cm_RawMail$+"Sender: "+_cm_Sender$+_CRLF$
    '_cm_RawMail$=_cm_RawMail$+"To: "+"=?iso-8859-1?B?"+@Encode64(_cm_Recipient$)+"?="+_CRLF$ 'muss mit der Angabe unten im Aufruf von clSSLSMTSendRawMail übereinstimmen
    _cm_RawMail$=_cm_RawMail$+"To: "+_cm_Recipient$+_CRLF$ 'muss mit der Angabe unten im Aufruf von clSSLSMTSendRawMail übereinstimmen
    if _cm_CC$<>""
      _cm_RawMail$=_cm_RawMail$+"CC: "+_cm_CC$+_CRLF$
    endif
    if _cm_BCC$<>""
      _cm_RawMail$=_cm_RawMail$+"BCC: "+_cm_BCC$+_CRLF$
    endif
    _cm_RawMail$=_cm_RawMail$+"Date: "+@Dt("GetDate",5)+_CRLF$
    _cm_RawMail$=_cm_RawMail$+"Subject: "+"=?iso-8859-1?B?"+@Encode64(_cm_Subject$)+"?="+_CRLF$ '+@clSSLSMTPPrepareUtf8Subject("Testmal aus XProfan mit Ümlaut")+_CRLF$
    '_cm_RawMail$=_cm_RawMail$+"Subject: "+_cm_Subject$+_CRLF$ '+@clSSLSMTPPrepareUtf8Subject("Testmal aus XProfan mit Ümlaut")+_CRLF$
    _cm_RawMail$=_cm_RawMail$+"Mime-Version: 1.0"+_CRLF$
    if _cm_AnzBodies&<=1
      if _cm_AnzBodies&=0
        inc _cm_AnzBodies&
        _cm_BodyArt$[1]="text/plain"
        _cm_BodyCharSet$[1]="ISO-8859-1"
        _cm_Body$[1]=""
      endif
      if (_cm_AnzAttachments&=0) and (_cm_AnzNestedEmails&=0)
        _cm_RawMail$=_cm_RawMail$+"Content-Type: "+_cm_BodyArt$[1]+"; charset=\q"+_cm_BodyCharSet$[1]+"\q"+_CRLF$
        _cm_RawMail$=_cm_RawMail$+"Content-Transfer-Encoding: quoted-printable"+_CRLF$
        _cm_RawMail$=_cm_RawMail$+"Content-Disposition: inline"+_CRLF$
      else
        _cm_RawMail$=_cm_RawMail$+"Content-Type: multipart/mixed; boundary=\q"+boundary$+"\q"+_CRLF$
      endif
    else
      if (_cm_AnzAttachments&=0) and (_cm_AnzNestedEmails&=0)
        _cm_RawMail$=_cm_RawMail$+"Content-Type: multipart/alternative; boundary=\q"+altboundary$+"\q"+_CRLF$
      else
        _cm_RawMail$=_cm_RawMail$+"Content-Type: multipart/mixed; boundary=\q"+boundary$+"\q"+_CRLF$
      endif
    endif
    _cm_RawMail$=_cm_RawMail$+_CRLF$ 'Trennzeichen zwischen Header und Boundary bzw. Body
    '}
    '{ 'Bodies erstellen
    'Wenn am Anfang einer Zeile ein Punkt steht, muss ein weiterer Punkt davor/dahinter eingefügt werden (also "..")! - wird in AddBody gemacht - siehe https://datatracker.ietf.org/doc/html/rfc5321#section-4.5.2
    if _cm_AnzBodies&=1
      if (_cm_AnzAttachments&=0) and (_cm_AnzNestedEmails&=0)
        _cm_RawMail$=_cm_RawMail$+_cm_Body$[1]
        _cm_RawMail$=_cm_RawMail$+_CRLF$ 'letztes CRLF$: Trennzeichen zwischen Body und Boundary (gehört nicht zum Body-Text selbst)
      else
        _cm_RawMail$=_cm_RawMail$+"--"+boundary$+_CRLF$ 'alle Boundaries werden mit führendem "--" vor dem eigentlichen Boundary-String geschrieben
        _cm_RawMail$=_cm_RawMail$+"Content-Type: "+_cm_BodyArt$[1]+"; charset=\q"+_cm_BodyCharSet$[1]+"\q"+_CRLF$
        _cm_RawMail$=_cm_RawMail$+"Content-Transfer-Encoding: quoted-printable"+_CRLF$
        _cm_RawMail$=_cm_RawMail$+"Content-Disposition: inline"+_CRLF$
        _cm_RawMail$=_cm_RawMail$+_CRLF$ 'erstes CRLF$: Trennzeichen zwischen Section-Header und Body-Text (gehört nicht zum Body-Text selbst)
        _cm_RawMail$=_cm_RawMail$+_cm_Body$[1]
        '_cm_RawMail$=_cm_RawMail$+_CRLF$ 'letztes CRLF$: Trennzeichen zwischen Body und Boundary (gehört nicht zum Body-Text selbst)
      endif
    else
      if (_cm_AnzAttachments&>0) or (_cm_AnzNestedEmails&>0)
        _cm_RawMail$=_cm_RawMail$+"--"+boundary$+_CRLF$ 'alle Boundaries werden mit führendem "--" vor dem eigentlichen Boundary-String geschrieben
        _cm_RawMail$=_cm_RawMail$+"Content-Type: multipart/alternative; boundary=\q"+altboundary$+"\q"+_CRLF$
        _cm_RawMail$=_cm_RawMail$+_CRLF$ 'Leerzeile zwischen Section-Header und nächster Boundary
      endif
      for i%,1,_cm_AnzBodies&
        if (_cm_AnzBodies&>1) or (_cm_AnzAttachments&>0)
          _cm_RawMail$=_cm_RawMail$+"--"+altboundary$+_CRLF$ 'alle Boundaries werden mit führendem "--" vor dem eigentlichen Boundary-String geschrieben
          _cm_RawMail$=_cm_RawMail$+"Content-Type: "+_cm_BodyArt$[i%]+"; charset=\q"+_cm_BodyCharSet$[i%]+"\q"+_CRLF$
          _cm_RawMail$=_cm_RawMail$+"Content-Transfer-Encoding: quoted-printable"+_CRLF$
          _cm_RawMail$=_cm_RawMail$+"Content-Disposition: inline"+_CRLF$
          _cm_RawMail$=_cm_RawMail$+_CRLF$ 'erstes CRLF$: Trennzeichen zwischen Section-Header und Body-Text (gehört nicht zum Body-Text selbst)
          _cm_RawMail$=_cm_RawMail$+_cm_Body$[i%]
        endif
        _cm_RawMail$=_cm_RawMail$+_CRLF$ 'letztes CRLF$: Trennzeichen zwischen Body und Boundary (gehört nicht zum Body-Text selbst)
      endfor 'i%
      _cm_RawMail$=_cm_RawMail$+"--"+altboundary$+"--"+_CRLF$
    endif
    '}
    '{ 'ggf. Attachments anfügen
    for i%,1,_cm_AnzAttachments&
      _cm_RawMail$=_cm_RawMail$+"--"+boundary$+_CRLF$
      'Depending on the type of file being attached, a file must first be encoded into a certain MIME type before it can be added to an email using MIME. The following MIME types are frequently used to encode files for email attachments:
      'unknown file types: "file/unknown"
      'Text files: "text/plain"
      'HTML files: "text/html"
      'Microsoft Word documents: "application/msword"
      'PDF files: "application/pdf"
      'Images (e.g. JPEG, PNG, GIF): "image/jpeg", "image/png", "image/gif"
      'Audio files (e.g. MP3, WAV): "audio/mpeg", "audio/x-wav"
      'Video files (e.g. MP4, AVI): "video/mp4", "video/x-msvideo"
      '
      'verschiedene Kodiermöglichkeiten für das Attachment: https://www.emailondeck.com/b/Understanding-Email-Attachments-How-Files-are-Encoded-and-Transferred
      '
      _cm_RawMail$=_cm_RawMail$+"Content-Type: "+_cm_AttachmentArt$[i%]+"; name=\q"+@extractfilename(_cm_AttachmentFn$[i%])+"\q"+_CRLF$
      _cm_RawMail$=_cm_RawMail$+"Content-Transfer-Encoding: base64"+_CRLF$
      _cm_RawMail$=_cm_RawMail$+"Content-Disposition: attachment; filename=\q"+@extractfilename(_cm_AttachmentFn$[i%])+"\q"+_CRLF$
      _cm_RawMail$=_cm_RawMail$+_CRLF$ 'erstes CRLF$: Trennzeichen zwischen Section-Header und Attachment-Daten (gehört nicht zu den Attachment-Daten selbst)
      if @FileExists(_cm_AttachmentFn$[i%])=0
        erg%=-3
        weiter%=0
        break
      endif
      dim attachment#,@FileSize(_cm_AttachmentFn$[i%])
      @blockread(_cm_AttachmentFn$[i%],attachment#)
      dim rawattachment#,@FileSize(_cm_AttachmentFn$[i%])*2 'BASE64 ist länger als ASCII, daher x2 (das reicht auf jeden Fall)
      'clSSLConvertPlainToBase64(attachment#,@FileSize(_cm_AttachmentFn$[i%]),rawattachment#) 'ist zu langsam, PureBasic-Variante nehmen
      pbMailConvertPlainToBase64(attachment#,@FileSize(_cm_AttachmentFn$[i%]),rawattachment#)
      _cm_RawMail$=_cm_RawMail$+@string$(rawattachment#,0) '+_CRLF$ 'rawattachment# enthält am Ende bereits ein CRLF
      dispose attachment#,rawattachment#
      _cm_RawMail$=_cm_RawMail$+_CRLF$ 'letztes CRLF$: Trennzeichen Attachment-Daten und Boundary (gehört nicht zu den Attachment-Daten selbst)
    endfor 'i%
    '}
    '{ 'ggf. nested Emails anfügen
    if _cm_AnzNestedEmails&>0
      _cm_RawMail$=_cm_RawMail$+"--"+boundary$+_CRLF$
      _cm_RawMail$=_cm_RawMail$+"Content-Type: multipart/digest; Boundary=\q"+digestboundary$+"\q"+_CRLF$
      _cm_RawMail$=_cm_RawMail$+_CRLF$ 'erstes CRLF$: Trennzeichen zwischen Section-Header und Attachment-Daten (gehört nicht zu den Attachment-Daten selbst)
      for i%,1,_cm_AnzNestedEmails&
        _cm_RawMail$=_cm_RawMail$+"--"+digestboundary$+_CRLF$
        _cm_RawMail$=_cm_RawMail$+_CRLF$
        if @FileExists(_cm_NestedEmailFn$[i%])=0
          erg%=-4
          weiter%=0
          break
        endif
        dim attachment#,@FileSize(_cm_NestedEmailFn$[i%])
        @blockread(_cm_NestedEmailFn$[i%],attachment#)
        _cm_RawMail$=_cm_RawMail$+@translate$(@string$(attachment#,0),_CRLF$+"."+_CRLF$,_CRLF$+".."+_CRLF$)
        dispose attachment#
        case @right$(_cm_RawMail$,2)<>_CRLF$: _cm_RawMail$=_cm_RawMail$+_CRLF$
        _cm_RawMail$=_cm_RawMail$+_CRLF$ 'letztes CRLF$: Trennzeichen Attachment-Daten und Boundary (gehört nicht zu den Attachment-Daten selbst)
      endfor 'i%
      _cm_RawMail$=_cm_RawMail$+"--"+digestboundary$+"--"+_CRLF$
      _cm_RawMail$=_cm_RawMail$+_CRLF$
    endif
    '}
    '{ 'ggf. Boundary schließen
    if (_cm_AnzAttachments&>0) or (_cm_AnzNestedEmails&>0)
      _cm_RawMail$=_cm_RawMail$+"--"+boundary$+"--" 'letzte Boundary wird mit führendem UND ausgehendem "--" geschrieben
    endif
    '_cm_RawMail$=_cm_RawMail$+CRLF$+"."+_CRLF$ 'nein, das macht die Send-Routine
    '}
  endif
  return erg%
ENDPROC
'}

PROC clSSLConvertBase64ToPlain
  parameters rawattachment#,attachment#,aLenAttachment&,warn%
  declare pc%,ret%,rawattachm$,i%,s$,s2$,pos%
  if pc%=3
    warn%=0
  elseif pc%=2
    warn%=0
    aLenAttachment&=0
  endif
  rawattachm$=@string$(rawattachment#,0)
  pos%=0
  case aLenAttachment&<>0: long aLenAttachment&,0=0
  for i%,1,@len(rawattachm$,@chr$(13)+@chr$(10)+@chr$(13)+@chr$(10))
    s$=@substr$(rawattachm$,i%,@chr$(13)+@chr$(10)+@chr$(13)+@chr$(10))
    s2$=@Decode64(s$)
    string attachment#,pos%=s2$ 'damit ist das abschließende Nullbyte garantiert; es wird vor der letzten Zeile nur immer überschrieben
    pos%=pos%+@len(s2$)
  endfor 'i%
  case aLenAttachment&<>0: long aLenAttachment&,0=pos%+1
  return 1
ENDPROC 'clSSLConvertBase64ToPlain

PROC clSSLConvertPlainToBase64
  parameters plainattachment#,lenplain&,rawattachment#
  declare pc%,ret%,a%,i%,s$,s2$,posbase%,posraw%,base64$,lenbase64%
  base64$=@Encode64(@char$(plainattachment#,0,lenplain&))
  posraw%=0
  lenbase64%=@len(base64$)
'hinweisbox "lenplaint="+@str$(lenplain&)+"\nlenbase="+@str$(lenbase64%)+"\nlendecode="+@str$(@len(@Decode64(base64$))),1
  for i%,0,lenbase64%-1,76
    's$=@mid$(base64$,i%,76) 'das ist EXTREM langsam, daher mit @char$() direkt aus dem Speicher lesen
    if lenbase64%-i%>=76
      s$=@char$(@addr(base64$),i%,76)
    else
      s$=@char$(@addr(base64$),i%,((lenbase64%)-i%))
    endif
    string rawattachment#,posraw%=s$+@chr$(13)+@chr$(10)'+chr$(0) 'das garantiert das abschließende Nullbyte, das nur am Ende nicht sofort wieder überschrieben wird
    posraw%=posraw%+@len(s$)+2 'abschließendes Nullbyte wird überschrieben, wenn es eine weitere Zeile gibt
  endfor 'i%
  return 1
ENDPROC 'clSSLConvertPlainToBase64
'}

PROC clGetErrorText
  parameters errorcode%
  declare s$
  s$="cryptlib: "+_cl_errortext$[errorcode%+100]
  return s$
ENDPROC 'clGetErrorText

PROC WriteIni_
  'versucht, in ini-Datei bzw. Registry zu schreiben
  parameters ini1$,ini2$,ini3$,value$
  declare ret%,errlvl%
  ret%=1
  errlvl%=%errorlevel
  @set("errorlevel",-1)
  writeini ini1$,ini2$,ini3$=value$
  if %error<>0
    ret%=0
  endif
  @set("errorlevel",errlvl%)
  return ret%
ENDPROC 'WriteIni

PROC HinweisBox
  parameters Text$,art% 'art%=1: Bei Abbrechen wird sofort end aufgerufen; art%=2: bei Abbrechen wird 2 zurückgegeben, das Hauptprogramm muss darauf reagieren (es können noch Deinitialisierungen vor dem Beenden vorgenommen werden)
  declare erg%
  if (%pcount=2) and (art%>0) 'Abbruch-Hinweisbox
    erg%=@messagebox(Text$,"Hinweis",4161) '1+64+0+4096
    if erg%=2
      if art%=1
        end 'sofortige Beendigung
      else
        return 2 'das Hauptprogramm kann noch Deinitialisierungen vornehmen und muss dann selbst für die Beendigung sorgen
      endif
    endif
  else 'normale Hinweisbox
    @messagebox(Text$,"Hinweis",4160) '0+64+0+4096
    return 1
  endif
ENDPROC 'HinweisBox

PROC GetFileExtensionOnly 'Dateiendung ohne alles andere, auch ohne den Punkt davor, wird zurückgegeben
  parameters fn$
  declare i%,erg$
  if @instr(".",fn$)<>0
    i%=@len(fn$,".")
    erg$=@substr$(fn$,i%,".")
  else
    erg$=""
  endif
  return erg$
ENDPROC 'GetFileExtensionOnly

PROC ExtractFilename 'gibt Dateiname mit Endung ohne Pfad zurück
  parameters fn$
  declare erg$,i%
  i%=@len(fn$,"\\")
  if i%>0
    erg$=@substr$(fn$,i%,"\\")
  else
    erg$=fn$
  endif
  return erg$
ENDPROC 'ExtractFilename

'***************** Ende Teil von JR

'****************************************************************************
'*                                                                           *
'*                           Encryption Data Structures                      *
'*                                                                           *
'****************************************************************************

' Results returned from the capability query

STRUCT CRYPT_QUERY_INFO = algoname#(~CRYPT_MAX_TEXTSIZE-1),blockSize&,minKeySize&,keySize&,maxKeySize&
    ' Algorithm information
    'algoName(CRYPT_MAX_TEXTSIZE-1) As Byte' Algorithm name
    'blockSize                 ' Block size of the algorithm
    'minKeySize                ' Minimum key size in bytes
    'keySize                   ' Recommended key size in bytes
    'maxKeySize                ' Maximum key size in bytes


'End Type

'  Results returned from the encoded object query.  These provide
'  information on the objects created by cryptExportKey()/
'  cryptCreateSignature()

STRUCT CRYPT_OBJECT_INFO = objectType&,cryptAlgo&,cryptMode&,hashAlgo&,salt#(~CRYPT_MAX_HASHSIZE-1),saltSize&,interations&
    ' The object type
    'objectType As CRYPT_OBJECT_TYPE

    ' The encryption algorithm and mode
    'cryptAlgo As CRYPT_ALGO_TYPE
    'cryptMode As CRYPT_MODE_TYPE

'      The hash algorithm for signature objects or PRF algorithm for derived
'      keys
    'hashAlgo As CRYPT_ALGO_TYPE

    ' The salt and PRF iterations for derived keys
    'salt(CRYPT_MAX_HASHSIZE-1) As Byte
    'saltSize As Long
    'iterations As Long


'End Type

'  Key information for the public-key encryption algorithms.  These fields
'  are not accessed directly, but can be manipulated with the init/set/
'  destroyComponents() macros

STRUCT CRYPT_PKCINFO_RSA = isPublicKey&,n#(~CRYPT_MAX_PKCSIZE-1),nLen&,e#(~CRYPT_MAX_PKCSIZE-1),eLen&,d#(~CRYPT_MAX_PKCSIZE-1),dLen&,p#(~CRYPT_MAX_PKCSIZE-1),pLen&,q#(~CRYPT_MAX_PKCSIZE-1),qLen&,u#(~CRYPT_MAX_PKCSIZE-1),uLen&,e1#(~CRYPT_MAX_PKCSIZE-1),e1Len&,e2#(~CRYPT_MAX_PKCSIZE-1),e2Len&
    ' Status information
    'isPublicKey           ' Whether this is a public or private key

    ' Public components
    'n(CRYPT_MAX_PKCSIZE-1) As Byte   ' Modulus
    'nLen                  ' Length of modulus in bits
    'e(CRYPT_MAX_PKCSIZE-1) As Byte   ' Public exponent
    'eLen                  ' Length of public exponent in bits

    ' Private components
    'd(CRYPT_MAX_PKCSIZE-1) As Byte   ' Private exponent
    'dLen                  ' Length of private exponent in bits
    'p(CRYPT_MAX_PKCSIZE-1) As Byte   ' Prime factor 1
    'pLen                  ' Length of prime factor 1 in bits
    'q(CRYPT_MAX_PKCSIZE-1) As Byte   ' Prime factor 2
    'qLen                  ' Length of prime factor 2 in bits
    'u(CRYPT_MAX_PKCSIZE-1) As Byte   ' Mult.inverse of q, mod p
    'uLen                  ' Length of private exponent in bits
    'e1(CRYPT_MAX_PKCSIZE-1) As Byte  ' Private exponent 1 (PKCS)
    'e1Len                 ' Length of private exponent in bits
    'e2(CRYPT_MAX_PKCSIZE-1) As Byte  ' Private exponent 2 (PKCS)
    'e2Len                 ' Length of private exponent in bits


'End Type

STRUCT CRYPT_PKCINFO_DLP = isPublicKey&,p#(~CRYPT_MAX_PKCSIZE-1),pLen&,q#(~CRYPT_MAX_PKCSIZE-1),qLen&,g#(~CRYPT_MAX_PKCSIZE-1),gLen&,y#(~CRYPT_MAX_PKCSIZE-1),yLen&,x#(~CRYPT_MAX_PKCSIZE-1),xLen&
    ' Status information
    'isPublicKey           ' Whether this is a public or private key

    ' Public components
    'p(CRYPT_MAX_PKCSIZE-1) As Byte   ' Prime modulus
    'pLen                  ' Length of prime modulus in bits
    'q(CRYPT_MAX_PKCSIZE-1) As Byte   ' Prime divisor
    'qLen                  ' Length of prime divisor in bits
    'g(CRYPT_MAX_PKCSIZE-1) As Byte   ' h^( ( p - 1 ) / q ) mod p
    'gLen                  ' Length of g in bits
    'y(CRYPT_MAX_PKCSIZE-1) As Byte   ' Public random integer
    'yLen                  ' Length of public integer in bits

    ' Private components
    'x(CRYPT_MAX_PKCSIZE-1) As Byte   ' Private random integer
    'xLen                  ' Length of private integer in bits


'End Type

STRUCT CRYPT_PKCINFO_ECC = isPublicKey&,curveType&,p#(~CRYPT_MAX_PKCSIZE_ECC-1),pLen&,a#(~CRYPT_MAX_PKCSIZE_ECC-1),aLen&,b#(~CRYPT_MAX_PKCSIZE_ECC-1),bLen&,gx#(~CRYPT_MAX_PKCSIZE_ECC-1),gxLen&,gy#(~CRYPT_MAX_PKCSIZE_ECC-1),gyLen&,n#(~CRYPT_MAX_PKCSIZE_ECC-1),nLen&,h#(~CRYPT_MAX_PKCSIZE_ECC-1),hLen&,qx#(~CRYPT_MAX_PKCSIZE_ECC-1),qxLen&,qy#(~CRYPT_MAX_PKCSIZE_ECC-1),qyLen&,d#(~CRYPT_MAX_PKCSIZE_ECC-1),dLen&
    ' Status information
    'isPublicKey           ' Whether this is a public or private key

'      Curve domain parameters.  Either the curveType or the explicit domain
'      parameters must be provided
    'curveType As CRYPT_ECCCURVE_TYPE  ' Named curve
    'p(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Prime defining Fq
    'pLen                  ' Length of prime in bits
    'a(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Element in Fq defining curve
    'aLen                  ' Length of element a in bits
    'b(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Element in Fq defining curve
    'bLen                  ' Length of element b in bits
    'gx(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Element in Fq defining point
    'gxLen                 ' Length of element gx in bits
    'gy(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Element in Fq defining point
    'gyLen                 ' Length of element gy in bits
    'n(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Order of point
    'nLen                  ' Length of order in bits
    'h(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Optional cofactor
    'hLen                  ' Length of cofactor in bits

    ' Public components
    'qx(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Point Q on the curve
    'qxLen                 ' Length of point xq in bits
    'qy(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Point Q on the curve
    'qyLen                 ' Length of point xy in bits

    ' Private components
    'd(CRYPT_MAX_PKCSIZE_ECC-1) As Byte' Private random integer
    'dLen                  ' Length of integer in bits


'End Type

'  Macros to initialise and destroy the structure that stores the components
'  of a public key

' C-macro not translated to Visual Basic code:
'   #define cryptInitComponents( componentInfo, componentKeyType )
'    #{ memset( ( componentInfo ), 0, sizeof( *componentInfo ) );
'      ( componentInfo )->isPublicKey = ( ( componentKeyType ) ? 1 : 0 ); }
'

' C-macro not translated to Visual Basic code:
'   #define cryptDestroyComponents( componentInfo )
'    memset( ( componentInfo ), 0, sizeof( *componentInfo ) )
'

' Macros to set a component of a public key

' C-macro not translated to Visual Basic code:
'   #define cryptSetComponent( destination, source, length )
'    #{ memcpy( ( destination ), ( source ), ( ( length ) + 7 ) >> 3 );
'      ( destination##Len ) = length; }
'

'****************************************************************************
'*                                                                           *
'*                                   General Functions                       *
'*                                                                           *
'****************************************************************************

' The following is necessary to stop C++ name mangling


' Initialise and shut down cryptlib


'DEF cryptInit(0) !"CL32.DLL","cryptInit"


'DEF cryptEnd(0) !"CL32.DLL","cryptEnd"



' Query cryptlibs capabilities

'Public Declare Function cryptQueryCapability Lib "CL32.DLL" ( ByVal cryptAlgo As CRYPT_ALGO_TYPE, _
' ByRef cryptQueryInfo As CRYPT_QUERY_INFO) As Long
'DEF cryptQueryCapability(2) !"CL32.DLL","cryptQueryCapability"


' Create and destroy an encryption context

'Public Declare Function cryptCreateContext Lib "CL32.DLL" ( ByRef cryptContext As Long, _
' ByVal cryptUser As Long, _
' ByVal cryptAlgo As CRYPT_ALGO_TYPE) As Long
'DEF cryptCreateContext(3) !"CL32.DLL","cryptCreateContext"

'Public Declare Function cryptDestroyContext Lib "CL32.DLL" ( ByVal cryptContext As Long) As Long
'DEF cryptDestroyContext(1) !"CL32.DLL","cryptDestroyContext"


' Generic "destroy an object" function

'Public Declare Function cryptDestroyObject Lib "CL32.DLL" ( ByVal cryptObject As Long) As Long
'DEF cryptDestroyObject(1) !"CL32.DLL","cryptDestroyObject"


' Generate a key into a context

'Public Declare Function cryptGenerateKey Lib "CL32.DLL" ( ByVal cryptContext As Long) As Long
'DEF cryptGenerateKey(1) !"CL32.DLL","cryptGenerateKey"


' Encrypt/decrypt/hash a block of memory

' ***Warning: function 'cryptEncrypt' will replace the String 'buffer'
'Public Declare Function cryptEncrypt Lib "CL32.DLL" ( ByVal cryptContext As Long, _
' ByVal buffer As String, _
' ByVal length As Long) As Long
'DEF cryptEncrypt(3) !"CL32.DLL","cryptEncrypt"

' ***Warning: function 'cryptDecrypt' will replace the String 'buffer'
'Public Declare Function cryptDecrypt Lib "CL32.DLL" ( ByVal cryptContext As Long, _
' ByVal buffer As String, _
' ByVal length As Long) As Long
'DEF cryptDecrypt(3) !"CL32.DLL","cryptDecrypt"

' Get/set/delete attribute functions

'Public Declare Function cryptSetAttribute Lib "CL32.DLL" ( ByVal cryptHandle As Long, _
' ByVal attributeType As CRYPT_ATTRIBUTE_TYPE, _
' ByVal value As Long) As Long
'DEF cryptSetAttribute(3) !"CL32.DLL","cryptSetAttribute"

'Public Declare Function cryptSetAttributeString Lib "CL32.DLL" ( ByVal cryptHandle As Long, _
' ByVal attributeType As CRYPT_ATTRIBUTE_TYPE, _
' ByVal value As String, _
' ByVal valueLength As Long) As Long
'DEF cryptSetAttributeString(4) !"CL32.DLL","cryptSetAttributeString"

'Public Declare Function cryptGetAttribute Lib "CL32.DLL" ( ByVal cryptHandle As Long, _
' ByVal attributeType As CRYPT_ATTRIBUTE_TYPE, _
' ByRef value As Long) As Long
'DEF cryptGetAttribute(3) !"CL32.DLL","cryptGetAttribute"

' ***Warning: function 'cryptGetAttributeString' will modify the String 'value'
'Public Declare Function cryptGetAttributeString Lib "CL32.DLL" ( ByVal cryptHandle As Long, _
' ByVal attributeType As CRYPT_ATTRIBUTE_TYPE, _
' ByVal value As String, _
' ByRef valueLength As Long) As Long
'DEF cryptGetAttributeString(4) !"CL32.DLL","cryptGetAttributeString"

'Public Declare Function cryptDeleteAttribute Lib "CL32.DLL" ( ByVal cryptHandle As Long, _
' ByVal attributeType As CRYPT_ATTRIBUTE_TYPE) As Long
'DEF cryptDeleteAttribute(2) !"CL32.DLL","cryptDeleteAttribute"


'  Oddball functions: Add random data to the pool, query an encoded signature
'  or key data.  These are due to be replaced once a suitable alternative can
'  be found

'Public Declare Function cryptAddRandom Lib "CL32.DLL" ( ByVal randomData As String, _
' ByVal randomDataLength As Long) As Long
'DEF cryptAddRandom(2) !"CL32.DLL","cryptAddRandom"

'Public Declare Function cryptQueryObject Lib "CL32.DLL" ( ByVal objectData As String, _
' ByVal objectDataLength As Long, _
' ByRef cryptObjectInfo As CRYPT_OBJECT_INFO) As Long
'DEF cryptQueryObject(3) !"CL32.DLL","cryptQueryObject"


'****************************************************************************
'*                                                                           *
'*                           Mid-level Encryption Functions                  *
'*                                                                           *
'****************************************************************************

' Export and import an encrypted session key

' ***Warning: function 'cryptExportKey' will modify the String 'encryptedKey'
'Public Declare Function cryptExportKey Lib "CL32.DLL" ( ByVal encryptedKey As String, _
' ByVal encryptedKeyMaxLength As Long, _
' ByRef encryptedKeyLength As Long, _
' ByVal exportKey As Long, _
' ByVal sessionKeyContext As Long) As Long
'DEF cryptExportKey(5) !"CL32.DLL","cryptExportKey"

' ***Warning: function 'cryptExportKeyEx' will modify the String 'encryptedKey'
'Public Declare Function cryptExportKeyEx Lib "CL32.DLL" ( ByVal encryptedKey As String, _
' ByVal encryptedKeyMaxLength As Long, _
' ByRef encryptedKeyLength As Long, _
' ByVal formatType As CRYPT_FORMAT_TYPE, _
' ByVal exportKey As Long, _
' ByVal sessionKeyContext As Long) As Long
'DEF cryptExportKeyEx(6) !"CL32.DLL","cryptExportKeyEx"

'Public Declare Function cryptImportKey Lib "CL32.DLL" ( ByVal encryptedKey As String, _
' ByVal encryptedKeyLength As Long, _
' ByVal importKey As Long, _
' ByVal sessionKeyContext As Long) As Long
'DEF cryptImportKey(4) !"CL32.DLL","cryptImportKey"

'Public Declare Function cryptImportKeyEx Lib "CL32.DLL" ( ByVal encryptedKey As String, _
' ByVal encryptedKeyLength As Long, _
' ByVal importKey As Long, _
' ByVal sessionKeyContext As Long, _
' ByRef returnedContext As Long) As Long
'DEF cryptImportKeyEx(5) !"CL32.DLL","cryptImportKeyEx"


' Create and check a digital signature

' ***Warning: function 'cryptCreateSignature' will modify the String 'signature'
'Public Declare Function cryptCreateSignature Lib "CL32.DLL" ( ByVal signature As String, _
' ByVal signatureMaxLength As Long, _
' ByRef signatureLength As Long, _
' ByVal signContext As Long, _
' ByVal hashContext As Long) As Long
'DEF cryptCreateSignature(5) !"CL32.DLL","cryptCreateSignature"

' ***Warning: function 'cryptCreateSignatureEx' will modify the String 'signature'
'Public Declare Function cryptCreateSignatureEx Lib "CL32.DLL" ( ByVal signature As String, _
' ByVal signatureMaxLength As Long, _
' ByRef signatureLength As Long, _
' ByVal formatType As CRYPT_FORMAT_TYPE, _
' ByVal signContext As Long, _
' ByVal hashContext As Long, _
' ByVal extraData As Long) As Long
'DEF cryptCreateSignatureEx(7) !"CL32.DLL","cryptCreateSignatureEx"

'Public Declare Function cryptCheckSignature Lib "CL32.DLL" ( ByVal signature As String, _
' ByVal signatureLength As Long, _
' ByVal sigCheckKey As Long, _
' ByVal hashContext As Long) As Long
'DEF cryptCheckSignature(4) !"CL32.DLL","cryptCheckSignature"

'Public Declare Function cryptCheckSignatureEx Lib "CL32.DLL" ( ByVal signature As String, _
' ByVal signatureLength As Long, _
' ByVal sigCheckKey As Long, _
' ByVal hashContext As Long, _
' ByRef extraData As Long) As Long
'DEF cryptCheckSignatureEx(5) !"CL32.DLL","cryptCheckSignatureEx"


'****************************************************************************
'*                                                                           *
'*                                   Keyset Functions                        *
'*                                                                           *
'****************************************************************************

' Open and close a keyset

'Public Declare Function cryptKeysetOpen Lib "CL32.DLL" ( ByRef keyset As Long, _
' ByVal cryptUser As Long, _
' ByVal keysetType As CRYPT_KEYSET_TYPE, _
' ByVal name As String, _
' ByVal options As CRYPT_KEYOPT_TYPE) As Long
'DEF cryptKeysetOpen(5) !"CL32.DLL","cryptKeysetOpen"

'Public Declare Function cryptKeysetClose Lib "CL32.DLL" ( ByVal keyset As Long) As Long
'DEF cryptKeysetClose(1) !"CL32.DLL","cryptKeysetClose"


' Get a key from a keyset or device

'Public Declare Function cryptGetPublicKey Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByRef cryptContext As Long, _
' ByVal keyIDtype As CRYPT_KEYID_TYPE, _
' ByVal keyID As String) As Long
'DEF cryptGetPublicKey(4) !"CL32.DLL","cryptGetPublicKey"

'Public Declare Function cryptGetPrivateKey Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByRef cryptContext As Long, _
' ByVal keyIDtype As CRYPT_KEYID_TYPE, _
' ByVal keyID As String, _
' ByVal password As String) As Long
'DEF cryptGetPrivateKey(5) !"CL32.DLL","cryptGetPrivateKey"

'Public Declare Function cryptGetKey Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByRef cryptContext As Long, _
' ByVal keyIDtype As CRYPT_KEYID_TYPE, _
' ByVal keyID As String, _
' ByVal password As String) As Long
'DEF cryptGetKey(5) !"CL32.DLL","cryptGetKey"


' Add/delete a key to/from a keyset or device

'Public Declare Function cryptAddPublicKey Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByVal certificate As Long) As Long
'DEF cryptAddPublicKey(2) !"CL32.DLL","cryptAddPublicKey"

'Public Declare Function cryptAddPrivateKey Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByVal cryptKey As Long, _
' ByVal password As String) As Long
'DEF cryptAddPrivateKey(3) !"CL32.DLL","cryptAddPrivateKey"

'Public Declare Function cryptDeleteKey Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByVal keyIDtype As CRYPT_KEYID_TYPE, _
' ByVal keyID As String) As Long
'DEF cryptDeleteKey(3) !"CL32.DLL","cryptDeleteKey"


'****************************************************************************
'*                                                                           *
'*                               Certificate Functions                       *
'*                                                                           *
'****************************************************************************

' Create/destroy a certificate

'Public Declare Function cryptCreateCert Lib "CL32.DLL" ( ByRef certificate As Long, _
' ByVal cryptUser As Long, _
' ByVal certType As CRYPT_CERTTYPE_TYPE) As Long
'DEF cryptCreateCert(3) !"CL32.DLL","cryptCreateCert"

'Public Declare Function cryptDestroyCert Lib "CL32.DLL" ( ByVal certificate As Long) As Long
'DEF cryptDestroyCert(1) !"CL32.DLL","cryptDestroyCert"


'  Get/add/delete certificate extensions.  These are direct data insertion
'  functions whose use is discouraged, so they fix the string at char *
'  rather than C_STR

' ***Warning: function 'cryptGetCertExtension' will modify the String 'extension'
'Public Declare Function cryptGetCertExtension Lib "CL32.DLL" ( ByVal certificate As Long, _
' ByVal oid As String, _
' ByRef criticalFlag As Long, _
' ByVal extension As String, _
' ByVal extensionMaxLength As Long, _
' ByRef extensionLength As Long) As Long
'DEF cryptGetCertExtension(6) !"CL32.DLL","cryptGetCertExtension"

'Public Declare Function cryptAddCertExtension Lib "CL32.DLL" ( ByVal certificate As Long, _
' ByVal oid As String, _
' ByVal criticalFlag As Long, _
' ByVal extension As String, _
' ByVal extensionLength As Long) As Long
'DEF cryptAddCertExtension(5) !"CL32.DLL","cryptAddCertExtension"

'Public Declare Function cryptDeleteCertExtension Lib "CL32.DLL" ( ByVal certificate As Long, _
' ByVal oid As String) As Long
'DEF cryptDeleteCertExtension(2) !"CL32.DLL","cryptDeleteCertExtension"


' Sign/sig.check a certificate/certification request

'Public Declare Function cryptSignCert Lib "CL32.DLL" ( ByVal certificate As Long, _
' ByVal signContext As Long) As Long
'DEF cryptSignCert(2) !"CL32.DLL","cryptSignCert"

'Public Declare Function cryptCheckCert Lib "CL32.DLL" ( ByVal certificate As Long, _
' ByVal sigCheckKey As Long) As Long
'DEF cryptCheckCert(2) !"CL32.DLL","cryptCheckCert"


' Import/export a certificate/certification request

'Public Declare Function cryptImportCert Lib "CL32.DLL" ( ByVal certObject As String, _
' ByVal certObjectLength As Long, _
' ByVal cryptUser As Long, _
' ByRef certificate As Long) As Long
'DEF cryptImportCert(4) !"CL32.DLL","cryptImportCert"

' ***Warning: function 'cryptExportCert' will modify the String 'certObject'
'Public Declare Function cryptExportCert Lib "CL32.DLL" ( ByVal certObject As String, _
' ByVal certObjectMaxLength As Long, _
' ByRef certObjectLength As Long, _
' ByVal certFormatType As CRYPT_CERTFORMAT_TYPE, _
' ByVal certificate As Long) As Long
'DEF cryptExportCert(5) !"CL32.DLL","cryptExportCert"


' CA management functions

'Public Declare Function cryptCAAddItem Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByVal certificate As Long) As Long
'DEF cryptCAAddItem(2) !"CL32.DLL","cryptCAAddItem"

'Public Declare Function cryptCAGetItem Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByRef certificate As Long, _
' ByVal certType As CRYPT_CERTTYPE_TYPE, _
' ByVal keyIDtype As CRYPT_KEYID_TYPE, _
' ByVal keyID As String) As Long
'DEF cryptCAGetItem(5) !"CL32.DLL","cryptCAGetItem"

'Public Declare Function cryptCADeleteItem Lib "CL32.DLL" ( ByVal keyset As Long, _
' ByVal certType As CRYPT_CERTTYPE_TYPE, _
' ByVal keyIDtype As CRYPT_KEYID_TYPE, _
' ByVal keyID As String) As Long
'DEF cryptCADeleteItem(4) !"CL32.DLL","cryptCADeleteItem"

'Public Declare Function cryptCACertManagement Lib "CL32.DLL" ( ByRef certificate As Long, _
' ByVal action As CRYPT_CERTACTION_TYPE, _
' ByVal keyset As Long, _
' ByVal caKey As Long, _
' ByVal certRequest As Long) As Long
'DEF cryptCACertManagement(5) !"CL32.DLL","cryptCACertManagement"


'****************************************************************************
'*                                                                           *
'*                           Envelope and Session Functions                  *
'*                                                                           *
'****************************************************************************

' Create/destroy an envelope

'Public Declare Function cryptCreateEnvelope Lib "CL32.DLL" ( ByRef envelope As Long, _
' ByVal cryptUser As Long, _
' ByVal formatType As CRYPT_FORMAT_TYPE) As Long
'DEF cryptCreateEnvelope(3) !"CL32.DLL","cryptCreateEnvelope"

'Public Declare Function cryptDestroyEnvelope Lib "CL32.DLL" ( ByVal envelope As Long) As Long
'DEF cryptDestroyEnvelope(1) !"CL32.DLL","cryptDestroyEnvelope"


' Create/destroy a session

'Public Declare Function cryptCreateSession Lib "CL32.DLL" ( ByRef session As Long, _
' ByVal cryptUser As Long, _
' ByVal formatType As CRYPT_SESSION_TYPE) As Long
'DEF cryptCreateSession(3) !"CL32.DLL","cryptCreateSession"

'Public Declare Function cryptDestroySession Lib "CL32.DLL" ( ByVal session As Long) As Long
'DEF cryptDestroySession(1) !"CL32.DLL","cryptDestroySession"


' Add/remove data to/from and envelope or session

'Public Declare Function cryptPushData Lib "CL32.DLL" ( ByVal envelope As Long, _
' ByVal buffer As String, _
' ByVal length As Long, _
' ByRef bytesCopied As Long) As Long
'DEF cryptPushData(4) !"CL32.DLL","cryptPushData"

'Public Declare Function cryptFlushData Lib "CL32.DLL" ( ByVal envelope As Long) As Long
'DEF cryptFlushData(1) !"CL32.DLL","cryptFlushData"

' ***Warning: function 'cryptPopData' will modify the String 'buffer'
'Public Declare Function cryptPopData Lib "CL32.DLL" ( ByVal envelope As Long, _
' ByVal buffer As String, _
' ByVal length As Long, _
' ByRef bytesCopied As Long) As Long
'DEF cryptPopData(4) !"CL32.DLL","cryptPopData"


'****************************************************************************
'*                                                                           *
'*                               Device Functions                            *
'*                                                                           *
'****************************************************************************

' Open and close a device

'Public Declare Function cryptDeviceOpen Lib "CL32.DLL" ( ByRef device As Long, _
' ByVal cryptUser As Long, _
' ByVal deviceType As CRYPT_DEVICE_TYPE, _
' ByVal name As String) As Long
'DEF cryptDeviceOpen(4) !"CL32.DLL","cryptDeviceOpen"

'Public Declare Function cryptDeviceClose Lib "CL32.DLL" ( ByVal device As Long) As Long
'DEF cryptDeviceClose(1) !"CL32.DLL","cryptDeviceClose"


' Query a devices capabilities

'Public Declare Function cryptDeviceQueryCapability Lib "CL32.DLL" ( ByVal device As Long, _
' ByVal cryptAlgo As CRYPT_ALGO_TYPE, _
' ByRef cryptQueryInfo As CRYPT_QUERY_INFO) As Long
'DEF cryptDeviceQueryCapability(3) !"CL32.DLL","cryptDeviceQueryCapability"


' Create an encryption context via the device

'Public Declare Function cryptDeviceCreateContext Lib "CL32.DLL" ( ByVal device As Long, _
' ByRef cryptContext As Long, _
' ByVal cryptAlgo As CRYPT_ALGO_TYPE) As Long
'DEF cryptDeviceCreateContext(3) !"CL32.DLL","cryptDeviceCreateContext"


'****************************************************************************
'*                                                                           *
'*                           User Management Functions                       *
'*                                                                           *
'****************************************************************************

' Log on and off (create/destroy a user object)

'Public Declare Function cryptLogin Lib "CL32.DLL" ( ByRef user As Long, _
' ByVal name As String, _
' ByVal password As String) As Long
'DEF cryptLogin(3) !"CL32.DLL","cryptLogin"

'Public Declare Function cryptLogout Lib "CL32.DLL" ( ByVal user As Long) As Long
'DEF cryptLogout(1) !"CL32.DLL","cryptLogout"


'****************************************************************************
'*                                                                           *
'*                           User Interface Functions                        *
'*                                                                           *
'****************************************************************************



'*****************************************************************************
'*                                                                           *
'*                    End of Visual Basic Functions                          *
'*                                                                           *
'****************************************************************************}

PROC cl_HinweisBox
  parameters Text$,art%
  declare erg%
  'art%: 0 oder Parameter nicht angegeben: ganz normale Hinweisbox, die nur mit OK bestätigt werden kann; 1: Programm kann in der Hinweisbox auch abgebrochen werden
  if (%pcount=2) and (art%=1) 'Abbruch-Hinweisbox
     erg%=@messagebox(Text$,"Hinweis",4161) '1+64+0+4096
     case erg%=2: end
  else 'normale Hinweisbox
    @messagebox(Text$,"Hinweis",4160) '0+64+0+4096
  endif
ENDPROC

PROC cl_ExtractFilename 'gibt Dateiname mit Endung ohne Pfad zurück; CAVE: gibt's auch in den PowerDLLs! (duplicate Identifier)
  parameters fn$
  declare erg$,i%
  i%=@len(fn$,"\\")
  if i%>0
    erg$=@substr$(fn$,i%,"\\")
  else
    erg$=fn$
  endif
  return erg$
ENDPROC

PROC cl_ExtractPath 'endet immer mit ´\´, außer dann, wenn im Eingabestring gar kein Pfad enthalten ist (dann erg$=""); heißt in den PowerDLLs ExtractFilePath
  parameters fn$
  declare erg$
  whileloop @len(fn$),1,-1
    if @mid$(fn$,&loop,1)="\\"
      erg$=@left$(fn$,&loop)
      break 'raus, gefunden
    endif
  endwhile
  return erg$
ENDPROC

