178 lines
9.0 KiB
VB.net
178 lines
9.0 KiB
VB.net
Imports System.IO
|
|
Imports Microsoft.Office.Interop
|
|
|
|
Public Class ClassDragDrop
|
|
Public Shared files_dropped As String()
|
|
Public Shared Function Drop_File(e As DragEventArgs)
|
|
Try
|
|
ClassLogger.Add(">> Drop_File", False)
|
|
files_dropped = Nothing
|
|
Dim oApp As New Outlook.Application
|
|
Dim sql As String = "DELETE FROM TBPMO_FILES_USER WHERE UPPER(USER_WORK) = UPPER('" & Environment.UserName & "')"
|
|
ClassDatabase.Execute_non_Query(sql)
|
|
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
|
|
If LogErrorsOnly = False Then ClassLogger.Add(">> DataFormats.FileDrop", False)
|
|
Dim MyFiles() As String
|
|
Dim i As Integer
|
|
' Assign the files to an array.
|
|
MyFiles = e.Data.GetData(DataFormats.FileDrop)
|
|
' Loop through the array and add the files to the list.
|
|
For i = 0 To MyFiles.Length - 1
|
|
|
|
ReDim Preserve files_dropped(i)
|
|
files_dropped(i) = "@DROPFROMFSYSTEM@" & MyFiles(i)
|
|
' ListBox1.Items.Add(MyFiles(i))
|
|
Next
|
|
Return files_dropped
|
|
ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
|
|
If LogErrorsOnly = False Then ClassLogger.Add(">> Drop of OutlookMessage", False)
|
|
'supports a drop of a Outlook message
|
|
Dim myobj As Object
|
|
|
|
For i As Integer = 1 To oApp.ActiveExplorer.Selection.Count
|
|
myobj = oApp.ActiveExplorer.Selection.Item(i)
|
|
|
|
'hardcode a destination path for testing
|
|
Dim strFile As String = IO.Path.Combine(Path.GetTempPath, (myobj.Subject + ".msg").Replace(":", ""))
|
|
myobj.SaveAs(strFile)
|
|
ReDim Preserve files_dropped(i)
|
|
files_dropped(i) = "@OUTLOOKMESSAGE@" & strFile
|
|
|
|
Next
|
|
Return files_dropped
|
|
ElseIf e.Data.GetDataPresent("aryFileGroupDescriptor") AndAlso (e.Data.GetDataPresent("FileContents")) Then
|
|
If LogErrorsOnly = False Then ClassLogger.Add(">> FileGroupDescriptor/FileContents", False)
|
|
'// the first step here is to get the stbFileName
|
|
'// of the attachment and
|
|
'// build a full-path name so we can store it
|
|
'// in the temporary folder
|
|
'//
|
|
'// set up to obtain the aryFileGroupDescriptor
|
|
'// and extract the file name
|
|
Dim stmInput As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream)
|
|
Dim aryFileGroupDescriptor(512) As Byte ' = new byte[512]
|
|
stmInput.Read(aryFileGroupDescriptor, 0, 512)
|
|
'// used to build the stbFileName from the aryFileGroupDescriptor block
|
|
Dim stbFileName As System.Text.StringBuilder = New System.Text.StringBuilder("")
|
|
'// this trick gets the stbFileName of the passed attached file
|
|
Dim intCnt As Integer = 76
|
|
Do While aryFileGroupDescriptor(intCnt) <> 0
|
|
stbFileName.Append(Convert.ToChar(aryFileGroupDescriptor(intCnt), System.Globalization.CultureInfo.CreateSpecificCulture("de-DE")))
|
|
intCnt += 1
|
|
Loop
|
|
stmInput.Close()
|
|
|
|
Dim anhaenge = e.Data.GetDataPresent("FileContents")
|
|
'Dim path As String = "C:\VBProjekte\Dateien"
|
|
'// put the zip file into the temp directory
|
|
Dim strOutFile As String = Path.GetTempPath() & stbFileName.ToString()
|
|
'// create the full-path name
|
|
'//
|
|
'// Second step: we have the file name.
|
|
'// Now we need to get the actual raw
|
|
'// data for the attached file and copy it to disk so we work on it.
|
|
'//
|
|
'// get the actual raw file into memory
|
|
Dim msInput As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream) 'This returns nothing for an Email
|
|
If msInput Is Nothing = False Then
|
|
'// allocate enough bytes to hold the raw date
|
|
Dim aryFileBytes(CType(msInput.Length, Int32)) As Byte
|
|
'// set starting position at first byte and read in the raw data
|
|
msInput.Position = 0
|
|
msInput.Read(aryFileBytes, 0, CType(msInput.Length, Int32))
|
|
'// create a file and save the raw zip file to it
|
|
Dim fsOutput As IO.FileStream = New IO.FileStream(strOutFile, IO.FileMode.Create) ';
|
|
fsOutput.Write(aryFileBytes, 0, aryFileBytes.Length)
|
|
fsOutput.Close() ' // close the file
|
|
|
|
Dim finTemp As IO.FileInfo = New IO.FileInfo(strOutFile)
|
|
'// always good to make sure we actually created the file
|
|
If (finTemp.Exists = True) Then
|
|
'MsgBox("Attachment File from Outlook created:" & vbNewLine & strOutFile)
|
|
' lblFile.Text += "Attachment File from Outlook created" + Environment.NewLine
|
|
ReDim Preserve files_dropped(0)
|
|
files_dropped(0) = "@OUTLOOK_ATTMNT@" & strOutFile
|
|
If LogErrorsOnly = False Then ClassLogger.Add(">> Drop an Attachment - File: " & strOutFile, False)
|
|
Return files_dropped
|
|
Else
|
|
ClassLogger.Add(">> Attachment File from Outlook could not be created", False)
|
|
'lblFile.Text += "Attachment File from Outlook could not be created" + Environment.NewLine
|
|
End If
|
|
End If
|
|
Else
|
|
'otherwise, do not handle
|
|
e.Effect = DragDropEffects.None
|
|
frmForm_Constructor_OLD.tsstatus_Detail_show(True, "DragEnter ... Other FileFormat")
|
|
If LogErrorsOnly = True Then ClassLogger.Add("DragEnter ... Other FileFormat", False)
|
|
End If
|
|
|
|
|
|
|
|
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
|
|
|
|
'Drop eines Outlook Attachments
|
|
ElseIf (e.Data.GetDataPresent("FileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then
|
|
|
|
ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
|
|
|
|
End If
|
|
|
|
|
|
Catch ex As Exception
|
|
MsgBox("Error in Drop_File: " & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
|
|
|
|
'Else
|
|
' Dim files() As String = e.Data.GetData(DataFormats.FileDrop)
|
|
' Dim filestype() As String
|
|
|
|
' filestype = e.Data.GetData(DataFormats.CommaSeparatedValue)
|
|
' Dim sReader As New StreamReader(filestype(0))
|
|
' 'get the filename from the file without the path
|
|
' Dim file_name As String = Path.GetFileName(filestype(0))
|
|
|
|
' 'check the extension of the file
|
|
' If Path.GetExtension(filestype(0)).ToLower() = ".xml" Then
|
|
' 'Read the xml file
|
|
' For Each path In files
|
|
' 'ReadXMLFile(path)
|
|
' Next
|
|
' Else
|
|
' 'warning about the file type
|
|
' MessageBox.Show("Only XML files are supported!", "Warning!", _
|
|
'MessageBoxButtons.OK, _
|
|
' MessageBoxIcon.Warning)
|
|
' End If
|
|
'End If
|
|
|
|
End Function
|
|
Public Shared Sub Drag_enter(e As DragEventArgs)
|
|
Try
|
|
|
|
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
|
|
e.Effect = DragDropEffects.All
|
|
If LogErrorsOnly = True Then ClassLogger.Add("DragEnter ... SimpleFileDrop", False)
|
|
frmForm_Constructor_OLD.tslblStatusMain_show(True, "DragEnter ... SimpleFileDrop")
|
|
ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
|
|
'handle a message dragged from Outlook
|
|
e.Effect = DragDropEffects.Copy
|
|
frmForm_Constructor_OLD.tslblStatusMain_show(True, "DragEnter ... OutlookMessage")
|
|
If LogErrorsOnly = True Then ClassLogger.Add("DragEnter ... OutlookMessage", False)
|
|
ElseIf e.Data.GetDataPresent("aryFileGroupDescriptor") AndAlso (e.Data.GetDataPresent("FileContents")) Then
|
|
e.Effect = DragDropEffects.Copy
|
|
frmForm_Constructor_OLD.tslblStatusMain_show(True, "DragEnter ... Attachment from Outlook")
|
|
If LogErrorsOnly = True Then frmForm_Constructor_OLD.tsstatus_Detail_show(True, "DragEnter ... Attachment from Outlook")
|
|
Else
|
|
'otherwise, do not handle
|
|
e.Effect = DragDropEffects.None
|
|
frmForm_Constructor_OLD.tslblStatusMain_show(True, "DragEnter ... Other FileFormat")
|
|
If LogErrorsOnly = True Then ClassLogger.Add("DragEnter ... Other FileFormat", False)
|
|
End If
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
End Sub
|
|
End Class
|