Drag&Drop from Outlook (Express) - Possible?

[Derren]

Aaah guys,
first of all thanks for all the effort you already put it.I would have thought it was easier to accomplish.

Sadly it doesn't work (now).

Both codes, Hexor's "re-write" and this code here produce a file that is corrupted and can't be opened by outlook.
The saved .msg file only contains "ÐÏ" nothing more. Size = 2 Bytes

Is there any way to drag and drop the just the meassage? maybe as .msg

Well, this took me all mother-flipping day to get right,

It seems that this is the issue:

Code: Select all

streamsize  = ostats\cbSize

It results in just 2.
If I set streamsize to 99 999, it saves the test file correctly and it can be opened. But of course that's too small for most emails AND it just fills the saved file up with zeros or something.
Dragged from Outlook, my test msg file is 80kb, but with this code, the resulting file is 99.999kb. So I can't just put a very high number there, as the code will then produce huge files, even for a simple test email.

[dige]

Hi guys,

thanks a lot for the Outlook drag-and-drop code.
That's a big step forward in helping me, work better with Outlook.

What I still need is a way to extract the text from the .msg files.
I want to have a better way to search for emails.

Does anyone know of a tool, DLL, etc. that can extract the information as text from the message file?
According to ChatGPT, parsing it yourself with PB is very time-consuming.

Kind regards

Dige

[Axolotl]

Perhaps you should look for a converter for MSG files to TXT files or something similar.
I found this among many other online converters.
https://www.sysinfotools.com/blog/convert-msg-to-txt/

[dige]

The new ChatGPT5 can do it!

Code: Select all

; ================== Safe Stream Reader + ExtractMsgText ==================
EnableExplicit

; --- STGM ---
#STGM_READ             = $00000000
#STGM_SHARE_DENY_WRITE = $00000020
#STGM_SHARE_EXCLUSIVE  = $00000010

; --- MSG-Streams ---
#STREAM_BODY_UNICODE = "__substg1.0_1000001F"
#STREAM_BODY_ANSI    = "__substg1.0_1000001E"
#STREAM_HTML_UNICODE = "__substg1.0_1013001F"
#STREAM_HTML_ANSI    = "__substg1.0_1013001E"
#STREAM_RTF_COMP     = "__substg1.0_10090102"


ImportC "ole32.lib"
  CoInitializeEx(*pvReserved, dwCoInit.l)
  CoUninitialize()
  StgOpenStorage(*pwcsName, pStgPriority, grfMode.l, pSnB, reserved.l, *ppstg.IStorage)
EndImport

; --- Helpers ---
Procedure.i WideAlloc(str.s)
  Protected *p = AllocateMemory((Len(str)+1)*SizeOf(Character))
  If *p
    PokeS(*p, str, -1, #PB_Unicode)
  EndIf
  ProcedureReturn *p
EndProcedure

; *** NEU: sicherer Stream-Reader ohne AllocateMemory(0) ***
Procedure.s ReadAllFromIStream_Safe(*stm.IStream, isUnicode.i, isAnsi.i)
  Protected chunk   = 8192
  Protected *buf    = AllocateMemory(chunk)
  If *buf = 0 : ProcedureReturn "" : EndIf
  
  Protected *mem    = #Null
  Protected total   = 0
  Protected bytesRead.l
  Protected ok      = #True
  
  While ok
    bytesRead = 0
    If *stm\Read(*buf, chunk, @bytesRead) <> 0
      ok = #False : Break
    EndIf
    If bytesRead = 0
      Break
    EndIf
    
    If *mem = #Null
      *mem = AllocateMemory(bytesRead)
      If *mem = 0 : ok = #False : Break : EndIf
      CopyMemory(*buf, *mem, bytesRead)
      total = bytesRead
    Else
      Protected *new = ReAllocateMemory(*mem, total + bytesRead)
      If *new = 0 : ok = #False : Break : EndIf
      *mem = *new
      CopyMemory(*buf, *mem + total, bytesRead)
      total + bytesRead
    EndIf
    
    If bytesRead < chunk
      Break
    EndIf
  Wend
  
  FreeMemory(*buf)
  If ok = #False Or total = 0
    If *mem : FreeMemory(*mem) : EndIf
    ProcedureReturn ""
  EndIf
  
  Protected out.s
  If isUnicode
    out = PeekS(*mem, total/SizeOf(Character), #PB_Unicode)
  ElseIf isAnsi
    out = PeekS(*mem, total, #PB_Ascii)
  Else
    out = "" ; Binär (z.B. RTF-komprimiert)
  EndIf
  
  FreeMemory(*mem)
  ProcedureReturn out
EndProcedure

Procedure.s TryOpenStreamText(*stg.IStorage, name.s, isUnicode.i, isAnsi.i)
  Protected *stm.IStream, txt.s
  Protected *w = WideAlloc(name)
  If *w = 0 : ProcedureReturn "" : EndIf
  
  If *stg\OpenStream(*w, 0, #STGM_READ|#STGM_SHARE_EXCLUSIVE, 0, @*stm) = 0 And *stm
    txt = ReadAllFromIStream_Safe(*stm, isUnicode, isAnsi)
    *stm\Release()
  EndIf
  FreeMemory(*w)
  ProcedureReturn txt
EndProcedure

Procedure.s StripHtml(html.s)
  Protected out.s = html, s, e, pos
  out = ReplaceString(out, Chr(13), " ")
  out = ReplaceString(out, Chr(10), " ")
  While FindString(LCase(out), "<script", 1)
    s = FindString(LCase(out), "<script", 1)
    e = FindString(LCase(out), "</script>", s+1) : If e=0:Break:EndIf
    out = Left(out, s-1) + Mid(out, e+9)
  Wend
  While FindString(LCase(out), "<style", 1)
    s = FindString(LCase(out), "<style", 1)
    e = FindString(LCase(out), "</style>", s+1) : If e=0:Break:EndIf
    out = Left(out, s-1) + Mid(out, e+8)
  Wend
  pos = 1
  While pos
    pos = FindString(out, "<", 1)
    If pos
      e = FindString(out, ">", pos+1) : If e=0:Break:EndIf
      out = Left(out, pos-1) + Mid(out, e+1)
    EndIf
  Wend
  out = ReplaceString(out, "&nbsp;", " ")
  out = ReplaceString(out, "&amp;", "&")
  out = ReplaceString(out, "&lt;", "<")
  out = ReplaceString(out, "&gt;", ">")
  ProcedureReturn Trim(out)
EndProcedure

; ------------------------- API -------------------------
; ExtractMsgText(path$, StripHtmlIfNeeded=#True)
; Gibt bevorzugt Plaintext zurück, sonst (gestripptes) HTML, sonst Hinweis bei RTF-komprimiert.
Procedure.s ExtractMsgText(path.s, StripHtmlIfNeeded.i = #True)
  Protected txt.s, html.s
  Protected *stg.IStorage
  If path = "" Or FileSize(path) <= 0 : ProcedureReturn "" : EndIf
  
  CoInitializeEx(#Null, 0)
  
  Protected *wPath = WideAlloc(path)
  If *wPath = 0 : CoUninitialize() : ProcedureReturn "" : EndIf
  
  If StgOpenStorage(*wPath, #Null, #STGM_READ|#STGM_SHARE_DENY_WRITE, #Null, 0, @*stg) <> 0 Or *stg = 0
    FreeMemory(*wPath) : CoUninitialize() : ProcedureReturn ""
  EndIf
  FreeMemory(*wPath)
  
  ; 1) Plaintext
  txt = TryOpenStreamText(*stg, #STREAM_BODY_UNICODE, #True, #False)
  If txt = ""
    txt = TryOpenStreamText(*stg, #STREAM_BODY_ANSI, #False, #True)
  EndIf
  
  ; 2) HTML-Fallback
  If txt = ""
    html = TryOpenStreamText(*stg, #STREAM_HTML_UNICODE, #True, #False)
    If html = ""
      html = TryOpenStreamText(*stg, #STREAM_HTML_ANSI, #False, #True)
    EndIf
    If html <> ""
      If StripHtmlIfNeeded
        txt = StripHtml(html)
      Else
        txt = html
      EndIf
    EndIf  
  EndIf
  
  ; 3) RTF-komprimiert vorhanden?
  If txt = ""
    If TryOpenStreamText(*stg, #STREAM_RTF_COMP, #False, #False) <> ""
      txt = "[Hinweis] Nur RTF-komprimierter Body gefunden (10090102). " +
            "Für Klartext RTF-Dekompression implementieren."
    EndIf
  EndIf
  
  *stg\Release()
  CoUninitialize()
  ProcedureReturn txt
EndProcedure

; --- Beispiel:
Debug ExtractMsgText("P:\Outlook.msg")